In a Shiny app, I would like to be able to use check boxes or radio buttons to toggle on and off the visible output.
Currently, I can achieve this only by creating separate check box ui items and observe conditions for each element I would like to toggle.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
uiOutput('select1'),
uiOutput('select2'),
div(id='table1',tableOutput('data1')),
div(id='table2',tableOutput('data2'))
)
server <- function(input, output){
data1 <- data.frame(X1=1:5,
X2=6:10)
data2 <- data.frame(Y1=1:5,
Y2=6:10)
output$data1 <- renderTable(data1)
output$data2 <- renderTable(data2)
output$select1 <- renderUI({
checkboxGroupInput('select1', 'Select T1',
choices = 'table1',
selected = 'table1')
})
output$select2 <- renderUI({
checkboxGroupInput('select2', 'Select T2',
choices = 'table2'
)
})
observe({
toggle(id='table1', condition = input$select1)
})
observe({
toggle(id='table2', condition = input$select2)
})
}
shinyApp(ui, server)
Question 1
When the app loads both tables are displayed despite only one being selected. Toggling the second on and then off is required to hide it. Can this be changed so it isn't displayed on first load?
Question 2
I realise my approach is inefficient and it is likely possible to achieve the same with a single checkBoxGroupInput containing the various options and a single observe condition. I'm really inexperienced here and cannot figure it out.
Your help is appreciated.
toggle expects a boolean but input$select returns a character, which might explain the unexpected behaviour.
With a single checkboxGroupInput, using %in% to get booleans:
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
uiOutput('select'),
div(id='table1',tableOutput('data1')),
div(id='table2',tableOutput('data2'))
)
server <- function(input, output){
data1 <- data.frame(X1=1:5,
X2=6:10)
data2 <- data.frame(Y1=1:5,
Y2=6:10)
output$data1 <- renderTable(data1)
output$data2 <- renderTable(data2)
output$select <- renderUI({
checkboxGroupInput('select', 'Select table',
choices = list('table1','table2'),
selected = 'table1')
})
observe({
toggle(id='table1', condition = "table1" %in% input$select)
toggle(id='table2', condition = "table2" %in% input$select)
})
}
shinyApp(ui, server)
Related
The code at the bottom is taken from an example in https://shiny.rstudio.com/articles/modules.html though I de-modularized it so I can understand something more basic. With this code, each click of the action button renders a counter which counts the number of clicks. Fine.
Instead of counting the number of clicks in the same output of verbatimTextOutput() as the code currently works, I'd like each click to be represented as a new output of verbatimTextOutput(). See illustration below which shows what I'm trying to derive, assuming the user clicks the action button 3 times. I don't know how many times the user will click the action button so there's no way to pre-set or hard-code the number of outputs and assign output names such as output$out1, output$output2, etc. Is there a way to reactively generate the outputs names, as a I naively attempted in the below code with output$"paste(out,count())" and verbatimTextOutput("paste(out,count())") (without the quote marks, I only put them in so the example code would work)? If this is possible this could be a way to achieve the results I am seeking.
Illustration:
Code:
library(shiny)
newOutput <- function(x,y){verbatimTextOutput("paste(out,count())")}
ui <- fluidPage(uiOutput("uiButton"))
server <- function(input,output,session){
count <- reactiveVal(0)
observeEvent(input$button, {count(count() + 1)})
output$"paste(out,count())" <- renderText({count()})
count
output$uiButton <-
renderUI(
tagList(
actionButton("button", label = "Click me"),
newOutput()
)
)
}
shinyApp(ui, server)
This is an alternative approach using insertUI.
Compared to #stefan's renderUI based solution it has the advantage, that the UI elements are rendered only once. Using renderUI every element is re-rendered on button click, accordingly things will slow down depending on the number of elements.
library(shiny)
ui <- fluidPage(
actionButton("add", "Add UI")
)
server <- function(input, output, session) {
observeEvent(input$add, {
output_name <- paste0("out_", input$add)
output[[output_name]] <- renderText({
isolate(input$add)
})
insertUI(
selector = ifelse(input$add == 0L, "#add", paste0("#", "out_", input$add-1)),
where = "afterEnd",
ui = verbatimTextOutput(output_name)
)
}, ignoreNULL = FALSE)
}
shinyApp(ui, server)
Also check ?removeUI.
Adapting this example to dynamically create graphs to your example you could do:
library(shiny)
library(purrr)
newOutput <- function(x) {
verbatimTextOutput(x)
}
ui <- fluidPage(
actionButton("button", label = "Click me"),
uiOutput("uiText")
)
server <- function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
i <- count()
output_name <- paste("out", i)
output[[output_name]] <- renderText({
i
})
})
output$uiText <- renderUI({
out_list <- map(seq_len(count()), ~ {
tagList(
newOutput(paste("out", .x))
)
})
tagList(out_list)
})
}
shinyApp(ui, server)
Overall context: I am trying to build a decision tree app in shiny and have never used shiny before. I am trying to have text display when a certain radio button is selected. After trial and error I still can't get anything to display with different inputs. Below is the basic code.
library(shiny)
priceChange <- "Does it change the price?"
zpInfer1 <- "Can zero-price-change be inferred?"
ui <- fluidPage(
radioButtons("exist", "Does it exist?",
c("Yes" = "existYes",
"No" = "existNo"),
textOutput("a")
)
)
server <- function(input, output){
output$a <- renderText({
existAnswer <- switch(input$exist,
existYes = priceChange,
existNo = zpInfer1)
})
}
shinyApp(ui, server)
As #Phil said, this seems to be a simple syntax error. This one should work :
library(shiny)
priceChange <- "Does it change the price?"
zpInfer1 <- "Can zero-price-change be inferred?"
ui <- fluidPage(
radioButtons("exist", "Does it exist?",
c("Yes" = "existYes",
"No" = "existNo")),
textOutput("a")
)
server <- function(input, output){
output$a <- renderText({
existAnswer <- switch(input$exist,
existYes = priceChange,
existNo = zpInfer1)
})
}
shinyApp(ui, server)
In a shiny app (by RStudio), on the server side, I have a reactive that returns a list of variables by parsing the content of a textInput. The list of variables is then used in selectInput and/or updateSelectInput.
I can't make it work. Any suggestions?
I have made two attempts. The first approach is to use the reactive outVar directly into selectInput. The second approach is to use the reactive outVar in updateSelectInput. Neither works.
server.R
shinyServer(
function(input, output, session) {
outVar <- reactive({
vars <- all.vars(parse(text=input$inBody))
vars <- as.list(vars)
return(vars)
})
output$inBody <- renderUI({
textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
})
output$inVar <- renderUI({ ## works but the choices are non-reactive
selectInput(inputId = "inVar", label = h4("Select variables:"), choices = list("a","b"))
})
observe({ ## doesn't work
choices <- outVar()
updateSelectInput(session = session, inputId = "inVar", choices = choices)
})
})
ui.R
shinyUI(
basicPage(
uiOutput("inBody"),
uiOutput("inVar")
)
)
A short while ago, I posted the same question at shiny-discuss, but it has generated little interest, so I'm asking again, with apologies, https://groups.google.com/forum/#!topic/shiny-discuss/e0MgmMskfWo
Edit 1
#Ramnath has kindly posted a solution that appears to work, denoted Edit 2 by him. But that solution does not address the problem because the textinput is on the ui side instead of on the server side as it is in my problem. If I move the textinput of Ramnath's second edit to the server side, the problem crops up again, namely: nothing shows and RStudio crashes. I found that wrapping input$text in as.character makes the problem disappear.
Edit 2
In further discussion, Ramnath has shown me that the problem arises when the server attempts to apply the dynamic function outVar before its arguments have been returned by textinput. The solution is to first check whether is.null(input$inBody) exists.
Checking for existence of arguments is a crucial aspect of building a shiny app, so why did I not think of it? Well, I did, but I must have done something wrong! Considering the amount of time I spent on the problem, it's a bitter experience. I show after the code how to check for existence.
Below is Ramnath's code with textinput moved to the server side. It crashes RStudio so don't try it at home. (I have used his notation)
library(shiny)
runApp(list(
ui = bootstrapPage(
uiOutput('textbox'), ## moving Ramnath's textinput to the server side
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text)) ## existence check needed here to prevent a crash
vars <- as.list(vars)
return(vars)
})
output$textbox = renderUI({
textInput("text", "Enter Formula", "a=b+c")
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
The way I usually check for existence is like this:
if (is.null(input$text) || is.na(input$text)){
return()
} else {
vars <- all.vars(parse(text = input$text))
return(vars)
}
Ramnath's code is shorter:
if (!is.null(mytext)){
mytext = input$text
vars <- all.vars(parse(text = mytext))
return(vars)
}
Both seem to work, but I'll be doing it Ramnath's way from now on: maybe an unbalanced bracket in my construct had earlier prevented me to make the check work? Ramnath's check is more direct.
Lastly, I'd like to note a couple of things about my various attempts to debug.
In my debugging quest, I discovered that there is an option to "rank" the priority of "outputs" on the server side, which I explored in an attempt to solve my problem, but didn't work since the problem was elsewhere. Still, it's interesting to know and seems not very well known at this time:
outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)
In that quest, I also tried try:
try(vars <- all.vars(parse(text = input$text)))
That was pretty close, but still did not fix it.
The first solution I stumbled upon was:
vars <- all.vars(parse(text = as.character(input$text)))
I suppose it would be interesting to know why it worked: is it because it slows things down enough? is it because as.character "waits" for input$text to be non-null?
Whatever the case may be, I am extremely grateful to Ramnath for his effort, patience and guidance.
You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
EDIT. Another Solution using updateSelectInput
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))
EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.
library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
As far as I can tell, the problem is that input$inBody does not retrieve a character even though the selectInput function is given a character as value, namely value = "a+b+c". The solution is therefore to wrap input$inBody in a as.character
The following works:
The observe approach with updateSelectInput:
observe({
input$inBody
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
updateSelectInput(session = session, inputId = "inVar", choices = vars)
})
The reactive approach with selectInput:
outVar <- reactive({
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
return(vars)
})
output$inVar2 <- renderUI({
selectInput(inputId = "inVar2", label = h4("Select:"), choices = outVar())
})
Edit: I have edited my question with an explanation based on Ramnath's feedback. Ramnath has explained the problem and provided a better solution, which I give as an edit of my question. I'll keep this answer for the record.
server.R
### This will create the dynamic dropdown list ###
output$carControls <- renderUI({
selectInput("cars", "Choose cars", rownames(mtcars))
})
## End dynamic drop down list ###
## Display selected results ##
txt <- reactive({ input$cars })
output$selectedText <- renderText({ paste("you selected: ", txt() ,sep="") })
## End Display selected results ##
ui.R
uiOutput("carControls"),
br(),
textOutput("selectedText")
I'm very new to shiny and am having some trouble and have been searching all day, so hopefully someone can help me. Once an action button (actionButton, on UI) is selected by a user, I would like the server script to call a function (evenReactive in server) I wrote (myfunction, see below) that uses the input items from the UI and gets the right parameters I need to run myfunction and produce a n X2 data matrix that will be plotted as a table (renderTable in server, below). The data is a n X 2 matrix.
I have some sample code below. It's not the entre code, so you will not see the UI with the inputs I am putting in my function, or the server parts associated. But, it is the part I am trying to fix. I hope that's ok. I don't need the renderText, but when I take it out I get an error. Sorry for the formatting. Copy and pasting changed it a bit.
library(shiny)
ui <- shinyUI(fluidPage
(column(4,actionButton("gobutton", "Run"),verbatimTextOutput("ntext1")),
column(4, DT::dataTableOutput("table",width = "75%"))))
library(shiny)
shinyServer(function(input, output, session)
ntext1 <- eventReactive(input$gobutton, {
if (input$gobutton==1){
data=myfunction(input$checkbox,input$dateRange)}
})
output$ntext1 <- renderText({ntext1()})
output$table <- DT::renderDataTable(DT::datatable({
data
})
))
myfunction <-function(All,date1,date2,source_cd,tran_cd,airline_list,mag_level) {
print(All); print(date1); print(date2); print(source_cd);print(tran_cd);print(airline_list);print(mag_level)
setwd("C:/Users/TRomano/Documents/Projects/TrendAnalysis/Data")
data = read.csv("Airlines.csv",header = TRUE)
return(data)
}
For this type of problem I like to make use of reactiveValues()that are designed to store data in a reactive way.
Here is a simple app (single app, not split into server & ui) that demonstrates what I think you are trying to do
library(shiny)
library(DT)
ui <- shinyUI(
fluidPage(
column(width = 4,
actionButton("gobutton", "Run")
column(width = 4,
DT::dataTableOutput("table",
width = "75%"))))
server <- shinyServer(function(input, output, session){
rv <- reactiveValues()
rv$data <- NULL
observe({ ## will 'observe' the button press
if(input$gobutton){
print("here") ## for debugging
rv$data <- myfunction() ## store the data in the reactive value
rv$data
}
})
output$table <- DT::renderDataTable({
## The data has been stored in our rv, so can just return it here
rv$data
})
})
myfunction <- function(){
data <- data.frame(id = c(1,2,3),
val = letters[1:3])
return(data)
}
shinyApp(ui, server)
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Company Name"),
dashboardSidebar(sidebarMenu(
menuItem("Results Table", tabName = "ResultsTable", icon = icon
("ResultsTable")),
dashboardBody(
tabItems(
tabItem(tabName tabItem(tabName = "ResultsTable",
fluidPage(
headerPanel(
fluidRow(
column(4,
selectInput("sour",
"Source Type:",
c("All",
unique(as.character(data_source_cd)))), offset=2
),
column(4,
selectInput("tran",
"Transaction Type:",
c("All",
unique(as.character(tran_cd)))))),
# Create a new row for the table.
fluidRow(column(8, DT::dataTableOutput("table",width = "75%"),offset = 2))))))
library(shiny)
shinyServer(function(input, output, session) {
ntext1 <- eventReactive(input$gobutton, {
if (input$dateRange[2]<input$dateRange[1]){print("You selected the date range option;however, the end date entered occurs before the starting date")}else{
output$ntext1 <- renderText({print("Analysis complete...")});
observe({
if(input$gobutton){
rv$data <- myfunction() }
})
output$table <- DT::renderDataTable(DT::datatable({
data <- rv$data
if (input$sour != "All") {
data <- data[data[,5] == input$sour,]
}else{data}
if (input$tran != "All") {
data <-data[data[,6] == input$tran,]
}else{data}
}))
}})
Once an action button is selected on the main page of my dashboard(not shown), myfunction runs analysis with the inputs from the main dashboard page. On another tab, a table will show once the analysis is complete. There are drop down menus (input$tran, input$sour) that will reduce what is in the table depending on what the user selects. If there are any errors in the input, a warning of text comes up on the main dashboard page and the tab with the table will not be created until the correct inputs are selected.
The observe function allowed me to run my function and the output data of the function set to a variable I could later use to create the table (shown).
THis is my first time posting. Any questions feel free to ask.
In a shiny app (by RStudio), on the server side, I have a reactive that returns a list of variables by parsing the content of a textInput. The list of variables is then used in selectInput and/or updateSelectInput.
I can't make it work. Any suggestions?
I have made two attempts. The first approach is to use the reactive outVar directly into selectInput. The second approach is to use the reactive outVar in updateSelectInput. Neither works.
server.R
shinyServer(
function(input, output, session) {
outVar <- reactive({
vars <- all.vars(parse(text=input$inBody))
vars <- as.list(vars)
return(vars)
})
output$inBody <- renderUI({
textInput(inputId = "inBody", label = h4("Enter a function:"), value = "a+b+c")
})
output$inVar <- renderUI({ ## works but the choices are non-reactive
selectInput(inputId = "inVar", label = h4("Select variables:"), choices = list("a","b"))
})
observe({ ## doesn't work
choices <- outVar()
updateSelectInput(session = session, inputId = "inVar", choices = choices)
})
})
ui.R
shinyUI(
basicPage(
uiOutput("inBody"),
uiOutput("inVar")
)
)
A short while ago, I posted the same question at shiny-discuss, but it has generated little interest, so I'm asking again, with apologies, https://groups.google.com/forum/#!topic/shiny-discuss/e0MgmMskfWo
Edit 1
#Ramnath has kindly posted a solution that appears to work, denoted Edit 2 by him. But that solution does not address the problem because the textinput is on the ui side instead of on the server side as it is in my problem. If I move the textinput of Ramnath's second edit to the server side, the problem crops up again, namely: nothing shows and RStudio crashes. I found that wrapping input$text in as.character makes the problem disappear.
Edit 2
In further discussion, Ramnath has shown me that the problem arises when the server attempts to apply the dynamic function outVar before its arguments have been returned by textinput. The solution is to first check whether is.null(input$inBody) exists.
Checking for existence of arguments is a crucial aspect of building a shiny app, so why did I not think of it? Well, I did, but I must have done something wrong! Considering the amount of time I spent on the problem, it's a bitter experience. I show after the code how to check for existence.
Below is Ramnath's code with textinput moved to the server side. It crashes RStudio so don't try it at home. (I have used his notation)
library(shiny)
runApp(list(
ui = bootstrapPage(
uiOutput('textbox'), ## moving Ramnath's textinput to the server side
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text)) ## existence check needed here to prevent a crash
vars <- as.list(vars)
return(vars)
})
output$textbox = renderUI({
textInput("text", "Enter Formula", "a=b+c")
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
The way I usually check for existence is like this:
if (is.null(input$text) || is.na(input$text)){
return()
} else {
vars <- all.vars(parse(text = input$text))
return(vars)
}
Ramnath's code is shorter:
if (!is.null(mytext)){
mytext = input$text
vars <- all.vars(parse(text = mytext))
return(vars)
}
Both seem to work, but I'll be doing it Ramnath's way from now on: maybe an unbalanced bracket in my construct had earlier prevented me to make the check work? Ramnath's check is more direct.
Lastly, I'd like to note a couple of things about my various attempts to debug.
In my debugging quest, I discovered that there is an option to "rank" the priority of "outputs" on the server side, which I explored in an attempt to solve my problem, but didn't work since the problem was elsewhere. Still, it's interesting to know and seems not very well known at this time:
outputOptions(output, "textbox", priority = 1)
outputOptions(output, "variables", priority = 2)
In that quest, I also tried try:
try(vars <- all.vars(parse(text = input$text)))
That was pretty close, but still did not fix it.
The first solution I stumbled upon was:
vars <- all.vars(parse(text = as.character(input$text)))
I suppose it would be interesting to know why it worked: is it because it slows things down enough? is it because as.character "waits" for input$text to be non-null?
Whatever the case may be, I am extremely grateful to Ramnath for his effort, patience and guidance.
You need to use renderUI on the server side for dynamic UIs. Here is a minimal example. Note that the second drop-down menu is reactive and adjusts to the dataset you choose in the first one. The code should be self-explanatory if you have dealt with shiny before.
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
uiOutput('columns')
),
server = function(input, output){
output$columns = renderUI({
mydata = get(input$dataset)
selectInput('columns2', 'Columns', names(mydata))
})
}
))
EDIT. Another Solution using updateSelectInput
runApp(list(
ui = bootstrapPage(
selectInput('dataset', 'Choose Dataset', c('mtcars', 'iris')),
selectInput('columns', 'Columns', "")
),
server = function(input, output, session){
outVar = reactive({
mydata = get(input$dataset)
names(mydata)
})
observe({
updateSelectInput(session, "columns",
choices = outVar()
)})
}
))
EDIT2: Modified Example using parse. In this app, the text formula entered is used to dynamically populate the dropdown menu below with the list of variables.
library(shiny)
runApp(list(
ui = bootstrapPage(
textInput("text", "Enter Formula", "a=b+c"),
uiOutput('variables')
),
server = function(input, output){
outVar <- reactive({
vars <- all.vars(parse(text = input$text))
vars <- as.list(vars)
return(vars)
})
output$variables = renderUI({
selectInput('variables2', 'Variables', outVar())
})
}
))
As far as I can tell, the problem is that input$inBody does not retrieve a character even though the selectInput function is given a character as value, namely value = "a+b+c". The solution is therefore to wrap input$inBody in a as.character
The following works:
The observe approach with updateSelectInput:
observe({
input$inBody
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
updateSelectInput(session = session, inputId = "inVar", choices = vars)
})
The reactive approach with selectInput:
outVar <- reactive({
vars <- all.vars(parse(text=as.character(input$inBody)))
vars <- as.list(vars)
return(vars)
})
output$inVar2 <- renderUI({
selectInput(inputId = "inVar2", label = h4("Select:"), choices = outVar())
})
Edit: I have edited my question with an explanation based on Ramnath's feedback. Ramnath has explained the problem and provided a better solution, which I give as an edit of my question. I'll keep this answer for the record.
server.R
### This will create the dynamic dropdown list ###
output$carControls <- renderUI({
selectInput("cars", "Choose cars", rownames(mtcars))
})
## End dynamic drop down list ###
## Display selected results ##
txt <- reactive({ input$cars })
output$selectedText <- renderText({ paste("you selected: ", txt() ,sep="") })
## End Display selected results ##
ui.R
uiOutput("carControls"),
br(),
textOutput("selectedText")