Reset tableoutput with action button in shinydashboard - r

I have an shinydashboard app, the app get an filter box and a tabset which show a datatatable depending on filter.
I have a reset button which reset the filters whith shinyjs::reset function, and I want to reset also the tableset and showing the complete table or nothing.
I want also to do it for a valuboxes.
My app is like this :
For server interface I have an basic : output$tableprint_A <- DT::renderDataRable ({})
ui :
body <- dashboardBody(
tabItems(
#### First tab item #####
tabItem(tabName = "fpc",
fluidRow(
infoBoxOutput("kpm_inf", width = 6),
infoBoxOutput(outputId = "fpc_inf", width = 6)
),
fluidRow(
box(title = "Variables filter",
shinyjs::useShinyjs(),
id = "side_panel",
br(),
background = "light-blue",
solidHeader = TRUE,
width = 2,
selectInput("aaa", "aaa", multiple = T, choices = c("All", as.character(unique(fpc$aaa))))
br(),
br(),
p(class = "text-center", div(style = "display:inline-block", actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right"))),
div(style = "display:inline-block", actionButton("reset_button", "Reset",
icon = icon("repeat")))),
p(class = 'text-center', downloadButton('dl_fpc', 'Download Data'))),
tabBox(
title = tagList(),
id = "tabset1",
width = 10,
tabPanel(
"A \u2030 ",
DT::dataTableOutput("tableprint_A"),
bsModal(id = 'startupModal', title = 'Update message', trigger = '',
size = 'large',
tags$p(tags$h2("Last update of A : 01/09/2017",
br(), br(),
"Last update of B : 01/09/2017",
br(), br(),
"Last update of C : 01/09/2017",
style = "color:green", align = "center")))
),
tabPanel(
"B % Table",
DT::dataTableOutput("tableprint_B")),
type = "pills"
)
),
fluidRow(
# Dynamic valueBoxes
valueBoxOutput("info_gen", width = 6)
)
I tried this :
observeEvent(input$reset_button, {
output$tableprint_A <- NULL
})
Edit:
I want something like that, but when I action the search button I want it to appear again :
shinyjs::onclick("reset_button",
shinyjs::toggle(id = "tableprint_A", anim = TRUE))

You should try this out:
output$tableprint_A <- renderDataTable({
if(input$reset_button == 1) {
NULL
}else{
datatable(...)
}
})
if the button is clicked then nothing will be displayed, else the datatable is shown.
[EDIT]
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(selectInput("select", "select", choices = unique(iris$Species), multiple = T),
actionButton("go_button", "Search",
icon = icon("arrow-circle-o-right")),
actionButton("reset_button", "Reset",
icon = icon("repeat")),
DT::dataTableOutput('tbl')),
server = function(input, output) {
values <- reactiveValues(matrix = NULL)
observe({
if (input$go_button == 0)
return()
values$matrix <- iris[iris$Species %in% input$select, ]
})
observe({
if (input$reset_button == 0)
return()
values$matrix <- NULL
})
output$tbl = DT::renderDataTable({
datatable(values$matrix, options = list(lengthChange = FALSE))}
)
}
)

Related

Generate dynamic Tab using argonDash (shiny framework) package

I tried to make dynamic Tab using argonDash package. However, I met some trouble with my code.
I guess argonDash seems to get different behavior than native shiny because argonDash uses Bootstrap 4 (instead of 3).
My code is composed of two key features:
The first widget uiOutput(outputId = "new_argonSidebarItem") works well.
The second widget uiOutput(outputId = "new_argonTabItem") doesn't work properly. I expect that the argonBadge() toggle with the second tab.
library(shiny)
library(argonDash)
library(argonR)
ui <- argonDashPage(
sidebar = argonDashSidebar(
id = "sidebar01",
vertical = FALSE,
size = "md",
background = "white",
argonSidebarMenu(
style = "display:-webkit-inline-box;",
argonSidebarItem(
tabName = "Tab1",
icon = NULL,
"Dashboard"
),
# New Tab
uiOutput(outputId = "new_argonSidebarItem")
)
),
body = argonDashBody(
argonTabItems(
argonTabItem(
tabName = "Tab1",
actionButton("add_more", "Add a new btn")
),
# Body
uiOutput(outputId = "new_argonTabItem")
)
)
)
server <- function(input, output, session) {
observeEvent(input$add_more, {
tabId <- sample.int(n = 1000000, size = 1)
tabName <- paste0("Tab_", tabId)
insertUI(
selector = "#tab-Tab1",
where = "afterEnd",
ui = argonSidebarItem(
tabName = tabName,
tabName
)
)
output$new_argonTabItem <- renderUI({
argonTabItem(
tabName = tabName,
argonBadge(
text = tabName,
src = "#",
pill = FALSE,
status = "success"
)
)
})
})
}
shinyApp(ui, server)
Thank you for your time!
To update your badge you need to track which tab is selected. This is done accordingly to this solution : https://github.com/RinteRface/argonDash/issues/7
But your badge can not be modified, so I replaced it with a button from {shinyWidgets}.
I hope this is what you ask for, I'm not really sure to understand what you want to happen.
library(shiny)
library(argonDash)
library(argonR)
library(shinyWidgets)
ui <- argonDashPage(
sidebar = argonDashSidebar(
id = "sidebar01",
vertical = FALSE,
size = "md",
background = "white",
argonSidebarMenu(
style = "display:-webkit-inline-box;",
argonSidebarItem(
tabName = "Tab1",
icon = NULL,
"Dashboard"
),
# New Tab
uiOutput(outputId = "new_argonSidebarItem")
)
),
body = argonDashBody(
argonTabItems(
argonTabItem(
tabName = "Tab1",
actionButton("add_more", "Add a new btn")
),
# Body
uiOutput(outputId = "new_argonTabItem")
),
tags$script( "$(document).on('click', function(event) {
Shiny.onInputChange('activeTab', $('.active').data().value);});")
)
)
server <- function(input, output, session) {
x <- reactiveValues(tabs = NULL)
observeEvent(input$add_more, {
tabId <- sample.int(n = 1000000, size = 1)
tabName <- paste0("Tab_", tabId)
insertUI(
selector = "#tab-Tab1",
where = "afterEnd",
ui = argonSidebarItem(
tabName = tabName,
tabName
)
)
output$new_argonTabItem <- renderUI({
argonTabItem(
tabName = tabName,
actionBttn(
inputId = paste0(input$activeTab,"_b"),
label = tabName,
style = "float",
color = "success"
)#,
# argonBadge(
# text = tabName,
# src = "#",
# pill = FALSE,
# status = "success"
# )
)
})
})
observeEvent(input$activeTab, {
updateActionButton(session,
paste0(input$activeTab,"_b"),
input$activeTab)
})
}
shinyApp(ui, server)

how to automatically scale uiOutput() when sidebar collapses in Shiny

I have a toggle switch which collapses the sidebar panel; however, when I do that, the datatable in uiOutput() doesn't stretch accordingly. I don't know what argument I am missing.
I have changed the renderDatatable() arguments but nothing changed. Also, if possible, how can I change the render so that the datatable takes entire whitespace regardless of sidebard being collapsed?
library(shiny)
library(shinythemes)
library(shinyjs)
library(shinyWidgets)
#ui.r
ui <- fluidPage(
theme=shinytheme("flatly") ,
useShinyjs(),
dropdownButton(
tags$h3("Toggle"),
materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
value = TRUE, status = "success"),
circle = TRUE, status = "info",
icon = icon("gear"), width = "300px",
tooltip = tooltipOptions(title = "Choose for more options!")
),
# Sidebar layout with input and output definitions
sidebarLayout(
div( id ="Sidebar",
# Sidebar panel for inputs
sidebarPanel(
uiOutput("rad")
)),
# Main panel for displaying outputs
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
server <- function(input, output) {
data_sets <- list(NULL, iris, mtcars, ToothGrowth)
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
})
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3,"ToothGrowth" = 4),
selected = character(0))
})
output$tabers<- renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Welcome!")
)
}
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
#tabPanel("Plot" ),
tabPanel("etc.")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
I was wondering if I can get some assistance with that, please!
Since you are using shinyjs, it can easily be:
library(shiny)
library(shinyjs)
library(shinyWidgets)
#ui.r
ui <- fluidPage(
useShinyjs(),
dropdownButton(
tags$h3("Toggle"),
materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
value = TRUE, status = "success"),
circle = TRUE, status = "info",
icon = icon("gear"), width = "300px",
tooltip = tooltipOptions(title = "Choose for more options!")
),
# Sidebar layout with input and output definitions
sidebarLayout(
div( id ="Sidebar",
# Sidebar panel for inputs
sidebarPanel(
uiOutput("rad")
)),
# Main panel for displaying outputs
mainPanel(
id = "main_panel",
uiOutput("tabers")
)
)
)
#server.r
server <- function(input, output) {
data_sets <- list(NULL, iris, mtcars, ToothGrowth)
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3,"ToothGrowth" = 4),
selected = character(0))
})
output$tabers<- renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Welcome!")
)
}
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
#tabPanel("Plot" ),
tabPanel("etc.")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
I added an ID for the main panel so I can easily select it
mainPanel(
id = "main_panel",
uiOutput("tabers")
)
On server, add some javascript to toggle the same time you hide the sidebar:
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})

Reactivity and Renders doesn't work when switching to another tabPanel

I have a reproducible example below where only the first tabPanel is working, however when I switch to another panel, I don't get any renders (the toggle becomes un-interactable also). I have looked into conditionalPanel however I see them getting done without the use of mainPanel I was wondering if it possible to have tabs where each tab has its own mainPanel , so I can see a different sidebar and an output contained within different tabs. Any help is welcome!
options(scipen = 99999) #converts the sci numbers to their regular format
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinyalert)
library(esquisse)
library(DT)
library(dplyr)
#library(devtools)
#library(remotes)
#remotes::install_github("dreamRs/esquisse")
library(hrbrthemes)
library(ggthemes)
library(ggplot2)
library(svglite)
ui <- fluidPage(
shinyjs::useShinyjs(), # enables javascript/jQuery enhanchments
# Create Right Side Text
navbarPage(
title= div(HTML("G<em>T</em>")),
#General reports
tabPanel("General Reports",
shinyWidgets::materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
shinyWidgets::prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 1,
"iris"= 2),
icon= icon("check"),
selected = 1,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:xyz#email.us")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel1", "Text coming soon."
),
tabPanelBody(
"panel2",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel2_data')),
tabPanel(
"DIY Plot",
esquisse::esquisse_ui(
id = "esquisse2",
header = FALSE,
container = esquisseContainer(
width = "100%", height = "760px", fixed = FALSE
),
controls = c("labs", "parameters", "appearance", "filters", "code")
)
)
)
)
)
)
)
),
# monthly reports
tabPanel("Extra General Reports",
shinyWidgets::materialSwitch(inputId = "toggleSidebar", label = "Toggle Panel: ",
value = TRUE, status = "warning"),
sidebarLayout(
# radio/action buttons
sidebarPanel(
id = "Sidebar",
shinyWidgets::prettyRadioButtons(
inputId = "controller",
label = "Choose:",
choices = c("About"= 3,
"mtcars"= 4),
icon= icon("check"),
selected = 3,
status = "success",
animation="smooth"
),
br(),
br(),
a(actionButton(inputId = "admin_email", label = "Contact",
icon = icon("envelope", lib = "font-awesome")),
href="mailto:xyz#email.us")
),
#panel where output is shown from server
mainPanel(
id = "main_panel",
tabsetPanel(
id = "hidden_tabs",
type = "hidden",
tabPanelBody(
"panel3", "Text coming soon."
),
tabPanelBody(
"panel4",
tabsetPanel(
tabPanel("Data", DT::DTOutput('panel4_data')),
tabPanel(
"DIY Plot",
esquisse::esquisse_ui(
id = "esquisse4",
header = FALSE,
container = esquisseContainer(
width = "100%", height = "760px", fixed = FALSE
),
controls = c("labs", "parameters", "appearance", "filters", "code")
)
)
)
)
)
)
)
),
#resizes the navbar tabs/button
tags$head(tags$style(HTML('.navbar-brand {width: 270px; font-size:35px; text-align:left;
font-family: "serif";')))
)
)
server <- function(input, output, session) {
# this event hides the side panel when toggled on/off
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
# here we put all the data
data_sets <- list(df1 = data.frame(),
df2 = iris,
df3 = data.frame(),
df4 = mtcars)
# store current dataset in reactive so we can work with plot panels
data_to_use <- reactiveValues(name = "df", data = data.frame())
# modules only need to be called it once but individually for esquisse
esquisse::esquisse_server(id = "esquisse2", data_rv = data_to_use)
esquisse::esquisse_server(id = "esquisse4", data_rv = data_to_use)
observeEvent(input$controller, {
# skip first panel since it is used to display navigation
updateTabsetPanel(session, inputId= "hidden_tabs", selected = paste0("panel", input$controller))
# enswure value is avilable throught selected tabSet
req(input$controller)
# get current data and df name
data_to_use$data <- data_sets[[as.numeric(input$controller)]]
data_to_use$name <- names(data_sets[as.numeric(input$controller)])
# update table and sum. Use server = FALSE to get full table
output[[paste0('panel', input$controller, '_data')]] <- DT::renderDT(server = FALSE, {
DT::datatable(data_to_use$data,
filter = 'top',
extensions = 'Buttons')})
})
}
#runs the app
shinyApp(ui= ui, server= server)
You have two radioButtons, one for each sidebar, but both of them have the inputId = "controller". Same with inputId = "toggleSidebar". InputIds need to be unique in shiny!
I suggest you either use a single sidebar for the entire app, or since both tabs are essentially identical you can also use modules.

R shiny: slickROutput disappears when switching tabpanel()

I am making a Shiny app with tabPanels embedded in a navbarPage.
In each tabPanel, I generate a serie of image. When switching from one panel to the other one, the image loaded in one of them disappear.
I have to "refresh" manually the page to see it again. The problem seems similar than the one posted here but I cannot really subset my tabPanels, even though I gave $id and value to them.
Here is a reproducible example:
library(shiny)
library(shinythemes)
library(slickR)
## ui ----
# Image list
imgs <- list(
stackoverflow =
"https://upload.wikimedia.org/wikipedia/fr/9/95/Stack_Overflow_website_logo.png",
stackexchange =
"https://upload.wikimedia.org/wikipedia/commons/6/6f/Stack_Exchange_Logo.png"
)
ui <- navbarPage(title = div(
HTML('<span style="font-size:180%;color:white;font-weight:bold;"> Navbarpage</span></a>'),
tags$style(style = 'position:absolute; right:42px;'),
tags$style(HTML("#panel1{font-size: 25px}")),
tags$style(HTML("#panel2{font-size: 25px}")),
tags$style(HTML("#panel_about{font-size: 25px}"))
),
theme = shinytheme("flatly"),
windowTitle = "Navbarpage",
id = "navbar",
## First tabpanel ----
tabPanel(h1(id = "panel1", "Panel 1"), value = 1, fluid = TRUE,
fluidRow(column(4,
selectInput("img_list", "Image list",
choices = imgs,
selected = imgs[1])),
column(8,
slickROutput("plot_panel1"))),
),
tabPanel(h1(id = "panel2", "Panel 2"), value = 2, fluid = TRUE,
fluidRow(column(4,
selectInput("img_list", "Image list",
choices = imgs,
selected = imgs[1])),
column(8,
slickROutput("plot_panel2"))),
)
) # closes navbarpage
## server ----
server <- function(input, output, session){
observe({
output$plot_panel1 <- renderSlickR({
slick1 <- slick_list(slick_div(
input$img_list,
css = htmltools::css(width = "100%", margin.left = "auto",
margin.right = "auto"),
type = "img", links = NULL))
slickR(slick1)
})
})
observe({
output$plot_panel2 <- renderSlickR({
slick2 <- slick_list(slick_div(
input$img_list,
css = htmltools::css(width = "100%", margin.left = "auto",
margin.right = "auto"),
type = "img", links = NULL))
slickR(slick2)
})
})
}
shinyApp(ui, server)
And what it produces:
When there are multiple slickR objects to be rendered, you need to use a unique slideId for each. Furthermore you should not wrap render* functions in observe and use the same id for two selectInputs.
Please check the following:
library(shiny)
library(shinythemes)
library(slickR)
## ui ----
# Image list
imgs <- list(
stackoverflow =
"https://upload.wikimedia.org/wikipedia/fr/9/95/Stack_Overflow_website_logo.png",
stackexchange =
"https://upload.wikimedia.org/wikipedia/commons/6/6f/Stack_Exchange_Logo.png"
)
ui <- navbarPage(title = div(
HTML('<span style="font-size:180%;color:white;font-weight:bold;"> Navbarpage</span></a>'),
tags$style(style = 'position:absolute; right:42px;'),
tags$style(HTML("#panel1{font-size: 25px}")),
tags$style(HTML("#panel2{font-size: 25px}")),
tags$style(HTML("#panel_about{font-size: 25px}"))
),
theme = shinytheme("flatly"),
windowTitle = "Navbarpage",
id = "navbar",
## First tabpanel ----
tabPanel(h1(id = "panel1", "Panel 1"), value = 1, fluid = TRUE,
fluidRow(column(4,
selectInput("img_list1", "Image list",
choices = imgs,
selected = imgs[1])),
column(8,
slickROutput("plot_panel1"))),
),
tabPanel(h1(id = "panel2", "Panel 2"), value = 2, fluid = TRUE,
fluidRow(column(4,
selectInput("img_list2", "Image list",
choices = imgs,
selected = imgs[1])),
column(8,
slickROutput("plot_panel2"))),
)
) # closes navbarpage
## server ----
server <- function(input, output, session){
output$plot_panel1 <- renderSlickR({
slick1 <- slick_list(slick_div(
input$img_list1,
css = htmltools::css(width = "100%", margin.left = "auto",
margin.right = "auto"),
type = "img", links = NULL))
slickR(slick1, slideId = "slide1")
})
output$plot_panel2 <- renderSlickR({
slick2 <- slick_list(slick_div(
input$img_list2,
css = htmltools::css(width = "100%", margin.left = "auto",
margin.right = "auto"),
type = "img", links = NULL))
slickR(slick2, slideId = "slide2")
})
}
shinyApp(ui, server)

ConditionalPanel with more than one condition are true

I am having a conditionalPanel problem when more than one option is valid.
A part of my code that the user makes two choices in sequence, so that filters are made in the database.
In the first choice, a State will be selected from a list of possibilities. It is important to know that the user can select more than one State.
In the second choice, the City will be selected from a list of possibilities. In this second choice, the user can also select more than one City.
As I said, important information is that the user can select more than one state, so from that multiple choice of states, it should be shown the cities of all selected states.
Everything works fine when the user selects only one state. The problem with my code starts when it selects more than one state, the ConditionalPanel simply disappears (nothing is shown, not even the first option that was already shown). It only appears again when the user removes the selections, keeping only one.
If anyone has a few minutes to help me to sort out this problem I'm facing, I'll be very grateful.
library(shiny)
library(shinydashboard)
library(readr)
state_options <- c("1. Texas", "2. Massachusetts", "3. Colorado")
options_state_texas <- c("Alamo", "Alton", "Angus", "Atlanta", "Aurora",
"Brownsboro", "Premont", "Princeton", "Red Oak",
"Staples", "Texas City")
options_state_massachusetts <- c("Boston", "Cambridge", "Chelsea", "Springfield")
options_state_colorado <- c("Aspen", "Aurora", "Avon", "Cortez", "Denver",
"Vail")
createMainPanel <- function(index_id) {
mainPanel(
width = 12,
tabsetPanel(
tabPanel(
strong("Split"),
br(),
box(
title = strong("State:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0(index_id, "_state"),
label = NULL,
choices = state_options
)
),
conditionalPanel(
condition = "input.distribution_of_sales_sub_state == '1. Texas'",
box(
title = strong("Cities state 1:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0(index_id, "_checkbox_city_1"),
label = NULL,
choices = options_state_texas
)
)
),
conditionalPanel(
condition = "input.distribution_of_sales_sub_state == '2. Massachusetts'",
box(
title = strong("Cities state 2:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0(index_id, "_checkbox_city_2"),
label = NULL,
choices = options_state_massachusetts
)
)
),
conditionalPanel(
condition = "input.distribution_of_sales_sub_state == '3. Colorado'",
box(
title = strong("Cities state 3:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0(index_id, "_checkbox_city_3"),
label = NULL,
choices = options_state_colorado
)
)
)
)
)
)
}
createTabItem <- function(title, index_id) {
tabItem(
tabName <- paste0(index_id, "_tab"),
h2(title),
createMainPanel(index_id))
}
createBox <- function(session, index_id, opcoes){
updateCheckboxGroupInput(
session,
index_id,
choices = c(opcoes))
}
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(
title = img(src='logo.png', height = 60, width = 180, style = "display: block;
margin-left: auto; margin-right: auto;"),
HTML("<br><br>"),
width = 230,
sidebarMenu(
menuItem(strong("Sales"), tabName = "distribution_of_sales_sub_tab")
)
),
dashboardBody(
tabItems(
createTabItem(strong("Distribution of sales"),
"distribution_of_sales_sub")
)
)
)
server <- function(input, output, session) {
observe({
createBox(session,"distribution_of_sales_sub_state", state_options)
createBox(session,"distribution_of_sales_sub_checkbox_city_1",
options_state_texas)
createBox(session,"distribution_of_sales_sub_checkbox_city_2",
options_state_massachusetts)
createBox(session,"distribution_of_sales_sub_checkbox_city_3",
options_state_colorado)
})
}
shinyApp(ui, server)
You need to change your conditions to
condition = "input.distribution_of_sales_sub_state.includes('1. Texas')",
condition = "input.distribution_of_sales_sub_state.includes('2. Massachusetts')",
condition = "input.distribution_of_sales_sub_state.includes('3. Colorado')",
EDIT: SOLUTION FOR QUESTION IN COMMENTS
This definitely is not the best solution but this should give you what you want and a good start to make it better.
library(shiny)
library(shinydashboard)
library(readr)
state_options <- c("1. Texas", "2. Massachusetts", "3. Colorado")
options_state_texas <- c("Alamo", "Alton", "Angus", "Atlanta", "Aurora",
"Brownsboro", "Premont", "Princeton", "Red Oak",
"Staples", "Texas City")
options_state_massachusetts <- c("Boston", "Cambridge", "Chelsea", "Springfield")
options_state_colorado <- c("Aspen", "Aurora", "Avon", "Cortez", "Denver",
"Vail")
city_options <- c()
createMainPanel <- function(index_id) {
mainPanel(
width = 12,
tabsetPanel(
tabPanel(
strong("Split"),
br(),
box(
title = strong("State:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0(index_id, "_state"),
label = NULL,
choices = state_options
)
),
conditionalPanel(
condition = "input.distribution_of_sales_sub_state != ''",
uiOutput("city")
)
)
)
)
}
createTabItem <- function(title, index_id) {
tabItem(
tabName <- paste0(index_id, "_tab"),
h2(title),
createMainPanel(index_id))
}
createBox <- function(session, index_id, opcoes){
updateCheckboxGroupInput(
session,
index_id,
choices = c(opcoes))
}
ui <- dashboardPage(
dashboardHeader(disable = TRUE),
dashboardSidebar(
title = img(src='logo.png', height = 60, width = 180, style = "display: block;
margin-left: auto; margin-right: auto;"),
HTML("<br><br>"),
width = 230,
sidebarMenu(
menuItem(strong("Sales"), tabName = "distribution_of_sales_sub_tab")
)
),
dashboardBody(
tabItems(
createTabItem(strong("Distribution of sales"),
"distribution_of_sales_sub")
)
)
)
server <- function(input, output, session) {
output$city <- renderUI({
box(
title = strong("Cities state:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = paste0("distribution_of_sales_sub", "_checkbox_city_1"),
label = NULL,
choices = cities()
)
)
})
city_options1 <- c()
city_options2 <- c()
city_options3 <- c()
cities <- reactive({
if(c("1. Texas") %in% input$distribution_of_sales_sub_state ){
city_options1<- c(options_state_texas)
}
if (c("2. Massachusetts") %in% input$distribution_of_sales_sub_state) {
city_options2 <- c(options_state_massachusetts)
}
if (c("3. Colorado") %in% input$distribution_of_sales_sub_state ) {
city_options3 <- c(options_state_colorado)
}
city_options <- c(city_options1,city_options2, city_options3)
city_options <- sort(city_options)
})
observe({
createBox(session,"distribution_of_sales_sub_state", state_options)
createBox(session,"distribution_of_sales_sub_checkbox_city_1",
options_state_texas)
createBox(session,"distribution_of_sales_sub_checkbox_city_2",
options_state_massachusetts)
createBox(session,"distribution_of_sales_sub_checkbox_city_3",
options_state_colorado)
})
}
shinyApp(ui, server)
Your code is not reproducible at all, You should take care of that before posting the question.
Well my guess without proper code and data would be to move all your conditions to server.R. So in ui.R you should create for each state: uiOutput("state1") (its for the first conditional state: Texas), then in server.R:
output$state1 <- renderUI({
if(any(input$state == '1. Texas')){
box(
title = strong("Cities state 1:"),
status = "primary",
width = 3,
collapsible = TRUE,
checkboxGroupInput(
inputId = "checkbox_city_1"),
label = NULL,
choices = options_state_texas
)}
else{NULL})

Resources