From f54d5dbaf82951c678d956dffb8d529b20638f17 Mon Sep 17 00:00:00 2001 From: Joshua Kunst Date: Tue, 22 Nov 2022 17:44:11 -0300 Subject: [PATCH] thanks to @CCWOB --- dev/check-cran-counts.R | 19 ++++- dev/examples-charts/topo.R | 36 +++++++++ pkgdown/03-pkgdown-add-to-yalm-articles.R | 28 ++++++- vignettes/drilldown.Rmd | 96 ++++++++++++++++++++++- 4 files changed, 173 insertions(+), 6 deletions(-) create mode 100644 dev/examples-charts/topo.R diff --git a/dev/check-cran-counts.R b/dev/check-cran-counts.R index 4b0e2d28..f4a19ca4 100644 --- a/dev/check-cran-counts.R +++ b/dev/check-cran-counts.R @@ -12,6 +12,7 @@ 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)) %>% @@ -19,7 +20,8 @@ data <- pcks %>% 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};}") + ) diff --git a/dev/examples-charts/topo.R b/dev/examples-charts/topo.R new file mode 100644 index 00000000..37ea9837 --- /dev/null +++ b/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" + ) diff --git a/pkgdown/03-pkgdown-add-to-yalm-articles.R b/pkgdown/03-pkgdown-add-to-yalm-articles.R index 62a6f2bd..4e96d72a 100644 --- a/pkgdown/03-pkgdown-add-to-yalm-articles.R +++ b/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 ) ) diff --git a/vignettes/drilldown.Rmd b/vignettes/drilldown.Rmd index 4dc147cc..563a47aa 100644 --- a/vignettes/drilldown.Rmd +++ b/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 + ) +``` +