2022-11-12

This page is heavily influenced by Joshua Kunst’s blog, documentation, and issue responses.

Theme

thm <- hc_theme(
      colors = c("#7cb5ec", "#434348", "#90ed7d", "#f7a35c", "#8085e9", "#f15c80", 
"#e4d354", "#2b908f", "#f45b5b", "#91e8e1"), chart = list(
      backgroundColor = "var(--page-background)"
    ), xAxis = list(
      labels = list(style = list(color = "var(--text-color)")),
      gridLineDashStyle = "Dash",
      gridLineWidth = 1, gridLineColor = "var(--code-block-background)", lineColor = "var(--text-color)",
      minorGridLineColor = "var(--text-color)", tickColor = "var(--text-color)", tickWidth = 1,
      title = list(style = list(color = "var(--text-color)"))
    ), yAxis = list(
      labels = list(style = list(color = "var(--text-color)")),
      gridLineDashStyle = "Dash",
      gridLineWidth = 1, gridLineColor = "var(--code-block-background)", lineColor = "var(--text-color)",
      minorGridLineColor = "var(--text-color)", tickColor = "var(--text-color)", tickWidth = 1,
      title = list(style = list(color = "var(--text-color)"))    
      ), legendBackgroundColor = "var(--page-background)",
    background2 = "var(--page-background)", dataLabelsColor = "var(--text-color)", textColor = "var(--text-color)",
    contrastTextColor = "var(--text-color)", maskColor = "rgba(255,255,255,0.3)",
    title = list(style = list(color = "var(--text-color)")), subtitle = list(
      style = list(color = "var(--text-color)")
    ), legend = list(
      itemStyle = list(
        color = "var(--text-color)"
      ), itemHoverStyle = list(color = "var(--text-color)"),
      itemHiddenStyle = list(color = "var(--text-color)")
    )

)

thm <- hc_theme_merge(
  hc_theme_darkunica(),
  thm
)

options(highcharter.theme = thm)


highcharter::highcharts_demo()

messing around with grid

create_yaxis_horizontal <- function (naxis = 2, heights = 1, sep = 0.01, offset = 0, turnopposite = TRUE, 
                                     ...) 
{
  pcnt <- function(x) paste0(x * 100, "%")
  heights <- rep(heights, length = naxis)
  heights <- (heights/sum(heights)) %>% map(function(x) c(x, 
                                                          sep)) %>% unlist() %>% head(-1) %>% {
                                                            ./sum(.)
                                                          } %>% round(5)
  tops <- cumsum(c(0, head(heights, -1)))
  tops <- pcnt(tops)
  heights <- pcnt(heights)
  dfaxis <- tibble(width = heights, left = tops, offset = offset)
  dfaxis <- dfaxis %>% dplyr::filter(seq_len(nrow(dfaxis))%%2 != 
                                       0)
  if (turnopposite) {
    ops <- rep_len(c(FALSE, TRUE), length.out = nrow(dfaxis))
    dfaxis <- dfaxis %>% mutate(opposite = ops)
  }
  dfaxis <- bind_cols(dfaxis, tibble(nid = seq(naxis), ...))
  axles <- list_parse(dfaxis)
  class(axles) <- "hc_axis_list"
  axles
}
highchart() %>%
  hc_xAxis_multiples(structure(list(list(width = "50%"),
                          list(opposite = FALSE,width = "45%",left = "55%")
  ) ,class = "hc_axis_list")) %>% 
  hc_yAxis_multiples(structure(list(list(width = "32.68%",height = "100%"),
                                    list(opposite = TRUE,width = "65.36%",left = "32.68%",height = "49.505%",top = "0%"),
                                    list(opposite = TRUE,width = "65.36%",left = "32.68%",height = "49.505%",top = "50.495%")
  ) ,class = "hc_axis_list")) %>%
  hc_add_series(data = c(1, 3, 2),xAxis = 0,yAxis = 0) %>%
  hc_add_series(data = c(20, 40, 10), type = "area", xAxis = 1,yAxis = 1) %>%
  hc_add_series(data = c(200, 400, 500), xAxis = 1,yAxis = 2) %>%
  hc_add_series(data = c(500, 300, 400), type = "areaspline", xAxis = 1,yAxis = 2)
highchart() %>%
  hc_xAxis_multiples(create_yaxis_horizontal(naxis = 3,turnopposite = FALSE)) %>% 
  hc_yAxis_multiples(create_yaxis_horizontal(naxis = 3, lineWidth = 2, title = list(text = NULL),turnopposite = FALSE,opposite = c(FALSE,TRUE,TRUE))) %>%
  hc_add_series(data = c(1, 3, 2),xAxis = 0,yAxis = 0) %>%
  hc_add_series(data = c(20, 40, 10), type = "area", xAxis = 1,yAxis = 1) %>%
  hc_add_series(data = c(200, 400, 500), xAxis = 2,yAxis = 2) %>%
  hc_add_series(data = c(500, 300, 400), type = "areaspline", xAxis = 2,yAxis = 2)

legend and last value

economics_long %>%
  mutate(date = datetime_to_timestamp(date)) %>%
  highcharter::hchart("area", hcaes(date, value01, group = variable)) %>%
  highcharter::hc_xAxis(type = "datetime") %>%
  hc_plotOptions(area = list(stacking = "normal")) %>%
  hc_legend(layout = "proximate", align = "right", labelFormatter = JS("function () {
           ydat = this.yData;
            return this.name + ' ' + ydat[ydat.length-1].toFixed(2); 
        }"))

Charts

Line Charts

Basic Line Chart

data(economics_long, package = "ggplot2")

economics_long2 <- dplyr::filter(economics_long, variable %in% c("pop", "uempmed", "unemploy"))

hchart(economics_long2, "line", hcaes(x = date, y = value01, group = variable))

Colored Area and Colored Line

library(dplyr)

set.seed(123); n <- 200; colors <- sample(viridisLite::cividis(5, end = .9))

df <- tibble(
  x = 1:n,
  y = abs(arima.sim(n = n, model = list(ar = c(0.9)))) + 2,
  y2 = 10 + y,
  col = rep(colors, each = n/10, length.out = n)
)

hchart(df, "coloredarea", hcaes(x, y, segmentColor = col)) %>% 
   hc_add_series(df, "coloredline", hcaes(x, y2 , segmentColor = col)) %>% 
   hc_add_dependency("plugins/multicolor_series.js")

Scatter and Model Confidence Interval

library(broom)

modlss <- loess(dist ~ speed, data = cars)

fit <- arrange(augment(modlss), speed) %>% 
  mutate(.se = predict(modlss, se = TRUE)$se.fit)

head(fit)
## # A tibble: 6 × 5
##    dist speed .fitted .resid   .se
##   <dbl> <dbl>   <dbl>  <dbl> <dbl>
## 1     2     4    5.89 -3.89   9.89
## 2    10     4    5.89  4.11   9.89
## 3     4     7   12.5  -8.50   4.99
## 4    22     7   12.5   9.50   4.99
## 5    16     8   15.3   0.719  4.55
## 6    10     9   18.4  -8.45   4.31
hc <- hchart(
  cars,
  type = "scatter",
  hcaes(x = speed, y = dist),
  name = "Speed and Stopping Distances of Cars",
  showInLegend = TRUE
  )


qtint <- qt(0.975, predict(modlss, se = TRUE)$df)

hc %>%
  hc_add_series(
    fit,
    type = "spline",
    hcaes(x = speed, y = .fitted),
    name = "Fit",
    id = "fit", ## this is for link the arearange series to this one and have one legend
    lineWidth = 1,
    showInLegend = TRUE
    ) %>% 
  hc_add_series(
    fit,
    type = "arearange",
    name = "SE",
    hcaes(x = speed, low = .fitted - qtint*.se, high = .fitted + qtint*.se),
    linkedTo = "fit", ## here we link the legends in one.
    showInLegend = FALSE,
    color = hex_to_rgba("gray", 0.2),  ## put a semi transparent color
    zIndex = -3 ## this is for put the series in a back so the points are showed first
    )
data(favorite_bars)
data(favorite_pies)

highchart() %>%
  ## Data
  hc_add_series(
    favorite_pies,
    "column", hcaes(
      x = pie, y = percent
    ),
    name = "Pie"
  ) %>%
  hc_add_series(
    favorite_bars, "pie", hcaes(
      name = bar, y = percent
    ),
    name = "Bars"
  ) %>%
  ## Options for each type of series
  hc_plotOptions(
    series = list(
      showInLegend = FALSE, pointFormat = "{point.y}%", colorByPoint = TRUE
    ), pie = list(
      center = c("30%", "10%"), size = 120, dataLabels = list(enabled = FALSE)
    )
  ) %>%
  ## Axis
  hc_yAxis(
    title = list(text = "percentage of tastiness"), labels = list(format = "{value}%"),
    max = 100
  ) %>%
  hc_xAxis(
    categories = favorite_pies$pie
  ) %>%
  ## Titles, subtitle, caption and credits
  hc_title(
    text = "How I Met Your Mother: Pie Chart Bar Graph"
  ) %>%
  hc_subtitle(
    text = "This is a bar graph describing my favorite pies
    including a pie chart describing my favorite bars"
  ) %>%
  hc_caption(
    text = "The values represented are in percentage of tastiness and awesomeness."
  ) %>%
  hc_credits(
    enabled = TRUE, text = "Source: HIMYM", href = "https://www.youtube.com/watch?v=f_J8QU1m0Ng", style = list(fontSize = "12px")
  ) %>%
  hc_size(
    height = 600
  )
n <- 6

set.seed(123)

colors <- c("#d35400", "#2980b9", "#2ecc71", "#f1c40f", "#2c3e50", "#7f8c8d")
colors2 <- c("#000004", "#3B0F70", "#8C2981", "#DE4968", "#FE9F6D", "#FCFDBF")

df <- data.frame(x = seq_len(n) - 1) %>% 
  mutate(
    y = 10 + x + 10 * sin(x - 1),
    z = 5 + (x*y) - median(x*y),
    e = 10 * abs(rnorm(length(x))) + 2,
    e = round(e, 1),
    low = y - e,
    high = y + e,
    value = round(y - 1),
    name = sample(fruit[str_length(fruit) <= 5], size = n),
    color = rep(colors, length.out = n)
  ) %>% 
  mutate_if(is.numeric, round, 1) %>% 
  select(-e)

catch_all_data <- df %>% 
  mutate(
    # label = name,
    from = name[c(1, 1, 1, 2, 3, 4)],
    to   = name[c(3, 4, 5, 3, 6, 6)],
    weight = c(1, 1, 1, 1, 2, 2)
  )

arcdiagram

Arc diagram series is a chart drawing style in which the vertices of the chart are positioned along a line on the Euclidean plane and the edges are drawn as a semicircle in one of the two half-planes delimited by the line, or as smooth curves formed by sequences of semicircles.

tibble(from = sample(letters),to = sample(letters[1:10],26,replace = TRUE),weight = sample(1:5,26,replace = TRUE)) %>%
  rowid_to_column() %>% 
  split(.$rowid) %>% 
  map(~{
    
    tibble(from = .x$from, to = .x$to, weight = .x$weight)
  }) %>% 
  highcharter::list_parse2() -> arc_data

tibble(from = sample(letters),to = sample(letters[1:10],26,replace = TRUE),weight = sample(1:5,26,replace = TRUE)) -> arc_data 
arc_data %>% 
  rowid_to_column() %>% 
  split(.$rowid) %>% 
  map(~{
    list(.x$from,.x$to,.x$weight)
  }) -> arc_data

# arc_data %>% 
#   list_parse() %>% jsonlite::toJSON(pretty = TRUE)



hchart(arc_data,"arcdiagram",hcaes(from = from,to = to,weight = weight)) %>% 
  hc_add_dependency("modules/arc-diagram.js")


highchart() %>%
  hc_add_series(
# series = list(
      data = unname(arc_data) %>% jsonlite::toJSON(auto_unbox = TRUE),
      keys = c("from", "to", "weight"),
      type = "arcdiagram",
      name = "Train connections",
      linkWeight = 1,
      centeredLinks = TRUE,
      dataLabels = list(
        rotation = 90,
        y = 30,
        align = "left",
        color = "black"
      ),
      offset = "65%"

    # )
  ) %>%
  hc_add_dependency("modules/arc-diagram.js")
# hc_add_dep

area

The area series type.

economics_long %>% 
  hchart("area",hcaes(date,value01,group = variable))

arearange

The area range series is a carteseian series with higher and lower values foreach point along an X axis, where the area between the values is shaded.

jsonlite::fromJSON("https://cdn.jsdelivr.net/gh/highcharts/highcharts@v7.0.0/samples/data/range.json") -> area_range_data

# area_range_data

highchart() %>% 
  hc_add_series(data = as_tibble(area_range_data) %>% list_parse2(),type = "arearange") %>% 
  hc_xAxis(
    type = "datetime"
  ) %>% 
  hc_title(
    text = "Temperature variation by day"
  )

areaspline

The area spline series is an area series where the graph between thepoints is smoothed into a spline.

moose_and_deer <- tibble(
  year = c(2000:2020),
  Moose = c(
    38000, 37300, 37892, 38564, 36770, 36026, 34978, 35657, 35620, 35971, 36409, 36435, 34643, 34956, 33199, 31136, 30835, 31611, 30666, 30319, 31766
  ), Deer = c(
    22534, 23599, 24533, 25195, 25896, 27635, 29173, 32646, 35686, 37709, 39143, 36829, 35031, 36202, 35140, 33718, 37773, 42556, 43820, 46445, 50048
  )
) %>% 
  gather(key,value,-year)



hchart(moose_and_deer,"areaspline",hcaes(x = year,y = value,group = key )) %>% 
  hc_legend(
    layout = "vertical",
    align = "left", verticalAlign = "top",
    x = 120, y = 70, floating  = TRUE,
    backgroundColor = "var(--accent-color)",
    labels = list(style = list(color = "var(--page-background)"))
  ) %>% 
  hc_title(text = "Moose and deer hunting in Norway 2000-2021") %>%
  hc_subtitle(text="Source:SSB")

bar

A bar series is a special type of column series where the columns arehorizontal.

palmerpenguins::penguins %>%
  group_by(species) %>%
  summarize(flipper_length = mean(flipper_length_mm, na.rm = TRUE)) %>% 
  hchart("bar",hcaes(species,flipper_length,color = I(viridis::viridis(3)))) %>%
  hc_title(text = "Average Flipper Length by Penguin Species") 

bellcurve

A bell curve is an areaspline series which represents the probabilitydensity function of the normal distribution. It calculates mean andstandard deviation of the base series data and plots the curve accordingto the calculated parameters.

boxplot

A box plot is a convenient way of depicting groups of data through theirfive-number summaries: the smallest observation (sample minimum), lowerquartile (Q1), median (Q2), upper quartile (Q3), and largest observation(sample maximum).

# hchart()
c(3.5, 3, 3.2, 3.1, 3.6, 3.9, 3.4, 3.4, 2.9, 3.1, 3.7, 3.4, 3, 3, 4,
    4.4, 3.9, 3.5, 3.8, 3.8, 3.4, 3.7, 3.6, 3.3, 3.4, 3, 3.4, 3.5, 3.4, 3.2,
    3.1, 3.4, 4.1, 4.2, 3.1, 3.2, 3.5, 3.6, 3, 3.4, 3.5, 2.3, 3.2, 3.5, 3.8, 3,
    3.8, 3.2, 3.7, 3.3, 3.2, 3.2, 3.1, 2.3, 2.8, 2.8, 3.3, 2.4, 2.9, 2.7, 2, 3,
    2.2, 2.9, 2.9, 3.1, 3, 2.7, 2.2, 2.5, 3.2, 2.8, 2.5, 2.8, 2.9, 3, 2.8, 3,
    2.9, 2.6, 2.4, 2.4, 2.7, 2.7, 3, 3.4, 3.1, 2.3, 3, 2.5, 2.6, 3, 2.6, 2.3,
    2.7, 3, 2.9, 2.9, 2.5, 2.8, 3.3, 2.7, 3, 2.9, 3, 3, 2.5, 2.9, 2.5, 3.6,
    3.2, 2.7, 3, 2.5, 2.8, 3.2, 3, 3.8, 2.6, 2.2, 3.2, 2.8, 2.8, 2.7, 3.3, 3.2,
    2.8, 3, 2.8, 3, 2.8, 3.8, 2.8, 2.8, 2.6, 3, 3.4, 3.1, 3, 3.1, 3.1, 3.1, 2.7,
    3.2, 3.3, 3, 2.5, 3, 3.4, 3) %>% 
  {
    dat <- .
    highchart() %>% 
      hc_add_series(data = dat,type = "bellcurve")%>% 
     hc_add_dependency("modules/histogram-bellcurve.js")
  } 

 ## %>% 
 ##  hchart("boxplot",hcaes(x = group,y = n, group = group))

bubble

structure(list(x = c(95, 86.5, 80.8, 80.4, 80.3, 78.4, 74.2, 
73.5, 71, 69.2, 68.6, 65.5, 65.4, 63.4, 64), y = c(95, 102.9, 
91.5, 102.5, 86.1, 70.1, 68.5, 83.1, 93.2, 57.6, 20, 126.4, 50.8, 
51.8, 82.9), z = c(13.8, 14.7, 15.8, 12, 11.8, 16.6, 14.5, 10, 
24.7, 10.4, 16, 35.3, 28.5, 15.4, 31.3), name = c("BE", "DE", 
"FI", "NL", "SE", "ES", "FR", "NO", "UK", "IT", "RU", "US", "HU", 
"PT", "NZ"), country = c("Belgium", "Germany", "Finland", "Netherlands", 
"Sweden", "Spain", "France", "Norway", "United Kingdom", "Italy", 
"Russia", "United States", "Hungary", "Portugal", "New Zealand"
)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-15L)) -> sugar_and_fat


sugar_and_fat %>%
  hchart(., "bubble", hcaes(x = x, y = y, z = z)) %>% 
  hc_plotOptions(
    series = list(
      dataLabels = list(enabled = TRUE, format = "{point.name}")
    )
  ) %>% 
  hc_tooltip(
    headerFormat = "<table>",
    pointFormat = paste(
      '<tr><th colspan="2"><h3>{point.country}</h3></th></tr>',
      "<tr><th>Fat intake:</th><td>{point.x}g</td></tr>",
      "<tr><th>Sugar intake:</th><td>{point.y}g</td></tr>",
      "<tr><th>Obesity (adults):</th><td>{point.z}%</td></tr>"
    ),
    footerFormat = "</table>",
    useHTML = TRUE
  ) %>% 
  hc_xAxis(
    plotLines = list(list(color = "var(--text-color)",dashStyle = "dot",value = 65,
                          label = list(text = "Safe fat intake 65g/day",style = list(color = "var(--text-color)"),rotation = 0)))
  ) %>%
  hc_yAxis(
    plotLines = list(list(color = "var(--text-color)",dashStyle = "dot",value = 50,
                          label = list(text = "Safe sugar intake 50g/day",style = list(color = "var(--text-color)"),rotation = 0,align = "right")))
  ) %>% 
  hc_title(
    text = "Sugar and fat intake per country"
  ) %>% 
  hc_subtitle(
    text = "Source: Euromonitor and OECD"
  ) 

A bubble series is a three dimensional series type where each pointrenders an X, Y and Z value. Each points is drawn as a bubble where theposition along the X and Y axes mark the X and Y values, and the size ofthe bubble relates to the Z value.

bullet

df <- data.frame(
  y = sample(5:10),
  target = sample(5:10),
  x = LETTERS[1:6]
  )

hchart(df, "bullet", hcaes(x = x, y = y, target = target), color = "black") %>%
  hc_chart(inverted = TRUE) %>%
  hc_yAxis(
    min = 0,
    max = 10,
    gridLineWidth = 0,
    plotBands = list(
      list(from = 0, to = 7, color = "#666"),
      list(from = 7, to = 9, color = "#999"),
      list(from = 9, to = 10, color = "#bbb")
    )
  ) %>%
  hc_xAxis(
    gridLineWidth = 15,
    gridLineColor = "white"
  ) %>% 
  hc_plotOptions(
    series = list(
      pointPadding = 0.25,
      pointWidth = 15,
      borderWidth = 0,
      targetOptions = list(width = '200%')
      )
    )

A bullet graph is a variation of a bar graph. The bullet graph featuresa single measure, compares it to a target, and displays it in the contextof qualitative ranges of performance that could be set usingplotBands on yAxis.

column

Column series display one column per value along an X axis.

diamonds %>% 
  group_by(cut,clarity) %>% 
  summarize(price = mean(price,na.rm=TRUE)) %>% 
  ungroup() %>% 
  hchart("column",hcaes(cut,price,group = clarity))

columnpyramid

Column pyramid series display one pyramid per value along an X axis.To display horizontal pyramids, set chart.inverted totrue.

columnrange

structure(list(name = "Temperatures", data = list(structure(c(-13.9, -16.7, -4.7, -4.4, -2.1, 5.9, 6.5, 4.7, 4.3, -3.5, -9.8, -11.5, 5.2, 10.6, 11.6, 16.8, 27.2, 29.4, 29.1, 25.4, 21.6, 15.1, 12.5, 8.4), .Dim = c(12L, 2L)))), class = "data.frame", row.names = 1L) %>% pull(data) %>% as.data.frame() %>% list_parse2() %>% 
  hchart(type = "columnrange") %>% 
  hc_xAxis(categories = month.abb) %>% 
  hc_chart(inverted = TRUE) %>% 
  hc_plotOptions(columnrange = list(dataLabels = list(
  enabled = TRUE,
  format = "{y}°C"
))) %>% 
  hc_legend(enabled = FALSE) %>% 
  hc_title(text = "Temperature variation by month") %>% 
  hc_subtitle(text = "Observed in Vik i Sogn, Norway, 2021 | Source: <a href=\"https://www.vikjavev.no/ver/\" target=\"_blank\">Vikjavev</a>")

The column range is a cartesian series type with higher and lowerY values along an X axis. To display horizontal bars, setchart.inverted to true.

cylinder

A cylinder graph is a variation of a 3d column graph. The cylinder graphfeatures cylindrical points.

dependencywheel

A dependency wheel chart is a type of flow diagram, where all nodes arelaid out in a circle, and the flow between the are drawn as link bands.

arc_data <- structure(list(from = c("Hamburg", "Hamburg", "Hamburg", "Hannover", 
"Hannover", "Berlin", "Berlin", "Berlin", "Berlin", "Berlin", 
"Berlin", "München", "München", "München", "München", "München", 
"Stuttgart", "Frankfurt", "Frankfurt", "Frankfurt", "Frankfurt", 
"Düsseldorf", "Düsseldorf", "Amsterdam", "Paris", "Paris", 
"Paris", "Paris", "Paris", "Paris", "Paris", "Paris", "Paris", 
"Nantes", "Bordeaux", "Nantes", "Milano", "Milano", "Milano", 
"Milano", "Milano", "Milano", "Torino", "Venezia", "Roma", "Roma", 
"Roma", "Catania"), to = c("Stuttgart", "Frankfurt", "München", 
"Wien", "München", "Wien", "München", "Stuttgart", "Frankfurt", 
"Köln", "Düsseldorf", "Düsseldorf", "Wien", "Frankfurt", "Köln", 
"Amsterdam", "Wien", "Wien", "Amsterdam", "Paris", "Budapest", 
"Wien", "Hamburg", "Paris", "Brest", "Nantes", "Bayonne", "Bordeaux", 
"Toulouse", "Montpellier", "Marseille", "Nice", "Milano", "Nice", 
"Lyon", "Lyon", "München", "Roma", "Bari", "Napoli", "Brindisi", 
"Lamezia Terme", "Roma", "Napoli", "Bari", "Catania", "Brindisi", 
"Milano"), weight = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -48L))

highchart() %>% 
  hc_add_series(
    type = "dependencywheel",
    data = list_parse(arc_data)
  )

dumbbell

The dumbbell series is a cartesian series with higher and lower valuesfor each point along an X axis, connected with a line between thevalues.

dumbbell

Requires highcharts-more.js and modules/dumbbell.js.

tibble(
  name = sample(letters,10),
  high = rnorm(10),
  low = rnorm(10)
) %>% 
  hchart("dumbbell",hcaes(x = name))

errorbar

example_dat <- tibble(
  Type = c("Human", "High-Elf", "Orc"), 
  key = c("World1", "World2", "World3")
  ) %>% 
  expand.grid() %>% 
  mutate(mean = runif(9, 5, 7)) %>% 
  mutate(sd = runif(9, 0.5, 1)) 

hchart(
  example_dat, 
  "column",
  hcaes(x = key, y = mean, group = Type),
  id = c("a", "b", "c")
  ) %>%
  
  hc_add_series(
    example_dat,
    "errorbar", 
    hcaes(y = mean, x = key, low = mean - sd, high = mean + sd, group = Type),
    linkedTo = c("a", "b", "c"),
    enableMouseTracking = TRUE,
    showInLegend = FALSE
    ) %>% 
  
  hc_plotOptions(
    errorbar = list(
      color = "black", 
      # whiskerLength = 1,
      stemWidth = 1
    ) 
  ) 

Error bars are a graphical representation of the variability of data andare used on graphs to indicate the error, or uncertainty in a reportedmeasurement.

funnel

structure(list(name = c("Website visits", "Downloads", "Requested price list", 
"Invoice sent", "Finalized"), y = c(15654, 4064, 1987, 976, 846
)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-5L)) %>% 
  hchart(type = "funnel")

Funnel charts are a type of chart often used to visualize stages in asales project, where the top are the initial stages with the mostclients. It requires that the modules/funnel.js file is loaded.

funnel3d

A funnel3d is a 3d version of funnel series type. Funnel charts area type of chart often used to visualize stages in a sales project,where the top are the initial stages with the most clients.

funnel3d

It requires that the highcharts-3d.js, cylinder.js andfunnel3d.js module are loaded.

gauge

Gauges are circular plots displaying one or more values with a dialpointing to values along the perimeter.

col_stops <- data.frame(
  q = c(0.15, 0.4, .8),
  c = c('#55BF3B', '#DDDF0D', '#DF5353'),
  stringsAsFactors = FALSE
)

highchart() %>%
  hc_chart(type = "solidgauge") %>%
  hc_pane(
    startAngle = -90,
    endAngle = 90,
    background = list(
      outerRadius = '100%',
      innerRadius = '60%',
      shape = "arc"
    )
  ) %>%
  hc_tooltip(enabled = FALSE) %>% 
  hc_yAxis(
    stops = list_parse2(col_stops),
    lineWidth = 0,
    minorTickWidth = 0,
    tickAmount = 2,
    min = 0,
    max = 100,
    labels = list(y = 26, style = list(fontSize = "22px"))
  ) %>%
  hc_add_series(
    data = 90,
    dataLabels = list(
      y = -50,
      borderWidth = 0,
      useHTML = TRUE,
      style = list(fontSize = "40px")
    )
  ) %>% 
  hc_size(height = 300)

heatmap

A heatmap is a graphical representation of data where the individualvalues contained in a matrix are represented as colors.

economics_long %>% 
  mutate(date = as_factor(as.character(date))) %>% 
  hchart("heatmap",hcaes(x = date, y = variable,value = value01)) %>% 
  hc_size(width = 900)

heatmap

Requires modules/heatmap.

histogram

A histogram is a column series which represents the distribution of thedata set in the base series. Histogram splits data into bins and showstheir frequencies.

x <- diamonds$price
hchart(x)
hchart(density(x), type = "area", color = "#B71C1C", name = "Price")

item

An item chart is an infographic chart where a number of items are laidout in either a rectangular or circular pattern. It can be used tovisualize counts within a group, or for the circular pattern, typicallya parliament.

df <- data.frame(
  stringsAsFactors = FALSE,
  name = c(
    "The Left",
    "Social Democratic Party",
    "Alliance 90/The Greens",
    "Free Democratic Party",
    "Christian Democratic Union",
    "Christian Social Union in Bavaria",
    "Alternative for Germany"
  ),
  count = c(69, 153, 67, 80, 200, 46, 94),
  col = c("#BE3075", "#EB001F", "#64A12D", "#FFED00",
          "#000000", "#008AC5", "#009EE0"
  ),
  abbrv = c("DIE LINKE", "SPD", "GRÜNE", "FDP", "CDU", "CSU", "AfD")
)

hchart(
  df,
  "item",
  hcaes(
    name = name,
    y = count,
    label = abbrv,
    color = col
  ),
  name = "Representatives",
  showInLegend = TRUE,
  size = "100%",
  center = list("50%", "75%"),
  startAngle = -100,
  endAngle  = 100
) %>%
  hc_title(text = "Item chart with different layout") %>%
  hc_legend(labelFormat = '{name} <span style="opacity: 0.4">{y}</span>')

item

The circular layout has much in common with a pie chart. Many of the itemseries options, like center, size and data label positioning, areinherited from the pie series and don’t apply for rectangular layouts.

line

A line series displays information as a series of data points connected bystraight line segments.

economics %>% 
  hchart("line",hcaes(date,pce))

lollipop

The lollipop series is a carteseian series with a line anchored fromthe x axis and a dot at the end to mark the value.Requires highcharts-more.js, modules/dumbbell.js andmodules/lollipop.js.

tibble(
  name = sample(letters,10),
  # high = rnorm(10),
  low = rnorm(10)
) %>% 
  hchart("lollipop",hcaes(x = name)) %>% 
  hc_add_dependency("modules/lollipop.js")

networkgraph

A networkgraph is a type of relationship chart, where connnections(links) attracts nodes (points) and other nodes repulse each other.

organization

An organization chart is a diagram that shows the structure of anorganization and the relationships and relative ranks of its parts andpositions.

tibble(from = sample(letters[1:3],10,replace = TRUE),to = sample(letters[1:10],10),weight = 1:10,id = 0:9) %>% 
  hchart("organization") %>%
  hc_chart(inverted = TRUE)

packedbubble

A packed bubble series is a two dimensional series type, where each pointrenders a value in X, Y position. Each point is drawn as a bubblewhere the bubbles don’t overlap with each other and the radiusof the bubble relates to the value.

gapminder::gapminder %>%
  filter(year == max(year)) %>%
  hchart("packedbubble", hcaes(name = country, value = pop, z = pop, group = continent), dataLabels = list(enabled = TRUE, format = "{point.country}", filter = list(property = "y", operator = ">", value = 31210042))) %>%
  hc_plotOptions(
    packedbubble = list(
      minSize = "30%", maxSize = "150%"
    )
  )
hc <- gapminder::gapminder %>% 
  filter(year == max(year)) %>% 
  select(country, pop, continent) %>% hchart("packedbubble", hcaes(name = country, value = pop, group = continent))

q95 <- as.numeric(quantile(gapminder::gapminder$pop, .95))

hc %>% 
  hc_tooltip(
    useHTML = TRUE,
    pointFormat = "<b>{point.name}:</b> {point.value}"
  ) %>% 
  hc_plotOptions(
    packedbubble = list(
      maxSize = "150%",
      zMin = 0,
      layoutAlgorithm = list(
        gravitationalConstant =  0.05,
        splitSeries =  TRUE, ## TRUE to group points
        seriesInteraction = TRUE,
        dragBetweenSeries = TRUE,
        parentNodeLimit = TRUE
      ),
      dataLabels = list(
        enabled = TRUE,
        format = "{point.name}",
        filter = list(
          property = "y",
          operator = ">",
          value = q95
        ),
        style = list(
          color = "black",
          textOutline = "none",
          fontWeight = "normal"
        )
      )
    )
  )  

pareto

A pareto diagram is a type of chart that contains both bars and a linegraph, where individual values are represented in descending order bybars, and the cumulative total is represented by the line.

catch_all_data %>% 
  select(x,y) %>% 
  hchart("pareto") %>% 
  # hc_add_series(type = "pareto",baseSeries = 1L,
  #               tooltip = list(valueDecimals = 2)) %>% 
  hc_tooltip(shared = TRUE) %>% 
  hc_add_dependency("modules/pareto.js")

pie

library(scales)

diamond_data <- count(diamonds, clarity)
diamond_data <- mutate(diamond_data, porcentaje = percent(n/sum(n)))


hchart(
  diamond_data, "pie", hcaes(name = clarity, y = n),
  name = "Corte",
  innerSize = "80%",
  dataLabels = list(format = "{point.name}<br>({point.porcentaje})")
  ) -> hc
hc
hc%>% 
  hc_tooltip(
    useHTML = TRUE,
    style = list(fontSize = "30px"),
    headerFormat = "",
    pointFormat = "<div style='text-align: center;'> <b>{point.name}</b><br>{point.y} <br>{point.porcentaje} </div>",
    positioner = JS(
      "function () {
      
        /* one of the most important parts! */
        xp =  this.chart.chartWidth/2 - this.label.width/2
        yp =  this.chart.chartHeight/2 - this.label.height/2
      
        return { x: xp, y: yp };
      
      }"),
    shadow = FALSE,
    borderWidth = 0,
    backgroundColor = "transparent",
    hideDelay = 1000
    )

A pie chart is a circular graphic which is divided into slices toillustrate numerical proportion.

polygon

A polygon series can be used to draw any freeform shape in the cartesiancoordinate system. A fill is applied with the color option, andstroke is applied through lineWidth and lineColor options.

pyramid

A pyramid series is a special type of funnel, without neck and reversedby default.

pyramid3d

A pyramid3d is a 3d version of pyramid series type. Pyramid charts area type of chart often used to visualize stages in a sales project,where the top are the initial stages with the most clients.

sankey

A sankey diagram is a type of flow diagram, in which the width of thelink between two nodes is shown proportionally to the flow quantity.

data(diamonds, package = "ggplot2")
diamonds2 <- select(diamonds, cut, color, clarity)
data_to_sankey(diamonds2)
## # A tibble: 91 × 4
##    from  to    weight id   
##    <chr> <chr>  <int> <chr>
##  1 Fair  D        163 FairD
##  2 Fair  E        224 FairE
##  3 Fair  F        312 FairF
##  4 Fair  G        314 FairG
##  5 Fair  H        303 FairH
##  6 Fair  I        175 FairI
##  7 Fair  J        119 FairJ
##  8 Good  D        662 GoodD
##  9 Good  E        933 GoodE
## 10 Good  F        909 GoodF
## # … with 81 more rows
hchart(data_to_sankey(diamonds2), "sankey", name = "diamonds")

scatter

hchart(sample_n(diamonds,1000),"scatter",hcaes(carat,price,group = clarity))

A scatter plot uses cartesian coordinates to display values for twovariables for a set of data.

scatter3d

A 3D scatter plot uses x, y and z coordinates to display values for threevariables for a set of data.

solidgauge

A solid gauge is a circular gauge where the value is indicated by a filledarc, and the color of the arc may variate with the value.

spline

A spline series is a special type of line series, where the segmentsbetween the data points are smoothed.

streamgraph

A streamgraph is a type of stacked area graph which is displaced around acentral axis, resulting in a flowing, organic shape.

sunburst

A Sunburst displays hierarchical data, where a level in the hierarchy isrepresented by a circle. The center represents the root node of the tree.The visualization bears a resemblance to both treemap and pie charts.

library(dplyr)
data(gapminder, package = "gapminder")

gapminder_2007 <- gapminder::gapminder %>%
  filter(year == max(year)) %>%
  mutate(pop_mm = round(pop / 1e6))

dout <- data_to_hierarchical(gapminder_2007, c(continent, country), pop_mm)

hchart(dout, type = "sunburst")

tilemap

A tilemap series is a type of heatmap where the tile shapes areconfigurable.

structure(list(`hc-a2` = c("AL", "AK", "AZ", "AR", "CA", "CO", 
"CT", "DE", "DC", "FL", "GA", "HI", "ID", "IL", "IN", "IA", "KS", 
"KY", "LA", "ME", "MD", "MA", "MI", "MN", "MS", "MO", "MT", "NE", 
"NV", "NH", "NJ", "NM", "NY", "NC", "ND", "OH", "OK", "OR", "PA", 
"RI", "SC", "SD", "TN", "TX", "UT", "VT", "VA", "WA", "WV", "WI", 
"WY"), name = c("Alabama", "Alaska", "Arizona", "Arkansas", "California", 
"Colorado", "Connecticut", "Delaware", "District of Columbia", 
"Florida", "Georgia", "Hawaii", "Idaho", "Illinois", "Indiana", 
"Iowa", "Kansas", "Kentucky", "Louisiana", "Maine", "Maryland", 
"Massachusetts", "Michigan", "Minnesota", "Mississippi", "Missouri", 
"Montana", "Nebraska", "Nevada", "New Hampshire", "New Jersey", 
"New Mexico", "New York", "North Carolina", "North Dakota", "Ohio", 
"Oklahoma", "Oregon", "Pennsylvania", "Rhode Island", "South Carolina", 
"South Dakota", "Tennessee", "Texas", "Utah", "Vermont", "Virginia", 
"Washington", "West Virginia", "Wisconsin", "Wyoming"), region = c("South", 
"West", "West", "South", "West", "West", "Northeast", "South", 
"South", "South", "South", "West", "West", "Midwest", "Midwest", 
"Midwest", "Midwest", "South", "South", "Northeast", "South", 
"Northeast", "Midwest", "Midwest", "South", "Midwest", "West", 
"Midwest", "West", "Northeast", "Northeast", "West", "Northeast", 
"South", "Midwest", "Midwest", "South", "West", "Northeast", 
"Northeast", "South", "Midwest", "South", "South", "West", "Northeast", 
"South", "West", "South", "Midwest", "West"), x = c(6, 0, 5, 
5, 5, 4, 3, 4, 4, 8, 7, 8, 3, 3, 3, 3, 5, 4, 6, 0, 4, 2, 2, 2, 
6, 4, 2, 4, 4, 1, 3, 6, 2, 5, 2, 3, 6, 4, 3, 2, 6, 3, 5, 7, 5, 
1, 5, 2, 4, 2, 3), y = c(7, 0, 3, 6, 2, 3, 11, 9, 10, 8, 8, 0, 
2, 6, 7, 5, 5, 6, 5, 11, 8, 10, 7, 4, 6, 5, 2, 4, 2, 11, 10, 
3, 9, 9, 3, 8, 4, 1, 9, 11, 8, 4, 7, 4, 4, 10, 8, 1, 7, 5, 3), 
    value = c(4849377, 737732, 6745408, 2994079, 39250017, 5540545, 
    3596677, 935614, 7288000, 20612439, 10310371, 1419561, 1634464, 
    12801539, 6596855, 3107126, 2904021, 4413457, 4649676, 1330089, 
    6016447, 6811779, 9928301, 5519952, 2984926, 6093000, 1023579, 
    1881503, 2839099, 1326813, 8944469, 2085572, 19745289, 10146788, 
    739482, 11614373, 3878051, 3970239, 12784227, 1055173, 4832482, 
    853175, 6651194, 27862596, 2942902, 626011, 8411808, 7288000, 
    1850326, 5778708, 584153)), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -51L)) -> tile_map_usa


hchart(tile_map_usa, "tilemap",dataLabels = list(enabled = TRUE, format = "{point.hc-a2}")) %>%
  hc_chart(inverted = TRUE) %>%
  hc_colorAxis(
    dataClasses = list_parse(bind_rows(c(
      from = 0,
      to = 1000000,
      color = "#F9EDB3",
      name = "< 1M"
    ), c(
      from = 1000000,
      to = 5000000,
      color = "#FFC428",
      name = "1M - 5M"
    ), c(
      from = 5000000,
      to = 20000000,
      color = "#FF7987",
      name = "5M - 20M"
    ), c(
      from = 20000000,
      color = "#FF2371",
      name = "> 20M"
    )))
  ) %>% 
  hc_title(
    text = "U.S. states by population in 2016"
  ) %>% 
  hc_subtitle(
    text = "Source: Wikipedia"
  ) %>% 
  hc_size(width = 600,height = 600)

timeline

The timeline series presents given events along a drawn line.

treemap

A treemap displays hierarchical data using nested rectangles. The datacan be laid out in varying ways depending on options.

library(dplyr)
data(gapminder, package = "gapminder")

gapminder_2007 <- gapminder::gapminder %>%
  filter(year == max(year)) %>%
  mutate(pop_mm = round(pop / 1e6))

dout <- data_to_hierarchical(gapminder_2007, c(continent, country), pop_mm)



hchart(dout, type = "treemap")

variablepie

A variable pie series is a two dimensional series type, where each pointrenders an Y and Z value. Each point is drawn as a pie slice where thesize (arc) of the slice relates to the Y value and the radius of pieslice relates to the Z value.

variwide

A variwide chart (related to marimekko chart) is a column chart with avariable width expressing a third dimension.

vector

A vector plot is a type of cartesian chart where each point has an X andY position, a length and a direction. Vectors are drawn as arrows.

venn

A Venn diagram displays all possible logical relations between acollection of different sets. The sets are represented by circles, andthe relation between the sets are displayed by the overlap or lack ofoverlap between them. The venn diagram is a special case of Eulerdiagrams, which can also be displayed by this series type.

waterfall

A waterfall chart displays sequentially introduced positive or negativevalues in cumulative columns.

windbarb

Wind barbs are a convenient way to represent wind speed and direction inone graphical form. Wind direction is given by the stem direction, andwind speed by the number and shape of barbs.

wordcloud

A word cloud is a visualization of a set of words, where the size andplacement of a word is determined by how it is weighted.

xrange

The X-range series displays ranges on the X axis, typically timeintervals with a start and end date.

extra

simulating arima

library(highcharter)
library(stringr)
sim_ar_hc <- function(ar = c(0.3, 0.2), time = 1){
  
   # the first values of the model
  ts <- as.vector(arima.sim(model = list(ar = ar), n = 10))
  ts <- round(ts, 3)
  ts
  
load_fn <- "function () {{
    dot = (a, b) => a.map((x, i) => a[i] * b[i]).reduce((m, n) => m + n);
  function randn_bm() {{
    var u = 0, v = 0;
    while(u === 0) u = Math.random(); //Converting [0,1) to (0,1)
    while(v === 0) v = Math.random();
    return Math.sqrt( -2.0 * Math.log( u ) ) * Math.cos( 2.0 * Math.PI * v );
   }}
  
    var dat = [{ data }];
  var ar = [{ ar }];
  dat = dat.slice(-ar.length);
  
  // set up the updating of the chart each second
  var series = this.series[0];
  
  setInterval(function () {{
      
      console.log(dat);
      var new_value = dot(dat, ar) + randn_bm();
      new_value = Math.round(1000 * new_value)/1000
      console.log(new_value)
      dat.shift(); 
      dat.push(new_value);
      series.addPoint([new_value]);  
      
      //if (series.data.length < 500) {{
      //  series.addPoint([new_value], true, false);
      //}} else {{
      //  series.addPoint([new_value], true, true);
      //}}
      
  }}, { time });
  
}}"
  
  load_fn_glued <- str_glue(
    load_fn,
    data = str_c(ts, collapse = ","),
    ar = str_c(ar, collapse = ","),
    time = time * 1000
  )
  
  tick_post_fn <- "function(min,max){        
    var data = this.chart.yAxis[0].series[0].processedYData;
    //last point
    return [Math.round(1000 * data[data.length-1])/1000]; 
  }"
  
  rm_poinst_fn <- "function () {
    for (var i = 1; i <= 500; i++) {
      if (this.series[0].data.length) {
        this.series[0].data[0].remove();
      }
    }
  }"
    
  formula <- purrr::map2(ar, seq_along(ar), function(par, t){
    
    if(par > 0 & t > 1) {
      par <- str_c("+ ", par)
    }
    
    htmltools::tagList(par, "×", "X", tags$sub(stringr::str_glue("t - { i }", i = t)))
    
  }) 
  
  formula <- purrr::reduce(formula, htmltools::tagList)
  
  formula <- str_c("X", tags$sub("t") %>% as.character(), " = ",formula %>% as.character(), " + &epsilon;",  tags$sub("t") %>% as.character())
  
  hc <- highchart() %>% 
    hc_add_series(data = ts, name = "Process") %>% 
    hc_chart(
      events = list(load = JS(load_fn_glued)), 
      animation = list(duration = time*1000/2)
      ) %>%
    hc_title(text = "Autoregressive process") %>%
    hc_subtitle(text = formula, useHTML = TRUE) %>%
    hc_plotOptions(series = list(marker = list(enabled = FALSE))) %>%
    hc_tooltip(valueDecimals = 3) %>%
    hc_xAxis(width = "95%") %>%
    hc_exporting(
      enabled = TRUE,
      buttons = list(
        list(
          text =  "Remove last 500 values",
          onclick = JS(rm_poinst_fn),
          theme = list(stroke = 'silver')
          )
        )
      ) %>%
    hc_yAxis_multiples(
      # default axis
      list(
        title = list(text = ""),
        plotLines = list(
          list(value = 0, width = 2, color = "#AAA", zIndex = 1)
          )
        ),
      # opposite axis
      list(
        title = list(text = ""),
        linkedTo = 0,
        opposite = TRUE,
        gridLineWidth = 0,
        tickPositioner = JS(tick_post_fn)
      )
    ) %>%
    hc_navigator(
      enabled = TRUE,
      series = list(type = "line"),
      xAxis = list(labels = list(enabled = FALSE), width = "95%")
    )
  
  hc
  
}



sim_ar_hc()

code src

library(highcharter)
library(tidyverse)

hcExamples

hcExamples %>% 
  split(.$text) %>% 
  map(~{
    
 unique(.x$example) %>% 
      map(~{tags$a(basename(.x),href = .x,target = '_blank')}) %>% 
      div() %>% as.character() -> examples_out
    
    glue::glue(
      "## {unique(.x$text)}
      
      {unique(.x$desc)}
      
      ```{{=html}}
      
      {examples_out}
      
      ```
      
            
            "
    ) %>% 
      str_trim()
    
  }) %>% 
  
  unlist() %>% 
  paste(collaspe = "\n\n\n") %>%
  clipr::write_clip()
  
  map(~{
    div(
      h1(unique(.x$text))
    )
  }) %>% 
  div()
  

  map(~{

  header <- unique(.x$text)
  descrip <- unique(.x$desc)
  examples <- unique(.x$example)
  links <- unique(.x$example)
  list_unique <-
      .x %>% lapply(unique)

    div(
      h1(list_unique$text),
      p(list_unique$text),
      lapply(links_unique(tags$a(href  = .)
    )

    .x %>%
      div(h1(unique(.x$text)),p(unique(.x$desc)),unique(.x$example) %>% map(~{tags$a(href = .x,target = "blank_")}))
  })

js files

path.expand("~/html_projects/highcharts-master/samples/highcharts/demo/") -> base_dir

list.files(base_dir) %>% 
  map_dfr(~{
    file.path(base_dir,.x) %>% 
      list.files() %>% 
      tibble(files = .) %>% 
      mutate(group = .x)
  }) %>% 
  ungroup() %>% 
  filter(tools::file_ext(files)=="js") %>% 
  rowwise() %>% 
  mutate(
    lines = map2(group,files,~{
      read_lines(file.path(base_dir,.x,.y)) %>%
      paste(collapse = "\n") %>% 
      prettifyAddins::prettify_V8(language = "javascript") %>% 
        str_split("\n") %>% unlist() %>% tibble(code_line = .)
      })
  ) -> js_files



readr::read_lines("inst/highcharts.Rmd") %>%
  tibble(line = .) %>%
  filter(str_detect(line, "href=")) %>%
  mutate(group = stringr::str_extract(line, "demo/[a-zA-Z-]+/")) %>%
  select(group) %>% 
  mutate(group = stringr::str_remove_all(group,"demo\\/|\\/")) %>% 
  inner_join(js_files) %>%
  unique() %>% 
  split(.$group) -> js_examples





c("title","series",  "yAxis",  "chart", "xAxis", 
"tooltip",  "plotOptions", "subtitle", "name", "legend", 
"accessibility",  "colors", "credits", "responsive", 
"exporting", "colorAxis", "id", "marker",
"annotations", "boost", "caption","data"
) -> group_keys

js_examples %>%
  map_dfr(~ {
    unnest(.x, lines) %>%
      mutate(group_level = (stringr::str_length(code_line) - stringr::str_length(code_line %>% stringr::str_trim())) %>% dense_rank())
  }) %>%
  filter(group_level != 1) %>%
  # filter(group_level == 2) %>% 
  rowwise() %>%
  mutate(code_group = stringr::str_split(code_line, ":") %>% unlist() %>% .[[1]] %>% str_trim()) %>%
  mutate(code_group = case_when(code_group %in% group_keys & group_level == 2 ~ code_group,TRUE ~ NA_character_)) %>% 
  ungroup() %>% 
  fill(code_group) %>%
  mutate(code_line = case_when(
    group_level == 2 ~ str_replace(code_line,paste0(code_group,":"),glue::glue("{code_group} =")), TRUE ~ code_line
  )) -> group_code 
 

ctx <- V8::v8()

parse_code <- function(x){
      x %>%
      split(.$code_group) %>%
      imap(~ {
        .x <- .x %>%
          mutate(code_line = case_when(
            row_number() == max(row_number()) & str_sub(code_line, -1L, -1L) == "," ~ str_sub(code_line, 1, -2L), TRUE ~ code_line
          ))

        ctx$eval(JS(pull(.x, code_line) %>% paste(collapse = "")))
        ctx$eval(glue::glue("console.r.assign('eval_js_example',JSON.stringify({unique(.x$code_group)}))"))

        jsonlite::fromJSON(eval_js_example)
      }) %>%
      imap(~ {
        out_str <- glue::glue("hc_{.y}({capture.output(dput(.x)) %>% paste(collapse = '')})")
        if(!.y %in% c("series","colors")){
          out_str <- out_str %>% stringr::str_replace_all(",",",\n")
        }
        
        if(str_detect(out_str,glue::glue("hc_{.y}\\(list\\("))){

            out_str %>%
          stringr::str_remove("list\\(") %>%
          stringi::stri_reverse() %>% stringr::str_remove("\\)") %>% stringi::stri_reverse()

                    
        }else{
          out_str
        }
        
      }) %>%
      
      styler::style_text()
}

parse_code_safely <- safely(parse_code)
group_code %>%
  # filter(group == "arc-diagram") %>% 
  # print(n = nrow(.))
  # filter(group == "bubble") %>%
  split(.$group) %>%
  map(~ {
    # print(.x)
    out_res <- parse_code_safely(.x)$result
    out_res
  }) -> out_code
  
out_code %>% 
imap(~{
  
  if(!is.null(.x)){
    code_lines <- paste(.x,collapse = "\n")
      glue::glue(
        "### {.y}

        ```{{r,eval = FALSE}}

        {code_lines}

        ```\n\n"
      )
    
  }
  }) %>% 
  unlist() %>% 
  clipr::write_clip()

JS example print

js_examples %>% 
  map(~{
    print(.x)
    code_lines <- pull(.x,lines) %>% unlist() %>% as_tibble()
    code_chunk <- paste(collapse = "\n",code_lines$value)
    print(length(code_chunk))
    
    htmltools::tags$div(
      htmltools::tags$h1(.x$group),
        htmltools::tags$pre(code_chunk)
    )
  }) %>% 
  shiny::fluidPage() %>% 
  htmltools::html_print()
library(highcharter)
library(tidyverse)

hcExamples

hcExamples %>% 
  split(.$text) %>% 
  map(~{
    
 unique(.x$example) %>% 
      map(~{tags$a(basename(.x),href = .x,target = '_blank')}) %>% 
      div() %>% as.character() -> examples_out
    
    glue::glue(
      "## {unique(.x$text)}
      
      {unique(.x$desc)}
      
      ```{{=html}}
      
      {examples_out}
      
      ```
      
            
            "
    ) %>% 
      str_trim()
    
  }) %>% 
  
  unlist() %>% 
  paste(collaspe = "\n\n\n") %>%
  clipr::write_clip()
  
  map(~{
    div(
      h1(unique(.x$text))
    )
  }) %>% 
  div()
  

  map(~{

  header <- unique(.x$text)
  descrip <- unique(.x$desc)
  examples <- unique(.x$example)
  links <- unique(.x$example)
  list_unique <-
      .x %>% lapply(unique)

    div(
      h1(list_unique$text),
      p(list_unique$text),
      lapply(links_unique(tags$a(href  = .)
    )

    .x %>%
      div(h1(unique(.x$text)),p(unique(.x$desc)),unique(.x$example) %>% map(~{tags$a(href = .x,target = "blank_")}))
  })
path.expand("~/html_projects/highcharts-master/samples/highcharts/demo/") -> base_dir

list.files(base_dir) %>% 
  map_dfr(~{
    file.path(base_dir,.x) %>% 
      list.files() %>% 
      tibble(files = .) %>% 
      mutate(group = .x)
  }) %>% 
  rowwise() %>% 
  mutate(
    lines = map2(group,files,~read_lines(file.path(base_dir,.x,.y)) %>% tibble(code_line = .))
  ) %>% 
  ungroup() %>% 
  filter(tools::file_ext(files)=="js") -> js_files


readr::read_lines("inst/highcharts.Rmd") %>% 
  tibble(line = .) %>% 
  filter(str_detect(line,"##"))

readr::read_lines("inst/highcharts.Rmd") %>%
  tibble(line = .) %>%
  filter(str_detect(line, "href=")) %>%
  mutate(group = stringr::str_extract(line, "demo/[a-zA-Z-]+/")) %>%
  select(group) %>%
  print(n = nrow(.))

helper funs

page



.Wrap {
    max-width: calc(max(1180px,85%)) !important;
}
function resizedw(){
    $(".highchart, .highcharts-container, .highcharts-container > svg").each(function(){
    
      var chartHeight = $(this).height(), 
          chartWidth = $(this).find("rect").width(), 
          mainWidth = $(".Content").width(), 
          newHeight = Math.round((chartHeight / chartWidth)*mainWidth);
         // "height": Math.round(((9 / 16) * mainWidth)) 
      //console.log(chartHeight,chartWidth,newHeight);
       
      $(this).css({"width":"100%","max-width": "100%"});
  })
}

var doit;
window.onresize = function(){
  clearTimeout(doit);
  doit = setTimeout(resizedw, 1000);
};

window.dispatchEvent(new Event('resize'));