rshinyecharts4r

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:

enter image description here

But when the first group (D) is toggled off in the legend, although it correctly highlights F, it does not show a marker:

[pic2](https://i.sstatic.net/bZghwLlU.png)

And when serie_index == linenum rather than 1, it does weird things and will show multiple markers after you've made different selections.

enter image description here

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)
Solution

  • 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:

    enter image description here

    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)