Is it possible for multiple users of the same app to make changes to the same set of reactive values?
This question (handling multiple users simulaneously in an R Shiny app) suggests that multiple users in different sessions can make changes to the same value (by declaring it outside of server() and using <<- instead of <- ) But that is for just plain old values/variables. Is this possible for reactive values?
Ideally, I would like a change made by user A to be immediately reflected in some output viewed by user B.
Here's a minimal working example based on RStudio's default one-file Shiny app:
library(shiny)
slidervalue <- 30
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = slidervalue)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput('txt')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
slidervalue <<- input$bins
})
reactive_slidervalue <- reactivePoll(100, session,
checkFunc = function() { slidervalue },
valueFunc = function() { slidervalue }
)
output$txt <- renderText(reactive_slidervalue())
observe({
updateSliderInput(session, 'bins', value = reactive_slidervalue())
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = reactive_slidervalue() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Basically, I am using a global variable (as you and and the post suggested), and then hooked it back into server by using the reactivePoll function to make the external dependency reactive.
Related
I have an output that takes user input to select which of a number of calculations to use and results in 5 numbers. That output pushes out the results of this and other calculations as an HTML table. The individual calculations are not particularly complicated, but user selections choose which of many approaches they are using, so I don't really want to replicate all that code in other outputs that are going to use just those 5 numbers.
My thought was to use the double-arrow to make those numbers available to the other outputs (in my case some plots). My goal is to generate graphs from numbers already generated in a different output, however that gets accomplished. I am not attached to the approach below, it is just where I am right now.
I ran into a number of problems just using <<- and tried a lot of things to get it to work. I won't complicate this further with all the things I tried and the problems they created.
The MRE below replicates this by calculating a number in one output that is then to be used in another output. If you enter different numbers of bins, the second output is never triggered to update to the new number. For this MRE I could of course directly use the user input to calculate that number but that is what I am trying to avoid in the real app. I also don't want to use a "Go!" button if I can avoid it since part of the fun is watching how things change in response to your various selections.
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput("binnum")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
a_number<-0
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
a_number<<-bins[2]/5}
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$binnum<-renderText({
a_number
})
}
# Run the application
shinyApp(ui = ui, server = server)
Could you just treat bins and a_number as reactive?
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput("binnum")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# a_number<-0
# generate bins based on input$bins from ui.R
data(faithful)
x <- faithful[, 2]
bins <- reactive({
seq(min(x), max(x), length.out = input$bins + 1)
})
a_number <- reactive({
req(bins())
-bins()[2]/5
})
output$distPlot <- renderPlot({
# draw the histogram with the specified number of bins
hist(x, breaks = bins(), col = 'darkgray', border = 'white', xlab = paste0("a = ", -bins()[2]/5))
})
output$binnum<-renderText({
a_number()
})
}
# Run the application
shinyApp(ui = ui, server = server)
Example shiny app:
library(tidyverse)
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput(inputId = "cut",
label = "cut",
# choices = unique(diamonds$cut), # works
choices = unique(my_diamonds$cut), # does not work
selected = "Ideal")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
my_diamonds <- diamonds
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- my_diamonds$carat
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
In this case I am using a faux data frame 'my_diamonds'. In my real code I am connecting to a database using dbplyr and then making some transformations to it, so duplicating that in ui section seems wasteful.
What is the 'right' way to use a dataframe defined in server section to get the unique values, in this case my_diamonds$cut to use as a select input's drop down choices?
Instead of using selectInput in the UI, you can instead use UIoutput in the UI and then define the UI element within the server function using renderUI.
So given that you have defined a UIOutput element called otn_race_selection_op, then we can define that as a selectInput object using the below code. Here getData is a reactive element that updates itself to the latest data. So based on that, you can modify the input choices for your selectInput object
output$otn_race_selection_op <- renderUI({
df <- getData()
options <- sort(unique(df$Race))
selectInput(
inputId = "otn_race_selection",
label = "Race",
choices = c("All", options)
,
selected = "All"
)
})
I want to modularise my shiny app code, by moving parts of the code in separate files. I then include the content of the file with a call to the source function: source("./www/some_code.R", local = TRUE)
It works well except for an undesired effect: the word TRUE is added just below the insert.
Could you help me understand why this happen and how I can remove this undesired text?
For a reproducible example,
create app.R:
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
source("./www/slider.R", local = TRUE)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
and in the www folder the slider.R:
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
Just when I posted this, I saw a link to this which answer the question: displaying TRUE when shiny files are split into different folders
I thought that I did my research though... Should I delete the whole thread?
I´m using a shinyapp on an opensource shiny-server to display a dashboard on multiple devices. I want to give the opportunity to change the plots on all dashboards from a local PC.
If the input is altered in any session, all sessions should update their plots to this new input. How do i do this? Can i save the input in a global variable?
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
observe({
invalidateLater(10000)
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
p<<- hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot <- renderPlot({print(p)})
}
# Run the application
shinyApp(ui = ui, server = server)
You can initiate an reactiveValue in the global file and use this instead up the original input
In principal all objects initiated in the global file are shared over sessions.
Example
**UI **
library(shiny)
# Define UI for application that plots random distributions
shinyUI(pageWithSidebar(
# Application title
headerPanel("It's Alive!"),
# Sidebar with a slider input for number of observations
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot", height=250)
)
))
**Server **
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
# Expression that generates a histogram. The expression is
# wrapped in a call to renderPlot to indicate that:
#
# 1) It is "reactive" and therefore should be automatically
# re-executed when inputs change
# 2) Its output type is a plot
observe({
RV$bins = input$bins
})
output$distPlot <- renderPlot({
x <- faithful[, 2] # Old Faithful Geyser data
bins <- seq(min(x), max(x), length.out = RV$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
** Global **
RV <- reactiveValues(bins = 10)
When a user changes the number of bins the histogram will changes for all users but not the slider.
Hope this helps!!
I generate and display a flextable in a Shiny app and want to place it in a PDF. The only available method is to convert the flextable object to a PNG then place the PNG in the PDF. For each PNG file I assign a filename including a date-time stamp to make it unique between sessions. This file name is saved in a reactiveValue.
When the user is finished and the session is closed, how can I delete the file? If I do not I will pile up extraneous files. I cannot use onSessionEnded() because the reactive values are all gone when the browser is closed. I cannot generalize using a pattern because other users have files with a similar name. I have to delete these PNG files specifically.
Any ideas?
onSessionEnded code that does not work:
observe({
session$onSessionEnded(function() {
unlink(c(values$fnameSummary))
unlink(c(values$fnameLike))
unlink(c(values$fnameRisk1))
})
})
This produces the following error:
Warning: Error in .getReactiveEnvironment()$currentContext: Operation not
allowed without an active reactive context. (You tried to do something
that can only be done from inside a reactive expression or observer.)
Stack trace (innermost first):
33: .getReactiveEnvironment()$currentContext
32: .subset2(x, "impl")$get
31: $.reactivevalues
30: $
29: unlink
28: callback [C:\Users\jch1748\Documents\Projects\W2017010 - Combined Risk Tool\testing/server.R#2790]
1: runApp
maybe a working example will help?
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
tsts <- reactiveValues()
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
observe({
tsts$fname <- "AAA.txt"
write(input$bins, file=tsts$fname)
})
onSessionEnded(function() {
cat("Session Ended\n")
unlink(tsts$fname)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I had a similar problem where I wanted to dynamically serve images and pdf files for download in a shiny app. Therefore the files need to be placed within the www-directory which makes the use of tempdir impossible. Additionally, the created files needed to be deleted after the app stops. I solved the problem with the following code:
session$onSessionEnded(function() {
system(paste("rm -f", PathToFile))
})
No need to use reactiveValues. Please see:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
fname <- "AAA.txt"
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
observe({
write(input$bins, file=fname)
})
session$onSessionEnded(function() {
cat("Session Ended\n")
unlink(fname)
})
}
# Run the application
shinyApp(ui = ui, server = server)