How to correctly use echarts4rProxy to add and remove markers from a plot?
I'm attempting to use echarts4rProxy to dynamically add and remove highlighting and markers from a plot in Shiny. I'm not sure that I understand how to correctly use serie_index when adding a marker though, as it does weird things if I have the serie_index equal anything but 1.
This post on SO was super helpful in learning how to remove markers.
It mostly does what I want when I have serie_index = 1, except when toggling off the first series in the legend and then requesting that a different series be highlighted/show a marker. It is then no longer able to show a marker at all on the correct line.
In this picture, group F has been correctly highlighted/marked:
But when the first group (D) is toggled off in the legend, although it correctly highlights F, it does not show a marker:
](https://i.sstatic.net/vmXVx7o7.png)
And when serie_index == linenum rather than 1, it does weird things and will show multiple markers after you've made different selections.
Example code below:
library(shiny)
library(plotly)
library(data.table)
library(echarts4r)
dt <- as.data.table(copy(diamonds))
dt <- unique(dt[color %in% c("D", "E", "F") & cut == "Premium"], by = c("cut", "color", "clarity"))
setorder(dt, clarity)
# Function to remove all markers on an echarts plot
e_remove_mark_p <- function (proxy) {
opts <- list(id = proxy$id)
proxy$session$sendCustomMessage("e_remove_mark_p", opts)
return(proxy)
}
ui <- fluidPage(
# Javascript to remove all markers on an echarts plot
tags$head(
tags$script(HTML("
Shiny.addCustomMessageHandler('e_remove_mark_p',
function(data) {
var chart = get_e_charts(data.id);
let opts = chart.getOption();
if(opts.markPoint.length > 0) {
opts.markPoint.length = 0; /* remove data */
}
chart.setOption(opts, true);
})
"))),
fluidRow(radioButtons("line", label = "Focus on line", choices = c("D", "E", "F", "None"), selected = "None")),
fluidRow(echarts4rOutput("plot"))
)
server <- function(input, output, session) {
# Create plot
output$plot <- renderEcharts4r({
dt |>
group_by(color) |>
e_charts(clarity) |>
e_line(price,
legendHoverLink = T,
emphasis = list(disabled = F, focus = "series", blurScope = "coordinateSystem", lineStyle = list(width = 2))) |>
e_tooltip(trigger = "item")
})
# Proxy plot to highlight and show a marker for the selected line
observe({
echarts4rProxy("plot") |>
e_downplay_p()
echarts4rProxy("plot", data = NULL) %>%
e_remove_mark_p()
if (input$line != "None") {
linename <- input$line
linenum <- which(c("D", "E", "F") %in% input$line)
tmp <- dt[color == linename]
echarts4rProxy("plot") |>
e_highlight_p(series_name = linename)
echarts4rProxy("plot", data = NULL) |>
e_mark_p(
# serie_index = linenum,
serie_index = 1,
data = list(yAxis = tmp[clarity == "IF", price],
xAxis = tmp[clarity == "IF", clarity],
value = tmp[clarity == "IF", price]
),
itemStyle = list(color = "red")) |>
e_merge()
} else {
echarts4rProxy("plot") |>
e_downplay_p()
echarts4rProxy("plot", data = NULL) %>%
e_remove_mark_p()
}
})
}
shinyApp(ui, server)
The first problem with the missing markers comes from the serie_index = 1, what has to be changed to serie_index = linenum as you already suggested.
The problem with the multiple markers which arises then comes from the fact that the js which is used for deleting the markers (opts.markPoint.length = 0;) is not strict enough, one needs to extend it to something like
opts.series.map(function(e) {
e.markPoint = null;
})
Then it will work:
library(shiny)
library(plotly)
library(data.table)
library(echarts4r)
dt <- as.data.table(copy(diamonds))
dt <- unique(dt[color %in% c("D", "E", "F") & cut == "Premium"], by = c("cut", "color", "clarity"))
setorder(dt, clarity)
# Function to remove all markers on an echarts plot
e_remove_mark_p <- function (proxy) {
opts <- list(id = proxy$id)
proxy$session$sendCustomMessage("e_remove_mark_p", opts)
return(proxy)
}
ui <- fluidPage(
# Javascript to remove all markers on an echarts plot
tags$head(
tags$script(HTML("
Shiny.addCustomMessageHandler('e_remove_mark_p',
function(data) {
var chart = get_e_charts(data.id);
let opts = chart.getOption();
if (opts.series.length > 0) {
opts.markPoint.length = 0;
opts.series.map(function(e) {
e.markPoint = null;
})
}
chart.setOption(opts, true);
})
"))),
fluidRow(radioButtons("line", label = "Focus on line", choices = c("D", "E", "F", "None"), selected = "None")),
fluidRow(echarts4rOutput("plot"))
)
server <- function(input, output, session) {
# Create plot
output$plot <- renderEcharts4r({
dt |>
group_by(color) |>
e_charts(clarity) |>
e_line(price,
legendHoverLink = T,
emphasis = list(disabled = F, focus = "series", blurScope = "coordinateSystem", lineStyle = list(width = 2))) |>
e_tooltip(trigger = "item")
})
# Proxy plot to highlight and show a marker for the selected line
observe({
echarts4rProxy("plot") |>
e_downplay_p()
echarts4rProxy("plot", data = NULL) %>%
e_remove_mark_p()
if (input$line != "None") {
linename <- input$line
linenum <- which(c("D", "E", "F") %in% input$line)
tmp <- dt[color == linename]
echarts4rProxy("plot") |>
e_highlight_p(series_name = linename)
echarts4rProxy("plot", data = NULL) |>
e_mark_p(
serie_index = linenum,
data = list(yAxis = tmp[clarity == "IF", price],
xAxis = tmp[clarity == "IF", clarity],
value = tmp[clarity == "IF", price]
),
itemStyle = list(color = "red")) |>
e_merge()
} else {
echarts4rProxy("plot") |>
e_downplay_p()
echarts4rProxy("plot", data = NULL) %>%
e_remove_mark_p()
}
})
}
shinyApp(ui, server)