Creating reactive renderUI - r

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)

Related

How to set up actionButton() or actionBttn() to clear all selections in pickerInput()

When I click on the Action Button, I would like to clear everything: both the output and the selections in the picketInput() (input$engine and input$cylinder in the code below). For consistency if I can do it with shinyWidget's actionBttn, that will be great as well.
library(shiny)
library(shinyWidgets)
df <- mtcars
ui <- fluidPage(
sidebarPanel(
pickerInput("engine", "Select engine:", choices = unique(df$vs),
options = list(
`actions-box` = TRUE),
multiple = TRUE
),
pickerInput("cylinder", "Select cylinder:", choices = unique(df$cyl),
options = list(
`actions-box` = TRUE),
multiple = TRUE
),
actionButton("reset", "Clear Selection"),
),
mainPanel(
textOutput("results")
)
)
server <- function(input, output, session) {
data <- reactiveValues()
observeEvent(input$cylinder, {
tmp <- df
tmp1 <- tmp[tmp$vs %in% input$engine, ]
tmp2 <- tmp1[tmp1$cyl %in% input$cylinder, ]
data$tmp2 <- tmp2
})
output$results <- renderText({
if(is.null(data$tmp2)) return()
print(row.names(data$tmp2))
})
observeEvent(input$reset, {
updatePickerInput(session, "engine", NULL)
updatePickerInput(session, "cylinder", NULL)
data$tmp2 <- NULL
})
}
shinyApp(ui = ui, server = server)
You'll have to respect the order of updatePickerInput's parameters or name them. Your above approach would have updated the label.
Please see ?updatePickerInput and check the following:
library(shiny)
library(shinyWidgets)
library(datasets)
DF <- mtcars
ui <- fluidPage(
sidebarPanel(
pickerInput("engine", "Select engine:", choices = unique(DF$vs),
options = list(
`actions-box` = TRUE),
multiple = TRUE
),
pickerInput("cylinder", "Select cylinder:", choices = unique(DF$cyl),
options = list(
`actions-box` = TRUE),
multiple = TRUE
),
actionBttn("reset", "Clear Selection"),
),
mainPanel(
textOutput("results")
)
)
server <- function(input, output, session) {
data <- reactiveValues()
observeEvent(input$cylinder, {
tmp <- DF
tmp1 <- tmp[tmp$vs %in% input$engine, ]
tmp2 <- tmp1[tmp1$cyl %in% input$cylinder, ]
data$tmp2 <- tmp2
})
output$results <- renderText({
req(data$tmp2)
row.names(data$tmp2)
})
observeEvent(input$reset, {
updatePickerInput(session, inputId = "engine", selected = "")
updatePickerInput(session, inputId = "cylinder", selected = "")
data$tmp2 <- NULL
})
}
shinyApp(ui = ui, server = server)

Limit the options of an input by a previous input in R Shiny

I am building a shiny app and would like to know how to automatically limit the choices for a select input dependent on the option selected in the first input.
The app looks like this:
library(shiny)
library(shinyWidgets)
library(dslabs)
library(tidyverse)
library(plotly)
ui <- fluidPage(
titlePanel("Traffic Incidents"),
sidebarLayout(
sidebarPanel(
# inputs
selectizeInput("vehicleInput", "Vehicle",
choices = unique(incident$vehicle),
selected="448", multiple =FALSE),
selectizeInput("groupInput", "Incident Group",
choices = unique(incidents$group),
selected="None", multiple =FALSE)
),
mainPanel(
# outputs
plotlyOutput("plot"),
br(), br(),
plotlyOutput("plot2")
)
)
)
server <- function(input, output) {
d <- reactive({
filtered <-
incidents %>%
filter(vehicle == input$vehicleInput,
group %in% input$groupInput)
})
output$plot <- renderPlotly({
box <- plot_ly(d(), x = ~month, y = ~casualties) %>%
layout(title = "Incident Casualties",
yaxis = list(title=input$dataInput))
})
output$plot2 <- renderPlotly({
box <- plot_ly(d(), x = ~month, y = ~costs) %>%
layout(title = "Incident Costs",
yaxis = list(title=input$dataInput))
})
}
shinyApp(ui=ui, server=server)
I would like to know how could I limit the options in the "Incident Group" input by the option selected in the "Vehicle" input, i.e. to be able to choose only incidents groups related to individual vehicles.
I know I should use the observe() function, however, I do have difficulties using it properly.
Thank you for any suggestions!
Perhaps this will suffice
ui <- fluidPage(
titlePanel("Traffic Incidents"),
sidebarLayout(
sidebarPanel(
# inputs
uiOutput("veh"),
uiOutput("grp")
),
mainPanel(
# outputs
plotlyOutput("plot"),
br(), br(),
plotlyOutput("plot2")
)
)
)
server <- function(input, output) {
output$veh <- renderUI({
selectizeInput("vehicleInput", "Vehicle",
choices = unique(incident$vehicle),
selected="448", multiple =FALSE)
})
d1 <- reactive({
data <- incidents %>% filter(vehicle %in% req(input$vehicleInput))
})
output$grp <- renderUI({
req(d1())
selectizeInput("groupInput", "Incident Group",
choices = unique(d1()$group),
selected="None", multiple =FALSE)
})
d <- reactive({
req(d1(),input$groupInput)
filtered <- d1() %>% filter(group %in% input$groupInput)
})
output$plot <- renderPlotly({
box <- plot_ly(d(), x = ~month, y = ~casualties) %>%
layout(title = "Incident Casualties",
yaxis = list(title=input$dataInput))
})
output$plot2 <- renderPlotly({
box <- plot_ly(d(), x = ~month, y = ~costs) %>%
layout(title = "Incident Costs",
yaxis = list(title=input$dataInput))
})
}
shinyApp(ui=ui, server=server)

Selection of columns for the table in Shiny

I would like to add a new category at the beginning which will select the columns for the table. I can not combine variables with other elements in an application. Could someone explain to me what I'm doing wrong? As you can see on the graphics program does not work well.
My code:
library(shiny)
data <- data.frame(
Category1 = rep(letters[1:3], each = 15),
Info = paste("Text info", 1:45),
Category2 = sample(letters[15:20], 45, replace = T),
Size = sample(1:100, 45),
MoreStuff = paste("More Stuff", 1:45)
)
ui <- fluidPage(titlePanel("Test Explorer"),
sidebarLayout(
sidebarPanel(
selectizeInput(
"show_vars",
"Columns to show:",
choices = colnames(data),
multiple = TRUE,
selected = c("Category1", "Info", "Category2")
),
uiOutput("category1"),
uiOutput("category2"),
uiOutput("sizeslider")
),
mainPanel(tableOutput("table"))
))
server <- function(input, output, session) {
data2 <- reactive({
req(input$table)
if (input$table == "All") {
return(data)
}
data[, names(data) %in% input$show_vars]
})
output$category1 <- renderUI({
selectizeInput('cat1',
'Choose Cat 1',
choices = c("All", sort(as.character(
unique(data$Category1)
))),
selected = "All")
})
df_subset <- eventReactive(input$cat1, {
if (input$cat1 == "All") {
df_subset <- data
}
else{
df_subset <- data[data$Category1 == input$cat1, ]
}
})
df_subset1 <- reactive({
if (is.null(input$cat2)) {
df_subset()
} else {
df_subset()[df_subset()$Category2 %in% input$cat2, ]
}
})
output$category2 <- renderUI({
selectizeInput(
'cat2',
'Choose Cat 2 (optional):',
choices = sort(as.character(unique(
df_subset()$Category2
))),
multiple = TRUE,
options = NULL
)
})
output$sizeslider <- renderUI({
sliderInput(
"size",
label = "Size Range",
min = min(df_subset1()$Size),
max = max(df_subset1()$Size),
value = c(min(df_subset1()$Size), max(df_subset1()$Size))
)
})
df_subset2 <- reactive({
if (is.null(input$size)) {
df_subset1()
} else {
df_subset1()[df_subset1()$Size >= input$size[1] &
df_subset1()$Size <= input$size[2], ]
}
})
output$table <- renderTable({
df_subset2()
})
}
shinyApp(ui, server)
You have few problems with your code
You stored that reactive value of the columns selection in data2(), and displaying table df_subset2(). As with your code, the columns change when you add columns and select Cat1 dropdown, since its values are dependent on the data.react.
Avoid using generic names like data to store data. Sometimes it interfere with R base names
You need to use ObserveEvent and eventReactive, when you expect the change on UI to reflect
Below is what I fixed, you can change accordingly.
Added a submit button
Wrapped the input selections code into an ObserveEvent
By this, your data is displayed only when you click the submit button.
Here is the code.
library(shiny)
data.input <- data.frame(
Category1 = rep(letters[1:3], each = 15),
Info = paste("Text info", 1:45),
Category2 = sample(letters[15:20], 45, replace = T),
Size = sample(1:100, 45),
MoreStuff = paste("More Stuff", 1:45)
)
ui.r
ui <- fluidPage(titlePanel("Test Explorer"),
sidebarLayout(
sidebarPanel(
selectizeInput(
"show_vars",
"Columns to show:",
choices = colnames(data.input),
multiple = TRUE,
selected = c("Category1", "Info", "Category2")
),
actionButton("button", "An action button"),
uiOutput("category1"),
uiOutput("category2"),
uiOutput("sizeslider")
),
mainPanel(tableOutput("table"))
))
server.r
server <- function(input, output, session) {
data.react <- eventReactive(input$button, {
data.input[, input$show_vars]
})
observeEvent(input$button, {
output$category1 <- renderUI({
data.sel <- data.react()
selectizeInput('cat1',
'Choose Cat 1',
choices = c("All", sort(as.character(
unique(data.sel$Category1)
))),
selected = "All")
})
df_subset <- eventReactive(input$cat1, {
data.sel <- data.react()
if (input$cat1 == "All") {
data.sel
}
else{
data.sel[data.sel$Category1 == input$cat1,]
}
})
output$category2 <- renderUI({
selectizeInput(
'cat2',
'Choose Cat 2 (optional):',
choices = sort(as.character(unique(
df_subset()$Category2
))),
multiple = TRUE,
options = NULL
)
})
df_subset1 <- reactive({
if (is.null(input$cat2)) {
df_subset()
} else {
df_subset()[df_subset()$Category2 %in% input$cat2,]
}
})
output$sizeslider <- renderUI({
sliderInput(
"size",
label = "Size Range",
min = min(data.input$Size),
max = max(data.input$Size),
value = c(min(data.input$Size), max(data.input$Size))
)
})
df_subset2 <- reactive({
if (is.null(input$size)) {
df_subset1()
} else {
df_subset1()[data.input$Size >= input$size[1] &
data.input$Size <= input$size[2],]
}
})
output$table <- renderTable({
df_subset2()
})
})
}
shinyApp(ui, server)

Shiny: select variables to table

I have one question to open the topic already. Well, I'm trying to do a similar app to this one Shiny: dynamic dataframe construction; renderUI, observe, reactiveValues. And I would like to add a new category at the beginning which will select the variables from the table. I can not combine variables with other elements in an application. Could someone explain to me what I'm doing wrong?
As you can see on the graphics program does not work well.
Below is a script
#rm(list = ls())
library(shiny)
data <- data.frame(Category1 = rep(letters[1:3],each=15),
Info = paste("Text info",1:45),
Category2 = sample(letters[15:20],45,replace=T),
Size = sample(1:100, 45),
MoreStuff = paste("More Stuff",1:45))
ui <- fluidPage(
titlePanel("Test Explorer"),
sidebarLayout(
sidebarPanel(
selectizeInput("show_vars", "Columns to show:",
choices = colnames(data), multiple = TRUE,
selected = c("Category1","Info","Category2")),
uiOutput("category1"),
uiOutput("category2"),
uiOutput("sizeslider")
),
mainPanel(
tableOutput("table")
)
)
)
server <- function(input, output,session) {
data2 <- reactive({
req(input$table)
if(input$table == "All"){
return(data)
}
data[,names(data) %in% input$show_vars]
})
output$category1 <- renderUI({
selectizeInput('cat1', 'Choose Cat 1', choices = c("All",sort(as.character(unique(data$Category1)))),selected = "All")
})
df_subset <- eventReactive(input$cat1,{
if(input$cat1=="All") {df_subset <- data}
else{df_subset <- data[data$Category1 == input$cat1,]}
})
df_subset1 <- reactive({
if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Category2 %in% input$cat2,]}
})
output$category2 <- renderUI({
selectizeInput('cat2', 'Choose Cat 2 (optional):', choices = sort(as.character(unique(df_subset()$Category2))), multiple = TRUE,options=NULL)
})
output$sizeslider <- renderUI({
sliderInput("size", label = "Size Range", min=min(df_subset1()$Size), max=max(df_subset1()$Size), value = c(min(df_subset1()$Size),max(df_subset1()$Size)))
})
df_subset2 <- reactive({
if(is.null(input$size)){df_subset1()} else {df_subset1()[df_subset1()$Size >= input$size[1] & df_subset1()$Size <= input$size[2],]}
})
output$table <- renderTable({
df_subset2()
})
}
shinyApp(ui, server)
You don't need data2 since you are not using it and instead you can just use the same condition to filter columns with %in% everywhere you are displaying the dataframe.
#rm(list = ls())
library(shiny)
data <- data.frame(Category1 = rep(letters[1:3],each=15),
Info = paste("Text info",1:45),
Category2 = sample(letters[15:20],45,replace=T),
Size = sample(1:100, 45),
MoreStuff = paste("More Stuff",1:45))
ui <- fluidPage(
titlePanel("Test Explorer"),
sidebarLayout(
sidebarPanel(
selectizeInput("show_vars", "Columns to show:",
choices = colnames(data), multiple = TRUE,
selected = c("Category1","Info","Category2")),
uiOutput("category1"),
uiOutput("category2"),
uiOutput("sizeslider")
),
mainPanel(
tableOutput("table")
)
)
)
server <- function(input, output,session) {
output$category1 <- renderUI({
selectizeInput('cat1', 'Choose Cat 1', choices = c("All",sort(as.character(unique(data$Category1)))),selected = "All")
})
df_subset <- eventReactive(input$cat1,{
if(input$cat1=="All") {df_subset <- data}
else{df_subset <- data[data$Category1 == input$cat1,names(data) %in% input$show_vars]}
})
df_subset1 <- reactive({
if(is.null(input$cat2)){df_subset()} else {df_subset()[df_subset()$Category2 %in% input$cat2,names(data) %in% input$show_vars]}
})
output$category2 <- renderUI({
selectizeInput('cat2', 'Choose Cat 2 (optional):', choices = sort(as.character(unique(df_subset()$Category2))), multiple = TRUE,options=NULL)
})
output$sizeslider <- renderUI({
sliderInput("size", label = "Size Range", min=min(df_subset1()$Size), max=max(df_subset1()$Size), value = c(min(df_subset1()$Size),max(df_subset1()$Size)))
})
df_subset2 <- reactive({
if(is.null(input$size)){df_subset1()} else {df_subset1()[df_subset1()$Size >= input$size[1] & df_subset1()$Size <= input$size[2],names(data) %in% input$show_vars]}
})
output$table <- renderTable({
df_subset2()
})
}
shinyApp(ui, server)

Modify my rChart based on a reactive input?

I am having trouble with some code that I've written.
Here is a sample of the dataset: https://docs.google.com/spreadsheets/d/1C_P5xxzYr7HOkaZFfFiDhanqDSuSIrd2UkiC-6_G2q0/edit?usp=sharing
Objective:
I have a dataset that contains a column of Purchase_Month, candy and freq of the number of times that type of candy was purchased in that given month.
I have an rPlot which I was to change based on the chosen Candy bar in the SelectInput. And output a line chart based on the number of times that candy was purchased that month.
I have my current code below, but it tells me that candyCount is not found.
## ui.R ##
library(shinydashboard)
library(rCharts)
dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
width = 150,
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("bar-chart"))
)
),
dashboardBody(
sidebarPanel(
htmlOutput("candy")
),
mainPanel(
showOutput("plot2", "polycharts")
))
)
##server.R##
library(rCharts)
library(ggplot2)
library(ggvis)
server <- function(input, output, session) {
output$candy <- renderUI({
available2 <- dataset[(dataset$candy == input$candy), "candy"]
selectInput(
inputId = "candy",
label = "Choose a candy: ",
choices = sort(as.character(unique(available2))),
selected = unique(available2[1])
)
})
observeEvent(input$candy, {
candyChoice<- toString(input$customer_issue)
print(candyChoice)
candyCount<- dataset[dataset$candy == candyChoice, ]
})
})
output$plot2 <- renderChart2({
p2 <- rPlot(freq~purchase_month, data = candyCount, type = 'line')
p2$guides(y = list(min = 0, title = ""))
p2$guides(y = list(title = sprintf("%s Claims",input$candy)))
p2$addParams(height = 300, dom = 'chart2')
return(p2)
})
}
Updated Data: Why wouldn't this work?
candyCount<- reactive({
dataset[dataset$candy == input$candy, ]
})
output$plot2 <- renderChart2({
p2 <- rPlot(freq~purchase, data = candyCount(), type = 'line')
p2$guides(y = list(min = 0, title = ""))
p2$guides(y = list(title = ""))
p2$addParams(height = 300, dom = 'chart2')
return(p2)
})
output$candy <- renderUI({
available2 <- dataset[(dataset$candy == input$candy), "candy"]
selectInput(
inputId = "candy",
label = "Choose a candy: ",
choices = sort(as.character(unique(available2))),
selected = unique(available2[1])
)
})
In the above you are trying to subset by an input, which is inside your output. The selectInput needs to be inside UI.R.
A working basic example you may find useful.
library(shiny)
df <- read.csv("/path/to/my.csv")
ui <- shinyUI(pageWithSidebar(
headerPanel('Candy Data'),
sidebarPanel(
selectInput('candy', 'Candy', unique(as.character(df[,2])), selected = "Twix")
),
mainPanel(
plotOutput('plot1')
)
))
server <- shinyServer(function(input, output, session) {
selectedData <- reactive({
df[which(df[,2] == input$candy),3]
})
output$plot1 <- renderPlot({
barplot(selectedData())
})
})
shinyApp(ui, server)
In the above example the ui renders a selectInput which has the ID candy. The value, i.e the candy selected is now assigned to input$candy scope. In server we have a reactive function watching for any input change. When the user selects a new candy this function, df[which(df[,2] == input$candy),3] is saying "subset my data frame, df, by the new input$candy". This is now assigned to the selectedData(). Finally we render then boxplot.
EDIT
server.R
require(rCharts)
options(RCHART_WIDTH = 500)
df <- read.csv("path/to/my.csv")
shinyServer(function(input, output, session) {
selectedData <- reactive({
df[which(df[,2] == input$candy),]
})
output$plot1 <- renderChart({
p <- rPlot(freq~purchase_month, data = selectedData(), type = "line")
p$addParams(dom = 'plot1')
return(p)
})
})
ui.R
require(rCharts)
options(RCHART_LIB = 'polycharts')
shinyUI(pageWithSidebar(
headerPanel('Candy Data'),
sidebarPanel(
selectInput('candy', 'Candy', unique(as.character(df[,2])), selected = "Twix")
),
mainPanel(
showOutput('plot1', 'polycharts')
)
))
save files in directory and then runApp.
At available2 you're filtering the data about a selected candy with dataset$candy == input$candy. But you use the same available2 to determine which are the choices at selectInput. I'm guessing you wanted: available2 <- dataset[, "candy"].

Resources