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

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"))

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"))