I'm writing a shiny app, and there is a plot which is getting updated each 10 seconds. The app works perfectly and it is getting updated. However, after some number of updating, namely around 30 times, it stops with no reason.
Using for chart update:
invalidateLater
Would you please let me know what I should do?
library("shiny")
library("shinythemes")
library("ggplot2")
## generating the time of the system
t <- Sys.time()
n <- 101 # some time lage
df <- data.frame(c(1:1000), runif(1000, 0, 1) ) # in addition, df is just a dataframe in the memory
shinyUI(
tabPanel("Home", plotOutput(outputId = "plot0") )
)
shinyServer(function(input, output, session) {
output$plot0 <- renderPlot({ # Signal realtime View
invalidateLater(500, session) # updating the plot each 500 miliseconds
n <- as.integer(Sys.time() - t) + n # updating the new elements which should be visualized
ggplot() + geom_line(aes(x = df[((n-100) :n), 1], y = df[((n-100) :n) , 2] ), colour = "blue") +
xlab("Time [s]") + ylab("Channel") # normal ggplot :-)
})
})
Your time difference calculation doesnt take into account where the difference is in seconds, minutes or hours, so after 60 seconds the difference will be 1.
Try something like this:
#rm(list = ls())
library(shiny)
library("ggplot2")
t <- Sys.time()
n <- 101 # some evaluation
df <- data.frame(c(1:1000), c(1:1000) )
ui<- shinyUI(pageWithSidebar(
headerPanel("Distribution analysis"),
sidebarPanel(),
mainPanel(
plotOutput(outputId = "plot0"))
))
server<- shinyServer(function(input, output,session) {
mydata <- reactive({
invalidateLater(300, session) # updating the plot each 300 miliseconds
n <- as.integer(difftime(Sys.time(),t, units = "secs")) + n # updating the new elements which should be visualized
df[((n-100) :n),]
})
output$plot0 <- renderPlot({ # Signal realtime View
ggplot() + geom_line(aes(x = mydata()[,1], y = mydata()[,2]), colour = "blue") +
xlab("Time [s]") + ylab("Channel") # normal ggplot :-)
})
})
shinyApp(ui=ui, server=server)
Related
I am using a brushed histogram to query samples in a shiny app. In my full application, I overlay a new histogram that highlights the selected region and update a DT data table showing properties of the filtered samples.
I've noticed that a reactive that depends on the brush gets called twice each time I move it. For example, the table_data reactive below gets called twice each time I brush the histogram.
app.R
library(ggplot2)
library(shiny)
df <- data.frame(x = rnorm(1000))
base_histogram <- ggplot(df, aes(x)) +
geom_histogram(bins = 30)
# Define UI for application that draws a histogram
ui <- fluidPage(
column(
plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
width = 6
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$histogram <- renderPlot({
p <- base_histogram
current <- table_data()
if (nrow(current) > 0) {
p <- p + geom_histogram(data = current, fill = "red", bins = 30)
}
p
})
table_data <- reactive({
print("called")
brushedPoints(df, input$brush)
})
}
# Run the application
shinyApp(ui = ui, server = server)
In this toy example, it's barely noticeable. But in my full app, a heavy calculation has to be done within the table_data reactive, and this the double call is unnecessarily slowing everything down.
Is there any way to structure the app so that the reactive only executes once whenever a brush is ended?
Here is a GIF that shows that the table_data is being executed twice per brush.
try this, only trigger once on each brush movement.
library(ggplot2)
library(shiny)
df <- data.frame(x = rnorm(1000))
base_histogram <- ggplot(df, aes(x)) +
geom_histogram(bins = 30)
# Define UI for application that draws a histogram
ui <- fluidPage(
column(
plotOutput("histogram", brush = brushOpts(direction = "x", id = "brush", delay=500, delayType = "debounce")),
width = 6
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$histogram <- renderPlot({
p <- base_histogram
if(!is.null(table_data())) {
p <- p + geom_histogram(data = table_data(), fill = "red", bins = 30)
}
p
})
table_data <- reactive({
if(is.null(input$brush)) return()
print("called")
brushedPoints(df, input$brush)
})
}
shinyApp(ui, server)
For the first time I really can't find this answer here already, so I hope you all can help me, I'm sure there is a pretty easy fix.
I am making a Shiny volcano plot with clickable points to give me a table with the data about that point. If I use a trans function (that I found here, thank you helpful stranger) within scale_y_continuous() in my plot, points in the scaled region are no longer clickable. How can I scale the axis this way and still be able to have the clickable points?
My code, with some fake data that has the same problem:
## Read in necessary libraries, function, and data
library(shiny)
library(ggplot2)
library(dplyr)
library(scales)
reverselog_trans <- function(base = exp(1)) {
trans <- function(x) -log(x, base)
inv <- function(x) base^(-x)
trans_new(paste0("reverselog-", format(base)), trans, inv,
log_breaks(base = base),
domain = c(1e-100, Inf))
}
pretend_data <- tibble(data=1:5, estimate = runif(5, min = -1, max = 2), plot = c(1e-50, 2e-35, 5e-1, 1, 50))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
The problem is that input$plot_click returns the coordinates on the transformed scale. nearPoints tries then to match those to the original scale which does not work.
You have a couple of options though:
Transform the data yourself and adapt y axis ticks via scale_y_continuous
Adapt pretend_data in the nearPoints call.
Option 1
This requires that you control y axis tick marks yourself and would need some more fiddling to get the exact same reuslts as in your example.
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data_traf, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
## would need to define breaks = to get same tick mark positions
scale_y_continuous(labels = reverselog_trans(10)$inverse)
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Option 2
pretend_data_traf <- pretend_data %>%
mutate(plot = reverselog_trans(10)$transform(plot))
# Define UI for application that draws a volcano plot
ui <- fluidPage(
# Application title
titlePanel("Pretend Plot"),
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
# Define server logic required to draw a volcano plot
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(data = pretend_data, aes(x=estimate, y=plot)) +
geom_vline(xintercept=c(-1, 1), linetype=3) +
geom_hline(yintercept=0.01, linetype=3) +
geom_point() +
scale_y_continuous(trans = reverselog_trans(10))
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
nearPoints(pretend_data_traf, input$plot_click) %>%
mutate(plot = reverselog_trans(10)$inverse(plot))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I'm new to shiny and I'm trying to use it for a simulation of a prey/predator model.
First, I wanted to generate the dataframe with all the initial positions for each animal; and try to plot it usign ggplot; but when I hit the actionButton, the plot never showed. I dont interstand why and there is any error message to let me at least know what is wrong.
Here is the code:
library(shiny)
library(tidyverse)
library(ggplot2)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("nPrey", "select total number of preys", 1, 100, 10, 1),
sliderInput("nHunter", "select total number of Hunters", 1, 100, 10, 1),
actionButton ("play", "Begin simulation")
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output, session) {
zMax = 20
simulation <- eventReactive(input$play, {
createInitialTable(input$nPrey, input$nHunter)
})
output$plot <- renderPlot({
p <- ggplot() +
geom_point(aes_string(x="X",y="Y"), data=simulation()) +
coord_cartesian(xlim =c(0, zMax), ylim = c(0, zMax))
})
createInitialTable <- function (nPrey, nHunter){
aAnimal <- data.frame()
cVar <- c("X", "Y")
for (i in 1:nPrey){
aAnimal <- rbind(aAnimal, c(round(runif(1)*zMax), round(runif(1)*zMax)))
}
for (i in 1:nHunter){
aAnimal <- rbind(aAnimal, c(round(runif(1)*zMax), round(runif(1)*zMax)))
}
colnames(aAnimal) <- cVar
return (aAnimal)
}
}
shinyApp(ui, server)
Thank you for reading this
Simple fix: Remove p <- and you should be good to go. However, to improve you need to check the reactivity of your execution when the nPrey and Hunter are dynamically changing.
I've looked through R Shiny tutorials and stackoverflow for answers related to my query. I usually wait for 3-4 days to solve a coding problem before I attempt to post.
I have an animated slider in my UI that loops through time interval in a column (column a) . I'm trying to produce an animated line plot that plots y values of another column (column b), corresponding to the nrow() of that time interval. The slider works perfectly, but I haven't been able to plot the output.
I mightve missed some concepts related to reactivity in Shiny app. Appreciate any guidance I can get related to my query. I'll be happy to post more info if needed.
a <- c(0,1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata())
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = 0,
max = nrow(mydata()),
value = 1, step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotlyOutput("plot")
)
)
server <- function(input, output) {
sliderValues <- reactive({
data.frame(
Name = "slider",
Value = input$slider)
})
output$plot <- renderPlot({
x<- as.numeric(input$slider)
y <- as.numeric(b[x])
ggplot(mydata,aes_string(x,y))+ geom_line()
})
}
Just as a demo, I wanted the animated plot to come out like this, but in correspondance to UI slider values :
library(gganimate)
library(ggplot2)
fake <- c(1,10)
goods <- c(11,20)
fakegoods <- cbind(fake,goods)
fakegoods <- data.frame(fakegoods)
ggplot(fakegoods, aes(fake, goods)) + geom_line() + transition_reveal(1, fake)
Does this accomplish what you are looking for? Note that I removed the first element, 0, from vector a as your original example had more elements in a than b, and in order for them to be cbind together they must be the same length.
library(ggplot2)
library(shiny)
a <- c(1,2,3,4,5,6)
b <- c(50,100,40,30,20,80)
mydata <- cbind(a,b)
mydata <- as.data.frame(mydata)
ui <- fluidPage (
headerPanel("basic app"),
sidebarPanel(
sliderInput("slider",
label = "Time elapsed",
min = min(mydata$a),
max = max(mydata$a),
value = min(mydata$a), step = 1,
animate =
animationOptions(interval = 200, loop = TRUE))
),
mainPanel(
plotOutput("plot")
)
)
server <- function(input, output) {
output$plot <- renderPlot({
plotdata <- mydata[1:which(input$slider==mydata$a),]
p <- ggplot(plotdata,aes(x = a,y = b))
if(nrow(plotdata)==1) {
p + geom_point()
} else {
p + geom_line()
}
})
}
My shiny code has an rhandstontable that the user can edit. This leads to an update of the rightmost columns, based on a custom function. the code also plots values from the table on two ggplots, which also get updated when the table values change. All of this works except that there is a funny double refresh that makes Shiny slow; my table isn't big, about 50rows by 23 columns where only 4 columns are used in the plots but about 12 columns go into my custom function.
Is there a way to make shiny faster using observe(), reactiveValues, or other related functions?
I'm new at reactive expressions and I've been reading that it might be possible to make the app faster by caching data properly.
library(shiny)
library(rhandsontable)
library(tidyverse)
library(ggthemes)
library(ggrepel)
## Create the dataset
DF <- readRDS("data/DF2.Rds")
numberofrows <- nrow(DF)
# weighting variables
w1 = (c(4,3,1))
w2 = (c(1,1,1,1))
w3 = (c(2,2,1,2,1,1,2))
# Function to calculate scores
ScoresTbl <- function(data, w1, w2, w3){
Description <- data[,1:9]
Potential <- crossprod(t(data[,10:12]), w1)/sum(w1)
Setting <- crossprod(t(data[,13:16]), w2)/sum(w2)
Risk <- crossprod(t(data[,17:23]),w3)/sum(w3)
data.frame(data[1:23],Potential,Setting,Risk) %>%
mutate(
SOP = rowMeans(data.frame(Potential,Setting,Risk)))
}
ui = fluidPage(
fluidRow(column(12,
rHandsontableOutput('hotable1', width = "100%", height = "25%")#,
# actionButton("go", "Plot Update")
)),
fluidRow(column(6, plotOutput("plot1")),
column(6, plotOutput("plot2")))
)
server <- shinyServer(function(input, output) {
indat <- reactiveValues(data=ScoresTbl(DF,w1, w2, w3))
observe({
if(!is.null(input$hotable1))
indat$data <- hot_to_r(input$hotable1)
})
output$hotable1 <- renderRHandsontable({
rhandsontable(ScoresTbl(indat$data,w1, w2, w3))
})
output$plot1 <- renderPlot({
ggplot(data = indat$data,
aes(x=Potential,
y=Setting, label = Project)) +
geom_point(alpha = 0.5) +
scale_size(range = c(2,15)) +
geom_text_repel(colour = "black",size = 2.5) +
theme_minimal()
})
output$plot2 <- renderPlot({
ggplot(data = indat$data,
aes(x=Potential,
y=Setting, label = Project)) +
geom_point(alpha = 0.5) +
scale_size(range = c(2,15)) +
geom_text_repel(colour = "black",size = 2.5) +
theme_minimal()
})
})
shinyApp(ui, server)