I'm trying to make an app which shows some data after the user clicks a point. It works, except that when the data is longer than the window the scrollbar shows up, resizing the plot and erasing the data. How to make the data show and stay?
Below the code of a minimal example.
library(shiny)
library(tidyr)
ui <- fluidPage(
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
req(input$plot_click)
np <- nearPoints(mtcars, input$plot_click) %>%
pull(gear)
mtcars %>%
filter(gear == np)
})
}
shinyApp(ui = ui, server = server)
The problem here is, that once the vertical scrollbar shows up the plotOutput is resized and therefore re-rendered, this results in input$plot_click being reset to NULL causing an empty table.
We can use req()'s cancelOutput parameter to avoid this behaviour.
Please see ?req:
cancelOutput: If TRUE and an output is being evaluated, stop processing as usual but instead of clearing the output, leave it in
whatever state it happens to be in.
library(shiny)
library(tidyr)
library(dplyr)
library(ggplot2)
ui <- fluidPage(
plotOutput("plot", click = "plot_click"),
tableOutput("data")
)
server <- function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
}, res = 96)
output$data <- renderTable({
req(input$plot_click, cancelOutput = TRUE)
np <- nearPoints(mtcars, input$plot_click) %>% pull(gear)
if(length(np) > 0){
mtcars %>% filter(gear == np)
} else {
NULL
}
})
}
shinyApp(ui = ui, server = server)
Related
I want to change chart type from e_line to e_bar based on a condition. What I tried to do was using some reactive expression or if else inside plot, but neither of them works. Any ideas how to tackle this?
So, I need to change dynamically e_line, I tried this:
newChartType <- reactive({
df = switch(
someCondition,
'1' = echarts4r::e_line(ColumnName2),
'2' = echarts4r::e_bar(ColumnName2)
)
})
output$plot <- echarts4r::renderEcharts4r({
dataChartStats() %>%
echarts4r::e_charts(ColumnName1) %>%
newChartType() %>%
echarts4r::e_legend(show = FALSE)
})
but it doesn't work. I'm interested in general rule on how to change dynamically building elements of plot code (can be ggplot as well etc, here I used echarts4r).
I couldn't find a way of obtaining the chart type directly from an input element, but here's one way of doing it:
library(shiny)
library(tidyverse)
ui <- fluidPage(
selectInput(
"type",
"Select a chart type:",
c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
output$plot <- renderPlot({
if (input$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Next time, please provide a minimum working example.
EDIT in response to OP's request for a solution based on a button click:
library(shiny)
library(tidyverse)
ui <- fluidPage(
actionButton("go", "Click me!"),
textOutput("type"),
# selectInput(
# "type",
# "Select a chart type:",
# c("point", "line")),
plotOutput("plot")
)
server <- function(input, output) {
v <- reactiveValues(type="line")
observeEvent(input$go, {
if (v$type == "line") v$type <- "point"
else v$type <- "line"
})
output$type <- renderText({ v$type })
output$plot <- renderPlot({
if (v$type == "line") {
mtcars %>% ggplot() + geom_line(aes(x=mpg, y=disp))
} else {
mtcars %>% ggplot() + geom_point(aes(x=mpg, y=disp))
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Problem: The following code produces a plotly bar chart. If you click on the bars data will be shown. If I am not interested anymore in the underlying table I want to click somewhere (i.e. not the bar) on the chart and the table shall "disappear".
Any idea how to do that? I already tried to add the is.null if-condition which is not working due to the req() (and req() is needed). Many thanks!
library(shiny)
library(plotly)
library(DT)
ui <- fluidPage(
plotlyOutput("plot"),
dataTableOutput("table")
)
server <- function(input, output) {
output$plot <- renderPlotly({
mtcars %>%
group_by(cyl) %>%
summarise(m = mean(mpg)) %>%
plot_ly(., x = ~cyl,
y = ~m, source = "test_plot") %>%
add_bars()
})
observe({
p <- event_data("plotly_click", source = "test_plot")
req(p)
output$table <- renderDataTable({
if (is.null(p)){
return(NULL)
}
mtcars
})
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to add a vertical line to an existing plotly plot using the addTraces method. I'd like to understand why the new vertical lines are added two units to the right of where the first trace lays.
Fixing this issue will probably solve my original problem (question title) which is avoiding the plot resizing/moving to the right upon adding the new trace.
Here's an example of what I'm trying to do :
library(shiny)
library(plotly)
ui <- bootstrapPage(
plotlyOutput("plot")
)
myvec <- rnorm(100)
server <- function(input, output, session) {
values <- reactiveValues(idx=1)
output$plot <- renderPlotly({
plot_ly(type='scatter', mode='lines') %>%
add_trace(y=myvec[1])
})
plotproxy <- plotlyProxy("plot", session)
observe({
plotproxy %>%
plotlyProxyInvoke("extendTraces",
list(y=list(list(myvec[values$idx]))),
list(1))
if(!values$idx%%10) {
plotproxy %>% plotlyProxyInvoke("addTraces",
list(x=c(values$idx, values$idx), # + 2 would "fix it"
y=c(0,myvec[values$idx]),
type="line", showlegend=F))
}
})
observe({
invalidateLater(1000)
isolate({
values$idx <- min(values$idx + 1, length(myvec))
})
})
}
shinyApp(ui = ui, server = server)
In short, I'd like the x axis limits to update with extendTraces only, I'm just guessing the 2 units mismatch is the problem.
I've managed to solve the x-axis mismatch, however this didn't solve the autosize issue. The problem was I wasn't using the same type and mode. Now it works :
library(shiny)
library(plotly)
ui <- bootstrapPage(
plotlyOutput("plot")
)
myvec <- rnorm(100)
server <- function(input, output, session) {
values <- reactiveValues(idx=1)
output$plot <- renderPlotly({
plot_ly(type='scatter', mode='lines') %>% # Must match with vertical line
add_trace(x=c(-1,0), y=myvec[1]) # use x values
})
plotproxy <- plotlyProxy("plot", session)
observe({
plotproxy %>%
plotlyProxyInvoke("extendTraces",
list(x=list(list(values$idx)), # match x values
y=list(list(myvec[values$idx]))),
list(1))
if(!values$idx%%10) {
plotproxy %>% plotlyProxyInvoke("addTraces",
list(x=c(values$idx, values$idx), # x limits match
y=c(0,myvec[values$idx]),
type='scatter', mode='lines', showlegend=F)) # must match
}
})
observe({
invalidateLater(1000)
isolate({
values$idx <- min(values$idx + 1, length(myvec))
})
})
}
shinyApp(ui = ui, server = server)
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'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.