I am creating a POC, where real time update will reflect on my shiny application. The idea is to plot the frequency distribution of the data that is being generated from a server. Since I do not have access to the server yet, I have simulated a data creation which I am feeding to my plot. I can see the data properly on my console, but nothing is being displayed on my application. I am sure that there is something I am missing out. I think the reason I am unable to view the plot is because the data is getting updated faster than the rendering speed. Is there any way to modify that.
library(shiny)
library(magrittr)
library(plotly)
ui <- shinyServer(fluidPage(
plotOutput("plot")
))
alarms = c("NodeDown","GrowthRate","DecayRate","DiskFull","ServiceDown","Planned_shutdown","etc.....etc","ServerOutage",
"No Casue")
server <- shinyServer(function(input, output, session){
# Function to get new observations
get_new_data <- function(){
new = sample(alarms,1)
# data <- new %>% rbind %>% data.frame
return(new)
}
# Initialize my_data
my_data <<- get_new_data()
# Function to update my_data
update_data <- function(){
my_data <<- c(get_new_data(), my_data)
}
output$plot <- renderPlotly({
invalidateLater(1000, session)
update_data()
# print(my_data)
dd = update_data()
dd = as.data.frame(table(dd))
print(dd)
plot_ly(dd, x = ~dd, y = ~Freq)
})
# Plot the 30 most recent values
# output$first_column <- renderPlot({
# print("Render")
# invalidateLater(1000, session)
# update_data()
# print(my_data)
# plot(X1 ~ 1, data=my_data[1:30,], ylim=c(-3, 3), las=1, type="l")
# })
})
shinyApp(ui=ui,server=server)
You should use reactiveValues to append your vector, and use reactiveTimer with observeEvent to trigger it every second
Also, if you want to use renderPlotly in server, you should use plotlyOutput rather than plotOutput in ui
Try this:
library(shiny)
library(magrittr)
library(plotly)
ui <- shinyServer(fluidPage(
plotlyOutput("plot")
))
alarms = c("NodeDown","GrowthRate","DecayRate","DiskFull","ServiceDown","Planned_shutdown","etc.....etc","ServerOutage",
"No Casue")
server <- shinyServer(function(input, output, session){
get_new_data <- function(){
new = sample(alarms,1)
return(new)
}
my_data <-reactiveValues(data=get_new_data())
observeEvent(reactiveTimer(2000)(),{ # Trigger every 2 seconds
my_data$data<-c(get_new_data(),my_data$data)
print(my_data$data)
})
output$plot <- renderPlotly({
dd=as.data.frame(table(my_data$data))
print(dd)
plot_ly(dd, x = ~Var1, y = ~Freq)
})
})
shinyApp(ui=ui,server=server)
Related
I'm using rhandsontable in a shiny app to manually update a dataframe to be displayed with ggplot2.
When adding/changing values in the rhandsontable in quick succession, the table starts an infinite loop, which immobilizes the entire shiny application.
Below an example. By quickly changing the values in the table, the app gets stuck.
library(shiny)
library(rhandsontable)
library(ggplot2)
ui <- fluidPage(
rHandsontableOutput("hot"),
plotOutput("plot")
)
server <- function(input, output, session) {
reactive.table <- reactiveValues(values = data.frame(x = c(1,2), y = c(1,2)))
observe({
if (!is.null(input$hot)) {
reactive.table$values <<- hot_to_r(input$hot)
}
})
output$hot <- renderRHandsontable({
rhandsontable(reactive.table$values)
})
output$plot <- renderPlot({
Sys.sleep(2)
ggplot(reactive.table$values, aes(x = x, y = y)) +
geom_point()
})
}
shinyApp(ui = ui, server = server)
Is there a way to stop the infinite loop or to disable further inputs until the plot is rendered?
Thanks.
I don't know how to stop rhandsontable from starting the infinite loop, but you can avoid inputs in quick succession altogether.
Taking your reprex, I restrict changes to be at least 1 second apart, and it works just fine.
library(shiny)
library(rhandsontable)
library(ggplot2)
ui <- fluidPage(
rHandsontableOutput("hot"),
plotOutput("plot")
)
server <- function(input, output, session) {
reactive.table <- reactiveValues(values = data.frame(x = c(1,2), y = c(1,2)))
rv_timer <- reactiveValues(
prev = NULL, current = NULL
)
observe({
if (!is.null(input$hot)) {
# if it's first time editing table:
if (is.null(rv_timer$prev)) {
rv_timer$prev <- Sys.time()
reactive.table$values <- hot_to_r(input$hot)
return(NULL)
}
# if it's not the first time to edit table, get current clock time:
rv_timer$current <- Sys.time()
# if the difference btwn prev recorded time and current time is less
# than 1second, don't do anything, just return:
if ((rv_timer$current - rv_timer$prev) < 1) {
return(NULL)
}
# otherwise proceed as normal:
reactive.table$values <- hot_to_r(input$hot)
# finally set current clock time as `rv_timer$prev` for use in the next
# invalidation:
rv_timer$prev <- Sys.time()
}
})
output$hot <- renderRHandsontable({
rhandsontable(reactive.table$values)
})
output$plot <- renderPlot({
Sys.sleep(2)
ggplot(reactive.table$values, aes(x = x, y = y)) +
geom_point()
})
}
shinyApp(ui = ui, server = server)
Might be a bug in {rhansontable}.
Considering a user filling in by hand a rhandsontable, I would like to implement a time related condition to proceed with table analysis and plot. E.g. if nothing has been added to table during the last 2 seconds, proceed, otherwise await till the 2 seconds are past.
I tried with validate() or simple condition (like below). It does not work because observe() is accessed immediately after table is modified, at that time the time related condition is false. When the condition should be true, the observe() function is not accessed anymore so condition is not tested...
I tried to provide a MRE but I have trouble defending the need for such feature in a simple example. The need is related to computation time of analysis and plot.
library(shiny)
library(rhandsontable)
library(ggplot2)
DF <- data.frame(x=integer(0), y=integer(0))
ui <- shinyUI(fluidPage(
mainPanel(
rHandsontableOutput("hot"),
plotOutput("plot1")
)
))
server <- shinyServer(function(input, output) {
values <- reactiveValues()
values$table <- DF
values$accessDF <- 0
observe({
if (!is.null(input$hot)) {
DF <- hot_to_r(input$hot)
values$accessDF <- Sys.time() # reset awaiting time when table is incremented
} else {
if (is.null(values[["DF"]]))
DF <- DF
else
DF <- values[["DF"]]
}
values[["DF"]] <- DF
})
output$hot <- renderRHandsontable({
rhandsontable(values[["DF"]], stretchH = "all", minRows=5)
})
observe({
if (Sys.time() - values$accessDF > 2){ # unfornate try...
# some modification of the table occuring here
values$table <- values$DF
}
})
output$plot1 <- renderPlot({
ggplot(data=values$table) + geom_line(aes(x=x, y=y))
})
})
shinyApp(ui=ui, server=server)
Another way is to let your plot depend on a debounced reactive expression that contains the reactive value:
library(shiny)
library(rhandsontable)
library(ggplot2)
ui <- shinyUI(fluidPage(
mainPanel(
rHandsontableOutput("hot"),
plotOutput("plot1")
)
))
server <- function(input, output, session) {
rv = reactiveVal(data.frame(x = integer(0), y = integer(0)))
r2 = reactive(rv()) |>
debounce(2000)
output$hot <- renderRHandsontable({
rhandsontable(rv(), stretchH = "all", minRows = 5)
})
output$plot1 <- renderPlot({
ggplot(r2(), aes(x = x, y = y)) +
geom_point(na.rm = TRUE) +
geom_line(na.rm = TRUE)
})
observeEvent(input$hot$changes, {
rv(hot_to_r(input$hot))
})
}
shinyApp(ui = ui, server = server)
I found one solution. Use reactiveTimer() to force the observe() to activate even though no variable it observes has been updated.
in server:
autoInvalidate <- reactiveTimer(200) # to activate observer every 200 ms
and then in observe()
autoInvalidate()
followed by the condition
if (Sys.time() - values$accessDF > 2){ # unfornate try...
# some modification of the table occuring here
values$table <- values$DF
}
see https://shiny.rstudio.com/reference/shiny/1.0.0/reactiveTimer.html
I know renderPlot produces plot that can be shown on Shiny plotOutput function. I also know autoinvalidate() helps to calculate data reactively.
I am displaying a radar chart (in fact can be any chart) using the below codes:
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
})
What I dont know is how to change the value of i from 1 to 300 during every event of autoinvalidate().
Or is there anyway I can change the row of data in plot so that the plot is dynamically animating every sec with a new row of data.
Can anyone help me plz?
The full code is here:
library(shiny)
library(ggplot2)
mtcars %>%
rownames_to_column( var = "group" ) %>%
mutate_at(vars(-group),funs(rescale)) %>%
tail(4) %>% select(1:10) -> mtcars_radar
ui <- fluidPage(
sidebarPanel(
actionButton("button", "Go!")
),
# Show the plot
mainPanel(
plotOutput("plot2")
)
)
server <- function(input, output) {
library(ggplot2)
library(ggradar)
suppressPackageStartupMessages(library(dplyr))
library(scales)
autoInvalidate <- reactiveTimer(2000)
plot2 <- NULL
output$plot2 <- renderPlot({
ggradar(mtcars_radar[1,])
})
observeEvent(input$button,{
output$plot2 <- renderPlot({
autoInvalidate()
p2<<-ggradar(mtcars_radar[i,])
p2
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
Any help please?
This is where you need a reactive value that stores the row index and changes every second. I do not have the library ggradar, so I will just print out the current row index value instead. I also used invalidateLater instead of reactiveTimer as suggested by Shiny documentation.
library(shiny)
ui <- fluidPage(
verbatimTextOutput("debug")
)
server <- function(input, output) {
row_idx_max <- 15
row_idx <- reactiveVal(0)
observe({
isolate(row_idx(row_idx() + 1))
cur_row_idx <- isolate(row_idx())
if (cur_row_idx < row_idx_max) {
invalidateLater(1000)
}
})
output$debug <- renderPrint({
row_idx()
})
}
shinyApp(ui, server)
I would like to fetch nearPoints using the data from a click event.
I have found the below snippet from the Shiny webpage and it works fine as expected.
output$plot <- renderPlot({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), input$plot_click, "speed", "dist")
if (nrow(res) == 0)
return()
res
})
I tried to mimic the above the approach to identify the nearPoints in the Plotly plots using the click event data. However, it did not work.
output$plot <- renderPlotly({
d <- data()
plot(d$speed, d$dist)
})
output$plot_clickedpoints <- renderPrint({
# For base graphics, we need to specify columns, though for ggplot2,
# it's usually not necessary.
res <- nearPoints(data(), event_data("plotly_click"), "speed", "dist")
if (nrow(res) == 0)
return()
res
})
Any idea on how to pass the coordinate information to the plotly plot?
I am not sure on how to do this with the nearPoints function, but is using that function really necessary? You could find the points that are within a threshold of the clicked point as well with the following code:
library(shiny)
library(plotly)
library(DT)
threshold_mpg = 3
threshold_cyl = 1
shinyApp(
ui <- shinyUI(
fluidPage(
plotlyOutput("plot"),
DT::dataTableOutput("table")
)
),
function(input,output){
data <- reactive({
mtcars
})
output$plot <- renderPlotly({
d <- data()
plot_ly(d, x= ~mpg, y=~cyl, mode = "markers", type = "scatter", source="mysource")
})
output$table<- DT::renderDataTable({
event.data <- event_data("plotly_click", source = "mysource")
print(event.data)
if(is.null(event.data)) { return(NULL)}
# A simple alternative for the nearPoints function
result <- data()[abs(data()$mpg-event.data$x)<=threshold_mpg & abs(data()$cyl-event.data$y)<=threshold_cyl, ]
DT::datatable(result)
})
}
)
Hope this helps.
The "plotly_selected" plotly.js event returns more information than event_data("plotly_selected") actually gives you, including coordinate information (this was arguably a design mistake made by event_data() that's too late to change). Fortunately, if you know a bit of JavaScript, know how to listen to plotly select events, and how to send data from client to a shiny server, you can do something like this to access that info:
library(shiny)
library(plotly)
library(htmlwidgets)
ui <- fluidPage(
plotlyOutput("p"),
verbatimTextOutput("info")
)
server <- function(input, output, session, ...) {
output$p <- renderPlotly({
plot_ly(x = 1:10, y = 1:10) %>%
layout(dragmode = "select") %>%
onRender(
"function(el, x) {
var gd = document.getElementById(el.id);
gd.on('plotly_selected', function(d) {
// beware, sometimes this event fires objects that can't be seralized
console.log(d);
Shiny.onInputChange('my-select-event', d.range)
})
}")
})
output$info <- renderPrint({
print(session$rootScope()$input[["my-select-event"]])
})
}
shinyApp(ui, server)
Using the coordinate information you could write a function that works in a similar way to nearPoints().
I have a plotly plot in R Shiny. I want to be able to click many points and have them displayed in a table. The plot is working great and I can get 1 plotly_click (via event_data()) to show in a table. How can a grow a vector of many event_data points. Here is some sample code. I was trying to save the event in d_save. Thanks.
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
p <- plot_ly(data1, x = data1$index, y = data1$data,mode = "lines")
add_trace(p, x = data_points$index, y = data_points$data, mode = "markers")
})
# show table of stances
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <- c(d_save,d$pointNumber[2]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
There is nothing seriously wrong with this and it was weird that it never got answered. It is not a bad example of pure plotly (without using ggplot).
I fixed it by:
changing the d_save <- c(...) assignment to a d_save <<- c(...) (using a reactiveValues here would be cleaner).
changing the plotly call to be a pipe, which seemingly allows some settings to carry over (like the type=scatter default) - eliminating the warning:
No trace type specified: Based on info supplied, a 'scatter' trace
seems appropriate.
fixed an "off-by-one" indexing error in the d_save assignment.
added a layout(...) to give it a title (this is useful for a lot of things).
The resulting code:
library(shiny)
library(plotly)
data1 <- data.frame(cbind(seq(1,1000,1),seq(1,1000,1)*5))
colnames(data1) <- c('index','data')
data_points <- data.frame(cbind(seq(1,1000,5),seq(1,1000,5)*5))
colnames(data_points) <- c('index','data')
ui <- fluidPage(
plotlyOutput("plot1"),
tableOutput("dataTable")
)
d_save <- vector()
server <- function(input, output, session) {
# make plotly plot
output$plot1 <- renderPlotly({
plot_ly(data1, x=data1$index, y=data1$data,mode = "lines") %>%
add_trace(x = data_points$index, y=data_points$data, mode = "markers") %>%
layout(title="Plotly_click Test")
})
# show table of point markers clicked on by number
output$dataTable <- renderTable({
d <- event_data("plotly_click")
d_save <<- c(d_save,d$pointNumber[1]+1)
data.frame(d_save)
})
}
shinyApp(ui, server)
The image: