Update visualMap from ecs.proxy echart proxy object

[yogat3ch]

original gist Hi @helgasoft, I'm trying to update the visualMap properties so the dimension can be changed for the visualMap. I created some helper functions for doing so, but it doesn't seem to want to update. I'm not sure I understand how the proxy objects options are formatted, but it may be something else?

library(shiny); library(echarty)
ec.visualMap <- function(ec,
                         .data,
                         type = 'continuous',
                         calculable = TRUE,
                         inRange = list(color = c('deepskyblue', 'pink', 'pink', 'red')),
                         min = NULL,
                         max = NULL,
                         dimension = 1,
                         top = "middle",
                         textGap = 5,
                         padding = 2,
                         itemHeight = 390,
                         ...) {

  if (ncol(.data)) {
    .dimension <- ec.col_locate(dimension, .data)
    .min <- min %||% min(.data[[.dimension]], na.rm = TRUE)
    .max <- max %||% max(.data[[.dimension]], na.rm = TRUE)
    mods <- list(
      type = type,
      calculable = calculable,
      inRange = inRange,
      min = .min,
      max = .max,
      dimension = ec.dim(.dimension, .data),
      top = top,
      textGap = textGap,
      padding = padding,
      itemHeight = itemHeight,
      ...
    ) |>
      purrr::compact()

    ec$x$opts$visualMap <- mods
  }

  return(ec)
}

`%||%` <- rlang::`%||%`

#' Convert R data dimension into JS dimension
#'
#' @param dim \code{chr/dbl} Column name or index
#' @param ec \code{echarty}
#'
#' @return \code{dbl}
#' @export

ec.dim <- function(dim, ec) {
  UseMethod("ec.dim")
}

ec.data_extract <- function(ec) {
  ec$x$opts$dataset[[1]]$source[-1] |>
    purrr::map(unlist) |>
    as.data.frame.list() |>
    t() |>
    as.data.frame() |>
    tibble::remove_rownames() |>
    rlang::set_names(ec$x$opts$dataset[[1]]$source[[1]])
}

ec.col_locate <- function(x, .data) {
  which(names(.data) == x)
}
#' @export
ec.dim.character <- function(x, ec) {
  ec.col_locate(x, ec) - 1
}
#' @export
ec.dim.numeric <- function(x, ec) {
  x - 1
}
#' @export
ec.dim.default <- function(x, ec) {
  x
}

jsfn <- "() => {
  chart = get_e_charts('pchart');
  serie = chart.getModel().getSeries()[0];
  indices = serie.getRawIndicesByActiveState('active');
  Shiny.setInputValue('axisbrush', indices);
};"
ui <- fluidPage(  ecs.output('pchart'),
                  selectizeInput(inputId = "colormap",
                                 label = "Map color to ",
                                 choices = names(mtcars),
                                 selected = names(mtcars)[1]
                  ))
server <- function(input, output) {
  ids <- c()  # keep track of highlighted lines
  output$pchart <- ecs.render({
    p <- mtcars |> ec.init(ctype= 'parallel') |> ec.theme('dark-mushroom')
    p$x$opts$series[[1]]$emphasis <- list(disabled= FALSE,
                                          lineStyle= list(opacity= 1, width= 3))   # ,color= 'green'
    p$x$opts$visualMap <- list(type= 'continuous', calculable= TRUE,
                               inRange= list(color= c('deepskyblue','pink','red')),
                               min= min(mtcars$mpg), max= max(mtcars$mpg),
                               dimension= 0  # mpg is first column, index 0 in JS
    )
    p$x$on <- list(list(event= 'axisareaselected',
                        handler= htmlwidgets::JS(jsfn) ))
    p
  })
  observeEvent(input$axisbrush, {
    print(input$axisbrush)
  })
  observeEvent(input$pchart_click, {   # echarty built-in event
    id <- input$pchart_click$dataIndex
    p <- ecs.proxy('pchart')
    if (id %in% ids) {
      p$x$opts <- list(type= 'downplay', dataIndex= id)
      ids <<- ids[! ids==id ]
    } else {
      p$x$opts <- list(type= 'highlight', dataIndex= id)
      ids <<- c(ids, id)
    }
    p |> ecs.exec('p_dispatch')
  })

  observeEvent(input$colormap, {
    echarty::ecs.proxy("pchart") |>
      ec.visualMap(dimension = input$colormap, .data =mtcars) |>
      echarty::ecs.exec("p_dispatch")
  }, ignoreInit = TRUE)
}
shinyApp(ui= ui, server= server)

[helgasoft]

Here is one solution - replacing the chart on each selection. For more Shiny code tips - run demo(eshiny) and see the code eshiny.R

library(shiny); library(echarty)

jsfn <- "() => {
  chart = get_e_charts('pchart');
  serie = chart.getModel().getSeries()[0];
  indices = serie.getRawIndicesByActiveState('active');
  Shiny.setInputValue('axisbrush', indices);
};"
ui <- fluidPage(  ecs.output('pchart'),
            selectizeInput(inputId = "colormap",
                      label = "Map color to ",
                      choices = names(mtcars)
            ))
server <- function(input, output) {
  ids <- c()  # keep track of highlighted lines
  bcha <- NULL  # base chart

  output$pchart <- ecs.render({
    p <- mtcars |> ec.init(ctype= 'parallel') |> ec.theme('dark-mushroom')
    p$x$opts$series[[1]]$emphasis <- list(disabled= FALSE,
                              lineStyle= list(opacity= 1, width= 3))   # ,color= 'green'
    p$x$opts$visualMap <- list(type= 'continuous', calculable= TRUE,
                      inRange= list(color= c('deepskyblue','pink','red')),
                      min= min(mtcars$mpg), max= max(mtcars$mpg),
                      dimension= 0  # mpg is first column, index 0 in JS
    )
    p$x$on <- list(list(event= 'axisareaselected',
                  handler= htmlwidgets::JS(jsfn) ))
    bcha <<- p
    p
  })
  observeEvent(input$axisbrush, {
    print(input$axisbrush)
  })
  observeEvent(input$pchart_click, {   # echarty built-in event
    id <- input$pchart_click$dataIndex
    p <- ecs.proxy('pchart')
    if (id %in% ids) {
      p$x$opts <- list(type= 'downplay', dataIndex= id)
      ids <<- ids[! ids==id ]
    } else {
      p$x$opts <- list(type= 'highlight', dataIndex= id)
      ids <<- c(ids, id)
    }
    p |> ecs.exec('p_dispatch')
  })

  observeEvent(input$colormap, {
    id <- input$colormap   # selected new visualMap dimension name
    p <- ecs.proxy('pchart')

    #' see https://echarts.apache.org/en/api.html#action.visualMap
    #' could not make it work, todo: why? & no examples anywhere
  #  p$x$opts <- list(type= 'selectDataRange', 
  #              visualMapIndex= which(names(mtcars)==id)-1)
  #  p |> ecs.exec('p_dispatch')

    #' replacing the chart works
    p$x$opts <- bcha$x$opts
    p$x$opts$visualMap$dimension <-  which(names(mtcars)==id)-1
    p$x$opts$visualMap$min <- min(mtcars[id])
    p$x$opts$visualMap$max <- max(mtcars[id])
    p |> ecs.exec('p_replace')
  })
}
shinyApp(ui= ui, server= server)

[yogat3ch]

Hi @helgasoft, Thanks for this! I had already managed this but was hoping that it was possible to make updates without replacing the chart. I see your comment that it doesn't seem to to work without replacing the chart. Thanks anyway! Should I leave this Issue open if you're going to investigate why the "p_dispatch" method doesn't work for this use case? Should we make the title more specific?

[helgasoft]

Replacing the chart does not seem to have any drawbacks. Would be good to know if you see one in your particular application. Action selectDataRange with visualMapIndex may be flawed by design, as Min and Max parameters are missing. Just switching the index without giving Min and Max values will not produce a valid chart, if any at all. The lack of reported issues or examples also suggests that this feature has not been used, is buggy or abandoned. I'll leave the issue open for a couple more days.

[yogat3ch]

Indeed, I think it will work for our purposes. I was just thinking the visualMap could be changed without losing the axis brushes - but it isn't particularly necessary for our implementation since we save the axis brush filters for modification outside of the parallel plot. If this isn't a much needed feature then I don't see a reason to pursue it any further.

I'll leave the issue open for a couple more days.

Ok sounds good

Thanks for your help!