R | ECharts | areaStyle and itemStyle, click event

area.item.style.R

library(dplyr)
library(lubridate)
# add event for clicking on blank area
jscode <- c('','',"chart.getZr().on('click', function(e) {
  if (!e.target) alert('blank area: '+JSON.stringify(e.event)); });")
set.seed(421)
df1 <- tibble(date= as_date("2021-11-01") + months(0:11),
              x= 12*10^6 + rnorm(12,0,2000000), 
              y= 12*10^6 + rnorm(12,0,1000000))

library(echarty)
p <- df1 %>% ec.init(js= jscode)
p$x$opts$yAxis <- list(axisLabel= list(formatter=ec.clmn('%@M', -1, scale=0.000001)))
p$x$opts$series <- list(
  list(type='line', name='lx', encode=list(y='x'), areaStyle=list(opacity=0.2,color="blue"), itemStyle=list(color='blue')), 
  list(type='line', name='ly', encode=list(y='y'), areaStyle=list(opacity=0.2,color="red"), itemStyle=list(color='red')))
p$x$opts$legend <- list(show=TRUE)
p$x$on <- list(         # event(s) with Javascript handler
  list(event= 'legendselectchanged',
       handler= htmlwidgets::JS("(evt) => alert('selected: '+evt.name);"))
)
p

@berkorbay, the above code will work for you I guess

Thanks a lot! This is a solution but I was looking for a solution within echarts4r package. Perhaps I can find a workaround. Aha echarty is also a new package for echarts, I didn't know! I will check that also.

Code updated to address two ways of event handling. Blank area click query by @astro-nomad, @troyjcross

If you like this solution, please consider granting a Github star ⭐ to echarty.

another example of event handling, inquiry by @yogat3ch

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'))
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')
  })
}
shinyApp(ui= ui, server= server)

If you like this solution, please consider granting a Github star ⭐ to echarty.

Attn. @yogat3ch
Code above updated with hover highlight/downplay + click event: first to set highlight, second - to downplay back to normal.

See also gallery code
If you like this solution, please consider granting a Github star ⭐ to echarty.

Well @helgasoft,
You've certainly outdone yourself with this one!
This nails all the functionality we want to have in this parallel plot - thank you for whipping this up for us 🙏
I just transitioned all the code in this module to echarty with surprising ease - thanks for you work on this!

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 <- list(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)

Thank you for trusting our code. Glad to see you are taking it further.
For documentation purposes, please copy your question in Issues.
There is a solution and will be given there.