问题
I need to create conditional 3 levels of tabs the first level or tabPanel includes three tabs "NUTS","SWEETS","DRINKS" so the
level1<-list(DRINKS,SWEETS,NUTS)
the second level or is conditional on the first level for example after selecting DRINKS, would be juices, energydrinks, hotdrinks the third level would be after selecting energy drinks to "powerhorse","redbull"
tried code but not working is this
lists -------------------------------------------------------------------
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
app ---------------------------------------------------------------------
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)
the manual steps
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) {}
))
as you can see this approach is too vulnerable to mistake, thanks in advance.
回答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) {}
))
The Full solution
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)})
})
}
})
}
))
来源：https://stackoverflow.com/questions/59079852/in-r-shiny-how-to-automatically-or-based-on-function-tabpanel-given-we-have-3