Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.9k views
in Technique[技术] by (71.8m points)

in R shiny, how to automatically or based on function tabPanel, given we have 3 levels of lists?

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.

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)
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)})
        })
      }
    })
  }
))

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...