Объединить несколько вариантов checkboxInput и checkboxgroupinput в именованном списке

Question

Я создаю раздел для своего приложения и изо всех сил пытаюсь создать желаемый результат.

У меня есть: n checkboxInput с для моих «каналов», затем i checkboxGroupInput с параметрами для каждого канала (идентичные наборы) и j checkboxGroupInput s вычислений для выбора для каждой комбинации ChannelxParameter.

Я сознательно не пошел за борт, поэтому я решил не разрешать пользователю выбирать другую статистику для каждого канала * Комбинация параметров.

Что я хотел бы получить как реактивный output это named list:
1. где имена - это объединенные имена input каналов иПараметры: ie paste ('Channel', 'Parameter')
2. "значения" - это текстовые строки выбранной статистики / вычислений
3. * list должен содержать только имена выбранной комбинации channel.parameter
4. Удалите элемент или значение list из list, если пользователь отменяет выбор статистики, параметра или канала

Единица app выглядит следующим образом:

В этом случае ожидаемый 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 s, что выбрано

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)

Answer 1

Я придумала решение, которое НЕ ТАК НИЧЕГО, что оно эффективно перестраивает весь список при ЛЮБОМ изменении.Если кто-то знает более чистый способ, не стесняйтесь опубликовать его.

Я сделал это так:

  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 s: «Каналы»

, тогда, если выбран канал: 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$Statisticlist выбранные вычисления: input[[paste("Calculations", x, sep = "")]]

Это в основном перестраивает весь список каждый раз, когда происходят какие-либо изменения во всей коллекциииз флажков , и, таким образом, также " drop " не выбранных элементов

PS Я не уверен, как еще сделать это, но так как количество флажков относительномаленький Я не думаю, что это вызовет проблемы с точки зрения скорости.