在命名列表中组合多个checkboxInput和checkboxgroupinput选择

时间:2019-02-15 12:14:56

标签: r list checkbox shiny

我正在为我的应用程序构建一个部分,我正在努力创建所需的输出。

我的“频道”有: n checkboxInput个 然后每个通道(相同组)的 i checkboxGroupInput个参数 和 j checkboxGroupInput个计算为每个ChannelxParameter组合选择。

我故意不落伍,所以我选择不允许用户为每个通道*参数组合选择不同的统计信息。

我希望得到的output是反应性的 named list
 1.其中名称是频道和参数input的组合名称:即paste('Channel','Parameter')
 2.“值”是所选统计数据/计算的文本字符串
 3. list仅应包含所选通道的名称。参数组合
 4.如果用户取消选择统计信息,参数或渠道,则从list中删除list元素或值

app单元如下所示: screeenshot

在这种情况下,预期的output将是这样的list

$SWS.Height
[1] "Sum" "Max"

$SWS.Total
[1] "Sum" "Max"

$FL.Red.Height
[1] "Mean"  "Stdev"

$FL.Red.Width
[1] "Mean"  "Stdev"

App:到目前为止,只有print个所选内容

library(shiny)
Channels <- c('SWS', 'FWS', 'FL.Red', 'FL.Orange', 'FL.Yellow')
Parameters <- c('Height', 'Width', 'Average', 'Total', 'Slope', 'Fill.Factor', 'Correlation.Coeff', 'Fill.Factor')
ui <- fluidPage(

  h5('Channels', style = 'font-weight:bold'),
  fluidRow(
    lapply(Channels, function(x) {
            column(2, checkboxInput(inputId = paste('Channel', x, sep = ''), label = x))
    })
 ),
 h5('Parameters', style = 'font-weight:bold'),
  fluidRow(
  lapply(Channels, function(x) {
    column(2, 
           checkboxGroupInput(inputId = paste("Parameters", x, sep = ''), label = NULL, choiceValues =Parameters, 
                              choiceNames = gsub('\\.', '\\ ', Parameters)) )})
  ),
 h5('Statistics', style = 'font-weight:bold'),

 fluidRow(
   lapply(Channels, function(x) {
     column(2, 
  checkboxGroupInput(paste("Calculations", x, sep = ''), label = NULL, c('Sum', 'Mean', 'Stdev', 'Max', 'Coef.Var'))
 )
   })
 )
)


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

  values <- reactiveValues(Statisticlist = list())
## build observer to deselect all sub category checkboxes if channel is deselected
  lapply(Channels, function(x) {
    observeEvent(input[[paste('Channel', x, sep = '')]], { 
                 if(!input[[paste('Channel', x, sep = '')]]) { 
                  updateCheckboxGroupInput(session, inputId = paste("Parameters", x, sep = ''), selected=character(0))
                  updateCheckboxGroupInput(session, inputId = paste("Calculations", x, sep = ''), selected=character(0))

                  }
              })
  })

   ## attempt to fill named list with selection, and remove it when deselected 
  observe({ 
    lapply(Channels, function(x) {
     if(input[[paste('Channel', x, sep = '')]]) {
       if(!is.null(input[[paste("Parameters", x, sep = '')]])) {
         if(!is.null(input[[paste("Calculations", x, sep = '')]])) {
      print(paste(x, input[[paste("Parameters", x, sep = '')]], sep = '.'))
       print(input[[paste("Calculations", x, sep = '')]])

       # values$Statisticlist <- list(paste(x, input[[paste("Parameters", x, sep = '')]], sep = '.') = input[[paste("Calculations", x, sep = '')]])  ## what to do here....
         }
       }
     }
    })
  })
}

shinyApp(ui, server)

1 个答案:

答案 0 :(得分:0)

我想出了一个解决方案,它的“不那么好的”部分是,它可以根据任何更改有效地重建整个列表。如果有人知道更干净的方法,请随时发布。

我完成的方式是:

  lapply(Channels, function(x) {
    observe({ 
      if(input[[paste('Channel', x, sep = '')]] & !is.null(input[[paste("Parameters", x, sep = '')]]) & !is.null(input[[paste("Calculations", x, sep = '')]])){
        lapply(input[[paste("Parameters", x, sep = '')]], function(y) { values$Statisticlist[[paste(x, y, sep = '.')]] <- input[[paste("Calculations", x, sep = "")]]
        })
        }
    })
  })

我们遍历所有主要的checkboxInput:“渠道”

然后如果选择了频道:if(input[[paste('Channel', x, sep = '')]])

结合了至少1个所选参数:!is.null(input[[paste("Parameters", x, sep = '')]])

并选择至少1个计算:!is.null(input[[paste("Calculations", x, sep = '')]]

然后遍历所有选定的参数lapply(input[[paste("Parameters", x, sep = '')]], function(y) {

并将所选计算分配给列表paste(x,y,sep= '.')的元素values$Statisticlistinput[[paste("Calculations", x, sep = "")]]

每次复选框的所有集合发生任何更改时,这基本上都会重建整个列表,因此也可以“ 丢弃”取消选择的项目

P.S。我不确定该怎么做,但是由于复选框的数量相对较少,我认为这不会在速度方面造成问题。