嵌套模块中输入的反应性

Question

我正在尝试使用 n=4 个不同的 tabPanel 做一个闪亮的应用程序 (NavbarPage)。所有面板都将具有（几乎）相同的结构，因此我决定为此使用模块。为了使代码可重用于其他应用程序，我将所有变量放入 global.R.

我的问题： 我想在每个站点的顶部都有一个选项面板。每个 tabPanel 有些选项是相同的，有些是不同的。在我的“optionServer”模块中，我想将所有输入存储到全局 reactiveValues 变量“optionSel”中。实际上，很容易通过 renderPrint() 访问输入变量[意味着它不应该是打字错误]，但我找不到将输入值存储为响应式(input$...)等等。

请查看我的代码，非常感谢您的帮助

#global.R

library(shiny)
source('module/functmodul.R')


    label<-c("Label1", "Label2","Label3", "Label4")
    tabs<-c("tab1","tab2","tab3", "tab4")
    
    optionset<-list(c('opt11'=1,'opt12'=2,'opt13'=3),
      c('opt21'=1,'opt22'=2,'opt23'=3),
      c(TRUE,FALSE),
      c('opt41'=1, 'opt42'=2, 'opt43'=3,'opt44'=4))
    option<-data.frame('id'=c('id11', 'id12','id13', 'id14'),
                       'label'=c("choice1: ", "choice2: ", "choice3", "choice4"), 
                       'defval'=c(1,1,FALSE,1))
    #checkboxGroupInput=1,radioButtons=2,checkboxInput=3
    opttab<-data.frame(
      c(1,2,3,0),
      c(2,0,0,0),
      c(0,0,0,0),
      c(0,0,0,1)
    )
    optionSel<-reactiveValues()

#ui.R

shinyUI(
    do.call(navbarPage,
            c(
            title = 'test',
            lapply(
                  1:length(tabs),
                  function(i) {
                      tabPanel(
                          label[i], id=tabs[i],
                          fluidRow(
                              column(h4(label[i]),width=9),
                              column(img(src="logo.jpg", height="100pt", style=""), width=3)),
                          optionUI(i),
                          detailUI(i)
                      )
                  }
              )
            )
    )
)

#server.R

shinyServer(function(input, output) {
  lapply(
    1:length(tabs),
    function(i){
      optionServer(i)
      detailServer(i)
    }
  )
})

模块代码module/functmodul.R

optionUI <- function(id) {
  ns <- NS(id)
  a<-as.integer(id)
  tagList(
    verbatimTextOutput(ns('testfx1')),
    lapply(1:nrow(option),function(d){ 
        getInput(a,d)
      })
  )
}

getInput<-function(id,d){
  ns<-NS(id)
  c<-opttab[id][,1][d] # c bestimmt die Art des Inputfelds (checkboxGroupI, radioButtons oder checkboxInput)
  switch(c,
         '1' = {checkboxGroupInput(ns(option$id[d]), option$label[d], optionset[[d]], selected = c(option$defval[d]), inline = TRUE)},
         '2' = {radioButtons(ns(option$id[d]), option$label[d], optionset[[d]], selected=option$defval[d], inline=TRUE)},
         '3' = {checkboxInput(ns(option$id[d]), option$label[d])},
         default = {}
  )
}

optionServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      for(z in 1:nrow(option)){
        c<-opttab[id][,1][z] 
       if (c!=0){
          optionSel[[paste0(option$id[z],tabs[id])]]<<-reactive({input[[option$id[z]]]})  #not working        
       }
      }
      output$testfx1<-renderPrint(input[[option$id[1]]]) #working
    }
  )    
}

detailUI<-function(id){
  ns <- NS(id)
  tagList(
    verbatimTextOutput(ns('testfx2'))
  )
}

detailServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      output$testfx2<-renderPrint(optionSel[[paste0(option$id[z],tabs[id])]]) #not working
    }
  )    
}

Answer 1

如果有人感兴趣，我找到了一个解决方案，即使它看起来不是很优雅，也可以让程序正常工作。

我改变了 module/functmodul.R // optionServer 如下

 optionServer <- function(id) {
      moduleServer(
        id,
        function(input, output, session) {
          a<-as.numeric(id)
          opt1<-reactive({input[[option$id[1]]]})
          opt2<-reactive({input[[option$id[2]]]})
          opt3<-reactive({input[[option$id[3]]]})
          opt4<-reactive({input[[option$id[4]]]})
          return(
            list(
              opt1,
              opt2,
              opt3,
              opt4
            )
          )
        }
      )    
    }

然后我进入了 Server.R

optionSel<-optionServer(i) 

而不仅仅是函数调用... 所以我可以在 server.R 中使用 optionSel[[1]], optionSel[[2]],...,optionSel[[5]] 来调用返回值