I saw some previous questions that may circle around this issue, but I couldn't find a clear answer to that.
My problem is that an ui element added using insertUI that depends on a reactive value does not update.
In the example I gave below, if one adds the new selectInput using the button and then changes the gender selection, the choices are updated only in the first selectInput.
The question is: is there an "official" way to make this selectInput reactive? I can imagine some workarounds, but they are not ideal.
server.R
library(shiny)
library(tidyverse)
server <- function(input, output, session) {
data <- reactive({
req(input$genderSelection)
starwars %>%
filter(gender == input$genderSelection)
})
output$characterSelection1 <- renderUI({
selectInput(
"char1",
"Character 1",
choices = data() %>%
.$name
)
})
observeEvent(
input$btn,
{
insertUI(
selector = "#selection2",
where = "beforeEnd",
ui = selectInput(
"char2",
"Character 2",
choices = data() %>%
.$name
)
)
}
)
}
ui.R
ui <- fluidPage(
radioButtons(
"genderSelection",
"Gender",
choices = c("male", "female")
),
uiOutput("characterSelection1"),
tags$div(
id = "selection2",
actionButton("btn", "Add selection")
)
)
Related
I want to hide a selectInput so it doesnt let people try and use it before the data has loaded.
Snippet of UI code.
ui <- dashboardPage(
dashboardHeader(title = "TCS Adverse Event Search Tool"),
dashboardSidebar(
sidebarMenu(
shinycssloaders::withSpinner(
selectInput("ingredients",
label = "Select one or more Active Ingredients:",
choices = NULL,
multi=TRUE)
),
In my server function I have this:
server <- function(input, output, session) {
# get main data frame
ingredients_df <- reactive({
ingredients_df <- read.csv(file="/projects/other/pv_compliance/active_ingredients.csv")
print(paste(nrow(ingredients_df)," active ingredient rows returned"))
return(ingredients_df)
})
cases_df <- reactive({
cases_df <- read.csv(file="/projects/other/pv_compliance/adverse_events.csv")
print(paste(nrow(cases_df)," case rows returned"))
return(cases_df)
})
observeEvent(ingredients_df(), {
updateSelectInput(session,
"ingredients",
choices = ingredients_df()$PRIMARY_SUSPECT_KEY_INGREDIENT,
selected = NULL
)
})
Two things are happening...
the set of widgets now appear about halfway down the sidebar and not the top
the css loader does not display when the updateSelectInput is getting the data
I am recently building a shiny app, somewhere in my app I am expecting an arbitrary number of inputs which the user can specify from a line of selectInput() widgets.
Since the number of selectInput() widgets may be large, I would like it to happen that the next selectInput() widget only shows when the pervious one is filled by the user.
My idea is that I will:
create all possible selectInput() widgets in a tagList,
hide them all by default, and
show the next one when the previous one is filled.
I am fine with the first and third step, but when I tried to hide them all using the shinyjs function hide, it seems it does not work for input objects created in a tagList, it only works for those widgets that is created with a specific name, please see the example below:
library(shiny)
library(shinyjs)
ui <- fluidPage(
# Application title
titlePanel("Hello Shiny!"),
sidebarLayout(
# Sidebar with a slider input
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 0,
max = 1000,
value = 500)
),
# Show a plot of the generated distribution
mainPanel(
useShinyjs(),
uiOutput('comparisons')
)
)
server <- shinyServer(function(input, output, session) {
observe(1, shinyjs::hide('compare_1') )
output$comparisons=renderUI({
out=tagList()
out=lapply(1:6, function(x){
selectizeInput(paste0('compare_',x),
label = 'Condition 1',
c('aa','bb', 'cc'))
})
out
})
})
shinyApp(ui, server)
Say I'm creating 6 selectInput widgets, name them compare_1 to compare_6, I also created a sliderInput called obs just to show as an example. In Server if I just say shinyjs::hide('obs'), the sliderInput will be hidden, but when I call shinyjs::hide('compare_1'), the selectInput is still there. Any idea will be appreciated!
Hi you can do that with conditinalPanel quite easy
ui <- fluidPage(
# Application title
titlePanel("Hello Shiny!"),
sidebarLayout(
# Sidebar with a slider input
sidebarPanel(
sliderInput("obs",
"Number of observations:",
min = 0,
max = 1000,
value = 500)
),
# Show a plot of the generated distribution
mainPanel(
useShinyjs(),
uiOutput('comparisons')
)
)
)
server <- shinyServer(function(input, output, session) {
output$comparisons=renderUI({
out=tagList(
selectizeInput(paste0('compare_1'),
label = 'Condition 1',
c("",'aa','bb', 'cc')),
lapply(2:6, function(x){
conditionalPanel(
paste0("input.compare_",x-1," != ''"),
selectizeInput(paste0('compare_',x),
label = paste0('Condition ',x),
c("",'aa','bb', 'cc'))
)
})
)
out
})
})
shinyApp(ui, server)
I am trying to take the speed variable from the "car" data set which I am uploading to the application. Basically Under select speed: I would like to have all the numbers appearing in the dataset$speed. Under selecInput, the choices should depend upond the data set I am uploading using fileInput. How can I complete this task. For now I have added the choices as 1,2,3. In theory there should be all values of the speed variable of cars data set.
library(shiny)
library(datasets)
##the file I am uploading
data(cars)
dataset=write.csv(cars, "dataset.csv")
ui=fluidPage(
actionButton("upload", "Upload File"),
bsModal("uploadFile", " ", "upload",
sidebarLayout(
sidebarPanel(
fileInput("file","Choose file to upload")
),
mainPanel(
tableOutput("contents")
)
)
),
sidebarLayout(
sidebarPanel(
column(3, selectInput("selectElement", "Select speed:", c(1,2,3),multiple =
T, selectize = F)
)
),
mainPanel(
)
)
)
server=function(input,output,session){
output$contents <- renderTable({
inFile <- input$file
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath)
})
}
shinyApp(ui,server)
My apologies in advance for a somewhat incomplete response: see below.
First of all, an answer to your query:
If you have a dataset like cars, to identify the "speed" labels you can do:
labls <- unique(cars$speed)
...
selectInput("selectElement", "Select speed:", labls, multiple =
T, selectize = F)
I was hoping to post a complete example, but the current logic (maybe because of the limited code posted?) does not seems right: how can the app a) leave to the user to select which file to use; and at the same time b) already filter for speed?
Of course it is possible that you plan to display datasets that have all a column called "speed", then it would make sense :)
Additionally, but this was not part of your question, you appear to use modal dialogues through the package shinyBS.
Since version 0.14 of shiny (around October 2016) shiny has a very good modal function and personally I think it would be better to use the native function instead.
I thougth to post a simple example derived from your code (but with the selectInput for speed commented out because, as mentioned, it does not appear right in the context of the example posted).
library(shiny)
library(datasets)
data(cars)
dataset = write.csv(cars, "dataset.csv")
labls <- unique(cars$speed) # I left this in the code
ui=fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("upload", "Upload File")
),
mainPanel(tableOutput("contents") )
))
server=function(input,output,session){
# Show modal when button is clicked.
observeEvent(input$upload, {
showModal(dataModal())
})
dataModal <- function(failed = FALSE) {
modalDialog(
fileInput('inputId', label=NULL, multiple = FALSE, accept = NULL, width = NULL, buttonLabel = "Browse...", placeholder = "No file selected")
# , selectInput("selectElement", "Select speed:", labls, multiple =
# T, selectize = F)
)
}
output$contents <- renderTable({
if (length(input$inputId )== 0) return(NULL)
inFile <- input$inputId
# if (is.null(input$selectElement )) return(NULL)
input$inputId
})
}
shinyApp(ui,server)
Here is an existing example
library(shiny)
runExample("06_tabsets")
And you will see you can choose distribution type in radiobutton and there are three tabs "Plot", "Summary", and "Table".
My question is how can I add a selectInput under the sliderInput(number of observations) with two values. The default one is "NULL", the second one is "1". Once users select "1", the previous three tabs would disappear. Instead, a new tab would show whatever it content is.
This is the modified "06_tabsets". A select input is added and the UI is generated depending of the selection. The only difference is that is not using NULL, but two options. I could make it run with NULL. Let me know if this helps.
ui.R
library(shiny)
# Define UI for random distribution application
shinyUI(fluidPage(
# Application title
titlePanel("Tabsets"),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
br(),
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000),
selectInput("contentSelect", "Select content to dislay:", choices = c("1", "2"), selected = 1)
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
uiOutput("content")
)
)
))
server.R
library(shiny)
# Define server logic for random distribution application
shinyServer(function(input, output) {
# Reactive expression to generate the requested distribution.
# This is called whenever the inputs change. The output
# functions defined below then all use the value computed from
# this expression
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data. Also uses the inputs to build
# the plot label. Note that the dependencies on both the inputs
# and the data reactive expression are both tracked, and
# all expressions are called in the sequence implied by the
# dependency graph
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main=paste('r', dist, '(', n, ')', sep=''))
})
# Generate a summary of the data
output$summary <- renderPrint({
summary(data())
})
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
output$textA <- renderText({
paste(input$contentSelect, " A")
})
observeEvent(input$contentSelect, {
if (input$contentSelect == "1") {
output$content <- renderUI({
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
})
} else {
output$content <- renderUI({
tabsetPanel(type = "tabs",
tabPanel("A", textOutput("textA"))
)
})
}
})
})
How can I get the list of choices in a SelectInpute?
ui.R
selectInput(inputId = "select_gender",
label = "Gender",
choices = c("Male","Female"),
width = 150
)
server.R
# Something like...
genders <- input$select_gender["choices"]
# So that the gender would be:
> genders
[1] Male Female
From the scoping rules of Shiny:
Objects defined in global.R are similar to those defined in app.R outside of the server function definition, with one important difference: they are also visible to the code in the ui object. This is because they are loaded into the global environment of the R session; all R code in a Shiny app is run in the global environment or a child of it.
However, this doesn't mean that objects defined in the app.R can't be used on both the UI and Server side, they just belong to a different environment.
For example:
library("shiny")
library("pryr")
# or in global.R
genders <- c("Male", "Female")
gen_env <- where("genders")
par_env <- parent.env(gen_env)
ui <- fluidPage(
selectInput("shiny_gender", "Select Gender", choices = genders),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print")
)
server <- function(input, output) {
output$selected_gender_index <- renderPrint({
# use the 'genders' vector on the server side as well
which(genders %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(gen_env)
output$par_env_print <- renderPrint(par_env)
}
shinyApp(ui = ui, server = server)
I've looked for get choices of selectinput but without recompute the choices. For example if the datas come from database, or file or other source.
And I didn't get answer. (I get this question but not the solution for me).
Here is ma solution which also could set the selectinput from the server:
set the choices list in a reactive function
build the selectinput in the server side (with the choices list reactive function)
set and get the selectinput in the server side
Here is the code
options(encoding = "UTF-8")
library("shiny")
library("pryr")
ui <- fluidPage(
uiOutput("shiny_gender.UI"),
verbatimTextOutput("selected_gender_index"),
p("The `genders` object belongs to the environment:"),
verbatimTextOutput("gen_env_print"),
p("Which is the child of the environment:"),
verbatimTextOutput("par_env_print"),
p(""),
textInput("set_input_txt","Set the car in letter (for example `Datsun 710`)",
#" Set the Select Input Male / Female ",
""),
actionButton("submit","submit")
)
server <- function(input, output, session) {
observeEvent(
c(input$submit),
{
if (input$submit>0) {
updateSelectInput(session, "shiny_gender",
# server = TRUE, if updateSelectizeInput
choices =shiny_gender.list(),
selected = input$set_input_txt
)
}
}
)
shiny_gender.list <- reactive ({
#c("Male", "Female")
rownames(mtcars)
})
output$shiny_gender.UI <- renderUI({
selectInput( "shiny_gender",
label="Select car",#"Select Gender",
choices =shiny_gender.list()
)
})
output$selected_gender_index <- renderPrint({
which(shiny_gender.list() %in% input$shiny_gender)
})
output$gen_env_print <- renderPrint(where("shiny_gender.list"))
output$par_env_print <- renderPrint(parent.env( where("shiny_gender.list")))
}
shinyApp(ui = ui, server = server)