Reputation: 897
I have a shiny code that creates a formula box and when user clicks on the button it adds them to the text area and updates the formula and text area as below:
library(shiny)
library(shinyWidgets)
# Sample data frame for testing
DataFrame <- data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10))
response <- c("A")
initial_covariates <- c("PART1", "PART2")
secondary_covariates<- c("G")
# Define UI
ui <- fluidPage(
sidebarPanel(
uiOutput("formulaM") # Dynamically generated UI
),
mainPanel(
textOutput("formulaOutput") # Displaying the current formula for debugging
)
)
# Define server logic
server <- function(input, output, session) {
output$formulaM <- renderUI({
# Columns available to the user, excluding TargetNames
col_names <- setdiff(names(DataFrame), response)
# Create buttons for each variable
ctrl <- lapply(seq_along(col_names), function(x) {
actionButton(paste0('varBtn', x), col_names[[x]], size = 'xs')
})
# Initial formula value
formula_initial_value <- paste(c(initial_covariates, secondary_covariates), collapse = " + ")
ctrl <- append(ctrl, list(
br(),
textAreaInput('formula', '', value = formula_initial_value, width = '100%')
))
# Create observeEvent for each button
lapply(seq_along(col_names), function(x) {
observeEvent(input[[paste0('varBtn', x)]], {
new_value <- paste0(input[['formula']], ' + ', col_names[[x]])
updateTextAreaInput(session, 'formula', value = new_value)
})
})
return(ctrl)
})
# Debugging: Display the current formula
output$formulaOutput <- renderText({
input[["formula"]]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Since I want to have the formula box in multiple places in my app, then I decided to make it module and I did this: library(shiny)
# Sample data frame for testing
DataFrame <- data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10))
response <- c("A")
initial_covariates <- c("PART1", "PART2")
secondary_covariates <- c("G")
# UI MODULE
formulaModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns('constructedFormula'))
}
# SERVER MODULE
formulaModuleServer <- function(id, data_frame, response_variables, initial_covariates, secondary_covariates) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$constructedFormula <- renderUI({
# Columns available to the user, excluding response variable
col_names <- setdiff(names(data_frame), response_variables)
# Create buttons for each variable
ctrl <- lapply(seq_along(col_names), function(x) {
actionButton(ns(paste0('varBtn', x)), col_names[[x]], size = 'xs')
})
# Initial formula value
formula_initial_value <- paste(c(initial_covariates, secondary_covariates), collapse = " + ")
ctrl <- append(ctrl, list(
br(),
textAreaInput(ns('formula'), '', value = formula_initial_value, width = '100%')
))
# Create observeEvent for each button
lapply(seq_along(col_names), function(x) {
observeEvent(input[[ns(paste0('varBtn', x))]], {
new_value <- paste0(input[[ns('formula')]], ' + ', col_names[[x]])
updateTextAreaInput(session, ns('formula'), value = new_value)
})
})
return(ctrl)
})
})
}
# Define UI
ui <- fluidPage(
sidebarPanel(
formulaModuleUI("formulaModule") # UI call for the module
),
mainPanel(
textOutput("formulaOutput") # Debugging output for the current formula
)
)
# Define server logic
server <- function(input, output, session) {
# Call the formula module server function
formulaModuleServer("formulaModule", DataFrame, response, initial_covariates, secondary_covariates)
# Optional: To display the current formula for debugging
output$formulaOutput <- renderText({
input[["formulaModule-formula"]]
})
}
# Run the application
shinyApp(ui = ui, server = server)
However, this time when I click on the button on top of the text area it no longer updates the text area and formula. how to fix the issue?
Upvotes: 0
Views: 39
Reputation: 21287
You don't need an observer inside a renderUI
, and you had ns
in a couple of extra places. Try this
# Sample data frame for testing
DataFrame <- data.frame(A = rnorm(10), B = rnorm(10), C = rnorm(10))
response <- c("A")
initial_covariates <- c("PART1", "PART2")
secondary_covariates <- c("G")
# UI MODULE
formulaModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns('constructedFormula'))
}
# SERVER MODULE
formulaModuleServer <- function(id, parent_session, data_frame, response_variables, initial_covariates, secondary_covariates) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
# Columns available to the user, excluding response variable
col_names <- setdiff(names(data_frame), response_variables)
output$constructedFormula <- renderUI({
# Create buttons for each variable
ctrl <- lapply(seq_along(col_names), function(x) {
actionButton(ns(paste0('varBtn', x)), col_names[[x]], size = 'xs')
})
# Initial formula value
formula_initial_value <- paste(c(initial_covariates, secondary_covariates), collapse = " + ")
ctrl <- append(ctrl, list(
br(),
textAreaInput(ns('formula'), '', value = formula_initial_value, width = '100%')
))
return(ctrl)
})
# Create observeEvent for each button
lapply(seq_along(col_names), function(x) {
observeEvent(input[[paste0('varBtn', x)]], {
new_value <- paste0(input[['formula']], ' + ', col_names[[x]])
updateTextAreaInput(session, 'formula', value = new_value)
})
})
})
}
# Define UI
ui <- fluidPage(
sidebarPanel(
formulaModuleUI("formulaModule") # UI call for the module
),
mainPanel(
textOutput("formulaOutput") # Debugging output for the current formula
)
)
# Define server logic
server <- function(input, output, session) {
# Call the formula module server function
formulaModuleServer("formulaModule", session, DataFrame, response, initial_covariates, secondary_covariates)
# Optional: To display the current formula for debugging
output$formulaOutput <- renderText({
input[["formulaModule-formula"]]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Upvotes: 1