Scoring ring

[stvanh]

Hi John,

I would like to know if we can do the same with echarts4r like the following link:

https://echarts.apache.org/examples/zh/editor.html?c=gauge-ring

Thanks in advance.

[munoztd0]

Somehting like that ?

library(echarts4r)
library(dplyr)

# Function to generate random values adding up to 100
generate_random_values <- function() {
  value <- runif(2)
  c(Perfect = value[1] * 100,
    Good = value[2] * (100 - value[1] * 100),
    Commonly = 100 - (value[1] * 100) - (value[2] * (100 - value[1] * 100)))
}

# Create polar chart with given data
create_polar_chart <- function(data) {
  data %>%
    e_charts(category) %>%
    e_polar(show = FALSE) %>%
    e_angle_axis(show = FALSE) %>%
    e_radius_axis(value, min = 0.1, max = 0.2) %>%
    e_bar(value, coord_system = "polar", barWidth = 10) %>%
    e_theme("auritus") %>%
    e_tooltip(trigger = "item") 
}

# Generate random data for the first polar plot
df1 <- tibble(category = c("Perfect", "Good", "Commonly"), value = generate_random_values())

# Generate random data for the second polar plot
df2 <- tibble(category = c("Perfect", "Good", "Commonly"), value = generate_random_values())

# Create polar plots
polar_plot1 <- create_polar_chart(df1 |> group_by(category) )
polar_plot2 <- create_polar_chart(df2 |> group_by(category))

# Define callback function for morphing
cb <- "() => {
  let x = 0;
  setInterval(() => {
    x++
    chart.setOption(opts[x % 2], true);
  }, 3000);
}"

# Morph the polar plots
e_morph(polar_plot1, polar_plot2, callback = cb)

[stvanh]

Oh that's awesome. Really appreciate your help :) Could you please suggest a solution to put the label and legend inside and middle of the plot, like in the original plot?

[munoztd0]

yes for sure:

library(echarts4r)
library(dplyr)

# Function to generate random values adding up to 100
generate_random_values <- function() {
  value <- runif(2)
  c(Perfect = value[1] * 100,
    Good = value[2] * (100 - value[1] * 100),
    Commonly = 100 - (value[1] * 100) - (value[2] * (100 - value[1] * 100)))
}

# Create polar chart with given data
# 
# 
custom_labels <- function(data) {

  c("Good" = paste("Good:", trunc(data$value[data$category == "Good"]), "%"),
  "Perfect" = paste("Perfect:", trunc(data$value[data$category == "Perfect"]), "%"),
  "Commonly" = paste("Commonly:", trunc(data$value[data$category == "Commonly"]), "%") )

}

create_polar_chart <- function(data, labels) {

  data <- data |>
    arrange(desc(value))  # Sort data by value in descending order

  legend_formatter <- paste0(
    "function (name) {
      if (name === 'Good') {
        return '" , labels["Good"], "';
      } else if (name === 'Perfect') {
        return '" , labels["Perfect"], "';
      } else if (name === 'Commonly') {
        return '" , labels["Commonly"], "';
      }
    }"
  )

  data |>
    e_charts(category) |>
    e_polar(show = FALSE) |>
    e_angle_axis(show = FALSE) |>
    e_radius_axis(value, min = 0.1, max = 0.2, axisLine = list(lineStyle = list(color = "#fff")), axisLabel = list(color = "#fff")) |>
    e_bar(value, coord_system = "polar", barWidth = 10, label = list(show = FALSE)) |>
    e_theme("auritus") |>
    e_tooltip(trigger = "item") |>
    e_legend(orient = "vertical", left = "center", top = "middle", formatter = htmlwidgets::JS(
      legend_formatter
    )) |>
    e_grid(left = "center", bottom = "middle", containLabel = TRUE)
}

# Generate random data for the first polar plot
df1 <- tibble(category = c("Perfect", "Good", "Commonly"), value = generate_random_values())

# Generate random data for the second polar plot
df2 <- tibble(category = c("Perfect", "Good", "Commonly"), value = generate_random_values())

# Create polar plots
polar_plot1 <- create_polar_chart(df1 |> group_by(category), custom_labels(df1))
polar_plot2 <- create_polar_chart(df2 |> group_by(category), custom_labels(df2))

# Define callback function for morphing
cb <- "() => {
  let x = 0;
  setInterval(() => {
    x++
    chart.setOption(opts[x % 2], true);
  }, 3000);
}"

# Morph the polar plots
plot <- e_morph(polar_plot1, polar_plot2, callback = cb)

plot
#> Warning in e_morph(polar_plot1, polar_plot2, callback = cb): This is
#> experimental

^{Created on 2024-04-17 with reprex v2.0.2}

Here is my buy me a coffee link if you feel like it

[stvanh]

Perfect! Work like a charm <3
Love the way you solved it.