3
votes

I have created a toy example in which a textInput() box pops up for the user to input any string, and by clicking the add button, a selectInput() box pops up with the letters a:d prepended with the string. In other words, if the user inputs "1", then by clicking the "add" button, a selectInput() box pops up with 1a, 1b, 1c, and 1d as choices. I am using a module for the add/remove button functionality, and that module calls another module to generate the selectInput() box. The main server function calls the add/remove module, which calls the "first" module, which generates the selectInput() box. I pass a() as a reactive element to add/remove module, which in turn passes this on to "first" module. I just used "..." in the function signature of both the add/remove module and the "first" module to get a() to the nested module.

This seems to work, although a() seems to not be reactive by the time it gets to "first" module, meaning that if I type a different string in the "a" box, I would expect that the choices in the selectInput() box to change dynamically, or at least when I change the textInput() string and click "add", the new selectInput() should reflect the updated textInput() string, but this does not happen. What will make the selectInput() choices change dynamically with changes to textInput()? Code below, thanks!

library(shiny)

firstUI <- function(id) { uiOutput(NS(id, "first")) }

firstServer <- function(input, output, session, a) {

    output$first <- renderUI({
        selectInput(session$ns("select"), h4("Select"), paste0(a,letters[1:4]))
    })
}

removeFirstUI <- function(id) {
    removeUI(selector = paste0('#', NS(id, "first")))
}

addRmBtnUI <- function(id) {
    ns <- NS(id)

    tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )
}

addRmBtnServer <- function(input, output, session, moduleToReplicate,...) {
    ns = session$ns

    params <- reactiveValues(btn = 0)

    observeEvent(input$insertParamBtn, {
        params$btn <- params$btn + 1

        callModule(moduleToReplicate$server, id = params$btn, ...)
        insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
    })

    observeEvent(input$removeParamBtn, {
        moduleToReplicate$remover(ns(params$btn))
        params$btn <- params$btn - 1
    })
}

ui <- fluidPage(
          addRmBtnUI("addRm"),
          textInput("a", label = "a", value = 1, width = '150px') )

server <- function(input, output, session) {


    a <- reactive({ input$a })
    callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ), a = a()
  )
}

shinyApp(ui = ui, server = server)
2
Assuming i've inferred correctly here, @Sean does my approach solve your purpose ? - parth

2 Answers

7
votes

If you have

a <- reactive({input$a})

you need to pass a down to the inner (first) module, not a(). That is because a() represents the current value of the observable object a. This means a() is not observable. In your code, a() is evaluated in the server scope during startup. At that time, a has the value 1 (the default value defined in the corresponding textInput) and you pass it as a static object.

You can learn more about reactive values here.

library(shiny)

firstUI <- function(id) { uiOutput(NS(id, "first")) }

firstServer <- function(input, output, session, a) {

  output$first <- renderUI({
    selectInput(session$ns("select"), h4("Select"), paste0(isolate(a()),letters[1:4]))
  })
}

removeFirstUI <- function(id) {
  removeUI(selector = paste0('#', NS(id, "first")))
}

addRmBtnUI <- function(id) {
  ns <- NS(id)

  tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )
}

addRmBtnServer <- function(input, output, session, moduleToReplicate,...) {
  ns = session$ns

  params <- reactiveValues(btn = 0)

  observeEvent(input$insertParamBtn, {
    params$btn <- params$btn + 1

    callModule(moduleToReplicate$server, id = params$btn, ...)
    insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
  })

  observeEvent(input$removeParamBtn, {
    moduleToReplicate$remover(ns(params$btn))
    params$btn <- params$btn - 1
  })
}

ui <- fluidPage(
  addRmBtnUI("addRm"),
  textInput("a", label = "a", value = 1, width = '150px') )

server <- function(input, output, session) {


  a <- reactive({ input$a })
  callModule(
    addRmBtnServer, id = "addRm",
    moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
    ), 
    a = a
  )
}

shinyApp(ui = ui, server = server)
1
votes

Based on the example here, i've tweaked a little for the desired output.

app.R

library(shiny)

ui <- fluidPage( 
  actionButton('insertBtn', 'Insert'), 
  actionButton('removeBtn', 'Remove'), 
  tags$div(id = 'placeholder'),
  textInput(inputId = "a", label = "a", value = 1, width = '150px')
)

server <- function(input, output) {

  ## keep track of elements inserted and not yet removed
  inserted <- c()

  observeEvent(input$insertBtn, {
    btn <- input$a
    id <- paste0('txt', btn)
    insertUI(
      selector = '#placeholder',
      ## wrap element in a div with id for ease of removal
      ui = tags$div(
        selectInput(inputId = btn,label = btn,choices = paste(btn,letters[1:4])), 
        id = id
      )
    )
    inserted <<- c(id, inserted)
  })

  observeEvent(input$removeBtn, {
    removeUI(
      ## pass in appropriate div id
      selector = paste0('#', inserted[length(inserted)])
    )
    inserted <<- inserted[-length(inserted)]
  })

}

shinyApp(ui = ui, server = server)

This results in app like : snap1

As observed, the selectInputs are added based on a.