I am trying to make a reactive UI with sliders that drop in and out via a dropdown in shiny. I have a server with reactiveUI sliders (server.R):
library(shiny)
shinyServer(function(input, output) {
output$slider1 <- reactiveUI(function() {
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
})
output$slider2 <- reactiveUI(function() {
sliderInput("s2", "slide 2", min = 1, max = 100, value = 1)
})
})
I can run the server fine with the following code (ui.R):
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
sliderInput("s1", "slide 1", min = 1, max = 100, value = 1)
)
),
mainPanel(
)
))
but if I try to make both conditionalPanels call uiOutput, the server freezes:
library(shiny)
shinyUI(pageWithSidebar(
headerPanel("Hello Shiny!"),
sidebarPanel(
selectInput("dataset", "number of buckets:",
choices = c(1,2,3)),
conditionalPanel(
condition = "input.dataset==2",
uiOutput("slider1"),uiOutput("slider2")),
conditionalPanel(
condition = "input.dataset==1",
uiOutput("slider1")
)
),
mainPanel(
)
))
I have played around with this, and found that it happens anytime that use the same condition variable and multiple uiOutput calls. Any suggestions? Thanks.
See the comment from #Joe for the answer.
Basically, outputIDs and inputIDs have to be unique; two UI elements with the same IDs on the same page emits and error. This is a limitation of the reactivity in shiny.
The work around from #Jim is to create multiple elements for each output or input used by the client, e.g.
output$slider2_1 <- ...
output$slider2_2 <- ...
Related
I want to create an app that allows you to select one variable based on a condition.
So I have create a switchInput with conditions Yes, and No, and as you can see, a stratify SelectInput should appear in case Yes is marked.
However, no new SelectInput is displayed:
# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
# Data
library(readxl)
library(dplyr)
# Plots
library(ggplot2)
not_sel <- "Not Selected"
# User interface
ui <- navbarPage(
main_page <- tabPanel(
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
switchInput(
inputId = "Id013",
onLabel = "Yes",
offLabel = "No"
),
conditionalPanel(
condition = "Id013 == 'Yes'", selectInput("Stratify", "Stratify", choices = c(not_sel)), #uiOutput("factor"),
),
actionButton("run_button", "Run Analysis", icon = icon("play"))
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph")
)
)
)
)
)
)
# Server
server <- function(input, output){
# Dynamic selection of the data. We allow the user to input the data that they want
data_input <- reactive({
#req(input$xlsx_input)
#inFile <- input$xlsx_input
#read_excel(inFile$datapath, 1)
iris
})
}
# Connection for the shinyApp
shinyApp(ui = ui, server = server)
I understand, based on the conditionalPanel function:
Creates a panel that is visible or not, depending on the value of a JavaScript expression. The JS expression is evaluated once at startup and whenever Shiny detects a relevant change in input/output.
That the change on the switchInput value should be enough to generate this changes in the UI interface.
As said in the docs of conditionalPanel():
For example, if you have an input with an id of foo, then you can use input.foo to read its value.
So you need to use input.Id013 instead of Id013 in the condition. Also, even if the labels of the switch are "Yes" or "No", it returns a value TRUE/FALSE (which are written "true" or "false" in Javascript). So the condition you need to use is:
condition = "input.Id013 == true"
Currently by default as drafted in the below MWE, when first invoking the App, and also when clicking the "Base rate" radio button, only "plot1" is rendered. Instead, I would like both "plot1" and "plot2" to be rendered in the main panel (when first invoking the App and when clicking the "Base rate" radio button). Say one beneath the other. I would like a click of the "Spreads" radio button to continue rendering only "plot2", as it currently does.
I have tried modifying, in ui section, conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1")), by adding tagList(plotOutput("plot1"),plotOutput("plot2")) but this and other attempts have not worked.
I've had no problems with multiple plots when running this with fluidPage instead of pageWithSidebar, so I suspect there is some peculiarity with pageWithSidebar and/or conditionalPanel that I don't yet understand.
I have resisted trying renderUI to resolve this, but maybe that's the answer. I've been trying to move away from renderUI for code readability/flow reasons.
MWE code:
rm(list = ls())
library(shiny)
rate1 <- matrix(c(1:20), 20, 1, dimnames = list(NULL,c("Base rate")))
rate2 <- matrix(c(21:40), 20, 1, dimnames = list(NULL,c("Spreads")))
ui <- pageWithSidebar(
headerPanel("Model"),
sidebarPanel(),
mainPanel(
tabsetPanel(
tabPanel("Rates", value=2,
fluidRow(
radioButtons(
inputId = 'tab2',
label = "",
choices = c('Base rate','Spreads'),
selected = 'Base rate',
inline = TRUE
)
),
conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1")),
conditionalPanel(condition = "input.tab2 == 'Spreads'", plotOutput("plot2")),
),
id = "tabselected"
)
)
)
server <- function(input,output,session)({
output$plot1 <-renderPlot({plot(rate1)})
output$plot2 <-renderPlot({plot(rate2)})
}) # close server
shinyApp(ui, server)
Now the above MWE fixed to address the 2 comments by Stéphane Laurent (can't use same plot > 1 time, and pageWithSidebar replaced with fluidPage/sidebarLayout since pageWithSidebar is deprecated:
rm(list = ls())
library(shiny)
rate1 <- matrix(c(1:20), 20, 1, dimnames = list(NULL,c("Base rate")))
rate2 <- matrix(c(21:40), 20, 1, dimnames = list(NULL,c("Spreads")))
ui <- fluidPage(
titlePanel("Model"),
sidebarLayout(
sidebarPanel(),
mainPanel(
tabsetPanel(
tabPanel("Rates", value=2,
fluidRow(
radioButtons(
inputId = 'tab2',
label = "",
choices = c('Base rate','Spreads'),
selected = 'Base rate',
inline = TRUE
)
),
conditionalPanel(condition = "input.tab2 == 'Base rate'",plotOutput("plot1"),plotOutput("plot2")),
conditionalPanel(condition = "input.tab2 == 'Spreads'",plotOutput("plot3")),
),
id = "tabselected"
)
)
)
)
server <- function(input, output) {
output$plot1 <-renderPlot({plot(rate1)})
output$plot2 <-renderPlot({plot(rate2)})
output$plot3 <-renderPlot({plot(rate2)})
}
shinyApp(ui, server)
This is a reproducible example. I'm trying to understand using the conditionalpanel function under shiny.
How do I tweak the code in a manner such that when I check both checkboxes, the plot and image will be rendered together? (with the plot on the top and image at the bottom on main panel)
library(shiny)
ui = fluidPage(
titlePanel("Plot or Example?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Example or Plot",choices = c("Plot", "Example"), selected = 1),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot'",
plotOutput('my_test1')
),
conditionalPanel(
condition = "input.my_choices == 'Example'",
uiOutput("my_test2")
)
)
)
)
server = function(input, output) {
output$my_test1 <- renderPlot({plot(runif(100))})
output$my_test2 <- renderUI({
images <- c("http://www.i2symbol.com/images/abc-123/o/white_smiling_face_u263A_icon_256x256.png")
tags$img(src= images)
})
}
There are several things to do.
First, your selected argument of checkboxGroupInput should match one of the choices. Here I changed it to "Plot".
Second, I used "input.my_choices.includes('Example') && input.my_choices.includes('Plot')" as the condition when both are selected.
Third, Shiny doesn't allow the same output to be used more than once. To get around that, I made duplicates of the outputs in the server code, and referenced the duplicated names in the conditional Panel for the condition both boxes are checked.
library(shiny)
ui = fluidPage(
titlePanel("Plot or Example?"),
sidebarLayout(
sidebarPanel(
checkboxGroupInput("my_choices", "Example or Plot",choices = c("Plot", "Example"), selected = "Plot"),width=2),
mainPanel(
conditionalPanel(
condition = "input.my_choices == 'Plot'",
plotOutput("my_test1")
),
conditionalPanel(
condition = "input.my_choices == 'Example'",
uiOutput("my_test2")
),
conditionalPanel(
condition = "input.my_choices.includes('Example') && input.my_choices.includes('Plot')",
plotOutput("my_test1a"),
uiOutput("my_test2a")
)
)
)
)
server = function(input, output) {
output$my_test1 <- output$my_test1a <- renderPlot({plot(runif(100))})
output$my_test2 <- output$my_test2a <- renderUI({
images <- c("http://www.i2symbol.com/images/abc-123/o/white_smiling_face_u263A_icon_256x256.png")
tags$img(src= images)
})
}
shinyApp(ui, server)
This is my first Shiny App, as part of my Coursera Data Science Specialisation. I am trying to create a Tab for documentation but the output of the main tab displays in both, the MainApp tab and the Documentation.
I want no output in the "Documentation" tab
Any help? Thanks!
This is the ui.R code:
shinyUI(
pageWithSidebar(
headerPanel (" Six Sigma Control Charts"),
tabsetPanel(
tabPanel("MainApp",
sidebarPanel(
h5 ("Control Charts are six sigma tools that track process statistics over time to detect the presence of special causes of variation. There are different types of charts according to the data type that you are analysing."),
selectInput("DataType", "Please select Data Type",
choices = c("Continuous", "Attribute")),
conditionalPanel(condition = "input.DataType == 'Continuous'",
selectInput("Groups", "Data collected in groups?",
choices = c("Yes", "No"))),
conditionalPanel(condition = "input.DataType == 'Attribute'",
selectInput("Counting", "What are you counting?",
choices = c("Defective items", "Defects per unit"))),
conditionalPanel(condition = "input.Groups == 'Yes' & input.DataType == 'Continuous' ",
textInput ("SubgroupSize", "Enter sub group size",1 ) )
) ),
tabPanel("Documentation",
h5 ("This Shiny App helps you to familiarise with Six Sigma Control Charts."),
h5 ("The different types of graphs are produced according to the type of data that you want to analyse"),
h5 ("Make a choice according to the data type to explore the various Six Sigma graphs")
)
),
mainPanel (
plotOutput ("ControlChart"),
textOutput("Explanation"),
br(100),
br()
)
)
)
It is not possible with the pageWithSidebar function. This function is deprecated anyway. Try to wrap a fluidPage in a navbarPage:
# Define UI
ui <- navbarPage("App Title",
tabPanel("Plot",
fluidPage(
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(
plotOutput("distPlot")
)
)
)
),
tabPanel("Summary",
tags$br("Some text"))
)
# Server logic
server <- function(input, output) {
output$distPlot <- renderPlot({
hist(rnorm(input$obs))
})
}
# Complete app with UI and server components
shinyApp(ui, server)
I've got an application with a large number of parameters. Each parameters has lots of granularity which make finding the desired one a pain. This causes the reactive portion to constantly calculate which slows things down. I added a submitButton which solved the above problem but then experience another problem in turn.
Below is a simple replication of the framework I build. The parameter input takes in a number from 1 to 1000, which indicates the sample to which I want. What I would like to do is be able to do above but also be able to resample with the same set of parameters. What is happening now after adding the submit button is that it renders the resample button inoperable unless I click resample first AND then update button.
Any ideas of making them both working separately?
shinyServer(function(input, output) {
getY<-reactive({
a<-input$goButton
x<-rnorm(input$num)
return(x)
})
output$temp <-renderPlot({
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
submitButton("Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))
EDIT based on Joe's Answer:
shinyServer(function(input, output) {
getY<-reactive({
isolate({a<-input$goButton
x<-rnorm(input$num)
return(x)})
})
output$temp <-renderPlot({
b<-input$goButton1
plot(getY())
}, height = 400, width = 400)
})
shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
sliderInput("num",
"Number of Samples",
min = 2,
max = 1000,
value = 100),
actionButton("goButton", "Resample"),
actionButton("goButton1","Update View")
),
mainPanel(
tabsetPanel(
tabPanel("Heatmap",
plotOutput("temp")
),
tabPanel("About"),
id="tabs"
)#tabsetPanel
)#mainPane;
))
The answer was given by Joe Cheng in a comment above, but seeing that the OP had difficulty understanding it, I write it out explicitly below, for the record:
# ui.R
library("shiny")
shinyUI(
pageWithSidebar(
headerPanel("Example")
,
sidebarPanel(
sliderInput("N", "Number of Samples", min = 2, max = 1000, value = 100)
,
actionButton("action", "Resample")
)
,
mainPanel(
tabsetPanel(
tabPanel("Plot", plotOutput("plotSample"))
,
id = "tabs1"
)
)
)
)
# server.R
library("shiny")
shinyServer(
function(input, output, session) {
Data <- reactive({
input$action
isolate({
return(rnorm(input$N))
return(x)
})
})
output$plotSample <-renderPlot({
plot(Data())
} , height = 400, width = 400
)
})
Note that having input$action inside reactive(), where "action" is the actionButton's inputID, is enough to trigger a new rendering of the plot. So you need only one actionButton.
change getY so that all but the first line is wrapped in isolate({ ... })
change submitButton to actionButton
add a line inside of renderPlot to read the new actionButton