Access a dynamically generated input in r shiny

前端 未结 1 592
挽巷
挽巷 2021-01-15 15:27

I have an app where the user needs to assign randomly generated elements (in this case, letters) to groups, but gets to decide how many groups to use. Because the sele

1条回答
  •  -上瘾入骨i
    2021-01-15 15:51

    This solution mimics a couple others found on SO, namely this one.

    The key is to create a reactiveValues object and then assign the values using [[i]]. In my case it helped to use a submit button to trigger that.

    Complete, working code is as follows:

    UI module:

    library(shiny)
    mod1UI <- function(id) {
      ns <- NS(id)
      tagList(
        numericInput(ns("n"), "N",value = NULL),
        actionButton(ns("draw"),"Generate Letters"),
        hr(),
        numericInput(ns("groups"), "Enter number of groups (1-3)", value=NULL),
        uiOutput(ns("groupings")),
        actionButton(ns("submit"), "Submit Groupings")
      )
    }
    

    Server Module:

    mod1 <- function(input, output, session, data) {
      ns <- session$ns
      x <- reactiveValues(data=NULL)
    
      observeEvent(input$draw, {
        req(input$n)
        x$data <- sample(letters,input$n)
      })
    
      output$groupings <- renderUI({
        req(input$groups)
        ltrs <- data()
        lapply(1:input$groups, function(i) {
          selectizeInput(paste0(session$ns("usergroup"),i), 
                         paste0("Select letters for Group ", i),
                         choices = ltrs, 
                         options = list(placeholder = "Select letters for this group", 
                                    onInitialize = I('function() { this.setValue(""); }')), multiple=T)
        })
      })
    
      gps <- reactiveValues(x=NULL)
      observeEvent(input$submit, {
        lapply(1:input$groups, function(i) {
          gps$x[[i]] <- input[[paste0("usergroup", i)]]
        })
      })
    
      test <- session$ns("test")
    
      return(list(dat = reactive({x$data}),
                  groups = reactive({gps$x})
      ))
    }
    

    UI:

    ui <- navbarPage("Fancy Title",id = "tabs",
              tabPanel("Panel1",
                  sidebarPanel(
                      mod1UI("input1")
                  ),
                  mainPanel(verbatimTextOutput("lettersy")
                  )
              )
    )
    

    Server:

    server <- function(input, output, session) {
      y <- callModule(mod1, "input1", data=y$dat)
      output$lettersy <- renderText({
        as.character(c(y$groups()))
      })
    }
    
    shinyApp(ui, server)
    

    0 讨论(0)
提交回复
热议问题