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)
Related
I have the data frame below:
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
NN<-data.frame(Name,Number)
And a simple shiny app which creates a plotly histogram out of it. My goal is to click on a bar of the histogram and display the Name in a datatable that correspond to this bar. For example if I click on the first bar which is 3 I will take a table with John and Bob names.
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
p <- plot_ly(x = NN$Number, type = "histogram")
})
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click")
if (length(s) == 0) {
"Click on a bar in the histogram to see its values"
} else {
NN[ which(NN$Number==as.numeric(s[2])), 1]
}
})
}
shinyApp(ui, server)
I am adding the solution by modifying your data.frame as mentioned in the comment:
library(plotly)
library(shiny)
library(DT)
ui <- fluidPage(
mainPanel(
plotlyOutput("heat")
),
DT::dataTableOutput('tbl4')
)
server <- function(input, output, session) {
output$heat <- renderPlotly({
Name<-c("John","Bob","Jack")
Number<-c(3,3,5)
Count<-c(2,2,1)
NN<-data.frame(Name,Number,Count)
render_value(NN) # You need function otherwise data.frame NN is not visible
p <- plot_ly(x = NN$Number, type = "histogram",source="subset") # set source so
# that you can get values from source using click_event
})
render_value=function(NN){
output$tbl4 <- renderDataTable({
s <- event_data("plotly_click",source = "subset")
print(s)
return(DT::datatable(NN[NN$Count==s$y,]))
})
}
}
shinyApp(ui, server)
Screenshot from solution:
Say I have a Shiny app with a datatable and a plot. I want to be able to search/filter the datatable, and have a plot reflect the results.
How do I do this? Is this even possible? Is there any way to output the filtered datatable to an object I can use?
Here is a basic shiny application which does not work.
library(DT)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
plotOutput('plot1')
)
server <- function(input, output) {
output$mytable = DT::renderDataTable({
datatable(mtcars,filter = 'top')
})
output$plot1 <- renderPlot({
plot(input$mytable$wt, input$mytable$mpg)
})
}
shinyApp(ui, server)
I have edited your code a bit since your way has some mistakes as pointed out by #r2evans.
Anyways, you can get the filtered rows of a datatable using input$tableId_rows_all. It gives the indices of rows on all pages (after the table is filtered by the search strings).
In my code filtered_table() gives you a dataframe object after all search filters are applied. output$test shows this table in real-time.
library(shiny)
library(DT)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
verbatimTextOutput("test"),
plotOutput('plot1')
)
server <- function(input, output) {
mc <- head(mtcars) # could be reactive in real world case
output$mytable = DT::renderDataTable({
datatable(mc, filter = 'top')
})
filtered_table <- reactive({
req(input$mytable_rows_all)
mc[input$mytable_rows_all, ]
})
output$plot1 <- renderPlot({
plot(filtered_table()$wt, filtered_table()$mpg, col = "red", lwd = 10)
})
output$test <- renderPrint({
filtered_table()
})
}
shinyApp(ui, server)
Suggestions:
Tour input$mytable reference in output$plot1 is just a string, not a frame like you'd hope, so this needs to be replaced. You can hard-code mtcars, but hard-coding data doesn't really lend to an extensible and interactive experience.
Additionally, since you are going to be showing the same data in two different blocks ($mytable and $plot1), I suggest breaking the data into its own reactive block and referencing that block in the others.
Lastly, I think it's good defensive practice to use req(...) in blocks so that they do not try to execute before the data is available (common when reactive pathways are unclear or the inputs are not set yet).
Try this:
library(DT)
library(shiny)
ui <- basicPage(
h2("The mtcars data"),
DT::dataTableOutput("mytable"),
plotOutput('plot1')
)
server <- function(input, output) {
mydat <- reactive({
# eventually you'll support filtering here
mtcars
})
output$mytable = DT::renderDataTable({
req(mydat())
datatable(mydat(), filter = 'top')
})
output$plot1 <- renderPlot({
req(mydat())
plot(mydat()$wt, mydat()$mpg)
})
}
shinyApp(ui, server)
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'm exploring the possibilities with interactive ggplot2 in shiny. Inspired by this I created a shiny app that exclude points from a dataset and plots the data where the excluded points are of a different color.
app.R
library(shiny)
library(ggplot2)
server<-function(input, output) {
data <- reactive({
set.seed(10)
df=data.frame(x=rnorm(100),y=rnorm(100))
df
})
vals<-reactiveValues(keeprows=rep(TRUE, 100))
output$plot1 <- renderPlot({
df=data()
keep=df[vals$keeprows, ,drop=FALSE]
exclude=df[!vals$keeprows, ,drop=FALSE]
plot=ggplot(data=keep,aes(x,y))+geom_point()+theme_bw()+
geom_point(data=exclude,fill=NA,col="black",alpha=0.75,shape=21)
plot
})
observeEvent(input$plot1_click,{
df=data()
res <- nearPoints(df, input$plot1_click, allRows = TRUE,threshold=5)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
}
ui <- fluidPage(
titlePanel("Reactive test"),
mainPanel(
plotOutput("plot1",click="plot1_click")
)
)
shinyApp(ui = ui, server = server)
This works perfectly, but now I want to be able to define vals with:
vals<-reactiveValues(keeprows=rep(TRUE,nrow(CustomDataInput))
In the case of my example, I tried accessing number of rows from the data created in data():
vals<-reactiveValues(keeprows=rep(TRUE,nrow(data()))
This gives me an error because I tried to access a reactive variable in a non-reactive environment. Is there a way to access the data created in a reactive function to define reactiveValues?
Thank you for your time!
The error pretty much addresses the problem. The correct way to do this is as follows.
library(shiny)
library(ggplot2)
server<-function(input, output) {
vals <- reactiveValues()
data <- reactive({
set.seed(10)
df=data.frame(x=rnorm(100),y=rnorm(100))
vals$keeprows = rep(TRUE,nrow(df))
df
})
#vals<-reactiveValues(keeprows=rep(TRUE,100))
output$plot1 <- renderPlot({
df=data()
keep=df[vals$keeprows, ,drop=FALSE]
exclude=df[!vals$keeprows, ,drop=FALSE]
plot=ggplot(data=keep,aes(x,y))+geom_point()+theme_bw()+
geom_point(data=exclude,fill=NA,col="black",alpha=0.75,shape=21)
plot
})
observeEvent(input$plot1_click,{
df=data()
res <- nearPoints(df, input$plot1_click, allRows = TRUE,threshold=5)
vals$keeprows <- xor(vals$keeprows, res$selected_)
})
}
ui <- fluidPage(
titlePanel("Reactive test"),
mainPanel(
plotOutput("plot1",click="plot1_click")
)
)
shinyApp(ui = ui, server = server)
Declare the vals variable before hand and use that in reactive() function to send variables to vals as shown above. You should be fine.
I'm trying to use click events using the plot_click option in RShiny. What I want to do is:I want to select a particular bubble from the first chart and then the chart below should be populated only for the above selected car. How to do this? Here is my code :
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mt$wt, mt$mpg)
})
output$plot2 <- renderPlot({
test <- data.frame(nearPoints(mt, input$plot_click, xvar = "wt", yvar = "mpg"))
test2 <- filter(test,Car_name)
car <- test2[1,1]
mt2 <- filter(mt,Car_name == car)
plot(mt2$wt,mt2$mpg)
})
}
shinyApp(ui, server)
I rearranged your server-function a bit. I moved the selected points to a reactive Value, which can be used by print/plot outputs.
Furthermore, i am not exactly sure what you want to achievewith all that filtering. Maybe you could change your original question an make a reproducible example out of it with the mtcars-data, as it seems you are using that.
library(shiny)
ui <- basicPage(
plotOutput("plot1", click = "plot_click"),
verbatimTextOutput("info"),
plotOutput("plot2")
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
selected_points <- reactiveValues(pts = NULL)
observeEvent(input$plot_click, {
x <- nearPoints(mtcars, input$plot_click, xvar = "wt", yvar = "mpg")
selected_points$pts <- x
})
output$info <- renderPrint({
selected_points$pts
})
output$plot2 <- renderPlot({
req(input$plot_click)
test <- selected_points$pts
plot(test$wt,test$mpg)
})
}
shinyApp(ui, server)
The clicked points are stored in the selected_points reactive Value, which is assigned in the observeEvent function.
If you filter a lot in the plot2-function, you would have to use req() or validate(), as it may be possible that no value is left over and therefore nothing can be plotted.
I hope that helps.