Abbas
Abbas

Reputation: 897

R Shiny module not reacting/updating after clicking

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

Answers (1)

YBS
YBS

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

Related Questions