Related
My shiny app looks like this:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(textInput("my_text", # supposed to be a numeric input
"Text input:"),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
# output$my_init <- input$my_text + 28
}
shinyApp(ui, server)
I want to set the initial value of the slider as output$my_init, a numeric variable that will be the result of operating some input variables. I tried using renderPrint, but the output is not numeric.
Thanks in advance.
I piggybacked on #stefan's comments and came up with this answer:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotOutput("plot1", height = 250)),
box(numericInput("my_num", "Numeric input:", value = 50),
title = "Controls",
sliderInput("slider",
"Number of observations:",
min = 1, max = 100,
value = 50 # Want it to be output$my_init
)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
# My attempt
observeEvent(input$my_num, {
updateSliderInput(inputId = "slider", value = input$my_num)
})
}
shinyApp(ui, server)
The idea is to use observeEvent() to trigger updateSliderInput() (update slider input widget) and update the value parameter of sliderInput()
I am trying to lift state of the number of bins one level up from a module. This is a common technique in react, and I suspect shiny as well, when some data needs to be shared between different components (modules in shiny parlance)
This is the code I currently have
ui.R
library(shiny)
library(shinydashboard)
source("modules/my.R", local=my <- new.env())
ui <- dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("App 1", tabName="app1"),
menuItem("App 2", tabName="app2"),
id="selectedMenu"
)
),
dashboardBody(
uiOutput("foo")
)
)
server.R
library(shiny)
source("modules/my.R", local=my <- new.env())
server <- function(input, output) {
reactive = reactive({3})
callModule(my$my, "foo", numBins=reactive)
plot <- my$myUI("foo")
output$foo <- renderUI({
if (input$selectedMenu == "app1") {
return(plot)
} else {
return(br())
}
})
}
and this is the module
library(shiny)
myUI <- function(id) {
ns <- NS(id)
tagList(
fluidRow(
box(
plotOutput(outputId = ns("distPlot")),
width=12
)
),
fluidRow(
box(
sliderInput(inputId = ns("bins"), label = "Number of bins:", min = 1, max = 50, value = 30),
width=12
)
)
)
}
my <- function(input, output, session, numBins) {
output$distPlot <- renderPlot({
numBins()
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = numBins() + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
observe({
updateSliderInput(session, "bins", value=numBins())
})
}
I am trying to lift numBins out at the server.R level, and inject it in the module. However, it seems that the plot is not re-rendered. Initialisation seems to work however. I get the right number of bins, but moving the slider does nothing.
Please feel free to comment on other things that look dodgy. I am just a beginner with shiny and R (I do however have experience with react)
Edit
I have a simpler version with just two sliders, trying to make one change when the other is moved, by having numBins shared between the two from below.
library(shiny)
library(shinydashboard)
source("modules/my.R", local=my <- new.env())
ui <- dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(),
dashboardBody(
uiOutput("central")
)
)
library(shiny)
source("modules/my.R", local=my <- new.env())
server <- function(input, output) {
numBins = reactiveVal(value=3)
callModule(my$my, "slider1", id="slider1", numBins=numBins)
callModule(my$my, "slider2", id="slider2", numBins=numBins)
output$central <- renderUI({
tagList(
my$myUI("slider1"),
my$myUI("slider2")
)})
}
library(shiny)
myUI <- function(id) {
ns <- NS(id)
fluidRow(
box(
sliderInput(inputId = ns("bins"), label = "Number of bins:", min = 1, max = 50, value = 30),
width=12
)
)
}
my <- function(input, output, session, id, numBins) {
ns <- NS(id)
observeEvent(
numBins,
{
cat("1234", file=stderr())
updateSliderInput(session, ns("bins"), value=numBins())
})
}
Still not working and kind of ugly to have to provide the id twice for the server function.
I'm trying to answer your edited example with two synced sliders. My solution is to let the module return the value of the sliderInput, and also receive an input coupledValue which is used in in observeEvent to update the sliderInput value.
my.R
Somewhat counterintuitively (at least to me when I first learned about it), you do not need to wrap the id "bins" into an ns() inside the updateSliderInput().
library(shiny)
myUI <- function(id) {
ns <- NS(id)
fluidRow(
box(
sliderInput(inputId = ns("bins"), label = "Number of bins:", min = 1, max = 50, value = 30),
width=12
)
)
}
my <- function(input, output, session, id, coupledValue) {
observeEvent(coupledValue(), {
updateSliderInput(session, "bins", value=coupledValue())
})
return(reactive(input$bins))
}
server.R
The numBins() reactive becomes unnecessary, as well as the additional environment you provided within source().
library(shiny)
source("modules/my.R")
server <- function(input, output) {
valSlider1 <- callModule(my, "slider1", id="slider1", coupledValue = valSlider2)
valSlider2 <- callModule(my, "slider2", id="slider2", coupledValue = valSlider1)
}
ui.R
library(shiny)
library(shinydashboard)
source("modules/my.R")
ui <- dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(),
dashboardBody(
myUI("slider1"),
myUI("slider2")
)
)
If you want to sync to multiple inputs, you can use return(list(input1 = ..., input2 = ...)) as your return value from the module. When you pass that whole named list into another module, e.g. with the name coupledValues, you will have to reference it as coupledValues$input1() and coupledValues$input2() (note the () after the $).
Discalimer: This answer is based on In sync sliderInput and textInput
I am not sure if this is the best use case for shiny modules. Anyways, here's a way without using modules. Let me know if using modules is a must and I'll try and update my answer.
library(shiny)
ui <- fluidPage(
lapply(1:2, function(x) {
sliderInput(paste0("slider", x), paste0("Slider ", x), min = 1, max = 50, value = 30)
}),
verbatimTextOutput("test")
)
server <- function(input, output, session) {
observeEvent(input$slider1, {
if(input$slider1 != input$slider2) {
updateSliderInput(session, "slider2", value = input$slider1)
}
})
observeEvent(input$slider2, {
if(input$slider1 != input$slider2) {
updateSliderInput(session, "slider1", value = input$slider2)
}
})
output$test <- renderPrint({
c("Slider 1" = input$slider1, "Slider 2" = input$slider2)
})
}
shinyApp(ui, server)
Using return works nice for smaller applications, though using a strategy of reactiveValues pays of in larger apps.
I found the strategy in a blog post by rTask Communication between modules and its whims
The idea is to use r as a reactiveValues and pass it to each callModule.
Inside the module, you create a new reactiveValues based on r, e.g. r$my <- reactiveValues()
Then you don't need to return your module output and you don't need to pass any reactive variable except for r
Here I edited your code according to this strategy (and a few minor things, posted already):
ui.R
library(shiny)
library(shinydashboard)
source("modules/my.R")
ui <- dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(),
dashboardBody(
myUI("slider1"),
myUI("slider2")
)
)
server.R
library(shiny)
source("modules/my.R")
server <- function(input, output) {
r <- reactiveValues()
numBins = reactiveVal(value=3)
callModule(my, "slider1", id="slider1", r = r)
callModule(my, "slider2", id="slider2", r = r)
}
my.R
library(shiny)
myUI <- function(id) {
ns <- NS(id)
fluidRow(
box(
sliderInput(inputId = ns("bins"), label = "Number of bins:", min = 1, max = 50, value = 30),
width=12
)
)
}
my <- function(input, output, session, id, r) {
r$my <- reactiveValues()
observe({
r$my <- input$bins
})
observeEvent(
r$my,
{
cat("1234", file=stderr())
updateSliderInput(session, "bins", value=r$my)
})
}
Slightly too late to compete for the bounty. But as I have done the thinking, here is my contribution. This differs from all the existing answers in that it neither uses coupled sliders, nor observers.
First let me ensure I understand your intent: You want to pass the number of bins from the slider in the sub-module, back to the parent module, before passing it from the parent module into the output calculation of the (same) sub-module. (If I have misunderstood your intend, see note below for an alternative).
This would make more sense if you were passing values between two different sub-modules. Modules in Shiny are intended to pass their own values within themselves, so as to avoid cluttering the parent module.
If this is your intention, I recommend the following:
UI (essentially unchanged):
library(shiny)
library(shinydashboard)
source("modules/my.R")
ui <- dashboardPage(
dashboardHeader(title="Dashboard"),
dashboardSidebar(
sidebarMenu(
menuItem("App 1", tabName="app1"),
menuItem("App 2", tabName="app2"),
id="selectedMenu"
)
),
dashboardBody(
uiOutput("foo")
)
)
Server:
library(shiny)
source("modules/my.R")
server <- function(input, output) {
resource_numBins = reactive({ # reactive value is defined
if(exists('my_realised')
& !is.null(my_realised$num_bin())){ # conditions to prevent errors/warnings
return(my_realised$num_bins())
}else{
return(3) # required initial value
}
})
# reactive value passed to module
my_realised <- callModule(my, "foo", numBins = resource_numBins)
# my_realised stores values returned by module
output$foo <- renderUI({
if (input$selectedMenu == "app1") {
return(myUI("foo", initial_num_bins = resource_numBins()))
} else {
return(br())
}
})
}
Module (some white space removed):
library(shiny)
myUI <- function(id, initial_num_bins) {
ns <- NS(id)
tagList(
fluidRow( box(
plotOutput(outputId = ns("distPlot")), width=12
) ),
fluidRow( box(
sliderInput(inputId = ns("bins"), label = "Number of bins:",
min = 1, max = 50, value = initial_num_bins),
width=12
) )
)
}
my <- function(input, output, session, numBins) { # module receives value from parent
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = numBins() + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
return(list(num_bins = reactive({input$bins}))) # module returns slider value to parent
}
Note that the complexity of resource_numBins is due to it also being used as the initial value, and needing to persist when menu item "App 2" is selected. Without these additional requirements this reactive would simplify to:
resource_numBins = reactive({ # reactive value is defined
return(my_realised$num_bins())
})
As sub-modules will pass values between themselves without first needing to pass a value back to the parent, the other problem you might be seeking to solve is how to use a sub-module to update the value in a parent module. For this I suggest my existing answer here. Either approach will let you use the value from the sub-module in the parent module.
I have an existing Shiny script with standard widgets from the Shiny library. Now I wish to add something to show temperature on a graphical scale? This would be a read-only value, so it wouldn't make sense to use a slider unless the slider can be locked and only changed programatically. Is that possible? If not, what are other suggestions?
To clarify:
Is it possible to have a Shiny slider as read only. The user can not slide it but it can be programmatically changed. Here is a Shiny slider:
library(shiny)
ui <- fluidPage(
sliderInput("aa", "Temp",
min = -20, max = 20,
value = 10, step = 10)
)
server <- function(input, output) { }
shinyApp(ui, server)
I'm not familiar with Shiny Dashboard but I saw taskItem. Can these be "dropped in" and used with a normal Shiny app that uses fluidPage, sidebarPanel, mainPanel? How does one remove the bullet point and the percentage? Here is an example of a taskItem.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
taskItem(value = temp <- 89, color = "red",
"Temp"
))
)
server <- function(input, output) { }
temp <- 89
shinyApp(ui, server)
AFAIK, sliderInput cannot be used as an output. However here's a potential solution using progressBar from shinyWidgets package
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
h3("Sidebar")
),
mainPanel(
br(), br(), br(),
progressBar("tempbar", value = 0, title = "Temperature", status = "danger")
)
)
)
server <- function(input, output, session) {
temp <- 89
updateProgressBar(session, id = "tempbar", value = temp)
}
shinyApp(ui, server)
shiny app with temperature bar
Replace temp in server with whatever calculated value you might have. For fixed temperature value just set it in ui, no need to use updateProgressBar. By default progressBar is scaled from 0-100. To modify see documentation for it.
You can use updateSliderInput to achieve such an behaviour. Couple this with shinyjs::disabled and you get what you want. I would however look for a less hackish solution:
library(shiny)
library(shinyjs)
ui <- fluidPage(
## add style to remove the opacity effect of disabled elements
tags$head(
tags$style(HTML("
.irs-disabled {
opacity: 1
}")
)
),
useShinyjs(),
disabled(sliderInput("aa", "Temp",
min = -20, max = 20,
value = 10, step = 10)),
actionButton("Change", "Change")
)
server <- function(input, output, session) {
observeEvent(input$Change, {
new_temp <- sample(seq(-20, 20, 10), 1)
updateSliderInput(session, "aa", value = new_temp)
})
}
shinyApp(ui, server)
I would like to implement a 'Reset inputs' button in my shiny app.
Here is an example with just two inputs where I'm using the update functions to set the values back to the default values:
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
observe({
input$reset_input
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
}
))
What I would like to know is if there is also a function that sets back everything to default? That would be useful in case of multiple inputs.
Additionally, I'm not sure if my use of the observe function in order to detect when the action button was hit is the 'proper way' of handling the action buttons?
First of all, your use of the observer is correct, but there is another way that's slightly nicer. Instead of
observe({
input$reset_input
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
You can change it to
observeEvent(input$reset_input, {
updateNumericInput(session, "mynumber", value = 20)
updateTextInput(session, "mytext", value = "test")
})
Also note that you don't need to explicitly "return" from a renderText function, the last statement will automatically be used.
Regarding the main question: Matthew's solution is great, but there's also a way to achieve what you want without having to move all your UI into the server. I think it's better practice to keep your UI in the UI file just because separation of structure and logic is generally a good idea.
Full disclaimer: my solution involves using a package that I wrote. My package shinyjs has a reset function that allows you to reset an input or an HTML section back to its original value. Here is how to tweak your original code to your desired behaviour in a way that will scale to any number of inputs without having to add any code. All I had to do is add a call to useShinyjs() in the UI, add an "id" attribute to the form, and call reset(id) on the form.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
shinyjs::useShinyjs(),
id = "side-panel",
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
observeEvent(input$reset_input, {
shinyjs::reset("side-panel")
})
}
))
There isn't such a function in shiny, however, here's a way to accomplish this without having to essentially define your inputs twice. The trick is to use uiOutput and wrap the inputs you want to reset in a div whose id changes to something new each time the reset button is pressed.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
uiOutput('resetable_input'),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
),
server = function(input, output, session) {
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
output$resetable_input <- renderUI({
times <- input$reset_input
div(id=letters[(times %% length(letters)) + 1],
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter a text", "test"))
})
}
))
Here is yet another option that works for either static or dynamic inputs, and doesn't involve re-rendering inputs entirely.
It uses:
reactiveValuesToList to get all initial input values, and (optionally) any dynamic input values that get initialized afterward.
session$sendInputMessage to update values for generic inputs. The updateXyzInput functions call this under the hood like session$sendInputMessage(inputId, list(value = x, ...).
Every Shiny input uses value for its input message, and almost all will update with their input value as-is. Only a two inputs I've found need special casing - checkboxGroupInput to not send NULL when nothing is checked, and dateRangeInput to convert its c(start, end) to a list(start = start, end = end).
It may not be a good idea to blindly reset ALL inputs (even tabs will be reset), but this can easily be adapted to reset a filtered set of inputs.
library(shiny)
ui <- pageWithSidebar(
headerPanel("'Reset inputs' button example"),
sidebarPanel(
numericInput("mynumber", "Enter a number", 20),
textInput("mytext", "Enter text", "test"),
textAreaInput("mytextarea", "Enter text", "test"),
passwordInput("mypassword", "Enter a password", "password"),
checkboxInput("mycheckbox", "Check"),
checkboxGroupInput("mycheckboxgroup", "Choose a number", choices = c(1, 2, 3)),
radioButtons("myradio", "Select a number", c(1, 2, 3)),
sliderInput("myslider", "Select a number", 1, 5, c(1,2)),
uiOutput("myselUI"),
uiOutput("mydateUI"),
tags$hr(),
actionButton("reset_input", "Reset inputs")
),
mainPanel(
h4("Summary"),
verbatimTextOutput("summary")
)
)
server <- function(input, output, session) {
initialInputs <- isolate(reactiveValuesToList(input))
observe({
# OPTIONAL - save initial values of dynamic inputs
inputValues <- reactiveValuesToList(input)
initialInputs <<- utils::modifyList(inputValues, initialInputs)
})
observeEvent(input$reset_input, {
for (id in names(initialInputs)) {
value <- initialInputs[[id]]
# For empty checkboxGroupInputs
if (is.null(value)) value <- ""
session$sendInputMessage(id, list(value = value))
}
})
output$myselUI <- renderUI({
selectInput("mysel", "Select a number", c(1, 2, 3))
})
output$mydateUI <- renderUI({
dateInput("mydate", "Enter a date")
})
output$summary <- renderText({
return(paste(input$mytext, input$mynumber))
})
}
shinyApp(ui, server)
You can also create a reset button by assigning NULL to your reactive values object.
See this RStudio Shiny article on Using Action Buttons: http://shiny.rstudio.com/articles/action-buttons.html. Specifically, read the sections titled Pattern 4 - Reset buttons and Pattern 5 - Reset on tab change. Examples (including code) are provided in the article.
The article provides solutions that don't require additional packages if that's a concern.
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