代码之家 › 专栏 › 技术社区 › phalteman Andryas Waurzenczak

访问r shining中动态生成的输入

shiny r

1

phalteman Andryas Waurzenczak · 技术社区 · 7 年前

我有一个应用程序,用户需要将随机生成的元素(在本例中是字母)分配给组,但要决定使用多少组。因为 selectInput 在定义成员身份时,会根据用户指定的数字动态生成成员身份,并自动对菜单进行命名(例如, usergroup1 , usergroup2 等)。我无法访问输入值并将其从模块返回以供以后使用,因为我无法提前知道将有多少输入,因此也无法知道有多少输入 usergroups 打电话。以下是一个示例应用程序:

用户界面模块:

library(shiny) 
library(stringr)

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"))
  )
}

我在这里想做的是列出 usergroup 名称并返回这些值,但没有附加值,因此没有任何内容。

服务器模块:

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(gps=NULL)

  reactive({
    gps$gps <- lapply(1:input$groups, function(i) { paste0(session$ns("usergroup"),i) })
  })

  return(list(dat = reactive({x$data}),
              groups = reactive({gps$gps})
  ))
}

用户界面:

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

服务器:

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

shinyApp(ui, server)

非常感谢您的帮助!

1 回复 | 直到 7 年前

1

0

phalteman Andryas Waurzenczak 7 年前

这个解决方案模仿了其他两个这样的问题,即 this one .

关键是要创建一个 reactiveValues 对象,然后使用 [[i]] . 在我的例子中,使用提交按钮来触发它有帮助。

完整,工作代码如下:

用户界面模块:

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")
  )
}

服务器模块:

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 <- navbarPage("Fancy Title",id = "tabs",
          tabPanel("Panel1",
              sidebarPanel(
                  mod1UI("input1")
              ),
              mainPanel(verbatimTextOutput("lettersy")
              )
          )
)

服务器:

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

shinyApp(ui, server)