JohnCoene / echarts4r

🐳 ECharts 5 for R
http://echarts4r.john-coene.com/
Other
585 stars 82 forks source link

Aesthetic mapping in echarts4r legend #631

Open joekeane7 opened 1 month ago

joekeane7 commented 1 month ago

Hi,

I have a need to plot a single time series using echarts4r.

I have been able to plot the desired output using the below

library(dplyr)
library(echarts4r)

ptd_data <- data.frame(
  x = seq.Date(from = as.Date("2021-01-01"), by = "month", length.out = 12),
  y = rnorm(12, 100, 10),
  upl = rnorm(12, 110, 10),
  lpl = rnorm(12, 90, 10),
  point_type = sample(c("point_type_1", "point_type_2", "point_type_3", "point_type_4"), 12, replace = TRUE)
)
colours <- list(
  "point_type_1" = "grey90",
  "point_type_2" = "#361475",
  "point_type_3" = "#fab428",
  "point_type_4" = "#289de0"
)

ptd_data <- ptd_data %>%
  mutate(point_colour = sapply(point_type, function(pt) colours[[pt]]))

ptd_data %>%
  e_charts(x) %>%
  e_line(serie = y,
         symbol = "emptycircle"
         ,symbolSize = 4
         ,emphasis = list(
           scale = 2 # Enable scaling
         )
  ) %>%
  e_add_nested("itemStyle", color = point_colour) |>
  e_tooltip(trigger = "axis")

image

however as you can see the legend doesn't follow suit in terms of the e_add_nested color mapping

Desired output can be demonstrated using ggplot2 using the aes color mapping which splits the legend accordingly

library(ggplot2)

# Sample data
ptd_data <- data.frame(
  x = seq.Date(from = as.Date("2021-01-01"), by = "month", length.out = 12),
  y = rnorm(12, 100, 10),
  upl = rnorm(12, 110, 10),
  lpl = rnorm(12, 90, 10),
  point_type = sample(c("point_type_1", "point_type_2", "point_type_3", "point_type_4"), 12, replace = TRUE)
)
colours <- list(
  "point_type_1" = "grey90",
  "point_type_2" = "#361475",
  "point_type_3" = "#fab428",
  "point_type_4" = "#289de0"
)

ptd_data <- ptd_data %>%
  mutate(point_colour = sapply(point_type, function(pt) colours[[pt]]))

# Plot using ggplot2
ggplot() +
  geom_line(data = ptd_data, aes(x = x, y = y), color = "black") +
  geom_point(data = ptd_data, aes(x = x, y = y, color = point_type), shape = "circle", size = 4) +
  scale_color_manual(values = colours) +
  theme_minimal()

image

Is there a solution using e charts4r

JohnCoene commented 1 month ago

Your approach is technically correct but coloring things like this do not affect the legend, it's on echarts.js end.

Does the code below fix your issue?

    ptd_data <- data.frame(
      x = seq.Date(from = as.Date("2021-01-01"), by = "month", length.out = 12),
      y = rnorm(12, 100, 10),
      upl = rnorm(12, 110, 10),
      lpl = rnorm(12, 90, 10),
      point_type = sample(c("point_type_1", "point_type_2", "point_type_3", "point_type_4"), 12, replace = TRUE)
    )
    colours <- list(
      "point_type_1" = "grey90",
      "point_type_2" = "#361475",
      "point_type_3" = "#fab428",
      "point_type_4" = "#289de0"
    )

    ptd_data <- ptd_data %>%
      mutate(point_colour = sapply(point_type, function(pt) colours[[pt]]))

    points <- ptd_data %>%
      group_by(point_type)

    ptd_data %>%
      e_charts(x) %>%
      e_line(serie = y,
             symbol = "none"
             ,symbolSize = 4
             ,emphasis = list(
               scale = 2 # Enable scaling
             )
      ) %>%
      e_data(points, x) %>%
      e_scatter(y, symbol_size = 20L) %>%
      e_tooltip(trigger = "axis") %>%
      e_color(
        c("blue", colours |> unlist() |> unname(), colours |> unlist() |> unname())
      )
joekeane7 commented 1 month ago

Thankyou John! That does work for the legend.

Unfortunately as a result of having to layer e_scatter over e_line in this way we lose a lot of the visual appeal of the line chart, with the line going through the points and no option for the empty circle.

image

Not sure if there is any way we can amend this?

I managed to kind of hack the legend using e_visual_map as per below but obviously this doesn't fit as neatly and doesn't have series control.

library(dplyr) library(echarts4r)

color_mapping <- list( list(value = 1, color = "grey90", label = "Point 1"), list(value = 2, color = "#361475", label = "Point 2"), list(value = 3, color = "#fab428", label = "Point 3"), list(value = 4, color = "#289de0", label = "Point 4") )

ptd_data <- data.frame( x = seq.Date(from = as.Date("2021-01-01"), by = "month", length.out = 12), y = rnorm(12, 100, 10), upl = rnorm(12, 110, 10), lpl = rnorm(12, 90, 10), point_type = sample(c("point_type_1", "point_type_2", "point_type_3", "point_type_4"), 12, replace = TRUE) )

ptd_data <- ptd_data %>% mutate(point_colour = sapply(point_type, function(pt) colours[[pt]]))

ptd_data %>% e_charts(x) %>% e_line(serie = y, symbol = "emptycircle" ,legend = FALSE ,symbolSize = 4 ,emphasis = list( scale = 2 # Enable scaling ) ) %>% e_add_nested("itemStyle", color = point_colour) |> e_tooltip(trigger = "axis") |> e_visual_map( type = "piecewise", pieces = color_mapping, dimension = 2, # Assuming the point_type_num is in the third column (0-based index) left = "center", # Center align the visual map bottom = "5%", orient = "horizontal", # Set orientation to horizontal itemSymbol = "circle" # Change symbols to circles )

image Again Thankyou for your support with the package.