Shiny App checkboxInput and conditionalPanel - r

I am new to ShinyApp.
I want to use a checkboxInput() with conditionalPanel, so when it's checked, the options for Type will show up (then users can select a Type from "BEER", "REFRESHMENT", "SPIRITS", "WINE"). If it's not checked, the options for Type will not show up.
Below are my code, but when the Type options didn't show no matter I check the box or not. I guess I should write something in the server function? I really don't know. Thank you for your help.
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
img(src = "BCLS.png",align = "right"),
sidebarLayout(
sidebarPanel(sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),
wellPanel(
checkboxInput("checkbox", "Filter by Type", FALSE),
conditionalPanel(
condition="checkbox==true",
selectInput("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "WINE")
)
),
uiOutput("countryOutput")
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("coolplot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("results"))
)
)
)
)
server <- function(input, output, session) {
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected = "CANADA")
})
filtered <- reactive({
if (is.null(input$countryInput)) {
return(NULL)
}
bcl %>%
filter(Price >= input$priceInput[1],
Price <= input$priceInput[2],
Type == input$typeInput,
Country == input$countryInput
)
})
output$coolplot <- renderPlot({
if (is.null(filtered())) {
return()
}
filtered() %>% ggvis(~Alcohol_Content, fill := "#fff8dc") %>%
layer_histograms(width = 1, center = 0)
})
output$results <- renderTable({
filtered()
})
}

I came across this question recently while researching a similar one.
It seems the simple answer to the checkboxInput condition is as below:
condition="input.checkbox==1",

OK, you can classify conditional inputs in two categories.
1) Inputs that depend on the ui.R (in your case the checkboxInput)
2) Inputs that depend on the server.R (not necessary in your example)
Solutions:
1) you can easily solve with a renderUI() function, see the example below.
If you really want 2), you would need a conditionalPanel and you would use a reactive function in the server.R, that you save in an output object and access it with small JS-snippet in the ui.R. For me it looks like 1) is enough for you, if I am mistaken, let me know then we adapt the answer to solve 2).
A hint:
As a default your "checkbox" input takes the boolean value: false. So you would not render the "typeInput" (until you click "checkbox"). So up to that point "typeInput" is null.
However, if you now make dependencies on "typeInput" shiny will be confused,
since "typeInput" is not rendered and therefore does not exist.
So before using "typeInput", you should check, whether it is available:
if(!is.null(input$typeInput)) otherwise shiny will complain that you actually do not have a "typeinput" in your app (again: at least until you click "checkbox").
ui <- fluidPage(
titlePanel("BC Liquor Store prices"),
img(src = "BCLS.png",align = "right"),
sidebarLayout(
sidebarPanel(sliderInput("priceInput", "Price", 0, 100, c(25, 40), pre = "$"),
wellPanel(
checkboxInput("checkbox", "Filter by Type", FALSE),
uiOutput("conditionalInput")
),
uiOutput("countryOutput")
),
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("coolplot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("results"))
)
)
)
)
server <- function(input, output, session) {
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected = "CANADA")
})
output$conditionalInput <- renderUI({
if(input$checkbox){
selectInput("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "WINE")
}
})
filtered <- reactive({
if (is.null(input$countryInput)) {
return(NULL)
}
bcl %>%
filter(Price >= input$priceInput[1],
Price <= input$priceInput[2],
Type == input$typeInput,
Country == input$countryInput
)
})
output$coolplot <- renderPlot({
if (is.null(filtered())) {
return()
}
filtered() %>% ggvis(~Alcohol_Content, fill := "#fff8dc") %>%
layer_histograms(width = 1, center = 0)
})
output$results <- renderTable({
filtered()
})
}
# run the app
shinyApp(ui = ui, server = server)

Related

How to add a button that removes input rows?

I have some code to program a small shiny app for which I need to add input rows and, if needed, delete them again. I have figured out how to add inputs, however I can't figure out how to delete them.
Here is a MWE of my code. There is no output since I cannot share the excel sheet behind the code from which the output is generated. However, it should suffice for simply helping me find the correct code to remove the added rows with full input (except the first row):
library(shiny)
GeographyList <- c("Africa","Asia Pacific","Europe","Global", "United States","Latin America & Caribbean")
RegionList <- c("Emerging",
"Developed")
ClassList <- c("1",
"2",
"3")
# Define UI for app that draws a plot ----
ui <- fluidPage(
fluidRow(
mainPanel(
uiOutput("inputwidgets"),
actionButton("number",
"Add Row"),
# Input: Click to update the Output
actionButton("update", "Update View"),
# Output: Plot ----
h4("Allocation"),
plotOutput("distPlot")
)
)
)
# Define server logic required to call the functions required ----
server <- function(input, output, session) {
# Get new input by clicking Add Row
observeEvent(input$number, {
output$inputwidgets = renderUI({
input_list <- lapply(1:input$number, function(i) {
# for each dynamically generated input, give a different name
fluidRow(
column(2,
selectInput(paste0("Geography", i),
label = paste0("Geography", i),
choices = GeographyList,
multiple = FALSE,
selected = NA)
),
column(3,
selectInput(paste0("Region", i),
label = paste0("Region", i),
choices = RegionList,
multiple = FALSE,
selected = NA)
),
column(4,
selectInput(paste0("Class", i),
label = paste0("Class", i),
choices = ClassList,
multiple = FALSE,
selected = NA)
),
column(3,
# Input: Specify the amount ----
numericInput(paste0("amount",i), label="Amount", 0)
))
})
do.call(tagList, input_list)
})
})
output$distPlot <- renderPlot({
if (input$update == 0)
return()
isolate(input$number)
isolate(input$amount)
slices <- c(input$amount1,input$amount2,input$amount3,input$amount4)
pie(slices)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
Appreciate any tips since I am very new to shiny! Thanks in advance.
You could build your lapply loop based on a reactiveValue which is triggered by your add button and a delete button:
1. Edit: using sapply in output$distPlot according to lapply rows
2. Edit: using existing input values
library(shiny)
GeographyList <- c("Africa","Asia Pacific","Europe","Global", "United States","Latin America & Caribbean")
RegionList <- c("Emerging",
"Developed")
ClassList <- c("1",
"2",
"3")
# Define UI for app that draws a plot ----
ui <- fluidPage(
fluidRow(
mainPanel(
uiOutput("inputwidgets"),
actionButton("number",
"Add Row"),
actionButton("delete_number",
"Delete Row"),
# Input: Click to update the Output
actionButton("update", "Update View"),
# Output: Plot ----
h4("Allocation"),
plotOutput("distPlot")
)
)
)
# Define server logic required to call the functions required ----
server <- function(input, output, session) {
reac <- reactiveValues()
observeEvent(c(input$number,input$delete_number), {
# you need to add 1 to not start with 0
add <- input$number+1
# restriction for delete_number > number
delete <- if(input$delete_number > input$number) add else input$delete_number
calc <- add - delete
reac$calc <- if(calc > 0) 1:calc else 1
})
# Get new input by clicking Add Row
observe({
req(reac$calc)
output$inputwidgets = renderUI({
input_list <- lapply(reac$calc, function(i) {
Geography <- input[[paste0("Geography",i)]]
Region <- input[[paste0("Region",i)]]
Class <- input[[paste0("Class",i)]]
amount <- input[[paste0("amount",i)]]
# for each dynamically generated input, give a different name
fluidRow(
column(2,
selectInput(paste0("Geography", i),
label = paste0("Geography", i),
choices = GeographyList,
multiple = FALSE,
selected = if(!is.null(Geography)) Geography
)
),
column(3,
selectInput(paste0("Region", i),
label = paste0("Region", i),
choices = RegionList,
multiple = FALSE,
selected = if(!is.null(Region)) Region
)
),
column(4,
selectInput(paste0("Class", i),
label = paste0("Class", i),
choices = ClassList,
multiple = FALSE,
selected = if(!is.null(Class)) Class
)
),
column(3,
# Input: Specify the amount ----
numericInput(
paste0("amount",i),
label="Amount",
value = if(!is.null(amount)) amount else 0
)
))
})
do.call(tagList, input_list)
})
})
output$distPlot <- renderPlot({
req(reac$calc, input$update)
slices <- sapply(reac$calc, function(i) {
c(input[[paste0("amount",i)]])
})
pie(slices)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)

R shiny favourites in long selectInput lists

How do I deal with long lists of options? In the example below, I have a subset of the options as favourites, but want to be able to select all options including the non-favourites. How do I get the input$selected to return what I selected last based on both the radiogroupbutton() and the selectInput()?
EDIT: I would like to keep the look, which has radiobuttons AND a drop down list. Therefore, I assume both will need different inputID's which then could be combined (somehow) in the server site (as Joris suggested). I am not sure how to combine them on the server site, and how to identify what was selected last.
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId="selected",
choices = sort(favourites),
individual = TRUE,
selected = NULL,
width="20%"),
selectInput(inputId="selected", label = "Other options",
choices = ALL.options,
selected = NULL),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
)
server <- function(input, output) {
output$choice <- renderPrint(
input$selected
)
}
shinyApp(ui, server)
Perhaps it suffices to use a single selectInput or selectizeInput that lists the Favourites and Other options in separate option groups (see e.g. Shiny: Option groups for selectize input):
library(shiny)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
selectizeInput(inputId = "selected", label = "All options", choices = list(
Favourites = favourites,
`Other options` = setdiff(ALL.options, favourites)
),
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
output$choice <- renderPrint({
validate(need(input$selected, "None selected"))
input$selected
})
}
shinyApp(ui, server)
NB: If you instead use two separate inputs (radioGroupButtons and selectInput) you could combine the selected choices server-side in a reactive object. For instance:
library(shiny)
library(shinyWidgets)
ALL.options <- apply(expand.grid(LETTERS, LETTERS), 1, function(x){paste(x, collapse="")})
favourites <- sample(ALL.options, 20)
ui <- fluidPage(
h3("Favourites:"),
radioGroupButtons(inputId = "radio",
choices = sort(favourites),
individual = TRUE,
selected = character(0),
width="20%"),
selectizeInput(inputId="select", label = "Other options",
choices = ALL.options,
options = list(
placeholder = '<None selected>',
onInitialize = I('function() { this.setValue(""); }')
)
),
h3("THIS IS YOUR SELECTION:"),
verbatimTextOutput("choice")
)
server <- function(input, output) {
## initialize reactive value
currentSelected <- reactiveVal(NULL)
## update based on radioGroupButtons
observeEvent(input$radio, {
currentSelected(input$radio)
})
## update based on selectInput
observeEvent(input$select, {
currentSelected(input$select)
})
output$choice <- renderPrint({
validate(need(currentSelected(), "None selected"))
currentSelected()
})
}
shinyApp(ui, server)
Created on 2019-06-17 by the reprex package (v0.3.0)
I am not sure if I understand fully what you are trying to achieve. I also notice that both the radioGroupButtons and the selectInput have the same inputId. If the idea is to print both the choices, you could change the inputId of the selectInput to say, select and just modify the renderPrint as:
output$choice <- renderPrint(
c(input$selected, input$select)
)
Is this what you are looking for?

How to add a user defined value to the select list of values from dataset

I am new to Shiny R, and as part of a project I would have to show distinct values for selection in a selectlist, but I also need to provide an option called "All" to query with.
dataset <- read.csv("dataset.csv", header=TRUE)
fluidPage(
title = "ABC XYZ",
hr(),
fluidRow(
titlePanel("ABC XYZ"),
sidebarPanel(
selectInput("region", label = "Region",
choices = unique(dataset$region),
selected = 1)
)
)
Can anyone help me achieve the same.
Thanks in advance.
We could create an additional level or unique element 'All' in choices and update with updateSelectInput
library(shiny)
library(DT)
library(dplyr)
#using a reproducible example
dataset <- iris
allchoice <- c("All", levels(dataset$Species))
-ui
ui <- fluidPage(
title = "ABC XYZ",
hr(),
fluidRow(
titlePanel("ABC XYZ"),
sidebarPanel(
selectInput("species", label = "Species",
choices = allchoice, multiple = TRUE),
verbatimTextOutput("selected")
),
mainPanel(dataTableOutput('out')))
)
-server
server <- function(input, output, session) {
observe({
if("All" %in% input$species) {
selected <- setdiff(allchoice, "All")
updateSelectInput(session, "species", selected = selected)
}
})
output$selected <- renderText({
paste(input$species, collapse = ", ")
})
output$out <- renderDataTable({
dataset %>%
filter(Species %in% input$species)
})
-run app
shinyApp(ui, server)

Creating reactive renderUI

I am following this tutorial to learn to build Shiny apps. In the final version, the renderUI() for "Country" just takes all of the countries in the dataset. Is there a way to make this list reactive/filtered based on the price range selected with the slider?
Here is the relevant code:
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected="CANADA")
})
And here is the entire. very simple app:
library(shiny)
library(ggplot2)
library(dplyr)
bcl <- read.csv("bcl-data.csv", stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("BC Liquor Prices", windowTitle = "Mmmmm yeh"),
sidebarLayout(
sidebarPanel(
sliderInput("priceInput", "Price",
min = 0, max = 100,
value = c(25, 40), pre = "$"
),
radioButtons("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "WINE"
),
uiOutput("countryOutput")
),
mainPanel(plotOutput("coolplot"),
br(),
br(),
tableOutput("results")
)
)
)
server <- function(input, output, session) {
filtered <- reactive({
if (is.null(input$countryInput)) {return(NULL)}
bcl %>%
filter(
Price >= input$priceInput[1],
Price <= input$priceInput[2],
Type == input$typeInput,
Country == input$countryInput
)
})
output$countryOutput <- renderUI({
selectInput("countryInput", "Country",
sort(unique(bcl$Country)),
selected="CANADA")
})
output$coolplot <- renderPlot({
if (is.null(filtered())) {return()}
ggplot(filtered(), aes(Alcohol_Content)) + geom_histogram()
})
output$results <- renderTable({
filtered()
})
}
shinyApp(ui = ui, server = server)
Try this code...You need two different reactive values: 1) One to generate the country list based on first two inputs and 2) Two two generate the plot and table results based on the selected country.
Also, I changed the names to reflect the actual column names I get when reading that file. You may need to change back IF you changed them in some other part of the code.
library(shiny)
library(ggplot2)
library(dplyr)
bcl <- read.csv("bcl-data.csv", stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("BC Liquor Prices", windowTitle = "Mmmmm yeh"),
sidebarLayout(
sidebarPanel(
sliderInput("priceInput", "Price",
min = 0, max = 100,
value = c(25, 40), pre = "$"
),
radioButtons("typeInput", "Product type",
choices = c("BEER", "REFRESHMENT", "SPIRITS", "WINE"),
selected = "BEER"
),
uiOutput("countryOutput")
),
mainPanel(plotOutput("coolplot"),
br(),
br(),
tableOutput("results")
)
)
)
server <- function(input, output, session) {
filteredForCountry <- reactive({
bcl %>%
filter(
CURRENT_DISPLAY_PRICE >= input$priceInput[1],
CURRENT_DISPLAY_PRICE <= input$priceInput[2],
PRODUCT_SUB_CLASS_NAME == input$typeInput
)
})
output$countryOutput <- renderUI({
df <- filteredForCountry()
if (!is.null(df)) {
selectInput("countryInput", "Country",
sort(unique(df$PRODUCT_COUNTRY_ORIGIN_NAME)),
selected="CANADA")
}
})
filteredFull <- reactive({
if (is.null(input$countryInput)) {
return (filteredForCountry())
}
bcl %>%
filter(
CURRENT_DISPLAY_PRICE >= input$priceInput[1],
CURRENT_DISPLAY_PRICE <= input$priceInput[2],
PRODUCT_SUB_CLASS_NAME == input$typeInput,
PRODUCT_COUNTRY_ORIGIN_NAME == input$countryInput
)
})
output$coolplot <- renderPlot({
if (is.null(filteredFull())) {return()}
ggplot(filteredFull(), aes(PRODUCT_ALCOHOL_PERCENT)) +
geom_histogram(binwidth = 0.05)
})
output$results <- renderTable({
filteredFull()
})
}
shinyApp(ui = ui, server = server)

shiny conditionalPanel update problems

I have a Shiny app that doesn't give any error but clearly my conditionalPanel are not working properly. When I select the inputs some graphs get updated and some don't. For example if I select week and change the condition for 0 or 1 the graphs get updated, but if I select rel the graph gets update for 1 but not for 4 (If I do this outside the Shiny app it works for all cases). This is how the code looks like:
UI.R
shinyUI(pageWithSidebar(
headerPanel(' '),
sidebarPanel(
selectInput('zcol', 'Variable to be fixed', names(taxi[,-c(1,4,5,7,8,9,10,11)])),
conditionalPanel(condition = "input.zcol == 'week'",
selectInput("levels", "Levels",c(0,1)
)),
conditionalPanel(condition = "input.zcol == 'tollfree'",
selectInput("levels", "Levels",c(0,1)
)),
conditionalPanel(condition = "input.zcol == 'rel'",
selectInput("levels", "Levels",c(1,4)
)),
conditionalPanel(condition = "input.zcol == 'source'",
selectInput("levels", "Levels",c(1,2)
)),
conditionalPanel(condition = "input.zcol == 'hour'",
selectInput("levels", "Levels",c(seq(0,23))
))
),
mainPanel(
plotOutput('plot1'),
plotOutput('plot2')
)
))
Server.R
shinyServer(function(input, output, session) {
simiData <- reactive({
eval(substitute(taxi %>% group_by(simi.mean,col) %>% summarise(mean = mean(prop.conv)) %>%
filter(col==input$levels) %>% select(simi.mean,mean),
list(col=as.symbol(input$zcol))))
})
distData <- reactive({
eval(substitute(taxi %>% group_by(dist.mean,col) %>% summarise(mean = mean(prop.conv)) %>%
filter(col==input$levels) %>% select(dist.mean,mean),
list(col=as.symbol(input$zcol))))
})
output$plot1 <- renderPlot({
plot(simiData(),xlim=c(0,max(simiData()$simi.mean)),ylim=c(0,max(simiData()$mean)))
})
output$plot2 <- renderPlot({
plot(distData())
})
})
Any suggestions?
Thanks!
Instead of having multiple selectinputs, you can just have one and update the choices using updateSelectInput(session,"levels",choices = newValue)) You can use an observer to change the choices of input$levels each time a input$zcol changed.
Here is basic example of how to update a selectinput using an observer
taxi <- data.frame(week=sample(1:10),hour=sample(1:10))
runApp(list(
ui = shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("zcol", 'Variable to be fixed', names(taxi)),
selectInput("levels", "Levels",1:5)
),
mainPanel(
plotOutput('plot1')
)
)
)
),
server = function(input, output, session) {
output$plot1 <- renderPlot({
plot(taxi[1:input$levels,])
})
observe({
if ( input$zcol == 'week') {
updateSelectInput(session, "levels", choices = 1:5)
} else if(input$zcol == 'hour') {
updateSelectInput(session, "levels", choices = 6:10)
}
})
}
))
You can't have multiple selectInputs with the same inputId ("levels"). Each one needs a unique inputId.

Resources