r - 在 R shiny 中，如果我们有 3 个级别的列表，如何自动或基于函数 tabPanel？

Question

我需要创建有条件的 3 级选项卡，第一级或 tabPanel 包括三个选项卡“坚果”、“糖果”、“饮料”所以

level1<-list(DRINKS,SWEETS,NUTS)

二级或以一级为条件例如，选择 DRINKS 后，将是果汁、能量饮料、热饮第三个级别是在选择能量饮料到“powerhorse”、“redbull”之后

试过代码但不工作是这个

列表-------------------------------------------- ----------------------

library(shiny)
library(reshape2)
library(dplyr)

hotdrinks<-list('hotdrinks'=list("tea","green tea")) 
juices<-list('juices'=list("orange","mango") )
energydrinks<-list('energydrinks'=list("powerhorse","redbull")) 
drinks<-list('drinks'=list(hotdrinks,juices,energydrinks))
biscuits<-list('bisc'=list("loacker","tuc"))
choc<-list('choc'=list("aftereight","lindt") )
gum<-list('gum'=list("trident","clortes") )
sweets<-list('sweets'=list(gum,juices,energydrinks))

almonds<-list('almonds'=list("salted","roasted") )
pistcio<-list('pistcio'=list("flavourd","roasted")) 
nuts<-list('nuts'=list(almonds,pistcio))

all_products<-list(sweets,nuts,drinks)
mt<-melt(all_products)

mt2<-mt%>%mutate("Price"=c(23,34,23,23,54,32,45,23,12,56,76,34,62,12,98,43),
          "Quantity"=c(10,20,26,22,51,52,45,23,12,56,76,55,62,12,98,43))

t1<-mt2[,c(5,3,1,8,7)]
t1
colnames(t1)<-c("CAT","PN","SP","Quantity","Price")

t2<-list(unique(t1$CAT))
t2

应用程序-------------------------------------------- ------------------------

library(shiny)

server <- function(input, output,session) {
  observe({print(input$t)})
  observe({print(input$u)})
  observe({print(input$v)})
  t3<-t1%>%filter(t1$CAT==input$t)
  print(t3)
  t4<-list(unique(t3$PN))
  print(t4)
  t5<-t3%>%filter(t3$PN==input$r)
  print(t5)
  t6<-list(unique(t5$SP))
  print(t6)
  t7<-reactive({
         t1%>%filter(t1$CAT==input$t,t1$PN==input$u,t1$SP==inptut$v)
         print(t7())
       })
  output$mytable <- DT::renderDataTable({
         t7
       })

  lapply(1:5, function(j) {
         DT::dataTableOutput("mytable")
       })
}

ui <- pageWithSidebar(
  headerPanel("xxx"),
  sidebarPanel(),
  mainPanel(
    do.call(tabsetPanel, c(id='t',lapply(unlist(t2), function(i) {
  tabPanel(
      do.call(tabsetPanel, c(id='u',lapply(unlist(t4), function(i) {
      tabPanel(
        do.call(tabsetPanel, c(id='v',lapply(unlist(t6), function(i) {
          tabPanel(DT::dataTableOutput("mytable")
              )
        })))

          )
        })))  

      )
    })))

  )
)
shinyApp(ui, server)

手动操作

hotdrinks<-list("tea","green tea") 
juices<-list("orange","mango") 
energydrinks<-list("powerhorse","redbull") 
drinks<-list(hotdrinks,juices,energydrinks) 

biscuits<-list("loacker","tuc") 
choc<-list("aftereight","lindt") 
gum<-list("trident","clortes") 
sweets<-list(gum,juices,energydrinks) 

almonds<-list("salted","roasted") 
pistcio<-list("flavourd","roasted") 
nuts<-list(almonds,pistcio) 

all_products<-list(sweets,nuts,drinks)

choc<-  
tabsetPanel(
tabPanel("aftereight"),
tabPanel("lindt")
)
bisc<-  
tabsetPanel(
tabPanel("loacker"),
tabPanel("tuc")
)
gm<-  
tabsetPanel(
tabPanel("trident"),
tabPanel("clortes")
)

hdrinks<-  
tabsetPanel(
tabPanel("tea"),
tabPanel("green tea")
)
jcs<-  
tabsetPanel(
tabPanel("orange"),
tabPanel("mango")
)
ngdrinks<-  
tabsetPanel(
tabPanel("powerhorse"),
tabPanel("redbull")
)

al<-  
tabsetPanel(
tabPanel("salted"),
tabPanel("roasted")
)
pst<-  
tabsetPanel(
tabPanel("flavourd"),
tabPanel("roasted")
)

runApp(list(
ui = shinyUI( fluidPage(

sidebarLayout( 
  sidebarPanel(width = 2),      
  mainPanel(tabsetPanel(id='conditioned',
                        tabPanel("sweets",value=1,
                                 tabsetPanel(
                                   tabPanel("biscuits",
                                            tabsetPanel(bisc)),
                                   tabPanel("choc",
                                            tabsetPanel(choc)),
                                   tabPanel("gum",
                                            tabsetPanel(gm))
                                 )),
                        tabPanel("nuts",value=2,
                                 tabsetPanel(
                                   tabPanel("almonds",
                                            tabsetPanel(al)),
                                   tabPanel("pistcio",
                                            tabsetPanel(pst))
                                 )),

                        tabPanel("drinks",value=3,
                                 tabsetPanel(
                                   tabPanel("hotdrinks",
                                            tabsetPanel(hdrinks)),
                                   tabPanel("juices",
                                            tabsetPanel(jcs)),
                                   tabPanel("energydrinks",
                                            tabsetPanel(ngdrinks))

                                 ))
                        ))
  ))),

 server = function(input, output, session) {}
))

如您所见，这种方法很容易出错，在此先感谢您。

Answer 1

hotdrinks<-list("tea","green tea") 
juices<-list("orange","mango") 
energydrinks<-list("powerhorse","redbull") 
drinks<-list("hotdrinks"=hotdrinks, "juices"=juices, "energydrinks"=energydrinks) 

lst_drinks <- lapply(seq_along(drinks), 
                     #browser()
                     #create 2nd level, tab name with the corresponding 3rd level list  
                     function(x) tabPanel(names(drinks[x]),
                                          #create tabsetPanel for hdrinks, jcs, ngdrinks level i.e. 3rd level 
                                          do.call("tabsetPanel", 
                                                  lapply(drinks[[x]], function(y) tabPanel(y))
                                                  )
                                          )
                     )

hdrinks<-  
  tabsetPanel(
    tabPanel("tea"),
    tabPanel("green tea")
  )
jcs<-  
  tabsetPanel(
    tabPanel("orange"),
    tabPanel("mango")
  )
ngdrinks<-  
  tabsetPanel(
    tabPanel("powerhorse"),
    tabPanel("redbull")
  )

runApp(list(
  ui = shinyUI(fluidPage(
    sidebarLayout( 
      sidebarPanel(width = 2),      
      mainPanel(tabsetPanel(id='conditioned',
                            tabPanel("drinks",value=3,
                                     tabsetPanel(
                                       tabPanel("hotdrinks",
                                                #No need for tabsetPanel as hdrinks already has one, therefore I removed it in lapply
                                                tabsetPanel(hdrinks)),
                                       tabPanel("juices",
                                                tabsetPanel(jcs)),
                                       tabPanel("energydrinks",
                                                tabsetPanel(ngdrinks))

                                     )),
                            tabPanel("drinks-test",
                                     do.call("tabsetPanel", lst_drinks))
                                     ))
    ))),

  server = function(input, output, session) {}
))

完整解决方案

hotdrinks<-list("tea","green tea") 
juices<-list("orange","mango") 
energydrinks<-list("powerhorse","redbull") 
drinks<-list("hotdrinks"=hotdrinks,"juices"=juices,"energydrinks"=energydrinks) 

biscuits<-list("loacker","tuc") 
choc<-list("aftereight","lindt") 
gum<-list("trident","clortes") 
sweets<-list("gum"=gum,"biscuits"=biscuits,"choc"=choc)

all <- list("drinks"=drinks, "sweets"=sweets)

all_lst <- lapply(seq_along(all), function(z) tabPanel(names(all)[z], 
                                                       do.call("tabsetPanel", 
                                                               lapply(seq_along(all[[z]]), function(x) tabPanel(names(all[[z]][x]), 
                                                                                                                do.call("tabsetPanel", 
                                                                                                                        lapply(all[[z]][[x]], function(y) tabPanel(y, DT::dataTableOutput(y)))
                                                                                                                        )
                                                                                                                )
                                                                      )
                                                               )
                                                       )
                  )

runApp(list(
  ui = shinyUI(fluidPage( 
    sidebarLayout( 
      sidebarPanel(width = 2),      
      mainPanel(do.call("tabsetPanel", c(id='conditioned', all_lst)))
      ))),
  server = function(input, output, session) {
    observe({
      nms = unlist(all)
      names(nms) <- sub('\\d', '', names(nms))
      for(i in seq_along(nms)){
        #browser()
        local({
          nm      = nms[i]
          CAT_var = unlist(strsplit(names(nm), '\\.'))[1]
          PN_var  = unlist(strsplit(names(nm), '\\.'))[2]
          SP_var  = nm[[1]]
          output[[SP_var]] <- DT::renderDataTable({filter(t1, CAT==CAT_var, PN==PN_var, SP==SP_var)})
        })
      }
    })
  }
))