thanks to @CCWOB

dev/check-cran-counts.R

@@ -12,14 +12,16 @@ data <- pcks %>%
   cranlogs::cran_downloads(from = "2015-06-01", to = Sys.Date()) %>% 
   tibble::as_tibble() %>% 
   # mutate(date = floor_date(date, unit = "week")) %>% 
+  # mutate(date = floor_date(date, unit = "year")) %>% 
   mutate(date = floor_date(date, unit = "month")) %>% 
   group_by(date, package) %>% 
   summarize(count = sum(count)) %>% 
   ungroup() %>% 
   mutate(package = fct_reorder(package, -count)) %>% 
   group_by(package) %>% 
   arrange(date) %>% 
-  filter(row_number() != n())
+  filter(row_number() != n()) |>
+  filter(TRUE)
 
 
 hchart(data, type = "line", hcaes(x = date, y = count, group = package)) %>% 
@@ -28,3 +30,18 @@ hchart(data, type = "line", hcaes(x = date, y = count, group = package)) %>%
   hc_add_theme(hc_theme_smpl()) %>% 
   hc_navigator(enabled = TRUE) %>% 
   hc_yAxis(endOnTick = FALSE)
+
+data |> 
+  filter(year(date) > 2018) |> 
+  hchart(type = "line", hcaes(x = date, y = count, group = package)) %>% 
+  hc_chart(zoomType = "x") %>%
+  hc_tooltip(sort = TRUE, table = TRUE) %>%
+  hc_add_theme(hc_theme_smpl()) %>% 
+  # hc_navigator(enabled = TRUE) %>% 
+  hc_xAxis(title = list(text = "")) |> 
+  hc_yAxis(title = list(text = "")) |> 
+  hc_yAxis(endOnTick = FALSE) |> 
+  hc_legend(enabled = FALSE) |> 
+  hc_tooltip(
+    positioner = JS("function() {return { x: this.chart.plotLeft + 300, y: this.chart.plotTop};}")
+  )

dev/examples-charts/topo.R

@@ -0,0 +1,36 @@
+library(highcharter)
+
+options(highcharter.debug = TRUE)
+hcmap()
+
+urlmap <- "https://code.highcharts.com/mapdata/custom/world.topo.json"
+
+ftemp <- tempfile(fileext =".json")
+
+download.file(urlmap, ftemp)
+
+topo <- jsonlite::fromJSON(ftemp, simplifyVector = FALSE)
+
+# map <- highcharter:::fix_map_name(map)
+
+hc <- highchart(type = "map")
+
+highchart(type = "map") |> 
+  hc_chart(map = topo) |>
+  hc_add_series(
+    data = list()
+  )  
+
+highchart(type = "map") |> 
+  hc_chart(map = topo) |>
+  hc_add_series(data = list()) |> 
+  hc_add_series(
+    data = data.frame(
+      lat = c(20, 30, -73),
+      lon = c(10, 20, 35),
+      z = c(1, 2, 3)
+      ),
+    minSize =  '5%',
+    maxSize = '12.5%',
+    type = "mapbubble"
+  )

pkgdown/03-pkgdown-add-to-yalm-articles.R

@@ -12,6 +12,8 @@ artcls <- dir("vignettes") |>
   str_subset("png$", negate = TRUE) |> 
   str_remove(".Rmd")
 
+artcls
+
 # get_started
 get_started <- c(
   "highcharter",
@@ -25,14 +27,22 @@ get_started <- c(
 artcls <- setdiff(artcls, get_started)
 
 # highcharts
-highcharts <- c("highcharts", "maps", "stock", "themes", "modules")
+highcharts <- c("highcharts", "maps", "stock")
 
 artcls <- setdiff(artcls, highcharts)
 
 # Xperiments n Xamples
-# xx <- c("fontawesome", "drilldown")
-xx <- artcls
-xx <- unique(c("howtos", "shiny", xx))
+xx <- c("fontawesome", "drilldown")
+
+artcls <- setdiff(artcls, xx)
+
+# shiny
+shiny <- c("shiny")
+
+artcls <- setdiff(artcls, shiny)
+
+# extras
+artcls <- unique(c("themes", artcls))
 
 yml[["articles"]] <- list(
   list(
@@ -45,10 +55,20 @@ yml[["articles"]] <- list(
     navbar = "The highchartsJS bundle",
     contents = highcharts
   ),
+  list(
+    title = "Shiny Integration",
+    navbar = "Shiny Integration",
+    contents = shiny
+  ),
   list(
     title = "Experiments & Examples",
     navbar = "Experiments & Examples",
     contents = xx
+  ),
+  list(
+    title = "More of highcharter",
+    navbar = "More of highcharter", 
+    contents = artcls
   )
 )
 

vignettes/drilldown.Rmd

@@ -114,7 +114,7 @@ hchart(
 
 ## Exmaple II: Pokémon data
 
-Copy & pasting same code:
+Same recipe, different data. Just copy & pasting code:
 
 ```{r}
 pkmn_min <- pokemon |>
@@ -162,3 +162,97 @@ hchart(
   )
 ```
 
+## Example III: Custom tooltips and colors
+
+(Example thanks to Claire).
+
+```{r}
+dtrees <- tibble(
+  tree = c("A", "B"),
+  apples = c(5, 7),
+  species = c("Fuji", "Gala"),
+  trunk_size = c(30, 40)
+  ) |> 
+  # rowise is used to avoid vectorization in tags$td, ie, do it row by row
+  rowwise() |> 
+  mutate(
+    tooltip_text = list(
+      tags$table(
+        tags$tr(tags$th("Tree"), tags$td(tree)),
+        tags$tr(tags$th("# Apples"), tags$td(apples))
+      )
+    )
+  ) |> 
+  ungroup() |> 
+  mutate(
+    tooltip_text = map_chr(tooltip_text, as.character),
+    # clean text
+    tooltip_text = str_trim(str_squish(tooltip_text))
+    )
+
+dflowers <- tibble(
+  tree = c(rep("A", 3), rep("B", 4)),
+  rose = c("R1", "R2", "R3", "R4", "R5", "R6", "R7"),
+  petals = c(10, 13, 15, 20, 24, 26, 27),
+  color = c(
+    "gray",
+    "#FFB6C1",
+    "#8B0000",
+    "purple",
+    "#FF10F0",
+    "#ffffbf",
+    "red"
+  ),
+  price = c(3, 2, 4, 3.5, 5, 2.5, 4.5)
+  ) |>   
+  rowwise() |> 
+  mutate(
+    tooltip_text = list(
+      tags$table(
+        tags$tr(tags$th("Flower"), tags$td(rose)),
+        tags$tr(tags$th("# Petals"), tags$td(petals)),
+        tags$tr(tags$th("Price"), tags$td(str_c("$ ", price)))
+      )
+    )  
+  ) |> 
+  ungroup() |> 
+  mutate(
+    tooltip_text = map_chr(tooltip_text, as.character),
+    # clean text
+    tooltip_text = str_trim(str_squish(tooltip_text))
+  )
+
+dflowers_dd <- dflowers |>
+  group_nest(id = tree) |>
+  mutate(
+    type = "column",
+    data = map(data, mutate, name = rose, y = petals),
+    data = map(data, list_parse),
+    name = "Petals"
+  )
+
+hchart(
+  dtrees,
+  "column",
+  hcaes(tree, apples, drilldown = tree),
+  name = "Apples",
+  colorByPoint = TRUE
+) |>
+  hc_drilldown(
+    breadcrumbs = list(
+      format = 'back to {level.name} series',
+      # enabled = FALSE,
+      showFullPath = FALSE
+      ),
+    allowPointDrilldown = TRUE,
+    series = list_parse(dflowers_dd)
+    ) |>
+  hc_yAxis(title = list(text  = "")) |>
+  hc_xAxis(title = list(text  = "")) |>
+  hc_tooltip(
+    headerFormat = "", # remove header
+    pointFormat = "{point.tooltip_text}",
+    useHTML = TRUE
+    )
+```
+