How to combine line and bar charts?

Question

I would like to combine a stacked barplot (stacking = 'percent') with a lineplot using Highcharter. Unfortunately, the lineplot is somehow not displayed according to its values.

Here is my test data:

informatik_df <- list(
  list(
    name = "10/2017",
    data = list(
      list(
        absol_Vorlesung = 450,
        absol_Seminar = 200,
        absol_Uebung = 100,
        absol_Praktikum = 480,
        absol_gemischtes = 220,
        absol_sonstiges = 120,
        
        gemischtes = 14,
        Seminar = 30,
        sonstiges = 7,
        Uebung = 6,
        Vorlesung = 13,
        Praktikum = 30,
        
        Linie_1 = 13,
        absol_Linie_1=450,
        
        Linie_2 = 30,
        absol_Linie_2=200
      )
    )
  ),
  list(
    name = "10/2022",
    data = list(
      list(
        absol_Vorlesung = 500,
        absol_Seminar = 150,
        absol_Uebung = 50,
        absol_Praktikum = 530,
        absol_gemischtes = 170,
        absol_sonstiges = 70,
        
        gemischtes = 11,
        Seminar = 36,
        sonstiges = 4,
        Uebung = 3,
        Vorlesung = 34,
        Praktikum = 12,
        
        Linie_1 = 34,
        absol_Linie_1=500,
        
        Linie_2 = 36,
        absol_Linie_2=150
      )
    )
  )
)

Here is the function I wrote:

library(tidyverse)
library(highcharter)


# Funktion zum Erstellen von gestapelten Balken
create_stacked_bar <- function(data, title, y_title,x_title) {
  highchart() %>%
    hc_chart(type = "column") %>%
    hc_plotOptions(
      series = list(
        stacking = 'percent', 
        animation = list(duration = 1500) # Standard-Animationsgeschwindigkeit für alle Serien
      ),
      column = list(
        animation = list(duration = 1000) # Spezifische Animationsgeschwindigkeit für Balken
      ),
      line = list(
        animation = list(duration = 3000) # Spezifische Animationsgeschwindigkeit für Linien
      )
    ) %>%
    hc_add_series(name = "sonstiges", 
                  color="#c5ced3",
                  data = list(
                    list(y = data[[1]]$data[[1]]$sonstiges, abs = data[[1]]$data[[1]]$absol_sonstiges), 
                    list(y = data[[2]]$data[[1]]$sonstiges, abs = data[[2]]$data[[1]]$absol_sonstiges)
                  )) %>%
    hc_add_series(name = "gemischtes", 
                  color="#6A6F73",
                  data = list(
                    list(y = data[[1]]$data[[1]]$gemischtes, abs = data[[1]]$data[[1]]$absol_gemischtes), 
                    list(y = data[[2]]$data[[1]]$gemischtes, abs = data[[2]]$data[[1]]$absol_gemischtes)
                  )) %>%
    hc_add_series(name = "Praktikum", 
                  color="#4d5256",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Praktikum, abs = data[[1]]$data[[1]]$absol_Praktikum), 
                    list(y = data[[2]]$data[[1]]$Praktikum, abs = data[[2]]$data[[1]]$absol_Praktikum)
                  )) %>%
    hc_add_series(name = "Uebung", 
                  color="#195365",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Uebung, abs = data[[1]]$data[[1]]$absol_Uebung), 
                    list(y = data[[2]]$data[[1]]$Uebung, abs = data[[2]]$data[[1]]$absol_Uebung)
                  )) %>%
    hc_add_series(name = "Seminar",
                  color="#1e3b4c",
                  id="seminar",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Seminar, abs = data[[1]]$data[[1]]$absol_Seminar), 
                    list(y = data[[2]]$data[[1]]$Seminar, abs = data[[2]]$data[[1]]$absol_Seminar)
                  )) %>%
    hc_add_series(name = "Vorlesung", 
                  color="#e73f0c",
                  id="vorlesung",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Vorlesung, abs = data[[1]]$data[[1]]$absol_Vorlesung), 
                    list(y = data[[2]]$data[[1]]$Vorlesung, abs = data[[2]]$data[[1]]$absol_Vorlesung)))%>%
    
    hc_add_series(name = "Linie2", # Line 2 !!!!!!!!!!!!!
                  type = "line", 
                  linkedTo="seminar",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Linie_2, abs = data[[1]]$data[[1]]$absol_Linie_2), 
                    list(y = data[[2]]$data[[1]]$Linie_2, abs = data[[2]]$data[[1]]$absol_Linie_2)), 
                  showInLegend = FALSE, 
                  dashStyle = "LongDash", 
                  marker = list(
                    enabled = TRUE, 
                    symbol = "circle"), 
                  color = "#1e3b4c") %>%
    hc_add_series(name = "Linie1", # Line 1 !!!!!!!!!!!!!
                  type = "line", 
                  linkedTo="vorlesung",
                  data = list(
                    list(y = data[[1]]$data[[1]]$Linie_1, abs = data[[1]]$data[[1]]$absol_Linie_1), 
                    list(y = data[[2]]$data[[1]]$Linie_1, abs = data[[2]]$data[[1]]$absol_Linie_1)), 
                  showInLegend = FALSE, 
                  dashStyle = "LongDash",
                  marker = list(
                    enabled = TRUE, 
                    symbol = "circle"), 
                  color = "#e73f0c")  %>%
    
    hc_xAxis(categories = c("10/2017", "10/2022"),
             title = list(text=x_title)) %>%
    hc_title(text = title) %>%
    hc_yAxis(title = list(text = y_title),
             labels = list(formatter = JS("function() { return this.value + '%'; }")),
             max=100)  %>%
    hc_tooltip(pointFormat = '<span style="color:{series.color}"><b>{series.name}</b></span>: {point.percentage:.1f}% ({point.abs} Kurse)<br/>',
               shared = FALSE) %>%
    hc_legend(enabled = TRUE,  reversed=TRUE)
}

# Gestapelte Balken für Informatik
plot_1 <- create_stacked_bar(informatik_df, "Anzahl Informatikkurse nach Kursart (2017/2022)", "realtive Häuigkeiten angebotener Kurseformen", "Jahre")
plot_1

This is how the resulting plot looks like:

This is what I expect:

It is important for me that a stacked barplot of the type stacking = 'percent' is created, not stacking = 'normal'.

Answer 1

The issue is that with stacking="percent" the y values are computed similar to using position="fill" in ggplot2, i.e. as y / sum(y). And as you have only two categories for the lines the computed values will differ from the percentages in your data.

One possible option would be to draw lines for all categories, then make the unwanted lines invisible, i.e. set the opacity to 0, remove the tooltips, ....

Additionally note, that in the code below, instead of adding the series one by one by duplicating the code, I reshaped your data to tidy format and use split and Reduce to add the series:

library(tidyverse)
library(highcharter)

informatik_df_tidy <- informatik_df |>
  jsonlite::toJSON() |>
  jsonlite::fromJSON() |>
  tidyr::unnest_longer(c(name, data)) |>
  tidyr::unnest_wider(data) |>
  tidyr::unnest_longer(-name) |>
  rename_with(
    ~ paste("percent", .x, sep = "_"),
    !name & !starts_with("absol")
  ) |>
  rename(date = name) |>
  pivot_longer(
    -date,
    names_to = c(".value", "name"),
    names_pattern = "^(absol|percent)_(.*)$"
  ) |>
  filter(!grepl("^Linie", name)) |>
  mutate(
    name = fct_rev(fct_inorder(name)),
    id = tolower(name)
  )

informatik_df_split <- informatik_df_tidy |>
  split(~name) |>
  lapply(\(x) split(x, ~date))

create_stacked_bar <- function(data, title, y_title, x_title) {
  highchart() |>
    hc_chart(type = "column") |>
    hc_plotOptions(
      series = list(
        stacking = "percent",
        animation = list(duration = 1500) # Standard-Animationsgeschwindigkeit für alle Serien
      ),
      column = list(
        animation = list(duration = 1000) # Spezifische Animationsgeschwindigkeit für Balken
      ),
      line = list(
        animation = list(duration = 3000) # Spezifische Animationsgeschwindigkeit für Linien
      )
    ) |>
    hc_xAxis(
      categories = c("10/2017", "10/2022"),
      title = list(text = x_title)
    ) |>
    Reduce(
      \(hc, x) {
        hc_add_series(
          hc = hc,
          name = unique(x[[1]]$name),
          id = unique(x[[1]]$id),
          data = list(
            list(
              y = x[[1]]$percent,
              abs = x[[1]]$absol
            ),
            list(
              y = x[[2]]$percent,
              abs = x[[2]]$absol
            )
          )
        )
      },
      x = informatik_df_split,
      init = _
    ) |>
    Reduce(
      \(hc, x) {
        hc_add_series(
          hc = hc,
          name = unique(x[[1]]$name),
          id = paste0(unique(x[[1]]$id), "_line"),
          type = "line",
          linkedTo = unique(x[[1]]$id),
          enableMouseTracking = unique(x[[1]]$id) %in% c("vorlesung", "seminar"),
          opacity = if (unique(x[[1]]$id) %in% c("vorlesung", "seminar")) 1 else 0,
          dashStyle = "LongDash",
          marker = list(
            enabled = unique(x[[1]]$id) %in% c("vorlesung", "seminar"),
            symbol = "circle"
          ),
          states = list(
            inactive = list(
              enabled = unique(x[[1]]$id) %in% c("vorlesung", "seminar")
            )
          ),
          data = list(
            list(
              y = x[[1]]$percent
            ),
            list(
              y = x[[2]]$percent
            )
          )
        )
      },
      x = informatik_df_split,
      init = _
    ) |>
    hc_colors(
      c("#c5ced3", "#6A6F73", "#4d5256", "#195365", "#1e3b4c", "#e73f0c")
    ) |>
    hc_yAxis(
      title = list(text = y_title),
      labels = list(formatter = JS("function() { return this.value + '%'; }")),
      max = 100
    ) |>
    hc_tooltip(
      pointFormat = '<span style="color:{series.color}"><b>{series.name}</b></span>: {point.percentage:.1f}% ({point.abs} Kurse)<br/>',
      shared = FALSE
    ) |>
    hc_legend(enabled = TRUE, reversed = TRUE)
}

# Gestapelte Balken für Informatik
plot_1 <- create_stacked_bar(
  informatik_df_split,
  "Anzahl Informatikkurse nach Kursart (2017/2022)",
  "realtive Häuigkeiten angebotener Kurseformen",
  "Jahre"
)
plot_1