r - tab dependent input for shiny dashboard -


i facing issue shiny dashboard. trying create simple dashboard 2 tabitems on left. each tabitem have specific set of controls , plot. missing on server side link input tab because controls of second tab behaving strangely. appreciated. here code

library(shiny) library(shinydashboard) library(data.table) library(ggplot2) data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))  sidebar <- dashboardsidebar(   sidebarmenu(id = 'sidebarmenu',     menuitem("tab 1", tabname = "tab1", icon = icon("dashboard")),     menuitem("tab 2", icon = icon("th"), tabname = "tab2")   ) )  body <- dashboardbody(           tabitems(             tabitem(tabname = "tab1",               fluidrow(                 box(title = "controls",                     checkboxgroupinput('group', 'group:', c(1, 3, 6), selected = 6, inline = true), width = 4),                 box(plotoutput("plot1"), width = 8)              )            ),            tabitem(tabname = "tab2",              fluidrow(                box(title = "controls",                    checkboxgroupinput('group', 'group:', c(1, 3, 6), selected = 6, inline = true), width = 4),                box(plotoutput("plot2"), width = 8)              )           )        )     )   # put them dashboardpage  ui <- dashboardpage(  dashboardheader(title = "test tabbed inputs"),  sidebar,  body,  skin = 'green'  )  server <- function(input, output) {    output$plot1 <- renderplot({    plotdata <- data[group %in% input$group]    p <- ggplot(plotdata, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()    print(p)    })    output$plot2 <- renderplot({    plotdata <- data[group %in% input$group]    p <- ggplot(plotdata, aes(x = x, y = value, colour = factor(group))) + geom_line() + geom_point()    print(p)    }) }  shinyapp(ui, server) 

when change input in first tab changes in second , when try change time nothing happens or behaves weirdly. think need specify tie input tabitems somehow not find example of doing that. appreciated.

thanks, ashin

to deal dynamic number of tabs or other widgets, create them in server.r renderui. use list store tabs , do.call function apply tabitems function. same sidebar.

i think code below generates expectation.

library(shiny) library(shinydashboard) library(data.table) library(ggplot2) data = data.table(group = rep(c(1, 3, 6), each = 10), x = rep(1:10, times = 3), value = rnorm(30))  sidebar <- dashboardsidebar(   uioutput("sidebar") )  body <- dashboardbody(   uioutput("tabui") )  # put them dashboardpage ui <- dashboardpage(   dashboardheader(title = "test tabbed inputs"),   sidebar,   body,   skin = 'green' )  server <- function(input, output) {    ntabs <- 3   tabnames <- paste0("tab", 1:ntabs) # "tab1", "tab2", ...   checkboxnames <- paste0(tabnames, 'group') # "tab1group", "tab2group", ...   plotnames <- paste0("plot", 1:ntabs) # "plot1", "plot2", ...    output$sidebar <- renderui({     menus <- vector("list", ntabs)     for(i in 1:ntabs){       menus[[i]] <-   menuitem(tabnames[i], tabname = tabnames[i], icon = icon("dashboard"), selected = i==1)     }     do.call(function(...) sidebarmenu(id = 'sidebarmenu', ...), menus)   })    output$tabui <- renderui({     tabs <- vector("list", ntabs)     for(i in 1:ntabs){       tabs[[i]] <- tabitem(tabname = tabnames[i],                      fluidrow(                        box(title = "controls",                             checkboxgroupinput(checkboxnames[i], 'group:', c(1, 3, 6), selected = 6, inline = true),                             width = 4),                        box(plotoutput(paste0("plot",i)), width = 8)                      )       )     }     do.call(tabitems, tabs)   })    rv <- reactivevalues()   observe({     selection <- input[[paste0(input$sidebarmenu, 'group')]]     rv$plotdata <- data[group %in% selection]   })    for(i in 1:ntabs){     output[[plotnames[i]]] <- renderplot({       plotdata <-  rv$plotdata        p <- ggplot(plotdata, aes(x = x, y = value, colour = factor(group))) +          geom_line() + geom_point()         print(p)     })   }  }  shinyapp(ui, server) 

note put "plot data" in reactive list. otherwise, if did that:

output[[plotnames[i]]] <- renderplot({    selection <- input[[paste0(input$sidebarmenu, 'group')]]    plotdata <- data[group %in% selection]    ... 

the plot reactive each time go tab (try see mean).


Comments

Popular posts from this blog

angularjs - ADAL JS Angular- WebAPI add a new role claim to the token -

php - CakePHP HttpSockets send array of paramms -

node.js - Using Node without global install -