Echarts4r have barplot start at value other than 0

Question

I want to use echarts4r to plot a barplot where values above a cutoff are colored green and below red and the bars start at that value. If the cutoff is 0, we can use the answer provided here, for other values (eg 1 in the example below) this does not work so well as the bar always starts at zero. Is there a way I can make the bar start at other values?

See MWE below:

library(echarts4r)
set.seed(1)
df <- data.frame(
  x = 1:10,
  y = 1 + cumsum(rnorm(10, 0, 0.1))
)
df %>% 
  e_charts(x) %>% 
  e_bar(y) %>% 
  e_visual_map(
    type = "piecewise",
    pieces = list(
      list(
        gt = 1,
        color = "green"
      ),
      list(
        lte = 1,
        color = "red"
      )
    )
  )

Using ggplot2 I would do it like so

library(ggplot2)
CUTOFF <- 1
df$color <- ifelse(df$y > CUTOFF, "green", "red")
ggplot(df, aes(xmin = x - 0.5, xmax = x + 0.5,
               ymin = CUTOFF, ymax = y, fill = I(color))) +
  geom_rect()

Answer 1

An alternative solution is to shift the values by the offset and later add the values in the y-axis as well as the tooltip. This solution allows to have the y-axis not to start at 0 as well (for example if the deviations from 1 are only small, then displaying the 0 might not make much sense).

library(echarts4r)
library(dplyr)

## Create custom axis/tooltip formatter
tip <- htmlwidgets::JS("
function(value, index) {
  var fmt = new Intl.NumberFormat('en', {\"style\":\"decimal\",\"minimumFractionDigits\":2,\"maximumFractionDigits\":2,\"currency\":\"USD\"});
  return fmt.format(value + 1);
}")
custom_axis_formatter <- structure(tip, class = c("JS_EVAL", "item_formatter"))


tip2 <- htmlwidgets::JS("
function(params, ticket, callback) {
        var fmt = new Intl.NumberFormat('en', {\"style\":\"decimal\",\"minimumFractionDigits\":4,\"maximumFractionDigits\":4,\"currency\":\"USD\"});
        return params.value[0] + '<br>' +
               params.marker + ' ' +
               params.seriesName + ': ' + fmt.format(parseFloat(params.value[1] + 1));
    }
")
custom_e_tooltip <- structure(tip2, class = c("JS_EVAL", "item_formatter"))

## Create the dataset
set.seed(1)
df <- data.frame(
  x = 1:10,
  y = 1 + cumsum(rnorm(10, 0, 0.1))
)

# offset everything by 1
df$y2 <- df$y - 1

df |>
  e_charts(x) |>
  e_bar(y2) |>
  e_tooltip() |>
  e_y_axis(formatter = custom_axis_formatter) |> 
  e_tooltip(formatter = custom_e_tooltip) |>
  e_visual_map(
    type = "piecewise",
    pieces = list(list(gt = 0, color = "green"),
                  list(lte = 0, color = "red"))
  )

Answer 2

As an addendum to @stefans perfectly working solution, I have added the following JS code to make the tooltip work as well.

That is, the invisible bottom bars have no tooltip, whereas the lt and gte values are adjusted to show the correct value:

# ... construct df as shown above

tip <- htmlwidgets::JS("
function(params, ticket, callback) {
        var fmt = new Intl.NumberFormat('en', {\"style\":\"decimal\",\"minimumFractionDigits\":4,\"maximumFractionDigits\":4,\"currency\":\"USD\"});
        var idx = 0;
        if (params.name == params.value[0]) {
            idx = 1;
        }
        if (params.seriesName == \"bottom\") return '';
        
        var v = params.value[idx];
        if (params.seriesName == \"lt\") {
          v = 1 - v;
        } else {
          v = v * 1 + 1;
        }
        return params.value[0] + '<br>' +
               params.marker + ' ' +
               params.seriesName + ': ' + fmt.format(parseFloat(v));
    }
")
custom_e_tooltip <- structure(tip, class = c("JS_EVAL", "item_formatter"))


df |> 
  mutate(x = factor(x),
         bottom = ifelse(y < 1, y, 1),
         lt = ifelse(y < 1, 1 - y, 0),
         gte = ifelse(y < 1, 0, y - 1)) |>
  e_charts(x) |> 
  e_bar(bottom, stack = "x", itemStyle = list(color = "transparent", barBorderColor  = "transparent"), legend = FALSE) |>
  e_bar(lt, stack = "x") |> 
  e_bar(gte, stack = "x") |> 
  e_tooltip(formatter = custom_e_tooltip) |>  #< This is new here!
  e_color(c("red", "green"))

Answer 3

One option to achieve your desired result would be to use a stacked barchart using some helper columns. Basically I use a transparent bottom bar on top of which I add two bars reflecting the value below and above the cut-off.

Note: I had to convert the x column to a factor because otherwise I got an x-axis ranging up to 20.

library(echarts4r)
library(dplyr)

set.seed(1)

df <- data.frame(
  x = 1:10,
  y = 1 + cumsum(rnorm(10, 0, 0.1))
)

df |> 
  mutate(x = factor(x),
         bottom = ifelse(y < 1, y, 1),
         lt = ifelse(y < 1, 1 - y, 0),
         gte = ifelse(y < 1, 0, y - 1)) |>
  e_charts(x) |> 
  e_bar(bottom, stack = "x", itemStyle = list(color = "transparent", barBorderColor  = "transparent"), legend = FALSE) |>
  e_bar(lt, stack = "x") |> 
  e_bar(gte, stack = "x") |> 
  e_color(c("red", "green"))