I am new to RShiny. I want to populate RShiny dropdowns based previous selections.
For E.g. in the image below,
User first selects the 'route', upon which 'schedule' drop-down gets populated, then user selects 'schedule', then 'trip' drop-down is populated and user selects a 'trip' input.
This is my code:
library(shiny)
library("plotly")
library(lubridate)
require(rgl)
require(akima)
library(dplyr)
library(DT)
data335 <<- read.csv("final335eonly.csv")
#data335[c(2,4,5,8,9,10)] = lapply(data335[c(2,4,5,8,9,10)], as.numeric)
routes <<- as.vector(unique(data335[,'route_no']))
ui <- fluidPage(
titlePanel("Demand Analysis"),
selectInput("routeInput", "Select the route", choices = routes),
selectInput("scheduleInput", "Select the schedule", c("")),
selectInput("tripInput", "Select the trip", c(""))
)
server <- function(input, output, session) {
observeEvent(input$routeInput,
{
x <<- input$routeInput
updateSelectInput(session, "scheduleInput",
choices = data335[data335$route_no == input$routeInput, ]$schedule_no,selected = tail(x, 1)
)
}
)
observeEvent(input$scheduleInput,
{
y <<- input$scheduleInput
updateSelectInput(session, "tripInput",
choices = data335[(data335$route_no == input$routeInput & data335$schedule_no == input$scheduleInput), ]$trip_no,selected = tail(y, 1)
)
}
)
}
shinyApp(ui = ui, server = server)
The input csv file required is here:
Whenever I try to run this seemingly simple code, eventhough the UI appears, when I try to select the inputs in dropdown, RShiny crashes.
Can you please let me know what is causing this?
The problem is happening because you are not giving unique values as choices. data335[data335$route_no == input$routeInput, ]$schedule_no have duplicate values which causes the crash.
Also, you are selecting the value of input$routeInput in your scheduleInput, which is not listed in the choice could be another reason for the crash.
Just commenting the two statements and adding unique to your choices resolves the crash.
Also as #parth pointed out in his comments why are you using <<- everywhere in your code, it not necessary. Although its not the cause of the crash, until and unless you want to share variables between sessions use of <<- inside the server is not a good practice.
Here is your code with the commented section with two selected arguments commented and unique added that works:
library(shiny)
library("plotly")
library(lubridate)
require(rgl)
require(akima)
library(dplyr)
library(DT)
data335 <<- read.csv("final335eonly.csv", stringsAsFactors = FALSE)
routes <<- as.vector(unique(data335[,'route_no']))
ui <- fluidPage(
titlePanel("Demand Analysis"),
selectInput("routeInput", "Select the route", choices = routes),
selectInput("scheduleInput", "Select the schedule", c("")),
selectInput("tripInput", "Select the trip", c(""))
)
server <- function(input, output, session) {
observeEvent(input$routeInput,
{
x <<- input$routeInput
updateSelectInput(session, "scheduleInput",
choices =unique(data335[data335$route_no == input$routeInput, ]$schedule_no),#selected = tail(x, 1)
)
}
)
observeEvent(input$scheduleInput,
{
y <<- input$scheduleInput
updateSelectInput(session, "tripInput",
choices = unique(data335[(data335$route_no == input$routeInput & data335$schedule_no == input$scheduleInput), ]$trip_no),#selected = tail(y, 1)
)
}
)
}
shinyApp(ui = ui, server = server)
Related
I have create one app that contains a textInput and a selectizeInput. Depending on the user's input and if the input can be found in one dataset, you will see all the possibilities according to that textInput in the selectizeInput.
In this way, if the user introduces a word that it is not in the dataset, the selectizeInput can't display any choice.
Everything works fine, but I found one problem. If the user starts writing a correct word, the user gets a dropdown list... and then, if the input is removed... the dropdown list is still there (the choices from selectizeInput are still there).
Here the code:
library(shiny)
library(dplyr)
library(stringr)
ui <- fluidPage(
textInput("my_input", "Introduce a word"),
selectizeInput(inputId = "dropdown_list", label = "Choose the variable:", choices=character(0)),
)
server <- function(input, output, session) {
my_list <- reactive({
req(input$my_input)
data <- as.data.frame(storms)
res <- subset(data, (grepl(pattern = str_to_sentence(input$my_input), data$name))) %>%
dplyr::select(name)
res <- as.factor(res$name)
return(res)
})
# This is to generate the choices (gene list) depending on the user's input.
observeEvent(input$my_input, {
updateSelectizeInput(
session = session,
inputId = "dropdown_list",
choices = my_list(), options=list(maxOptions = length(my_list())),
server = TRUE
)
})
}
shinyApp(ui, server)
Do you know how can I remove the choices from the selectizeInput if the user deletes the input?
Thanks very much in advance
Regards
The issue is the req(input$myinput). Hence, if the user deletes the input my_list() does not get updated. Instead of req you could use an if to check whether the input is equal to an empty string:
my_list <- reactive({
if (!input$my_input == "") {
data <- as.data.frame(storms)
res <- subset(data, grepl(pattern = str_to_sentence(input$my_input), data$name), name)
res <- as.factor(res$name)
return(res)
}
})
Could you please help me solving an issue related to Hierarchical input select.
I build a simply app for hierarchical input selecting, where the choices of each selectInput are updating based on the previous user selection. The app works, but I have found some strange behavior, which I want to avoid if possible.
My first input is the sliderInput, where the user can select which rows of the mtcars table should be used for the further sub-selection.
Then the selected cars are shown in the first selectInput and after the user choose which cars he want to see, the second selectInput mpg is filtered respectively.
Then after pressing an Action button, the sub-selection is displayed as table output.
When the user start the procedure from the beginning by changing the sliderInput, only the cars choices are updated. If we press on mpg selectInput we can still see the old selection.
Off course when we select again some cars the mpg are getting updated.
Do you know some way to avoid this behavior. My goal is, that mpg is always empty after the sliderInput is getting updated and not showing the old selections.
Thank you.
John
# Hierarchical inputSelect Example with mtcars
library(shiny)
library(dplyr)
ui <- fluidPage(
mainPanel(
fluidRow(
column(width=2,
sliderInput(inputId = "RowsINP",label = "Rows",min=1, max = dim(mtcars)[1], value=16,step=1),
selectInput("carsINP", "cars", choices = NULL,multiple=TRUE),
selectInput("mpgINP", "mpg", choices = NULL,multiple=TRUE),
actionButton("actionINP", "action")
),
column(width=10,
tableOutput('table')
)
)
)
)
server <- function(input, output,session) {
mtcars_tab <- reactive({
req(input$RowsINP)
data.frame(cars=rownames(mtcars[1:input$RowsINP,]),mtcars[1:input$RowsINP,])
})
observeEvent(mtcars_tab(), {
updateSelectInput(session,"carsINP", choices = unique(mtcars_tab()$cars))
})
cars <- reactive({
req(input$carsINP)
filter(mtcars_tab(), cars %in% input$carsINP)
})
observeEvent(cars(), {
# Also tried this option and many others
# if (!isTruthy(input$carsINP[1])){choices <- NULL}
# else{ choices <- unique(arrange(cars(),mpg)$mpg)}
choices <- unique(arrange(cars(),mpg)$mpg)
updateSelectInput(session, "mpgINP", choices = choices)
})
mpg <-eventReactive(input$actionINP,{
filter(cars(), mpg %in% input$mpgINP)
})
output$table <- renderTable(mpg())
}
# Run the application
shinyApp(ui = ui, server = server)
In my opinion, uiOutput/renderUI is perfect for these situations. We can avoid using a bunch of observeEvent and updateSelectInput calls, and the dropdown choices are updated (effectively) instantaneously, so you won't see the issue you've shown in your example. I think it's also a little bit easier to follow.
library(dplyr)
library(shiny)
ui <- {
fluidPage(
fluidRow(
sliderInput(inputId = "rows",label = "Rows",
min=1, max = dim(mtcars)[1],
value=16, step=1),
uiOutput('car_selector'),
uiOutput('mpg_selector'),
actionButton('action', 'Action'),
dataTableOutput('table_data')
)
)
}
server <- function(input, output, session) {
# render the car selection input
output$car_selector <- renderUI({
selectInput('car_input', 'Cars',
choices = rownames(mtcars)[1:input$rows],
multiple = TRUE)
})
# render the mpg selection input
output$mpg_selector <- renderUI({
selectInput('mpg_input', 'mpg',
choices = mtcars[rownames(mtcars) %in% input$car_input, 'mpg'],
multiple = TRUE)
})
# update the table data when the action button is clicked
table_data <- eventReactive(input$action, {
mtcars[rownames(mtcars) %in% input$car_input & mtcars$mpg %in% input$mpg_input, ]
})
# render the table data
output$table_data <- renderDataTable(table_data())
}
shinyApp(ui, server)
Here is the context :
library(shiny)
liste_statut <- c("A","B","C")
ui <- shinyUI(fluidPage(uiOutput("testUI")))
server <- function(input, output, session) {
output$testUI <- renderUI({
navbarPage(
title = "Test",
tabPanel(icon = icon("users"), 'Test',
sidebarPanel(
# Statut
checkboxGroupInput("statut", "Statut", liste_statut, liste_statut),
checkboxInput('selectall_statut', 'Tout / Aucun', T))))
})
# observe({
# updateCheckboxGroupInput(
# session, 'statut', choices = liste_statut,
# selected = if (input$selectall_statut) liste_statut
# )
# })
}
shinyApp(ui = ui, server = server)
I would like to use my checkbox All/None (in comment lines) properly cause in this case i have a "Warning: Error in if: argument is of length zero". Where should i put it or maybe should i redefine properly something in the UI part?
I willingly use the renderUI/uiOutput option (contrary to the "standard mode" ui/server) because in future, i will add an authentification module, so be able to display several "panels" according to user.
Thanks and sorry for my terrible english :).
The following works for me:
library(shiny)
liste_statut <- c("A","B","C")
ui <- shinyUI(fluidPage(uiOutput("testUI")))
server <- function(input, output, session) {
output$testUI <- renderUI({
navbarPage(
title = "Test",
tabPanel(icon = icon("users"), 'Test',
sidebarPanel(
# Statut
checkboxGroupInput("statut", "Statut", liste_statut, liste_statut),
checkboxInput('selectall_statut', 'Tout / Aucun', T))))
})
observeEvent(input$selectall_statut,{
val <- liste_statut
if(!input$selectall_statut)
val <- character(0)
updateCheckboxGroupInput(
session, 'statut',
selected = val
)
})
}
I initially tried selected = ifelse(input$selectall_statut, liste_statut, character(0)) instead of the intermediate variable val. However, ifelse() only returned a single value, not a vector.
If you are going to do this many times over, then I would recommend a custom ifelse function. Perhaps something like the following:
ifelse2 <- function(test, yes, no){
if(test)
return(yes)
return(no)
}
I need your help, because I don't know how to solve my problem. I have my shiny app where I have data frame (imported from file) and checkboxgroupinput where I can mark which columns are for me interesting. After that in other tabpanel I would like to get two plot for each column (in one facet_wrap). All facet_wrap one under the other. The problem is that number of interesting columns is not constant. It is easy for my if I could hardcode number of rows with plots, but where it can change dynamically I have no idea how to program it, any tips from your side?
We can't solve your question without a reproducible example but you should be able to figure it out from this quick example of using uiOutput along with renderUI. This allows the use of dynamic values in UI elements.
Normally you would define your static input as checkboxGroupInput("columns", "Select the variables to plot", choices = vector_of_known_values).
However as per your question, this doesn't work if the dataset is not known beforehand (e.g.: user file upload). In this case use uiOutput in the UI part: uiOutput("ui"), so that you delay evaluation to server side. In server side you can dynamically set the choices regardless of the data structure.
output$ui <- renderUI( {
checkboxGroupInput("columns", "Select the variables to plot", choices = colnames(rv$data))
})
See full example:
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("datasets", "Select a dataset", choices = c("mtcars", "iris"), selected = "mtcars"),
uiOutput("ui")
),
mainPanel(
DT::dataTableOutput("table")
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues(data = NULL)
observe( {
rv$data <- eval(parse(text = input$datasets))
})
filtered <- reactive( {
req(input$columns)
if( all(!input$columns %in% colnames(rv$data))) {
NULL
} else {
rv$data %>% select(input$columns)
}
})
output$ui <- renderUI( {
checkboxGroupInput("columns", "Select the variables to plot", choices = colnames(rv$data))
})
output$table <- DT::renderDataTable( {
req(filtered())
DT::datatable(filtered())
})
}
shinyApp(ui, server)
I reproduced an example shiny app written by Yihui Xie (https://yihui.shinyapps.io/DT-rows/). The app uses DT::renderDataTable() which allows a row selection.
Everything works perfectly fine. I was however wondering if it's possible to reset the row selection (i.e. undo the click selection) ? I already tried it with an action button to reset s = input$x3_rows_selected (see script below).
With my current script,s = input$x3_rows_selected does indeed get emptied, I can however not refill it. Also the selected rows are still clicked (shaded)
Does anyone has an idea? Is there an option within DT::renderDataTable() to reset the selection? Or does anyone has an idea for a workaround?
Thank you!
Example form https://yihui.shinyapps.io/DT-rows/) with my modification (action button):
server.R
library(shiny)
library(DT)
shinyServer(function(input, output, session) {
# you must include row names for server-side tables
# to be able to get the row
# indices of the selected rows
mtcars2 = mtcars[, 1:8]
output$x3 = DT::renderDataTable(mtcars2, rownames = TRUE, server = TRUE)
# print the selected indices
selection <- reactive({
if (input$resetSelection)
vector() else input$x3_rows_selected
})
output$x4 = renderPrint({
if (length(selection())) {
cat("These rows were selected:\n\n")
output <- selection()
cat(output, sep = "\n")
}
})
})
ui.R
library(shiny)
shinyUI(
fluidPage(
title = 'Select Table Rows',
h1('A Server-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4'),
actionButton('resetSelection',
label = "Click to reset row selection"
) # end of action button
) #end of column
)))
In the current development version of DT (>= 0.1.16), you can use the method selectRows() to clear selections. Please see the section "Manipulate An Existing DataTables Instance" in the documentation.
Here is a possible solution, maybe not the best but it works. It is based on re-create the datatable each time the action button is clicked, so the selected rows are removed.
library(shiny)
library(DT)
runApp(list(
server = function(input, output, session) {
mtcars2 = mtcars[, 1:8]
output$x3 = DT::renderDataTable({
# to create a new datatable each time the reset button is clicked
input$resetSelection
mtcars2
}, rownames = TRUE, server = TRUE
)
# print the selected indices
selection <- reactive ({
input$x3_rows_selected
})
output$x4 = renderPrint({
if (length(selection())) {
cat('These rows were selected:\n\n')
output <- selection()
cat(output, sep = '\n')
}
})
},
ui = shinyUI(fluidPage(
title = 'Select Table Rows',
h1('A Server-side Table'),
fluidRow(
column(9, DT::dataTableOutput('x3')),
column(3, verbatimTextOutput('x4'),
actionButton( 'resetSelection',label = "Click to reset row selection")
) #end of column
)
))
))