Removing UI drop-down element dynamically in R Shiny - r

Probably very basic question - but can't translate similar posts I've found to my exact issue.
Within an R Shiny app, I have a first drop-down menu that is populated by a vector produced on the server - this allows me to make one set of choices.
I want to have a tick box that then introduces a second drop down - but I want that drop down to disappear if I un-tick the tick box.
I've had a go - see MWE below - the graph is just there to keep to the structure of my original code (obviously I'm aware my drop-downs do nothing but that's not the case in the original but wanted the MWE to be as 'M' as possible).
If I remove the removeUI() line then ticking the tick-box does create a new drop down as required - but then un-ticking the tick box fails to remove it.
I'm obviously missing something; any help much appreciated as I totally suck at R Shiny but really want to get better!
library(shiny)
library(shinyMobile)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
htmlOutput("reactive_drop_down") #second drop down
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
library(ggplot2)
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
observeEvent(input$initial_choice, {
# trying to add second drop down based on action in switch - not convinced my use of observeEvent is quite right - issue likely sits in here.
observeEvent(input$switch, {
if(input$switch == T){
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
}else{
removeUI(selector ="#reactive_drop_down")
}
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
})
}
# Run the application
shinyApp(ui = ui, server = server)

Could you use conditionalPanel? Put your htmlOutput for your second input there in your ui. I would avoid using nested observeEvent and output.
library(shiny)
library(shinyMobile)
library(ggplot2)
# define UI elements
ui <- f7Page(
f7SingleLayout(
navbar = f7Navbar(
),
f7Card(htmlOutput("initial_drop_down"), #first drop down
f7checkBox(inputId = "switch", label = "Introduce second choice", FALSE), #tick box for second drop down if required
conditionalPanel(
condition = "input.switch==1",
htmlOutput("reactive_drop_down") #second drop down
)
),
f7Shadow(
intensity = 16,
f7Card(
plotOutput("distPlot", height = "800px") # plot - originally linked to drop down choices but an arbitrary graph here for simplicity
)
)
)
)
# server calculations
server <- function(input, output) {
# generate first drop down - done on server side since usually choices vector is comprised of information read in from files
output$initial_drop_down = renderUI({
selectInput(inputId = "initial_choice",
label = "First choice:",
choices = c("Choice 1", "Choice 2", "Choice 3"))
})
output$reactive_drop_down = renderUI({
selectInput(inputId = "second_choice",
label = "Second (dynamic) choice:",
choices = c(1,2,3))
})
output$distPlot <- renderPlot({
ggplot(data = cars) + geom_line(aes(x=speed, y=dist))
})
}
# Run the application
shinyApp(ui = ui, server = server)

Related

Change Plot Output Based on checkboxInput Selection Shiny

Overview
Hello, I am trying to work with displaying different plots using checkboxes within tabsetPanels. I am working with a dynamic amount number of panels, so that is the reason for creating the UI contents within the server portion.
Ideal Output
For each tabPanel:
iris plot outputs if no checkboxes are selected
mtcars plot outputs if Box One is selected
islands plot outputs if Box Two is selected
sleep plot outputs if both Box One and Box Two are selected
What I have tried
-I have tried to use condtionalPanels to try to & capture the cases. I was under the impression that the value returns 'TRUE' if checked & 'FALSE' if unchecked, however I receive NULL for each of the boxed values, even if I set the default value to be checked.
-I believe my underlying issue is my lack of ability to trigger the dynamic checkboxes for each tabPanel
Disclaimer
This is a reproducible example, the default values of originally created tabPanels is set to 5. I did not accommodate proper code if the value were to change for the sake of simplicity.
Sample Code:
ui <- navbarPage(title="Dynamic tabsetPanels",id="navbar",
tabPanel("Home",
textInput(inputId = "numPanels",
label = "Enter # of Panels to produce",
value = 5)
),tabPanel("Analysis",
tabsetPanel(id = "tabs"))
)
server <- function(input, output) {
plotOne = renderPlot({plot(iris)})
plotTwo = renderPlot({plot(mtcars)})
plotThree = renderPlot({plot(islands)})
plotFour = renderPlot({plot(sleep)})
observe({
req(input$numPanels)
lapply(1:input$numPanels,function(i){
tabName = paste("Tab",i,sep=" ")
first = paste0("first",i)
second = paste0("second",i)
appendTab(inputId = "tabs",
tab = tabPanel(
tabName,
fluidPage(
sidebarLayout(
sidebarPanel(
#side-panel code
h2("Features"),
checkboxInput(inputId=first,label="Box One"),
checkboxInput(inputId=second,label="Box Two")
),mainPanel(
#output when nothing clicked
conditionalPanel(
condition = "!glue(input.{first} && !glue(input.{second})",
plotOutput(iris)
),
#output when box one is clicked
conditionalPanel(
condition = "glue(input.{first})",
plotOutput(mtcars)
),
#output when box two is clicked
conditionalPanel(
condition = "glue(input.{second})",
plotOutput(islands)
),
#output when box one and two are clicked
conditionalPanel(
condition = "glue(input.{first}) && glue(input.{second})",
plotOutput(sleep)
)
)
)
)
)
)
})
})
}
shinyApp(ui=ui, server=server)
Any suggestions would be greatly appreciated!
First issue with your code is the use of glue to create your conditions, i.e. you have to do e.g. condition = glue("input.{first}") instead of condition = "glue(input.{first})" to evaluate the glue string. Second issue is that in the plotOutputs you have to use the names of the outputs, e.g. plotOutput("plotOne") instead of plotOutput(iris). Finally, even after fixing these issues your app will not work as desired as you can't use outputs with the same id in several places or tabs, i.e. you get a duplicated id error. To fix that you also have to create a dynamic list of outputs so that the ids are unique.
library(shiny)
library(glue)
ui <- navbarPage(
title = "Dynamic tabsetPanels", id = "navbar",
tabPanel(
"Home",
textInput(
inputId = "numPanels",
label = "Enter # of Panels to produce",
value = 5
)
), tabPanel(
"Analysis",
tabsetPanel(id = "tabs")
)
)
server <- function(input, output) {
observe({
req(input$numPanels)
lapply(1:input$numPanels, function(i) {
output[[paste0("plotOne", i)]] <- renderPlot(plot(iris))
output[[paste0("plotTwo", i)]] <- renderPlot(plot(mtcars))
output[[paste0("plotThree", i)]] <- renderPlot(plot(islands))
output[[paste0("plotFour", i)]] <- renderPlot(plot(sleep))
})
})
observe({
req(input$numPanels)
lapply(1:input$numPanels, function(i) {
tabName <- paste("Tab", i, sep = " ")
first <- paste0("first", i)
second <- paste0("second", i)
appendTab(
inputId = "tabs",
tab = tabPanel(
tabName,
fluidPage(
sidebarLayout(
sidebarPanel(
# side-panel code
h2("Features"),
checkboxInput(inputId = first, label = "Box One"),
checkboxInput(inputId = second, label = "Box Two")
), mainPanel(
# output when nothing clicked
conditionalPanel(
condition = glue("!input.{first} && !input.{second}"),
plotOutput(paste0("plotOne", i))
),
# output when box one is clicked
conditionalPanel(
condition = glue("input.{first}"),
plotOutput(paste0("plotTwo", i))
),
# output when box two is clicked
conditionalPanel(
condition = glue("input.{second}"),
plotOutput(paste0("plotThree", i))
),
# output when box one and two are clicked
conditionalPanel(
condition = glue("input.{first} && input.{second}"),
plotOutput(paste0("plotFour", i))
)
)
)
)
)
)
})
})
}
shinyApp(ui = ui, server = server)

Need help making dependent dropdown boxes in the RStudio package Shiny

I have two datasets, one with a list of two hundred cities and their corresponding state and another much larger dataset that I'd like to make an app to sort through. I need help making two drop down boxes in my shiny app where the first is the state variable and the second is the list of cities within that chosen state. I then want those selections to filter the much larger, second dataset in the output. I've tried solutions from several similar but slightly different examples online, but I'm having trouble translating it to what I'm doing.
So far I have this:
ui <- fluidPage(
headerPanel(''),
sidebarPanel(
#add selectinput boxs
htmlOutput("state_selector"),
htmlOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DT::dataTableOutput("table")
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$State == input$state, "state"]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available), #calls list of available cities
selected = unique(data_available)[1])
})
shinyApp(ui = ui, server = server)
I tried to take out the portions of the code that weren't specifically related to the drop down boxes, since that's what I was more specifically asking about. So I'm sorry if I've left anything out! Let me know if I need to include anything else
Using available gapminder data, you can try this.
df <- gapminder
df$state <- gapminder$continent
df$city <- gapminder$country
citystatedata <- df
ui <- fluidPage(
headerPanel('Test'),
sidebarPanel(
#add selectinput boxs
uiOutput("state_selector"),
uiOutput("city_selector"),
),
mainPanel(
fluidRow(
# Create a new row for the table.
DTOutput("table")
)
)
)
server <- function(session, input, output) {
output$state_selector = renderUI({
selectInput("state", label = h4("State"),
choices = as.character(unique(citystatedata$state)), selected = NULL)
})
output$city_selector = renderUI({
data_available = citystatedata[citystatedata$state == req(input$state),]
selectInput(inputId = "city", #name of input
label = "City", #label displayed in ui
choices = unique(data_available$city), #calls list of available cities
selected = 1)
})
mydt <- reactive({
citystatedata %>% filter(citystatedata$state == req(input$state) & citystatedata$city %in% req(input$city))
})
output$table <- renderDT(mydt())
}
shinyApp(ui = ui, server = server)

Nested uiOutput within RShiny

In a nutshell, I believe I need to nest uiOutputs together and cannot figure a great way to do so.
The app is large but for this part, I would like to create a survey that renders sub-surveys (new panels) based on a slider input (I've accomplished that much). These panels will all be standard and so they can be created with a loop.
However, answers within these panels should generate more UI within the panel from which they were generated and therein lies the problem... the nesting of uiOutputs. I've tried to provide the shortest example possible below, with comments - and note that the second uiOutput call works if I specify a panel for which it should work ("oh_lawd_1" in this case).
Please let me know what you think! Have been looking at this in my spare time for at least 4 days. (also I realize that this is not an ideal use of shiny).
library(shiny)
library(shinyWidgets)
ui <- fluidPage( #UI
column(6, offset = 3,
sliderInput(inputId = "my_slider", # slider to choose number of panels
label = "Choose Panels to be Displayed",
min = 0, max = 5, value = 1),
uiOutput(outputId = "update_panels") # ui output to create panels
)
)
server <- function(input, output, session) { #Server
output$update_panels <- renderUI({ # rendering all the panels called for by user
panels <- input$my_slider
if(panels == 0){
return("No panels being displayed")# returning 0 if none selected
} else {
our_ui <- list() # creating a list to store a standard panel
for(i in 1:panels){
button_id <- paste("button_id", i, sep = "_") # a unique id for each panel's radiobuttons
oh_lawd <- paste("oh_lawd", i, sep = "_") # a unique id for each panel's uiOutput
update <- wellPanel(paste("Well Panel #", i), # "update" is what each panel should START OFF looking like
radioButtons(inputId = button_id,
label = "Choose a pill",
choices = c("Red Pill", "Blue Pill")),
uiOutput(oh_lawd)) # this part is the issue - I would like to update individual panels with a
# radio button selection specific to a choice in each panel... a nested uiOutput
our_ui <- list(our_ui, update)
}}
our_ui})
output$oh_lawd_1 <- renderUI({ # this works for the first... but I need to somehow create one of these for each based on
# number of panels and the choice in each panel
if(input$button_id_1 == "Red Pill"){
radioButtons("first_output", "Next Choices", choices = c("I'm a brave boi", "Knowledge schmoledge"))
} else {
radioButtons("first_output", "Next Choices", choices = c("Gimme dat ignorance", "Mhmm yea") )
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Is it what you want? I'm not sure.
library(shiny)
library(shinyWidgets)
ui <- fluidPage( #UI
column(6, offset = 3,
sliderInput(inputId = "my_slider", # slider to choose number of panels
label = "Choose Panels to be Displayed",
min = 0, max = 5, value = 1),
uiOutput(outputId = "update_panels") # ui output to create panels
)
)
server <- function(input, output, session) { #Server
output$update_panels <- renderUI({ # rendering all the panels called for by user
panels <- input$my_slider
if(panels == 0){
return("No panels being displayed")# returning 0 if none selected
} else {
our_ui <- list() # creating a list to store a standard panel
for(i in 1:panels){
button_id <- paste("button_id", i, sep = "_") # a unique id for each panel's radiobuttons
oh_lawd <- paste("oh_lawd", i, sep = "_") # a unique id for each panel's uiOutput
update <- wellPanel(paste("Well Panel #", i), # "update" is what each panel should START OFF looking like
radioButtons(inputId = button_id,
label = "Choose a pill",
choices = c("Red Pill", "Blue Pill")),
uiOutput(oh_lawd)) # this part is the issue - I would like to update individual panels with a
# radio button selection specific to a choice in each panel... a nested uiOutput
our_ui <- list(our_ui, update)
}}
our_ui})
observeEvent(input$my_slider, {
lapply(seq_len(input$my_slider), function(i){
uiID <- paste0("oh_lawd_", i)
buttonID <- paste0("button_id_", i)
radioID <- paste0("radio_id_", i)
output[[uiID]] <- renderUI({
if(input[[buttonID]] == "Red Pill"){
choices <- c("I'm a brave boi", "Knowledge schmoledge")
}else{
choices <- c("Gimme dat ignorance", "Mhmm yea")
}
radioButtons(radioID, "Next Choices", choices = choices)
})
})
})
}
# Run the application
shinyApp(ui = ui, server = server)

How to pass datatables row to machine learning model by clicking button?

I am creating a shiny machine learning application. I am displaying data in datatables and want to pass the data to machine learning model by selecting the row and clicking the button to get result.
How can it be done in shiny ?
I think I understand what you are trying to do. Hope this minimal example I made will help you. Use DT for table rendering and row selection (here i suppressed the selection of more than one row because I deduced that is what you want). Use button and isolate to run model only if row is selected and button is pressed. I didn't fit a model here, instead I made a plot with highlited row data, but the principle is exactly the same.
library(shiny)
library(DT)
server <- function(input, output, session) {
output$x1 = DT::renderDataTable(mtcars, server = FALSE, selection = "single")
# client-side processing
output$x2 = renderPrint({
s = input$x1_rows_selected
if (length(s)) {
cat('These rows were selected:\n\n')
cat(s, sep = ', ')
}
})
# highlight selected rows in the scatterplot - here you add your model
output$x3 = renderPlot({
input$run_model # button input
s = isolate(input$x1_rows_selected) # use isolate to run model only on button press
par(mar = c(4, 4, 1, .1))
plot(mtcars[, 2:3])
if (length(s)) points(mtcars[s, 2:3, drop = FALSE], pch = 19, cex = 2)
})
}
ui <- fluidPage(
title = 'Select Table Rows',
h1('A Client-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x1')),
column(3, verbatimTextOutput('x2'))
),
hr(),
h1('Model'),
fluidRow(
column(6, actionButton("run_model", "Go")),
column(9, plotOutput('x3', height = 500))
)
)
shinyApp(ui = ui, server = server)

R shiny Multiple slider inputs based on checkbox inputs

I have used the below code to create checkbox from my data.I would like to create slider input for each checkbox I select from the list.For example if the checkbox has 4 variables like "sky","earth","water","fire" and if I select sky, it should dynamically open a slider input for sky and if I select water it should open up one more slider input for water. I tried conditionalPanel,but I have more than 50 variables in my checkbox,so i cannot write condition for all the 50 variables. Is there any generalized method available in shiny?
server
output$choosedigital=renderUI({
if(is.null(bk$variables))
return()
checkboxGroupInput("choosemedia", "Choose digital",
choices = bk$variables,
selected = bk$variables)
})
output$test <- renderUI({
LL <- list(rep(0,length(input$choosedigital)))
for(i in 0:(length(input$choosedigital))) {
LL[i] <- list(sliderInput(inputId = paste(input$choosedigital,i)
, label = paste(input$choosedigital,i),
min=0,max=25,value = 5))
}
return(LL)
})
You want to put your sliderInputs inside a conditionalPanel in the UI and set the condition so that when the relevant checkbox is clicked the the condition equates to TRUE.
e.g.
library(shiny)
myData = c("One", "Two", "Three")
ui <- fluidPage(
checkboxGroupInput("choosemedia", "Choose digital",
choices = myData,
selected = myData),
textOutput("myText"),
conditionalPanel(condition = "input.choosemedia.includes('One')",
sliderInput("sliderOne", "Choose your value", min=0, max=100, value=50)
),
conditionalPanel(condition = "input.choosemedia.includes('Two')",
sliderInput("sliderTwo", "Choose your other value",
min=0, max=50, value=25))
)
# Define server logic
server <- function(input, output) {
output$myText <- renderText({input$choosemedia})
}
# Run the application
shinyApp(ui = ui, server = server)
If long as you know what the content of bk$variables is you can hardcode them, otherwise you'll have to generate these on the fly.
Hope this is enough info to get you going.

Resources