Merge branch 'master' of https://github.com/jbkunst/highcharter

R/api-hc-hc_add_series.R

@@ -392,14 +392,18 @@ hcaes_ <- hcaes_string
 #' Modify data frame according to mapping
 #' @param data A data frame object.
 #' @param mapping A mapping from \code{hcaes} function.
+#' @param drop A logical argument to you drop variables or not. Default is
+#'   \code{FALSE}
 #' @examples 
 #' 
-#' mutate_mapping(data = head(mtcars), mapping = hcaes(x = cyl, y = wt + cyl, group = gear))
+#' df <- head(mtcars)
+#' mutate_mapping(data = df, mapping = hcaes(x = cyl, y = wt + cyl, group = gear))
+#' mutate_mapping(data = df, mapping = hcaes(x = cyl, y = wt), drop = TRUE)
 #' 
 #' @export
-mutate_mapping <- function(data, mapping) {
+mutate_mapping <- function(data, mapping, drop = FALSE) {
 
-  stopifnot(is.data.frame(data), inherits(mapping, "hcaes"))
+  stopifnot(is.data.frame(data), inherits(mapping, "hcaes"), inherits(drop, "logical"))
 
   # http://rmhogervorst.nl/cleancode/blog/2016/06/13/NSE_standard_evaluation_dplyr.html
   tran <- as.character(mapping)
@@ -411,6 +415,9 @@ mutate_mapping <- function(data, mapping) {
   if(has_name(data, "series"))
     data <- rename_(data, "seriess" = "series")
 
+  if(drop)
+    data <- select_(data, .dots = names(mapping))
+
   data
 
 }

R/hchart-shorcuts.R

@@ -278,6 +278,11 @@ hciconarray <- function(labels, counts, rows = NULL, icons = NULL, size = 4,
         hc_theme_null()
         )
       )
+
+  if(!is.null(icons)) {
+    hc <- hc %>% hc_add_dependency_fa()
+  }
+
   hc
 
 }

R/hchart.R

@@ -724,8 +724,8 @@ hchart.survfit <- function(object, ..., fun = NULL, markTimes = TRUE,
 #' @importFrom tibble rownames_to_column
 #' @export
 
-hchart.density <- function(object, ...) { 
-  hc_add_series(highchart(), data = object, ...)
+hchart.density <- function(object, type = "area", ...) { 
+  hc_add_series(highchart(), data = object, type = type, ...)
 }
 
 #' @importFrom dplyr as_data_frame

dev/animation2.R

@@ -1,45 +1,100 @@
 library(highcharter)
 library(gapminder)
 library(dplyr)
-data("gapminder")
-gapminder
+library(purrr)
+data(gapminder, package = "gapminder")
+glimpse(gapminder)
 
+gp <- gapminder %>% 
+  arrange(desc(year)) %>% 
+  distinct(country, .keep_all = TRUE)
+gp
 
-dim(gapminder)
-dim(gapminder_unfiltered)
+hc <- hchart(gp, "point", hcaes(lifeExp, gdpPercap, size = pop, group = continent))
 
-data_strt <- distinct(gapminder_unfiltered, country, continent, .keep_all = TRUE) %>% 
-  mutate(x = lifeExp, y = gdpPercap, z = pop) %>% 
-  left_join(
-    data_frame(
-      continent = names(continent_colors),
-      color = continent_colors
-      )
-  ) %>% 
-  mutate(color = colorize(continent))
+hc %>% 
+  hc_yAxis(type = "logarithmic")
 
-data_seqc <- gapminder_unfiltered %>% 
-  arrange(country, year) %>% 
+gp2 <- gapminder %>% 
   group_by(country) %>% 
-  do(sequence = list_parse(select(., x = lifeExp, y = gdpPercap, z = pop)))
-  
+  do(lifeexpdata = .$lifeExp)
+gp2
 
-data <- left_join(data_strt, data_seqc)  
-data
+gp <- left_join(gp, gp2)
 
-data$sequence[[1]]
 
-summarise_if(gapminder, is.numeric, funs(min, max)) %>% 
-  tidyr::gather(key, value) %>% 
-  arrange(key)
+hc <- hchart(gp, "point", hcaes(lifeExp, gdpPercap, size = pop, group = continent)) %>% 
+  hc_yAxis(type = "logarithmic")
 
-highchart() %>% 
-  hc_add_series(data = data, type = "bubble",
-                minSize = 0, maxSize = 30) %>% 
-  hc_motion(enabled = TRUE, series = 0, labels = unique(gapminder$year),
-            loop = TRUE, autoPlay = TRUE, 
-            updateInterval = 1000, magnet = list(step =  1)) %>% 
-  hc_plotOptions(series = list(showInLegend = FALSE)) %>% 
+hc
+
+minichart <- "function(){
+var thiz = this;
+console.log(thiz);
+setTimeout(function() {
+$('#minichart').highcharts({
+title : {
+text: ''
+},
+subtitle: {
+text: thiz.country,
+align: 'left'
+},
+exporting: {
+enabled: false
+},
+legend: {
+enabled : false
+},
+series: [{
+animation: false,
+color: thiz.color,
+pointStart: 1952,
+data: thiz.lifeexpdata
+}],
+yAxis: {
+title: ''
+},
+xAxis: {
+}
+});
+}, 0);
+return '<div id=\"minichart\" style=\"width: 250px; height: 150px;\"></div>';
+}                        
+"
+
+hc <- hc %>% 
+  hc_tooltip(
+    useHTML = TRUE,
+    positioner = JS("function () { return { x: this.chart.plotLeft + 0, y: 0 }; }"),
+    headerFormat = "{point.country}",
+    pointFormatter = JS(minichart)
+  )
+hc
+
+gp3 <- gapminder %>% 
+  select(country, x = lifeExp, y = gdpPercap, z = pop) %>% 
+  nest(-country) %>% 
+  rename(sequence = data) %>% 
+  mutate(sequence = map(sequence, list_parse))
+
+gp <- left_join(gp, gp3)
+
+hc <- hchart(gp, "point", hcaes(lifeExp, gdpPercap, size = pop, group = continent)) %>% 
+  hc_yAxis(type = "logarithmic")
+
+hc
+
+hc <- hc %>% 
+  hc_motion(enabled = TRUE, series = 0:4, labels = sort(unique(gapminder$year)),
+            loop = FALSE, autoPlay = TRUE, 
+            updateInterval = 500, magnet = list(step =  1)) %>% 
   hc_xAxis(min = 20, max = 90) %>% 
   hc_yAxis(type = "logarithmic", min = 100, max = 100000) %>% 
-  hc_add_theme(hc_theme_smpl())
+  hc_tooltip(
+    useHTML = TRUE,
+    positioner = JS("function () { return { x: this.chart.plotLeft + 0, y: 0 }; }"),
+    headerFormat = "{point.country}",
+    pointFormatter = JS(minichart)
+  )
+hc

dev/check-cran-counts.R

@@ -1,10 +1,12 @@
-library("dplyr")
-library("lubridate")
-library("cranlogs")
-library("highcharter")
+library(dplyr)
+library(lubridate)
+library(cranlogs)
+library(highcharter)
 
-c("highcharter", "rbokeh", "dygraphs", "plotly",
-  "ggvis", "metricsgraphics", "rAmCharts") %>% 
+pcks <- c("highcharter", "rbokeh", "dygraphs", "plotly",
+  "ggvis", "metricsgraphics", "rAmCharts") 
+
+pcks %>% 
   cran_downloads(from = "2015-06-01", to = Sys.Date()) %>% 
   tbl_df() %>% 
   mutate(date = floor_date(date, unit="week")) %>% 
@@ -20,3 +22,11 @@ c("highcharter", "rbokeh", "dygraphs", "plotly",
   hc_add_theme(hc_theme_smpl())
 
 
+# devtools::install_github("ropenscilabs/packagemetrics")
+library(packagemetrics)
+
+pkg_df <- package_list_metrics(pcks)
+ft <- metrics_table(pkg_df)
+ft
+
+

dev/tooltipchart.R

@@ -0,0 +1,121 @@
+library(highcharter)
+library(gapminder)
+library(dplyr)
+library(purrr)
+library(tidyr)
+library(rlang)
+data(gapminder, package = "gapminder")
+glimpse(gapminder)
+
+
+# data --------------------------------------------------------------------
+gp <- gapminder %>% 
+  arrange(desc(year)) %>% 
+  distinct(country, .keep_all = TRUE)
+gp
+
+
+gpmini <- ""
+
+data <- gapminder
+
+mppng <- hcaes(x = year, y = lifeExp)
+
+
+gpmini <- gapminder %>% 
+  arrange(year) %>%
+  nest(-country) %>% 
+  mutate(data = map(data, mutate_mapping, hcaes(x = year, y = lifeExp), drop = TRUE),
+         data = map(data, list_parse)) %>% 
+  rename(tooltipdata = data)
+
+gptot <- left_join(gp, gpmini)
+
+gptot
+
+hchart(gp, "point", hcaes(lifeExp, gdpPercap, size = pop, group = continent)) %>% 
+  hc_yAxis(type = "logarithmic") %>% 
+
+hc
+
+point_formatter_minichart <- 
+  function(
+    hc_opts = list(
+      series = list(list(data = JS("thiz.tooltipdata"))),
+      legend = list(enabled = FALSE)
+      ),
+    width = 250,
+    height = 150
+    ) {
+
+
+  id <- highcharter:::random_id()
+
+  hcopts <- toJSON(hc_opts, pretty = TRUE, auto_unbox = TRUE, force = TRUE, null = "null", na = "null")
+  hcopts <- as.character(hcopts)
+
+  jss <- sprintf("function() {
+  var thiz = this;
+  setTimeout(function() {
+
+    $('tooltipchart-%s').highcharts({%s})
+
+  }, 0)
+
+  return '<div id=\"tooltipchart-%s\" style=\"width: %s; height: %s;\"></div>';
+
+  }", id, hcopts, id, width, height)
+
+  jss
+
+}
+
+library(highcharter)
+point_formatter_minichart()
+
+
+
+
+minichart <- "function(){
+var thiz = this;
+console.log(thiz);
+setTimeout(function() {$('#minichart').highcharts({});}, 0);
+return '<div id=\"minichart\" style=\"width: 250px; height: 150px;\"></div>';
+}                        
+"
+
+hc <- hc %>% 
+  hc_tooltip(
+    useHTML = TRUE,
+    positioner = JS("function () { return { x: this.chart.plotLeft + 0, y: 0 }; }"),
+    headerFormat = "{point.country}",
+    pointFormatter = JS(minichart)
+  )
+hc
+
+gp3 <- gapminder %>% 
+  select(country, x = lifeExp, y = gdpPercap, z = pop) %>% 
+  nest(-country) %>% 
+  rename(sequence = data) %>% 
+  mutate(sequence = map(sequence, list_parse))
+
+gp <- left_join(gp, gp3)
+
+hc <- hchart(gp, "point", hcaes(lifeExp, gdpPercap, size = pop, group = continent)) %>% 
+  hc_yAxis(type = "logarithmic")
+
+hc
+
+hc <- hc %>% 
+  hc_motion(enabled = TRUE, series = 0:4, labels = sort(unique(gapminder$year)),
+            loop = FALSE, autoPlay = TRUE, 
+            updateInterval = 500, magnet = list(step =  1)) %>% 
+  hc_xAxis(min = 20, max = 90) %>% 
+  hc_yAxis(type = "logarithmic", min = 100, max = 100000) %>% 
+  hc_tooltip(
+    useHTML = TRUE,
+    positioner = JS("function () { return { x: this.chart.plotLeft + 0, y: 0 }; }"),
+    headerFormat = "{point.country}",
+    pointFormatter = JS(minichart)
+  )
+hc