I have a Shiny app that uses the echarts4r package to display animated lines.
I want to control each animated line individually using checkboxes.
For example, when I check the Line A checkbox, the animation for Line A should start and remain visible until I uncheck it. The same behavior should apply for each additional line.
However, the current behavior is that when I check a checkbox, all the lines restart their animations and then disappear together. How can I modify my app so that each line's animation is controlled independently without affecting the others?
Here is an example:
library(shiny)
library(echarts4r)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("lineA", "Show Line A", value = TRUE),
checkboxInput("lineB", "Show Line B", value = TRUE),
checkboxInput("lineC", "Show Line C", value = TRUE)
),
mainPanel(
echarts4rOutput("chart", height = "400px")
)
)
)
server <- function(input, output, session) {
set.seed(123)
df <- data.frame(
x = 1:10,
yA = cumsum(runif(10, -1, 1)),
yB = cumsum(runif(10, -1, 1)),
yC = cumsum(runif(10, -1, 1))
)
output$chart <- renderEcharts4r({
chart <- df %>% e_charts(x)
if (input$lineA) {
chart <- chart %>%
e_line(serie = yA, name = "Line A")
}
if (input$lineB) {
chart <- chart %>%
e_line(serie = yB, name = "Line B")
}
if (input$lineC) {
chart <- chart %>%
e_line(serie = yC, name = "Line C")
}
chart %>%
e_tooltip(trigger = "axis") %>%
e_legend()
})
}
shinyApp(ui, server)
Questions:
- Is it possible to control the animated lines, line by line?
- Is there another option to accomplish this task?
I have a Shiny app that uses the echarts4r package to display animated lines.
I want to control each animated line individually using checkboxes.
For example, when I check the Line A checkbox, the animation for Line A should start and remain visible until I uncheck it. The same behavior should apply for each additional line.
However, the current behavior is that when I check a checkbox, all the lines restart their animations and then disappear together. How can I modify my app so that each line's animation is controlled independently without affecting the others?
Here is an example:
library(shiny)
library(echarts4r)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("lineA", "Show Line A", value = TRUE),
checkboxInput("lineB", "Show Line B", value = TRUE),
checkboxInput("lineC", "Show Line C", value = TRUE)
),
mainPanel(
echarts4rOutput("chart", height = "400px")
)
)
)
server <- function(input, output, session) {
set.seed(123)
df <- data.frame(
x = 1:10,
yA = cumsum(runif(10, -1, 1)),
yB = cumsum(runif(10, -1, 1)),
yC = cumsum(runif(10, -1, 1))
)
output$chart <- renderEcharts4r({
chart <- df %>% e_charts(x)
if (input$lineA) {
chart <- chart %>%
e_line(serie = yA, name = "Line A")
}
if (input$lineB) {
chart <- chart %>%
e_line(serie = yB, name = "Line B")
}
if (input$lineC) {
chart <- chart %>%
e_line(serie = yC, name = "Line C")
}
chart %>%
e_tooltip(trigger = "axis") %>%
e_legend()
})
}
shinyApp(ui, server)
Questions:
- Is it possible to control the animated lines, line by line?
- Is there another option to accomplish this task?
2 Answers
Reset to default 2If I understand you correctly you can use echarts4rProxy and some observeEvents to achieve your desired result. Also note the use of isolate() in the initial setup of the chart. Finally, note that the use of e_legend requires that at least on of the options is checked at the start up (perhaps a bug or I simply haven't found the right option (: ):
library(shiny)
library(echarts4r)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxInput("lineA", "Show Line A", value = TRUE),
checkboxInput("lineB", "Show Line B", value = TRUE),
checkboxInput("lineC", "Show Line C", value = TRUE)
),
mainPanel(
echarts4rOutput("chart", height = "400px")
)
)
)
server <- function(input, output, session) {
set.seed(123)
df <- data.frame(
x = 1:10,
yA = cumsum(runif(10, -1, 1)),
yB = cumsum(runif(10, -1, 1)),
yC = cumsum(runif(10, -1, 1))
)
output$chart <- renderEcharts4r({
chart <- df |>
e_charts(x) |>
e_tooltip(trigger = "axis") |>
e_legend()
if (isolate(input$lineA)) chart <- e_line(chart, serie = yA, name = "Line A")
if (isolate(input$lineB)) chart <- e_line(chart, serie = yB, name = "Line B")
if (isolate(input$lineC)) chart <- e_line(chart, serie = yC, name = "Line C")
chart
})
observeEvent(input$lineA, {
name <- "Line A"
proxy <- echarts4rProxy("chart", data = df, x = x)
proxy <- e_remove_serie(proxy, name)
if (input$lineA) proxy <- e_line(proxy, serie = yA, name = name)
proxy |>
e_execute()
})
observeEvent(input$lineB, {
name <- "Line B"
proxy <- echarts4rProxy("chart", data = df, x = x)
proxy <- e_remove_serie(proxy, name)
if (input$lineB) proxy <- e_line(proxy, serie = yB, name = name)
proxy |>
e_execute()
})
observeEvent(input$lineC, {
name <- "Line C"
proxy <- echarts4rProxy("chart", data = df, x = x)
proxy <- e_remove_serie(proxy, name)
if (input$lineC) proxy <- e_line(proxy, serie = yC, name = name)
proxy |>
e_execute()
})
}
shinyApp(ui, server)
I found a way with `echarts4r` only. Allthough @stefan answer is better I want to share my thoughts:
library(echarts4r)
df <- structure(list(time_month = 0:60, curve1 = c(100, 100, 99, 99,
99, 98, 98, 98, 96, 96, 95, 95, 95, 94, 94, 93, 92, 92, 91, 88,
88, 87, 86, 85, 84, 83, 82, 81, 81, 80, 78, 78, 78, 76, 75, 74,
74, 73, 73, 72, 71, 66, 65, 65, 64, 63, 62, 61, 59, 58, 58, 58,
57, 57, 56, 55, 54, 52, 52, 51, 50), curve2 = c(100, 100, 98,
97, 97, 96, 96, 96, 96, 95, 94, 92, 90, 87, 86, 85, 85, 85, 85,
84, 84, 83, 83, 78, 76, 75, 74, 72, 70, 69, 67, 67, 66, 66, 64,
63, 63, 63, 61, 61, 59, 58, 58, 57, 56, 56, 55, 55, 54, 54, 53,
52, 51, 51, 50, 49, 48, 47, 45, 45, 44), curve3 = c(100, 100,
99, 98, 98, 98, 96, 96, 96, 95, 95, 95, 94, 94, 93, 92, 92, 92,
92, 90, 90, 89, 89, 88, 88, 88, 87, 87, 87, 87, 86, 86, 85, 85,
85, 84, 84, 83, 83, 83, 83, 83, 82, 80, 80, 80, 80, 79, 79, 79,
79, 78, 78, 77, 76, 76, 75, 74, 73, 73, 73)), class = "data.frame", row.names = c(NA, -61L))
# selection to be active at start
sel <- setNames(as.list(rep(FALSE, length(names(df)[-1]))), names(df)[-1])
sel[1] <- TRUE
df |>
e_charts(time_month) |>
e_line(
serie = curve1,
name = "curve1",
endLabel = list(
show = TRUE,
formatter = JS("function(params){ return params.value[1]; }")
),
animationDuration = 5000
) |>
e_line(
serie = curve2,
name = "curve2",
endLabel = list(
show = TRUE,
formatter = JS("function(params){ return params.value[1]; }")
),
animationDuration = 5000
)|>
e_line(
serie = curve3,
name = "curve3",
endLabel = list(
show = TRUE,
formatter = JS("function(params){ return params.value[1]; }")
),
animationDuration = 5000
) |>
e_legend(
orient = "horizontal",
top = "bottom",
selected = sel
)
Resulting in this: (unable to upload .gif)