As an exercise, I have modified the default Old Faithful Geyser Data app to incorporate asynchronous programming. However it's behaviour doesn't satisfy my expectations based on my understanding of asynchronous programming I suspect there is a fundamental misunderstanding on my part.
Here, the app creates 2 plot outputs that are identical. One takes longer than the other but set up to work asynchronously, the other is fast.
server.R
library(future)
library(promises)
library(shiny)
plan(multisession)
function(input, output) {
bins = reactive({
future({
print("I'm slow")
Sys.sleep(10)
faithful[, 2]
}) %...>%
{seq(min(.), max(.), length.out = input$slow_bins + 1)}
})
output$slow_dist_plot <- renderPlot({
bins() %...>%
{hist(faithful[, 2], breaks = ., col = 'darkgray', border = 'white')}
})
output$fast_dist_plot = renderPlot({
print("I'm fast")
x <-faithful[, 2]
bins = seq(min(x), max(x), length.out = input$fast_bins + 1)
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
ui.R
library(shiny)
fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("slow_bins",
"Number of slow bins:",
min = 1,
max = 50,
value = 30),
sliderInput('fast_bins',
'fast bins',
min = 1,
max = 50,
value = 30)
),
mainPanel(
plotOutput("slow_dist_plot"),
plotOutput("fast_dist_plot")
)
)
)
Based on my understanding of asynchronous programming mainly derived from this Rstudio post, if two users are running this code at the same time, after the initial plotting of the two plots, if one of the users change the slow bins the other user should be free to play around with the fast bins and get instant plots as the other users request is processed by a new process.
However when I actually try this with two windows, I see that whenever I make a change in the slow bin, the other windows have to wait for slow bins to complete. What is going wrong here? Are my expectations wrong or did I set this up wrongly?
Expected behaviour in the question is correct. However, on a single core machine, the number of workers is set to 1 by default when using multisession plan. Doing
plan(multisession,workers = 2)
will have the expected behaviour. Raising the number is probably necessary for an app in live use.
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)
Im creating shiny app. for calculating risk score where the user will upload input file and select the input such as ethnic groups, type of calculating score and diseases. After all of the input are selected and file is uploaded, my App. will be run when user click at action button and the output such as graph and dataframe will be shown
Im using observeEvent to control my App for triggering unnecessarily( mulitple handleExpr with one eventExpr), and this is my shorten version of code. Im sorry for my code that is not reproducible.
observeEvent(input$action,{
isolate(system2("bash_script/plink.sh",args = c(input$file$datapath,input$type,input$sum_stat,input$Disease,input$Ethnic,input$Ref)))
output$table_score <- renderDataTable({
percentile <- read.csv("../output/score_percentile.csv",header = T, sep = "\t")
}, selection = "single")
output$table_variant <- renderDataTable({
varaints_in_sample <- fread("../output/summary.csv", header = T, drop = 1)
})
#Plot Graph
output$plot <- renderPlot({
s <- input$table_score_cell_clicked
plot("../output/score_percentile_plot.csv",s,"analysis")
})
})
my problem is that when Im running app for the first time, everything is controllable. However, if I want to select new input. for example im changing input disease from heart disease to another disease. my App. will be triggered unnecessarily although I did NOT click at action button.
So, Is there any way to use observeEvent with one evenExpr for mulitple handleExpr
Thanks everyone for your help!
I think, this is simplified example of your problem. The solution is to put all your input$... inside isolate().
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton('action', 'Click')
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
req(input$action)
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = isolate(input$bins) + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)
Hi I have a shiny app that helps a user visualize electropherograms (essentially spectra) that come from automated DNA sequencers. I would like the user to be able to hover over a peak and find out the time the peak came off the instrument. I also would like to be able to compare multiple electropherograms by plotting the spectra one above the other.
If I plot a single spectrum, I can recover the mouse x-position with the 'hover' option provided to plotOutput() in the ui. If I stack plots using base graphics and the par(mfrow=c(n,1)) where n is the number of spectra, the results are unpredictable. Basically the x-position is recoverable in part of the plot region but not throughout.
As a final piece of information, I wrote this app several years ago and it's been working as expected until I updated R and the shiny package to fairly recent versions: (R 3.4.4; shiny 1.2.0).
I've included an app.R file that reproduces this issue on a simple case using histograms and the old-faithful data and shows the approach I have been taking. I get the same behavior whether I set 'clip' in hoverOpts to TRUE or FALSE.
Thanks for any help
allan
library(shiny)
ui = fluidPage(
titlePanel("Mulitpanel hover: Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
sliderInput("bins","Number of bins:",min = 1,max = 50,value = 30)
),
mainPanel(
textOutput("xpos"),
plotOutput("distPlot",hover=hoverOpts(id="plot_hover",clip=TRUE))
)
)
)
server = function(input, output) {
output$xpos = renderText({paste("x coord:",input$plot_hover$x)})
output$distPlot = renderPlot({
x = faithful[, 2]
bins = seq(min(x), max(x), length.out = input$bins + 1)
par(mfrow=c(2,1))
hist(x, breaks = bins, col = 'darkgray', border = 'white')
hist(x, breaks = bins, col = 'orange', border = 'white')
})
}
shinyApp(ui = ui, server = server)
This question already has an answer here:
Can I let Shiny wait for a longer time for numericInput before updating?
(1 answer)
Closed 5 years ago.
In my app I've got an output depending on many inputs. Whenever one of the inputs is changed shiny refreshes the output which takes some long time. The problem occurs when I want to change more than one input, because I have to wait X times to get correct output. Is there a way to break the refreshing of the reactive/output if another input was changed?
In this simple example:
output$distPlot depends on input$bins and input$col. Every change in inputs takes 3 seconds to refresh a histogram, so when I want to change both of them I have to wait 6 seconds. What I want to do is break existing refreshing if another input change was made.
ui
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
selectInput("col","Color",
choices = c("green","red","blue"),selected = "green")
),
mainPanel(
plotOutput("distPlot")
)
)
))
server
library(shiny)
shinyServer(function(input, output) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = input$col, border = 'white')
Sys.sleep(3)
})
})
P.S. submitButton is not an option in my case, I'm looking for an option to reset/break rendering
Thanks to HubertL I found my answer. I had to create a reactive list with all my dependent inputs, and then use debounce on it, this way plot will change only once (if the time of changing the inputs will be less than 3000 mls in this example).
server:
library(shiny)
library(dplyr)
shinyServer(function(input, output,session) {
inputs_change<-reactive({
list(input$bins,input$col)
}) %>% debounce(3000)
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = inputs_change()[[1]] + 1)
hist(x, breaks = bins, col = inputs_change()[[2]], border = 'white')
Sys.sleep(3)
})
})
I came across the video tutorial here.
http://blog.revolutionanalytics.com/2016/03/rtvs-preview.html
Right around minute 24:15 the instructor starts talking about the shiny app that he built. He has it pre-built, and simply runs it, so it's basically impossible for me to figure out how he actually went from nothing to a real working app. I watched a few tutorials on YouTube, and they were helpful to get me up to speed a little, but still can't get this working. As best as I can tell, these are (kind of) the steps, but again, I stil can't get this working.
RStudio > File > New File > Shiny Web App. Then name the app and crate a directory.
Now, I have a template that looks like this.
#
# 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)
# Define UI for application that draws a histogram
ui <- shinyUI(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 <- shinyServer(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)
Based on the video, I created a template (with some basic R code). It looks like this.
library(shiny)
library(leaflet)
library(plyr)
ui <- fluidPage(
actionButton("recalc", "New points"),
mainPanel(
tabsetPanel(
tabPanel("Order Locations", leafletOutput("map",width="80%",height="400px")),
tabPanel("Markers", verbatimTextOutput("markers"))
)
)
)
server <- function(input, output, session) {
airports <- read.csv("https://raw.githubusercontent.com/jpatokal/openflights/master/data/airports.dat", header = FALSE)
colnames(airports) <- c("ID", "name", "city", "country", "IATA_FAA", "ICAO", "lat", "lon", "altitude", "timezone", "DST")
countries <- sort(unlist(lapply(unique(airports$country), as.character)))
}
shinyApp(ui, server)
This doesn't do anything at all. Ugh.
I believe the 'ui' is a function that calls arguments form the 'server'. Is that right? Am I close, or way off base? How can I get this working? It seems VERY useful. I'm trying to learn the nuts and bolts of this stuff so I can do it myself. Thank you!