updated data/serie id + data as df

dreamRs · Sep 4, 2024 · 5531db2 · 5531db2
1 parent 456224c
commit 5531db2
Show file tree

Hide file tree

Showing 34 changed files with 423 additions and 344 deletions.
diff --git a/R/layers.R b/R/layers.R
diff --git a/R/scales.R b/R/scales.R
@@ -808,7 +808,7 @@ v_scale_discrete <- function(vc,
 #'
 #' @name scale-color-manual
 #' @example examples/scale_color_manual.R
-v_scale_color_manual <- function(vc, values) {
+v_scale_color_manual <- function(vc, values) { # , na.value = "#A4A4A4"
   stopifnot(
     "'vc' must be a 'vchart' htmlwidget object" = inherits(vc, "vchart")
   )
@@ -818,7 +818,9 @@ v_scale_color_manual <- function(vc, values) {
   specified <- vc$x$specs$color$specified %||% list()
   specified <- modifyList(specified, as.list(values))
   vc$x$specs$color$specified <- specified
-  vc <- v_specs_legend(vc, visible = TRUE)
+  # vc$x$specs$color$domain <- c(names(values), "null")
+  # vc$x$specs$color$range <- c(unname(values), na.value)
+  # vc <- v_specs_legend(vc, visible = TRUE)
   return(vc)
 }
 
@@ -966,7 +968,6 @@ v_scale_gradient <- function(vc,
       type = "color",
       field = aesthetic,
       title = title,
-      # serieId = dataserie_id,
       orient = position,
       position = align
     )))
@@ -1027,15 +1028,15 @@ v_scale_size <- function(vc,
     FUN = function(x) has_name(x, "sizeField"),
     FUN.VALUE = logical(1)
   )
-  dataserie_id <- vc$x$specs$series[index][[1]]$id
+  serie_id <- vc$x$specs$series[index][[1]]$id
   vc <- v_specs(
     vc,
     size = list(
       type = "linear",
       # domain = c(2000, 7000),
       range = range
     ),
-    dataserie_id = dataserie_id
+    serie_id = serie_id
   )
   i <- vapply(vc$x$specs$legends, function(x) identical(x$type, "size"), logical(1))
   vc$x$specs$legends[i] <- NULL

diff --git a/R/specs.R b/R/specs.R
@@ -41,7 +41,7 @@
 #'
 #' @param vc An htmlwidget created with [vchart()].
 #' @param ... List of options to specify for the chart, see [https://www.visactor.io/vchart/option/](https://www.visactor.io/vchart/option/).
-#' @param dataserie_id Used to set or modify options for a chart where there are multiple series. You can use :
+#' @param serie_id Used to set or modify options for a chart where there are multiple series. You can use :
 #'   * a `numeric` to target the position of the serie in the order where it's added to the chart
 #'   * a `character` to refer to a `serie_id` set when the serie was added to the plot.
 #'
@@ -58,24 +58,24 @@
 #'     label = list(visible = TRUE),
 #'     color = list("firebrick")
 #'   )
-v_specs <- function(vc, ..., dataserie_id = NULL) {
+v_specs <- function(vc, ..., serie_id = NULL) {
   stopifnot(
     "'vc' must be a 'vchart' htmlwidget object" = inherits(vc, "vchart")
   )
-  if (is.null(dataserie_id)) {
+  if (is.null(serie_id)) {
     vc$x$specs <- modifyList(
       x = vc$x$specs,
       val = list(...),
       keep.null = TRUE
     )
-  } else if (is.numeric(dataserie_id)) {
-    vc$x$specs$series[[dataserie_id]] <- dropNulls(modifyList(
-      x = vc$x$specs$series[[dataserie_id]],
+  } else if (is.numeric(serie_id)) {
+    vc$x$specs$series[[serie_id]] <- dropNulls(modifyList(
+      x = vc$x$specs$series[[serie_id]],
       val = list(...),
       keep.null = TRUE
     ))
-  } else if (is.character(dataserie_id)) {
-    serie <- get_serie_index(vc, dataserie_id)
+  } else if (is.character(serie_id)) {
+    serie <- get_serie_index(vc, serie_id)
     if (length(serie) == 1) {
       vc$x$specs$series[[serie]] <- dropNulls(modifyList(
         x = vc$x$specs$series[[serie]],
@@ -185,6 +185,8 @@ v_labs <- function(vc, title = NULL, subtitle = NULL, x = NULL, y = NULL) {
 #' @return A [vchart()] `htmlwidget` object.
 #' @export
 #'
+#' @importFrom rlang is_named
+#'
 #' @examples
 #' library(vchartr)
 #' data("mpg", package = "ggplot2")
@@ -195,7 +197,7 @@ v_labs <- function(vc, title = NULL, subtitle = NULL, x = NULL, y = NULL) {
 #'
 v_specs_colors <- function(vc, ...) {
   args <- list(...)
-  if (length(args) == 1 && is.character(args[[1]]))
+  if (length(args) == 1 && is.character(args[[1]]) && !is_named(args))
     args <- as.list(args[[1]])
   vc <- .vchart_specs(
     vc,
@@ -348,7 +350,7 @@ v_specs_player <- function(vc, ...) {
 
 v_default_player <- function(vc,
                              mapdata,
-                             dataserie_id,
+                             data_id,
                              fun_values = create_values,
                              ...) {
   v_specs_player(
@@ -365,7 +367,7 @@ v_default_player <- function(vc,
       FUN = function(dat) {
         list(
           data = list(
-            id = dataserie_id,
+            id = data_id,
             values = fun_values(dat, ...)
           )
         )

diff --git a/R/utils.R b/R/utils.R
@@ -15,6 +15,30 @@ dropNullsOrEmpty <- function(x) {
   x[!vapply(x, null_or_empty, FUN.VALUE = logical(1))]
 }
 
+dropColumns <- function(x) {
+  x <- dropListColumns(x)
+  x <- dropArrayColumns(x)
+  return(x)
+}
+dropListColumns <- function(x) {
+  type_col <- vapply(
+    X = x, 
+    FUN = typeof, 
+    FUN.VALUE = character(1), 
+    USE.NAMES = FALSE
+  )
+  x[, type_col != "list", drop = FALSE]
+}
+dropArrayColumns <- function(x) {
+  cols_array <- vapply(
+    X = x, 
+    FUN = is.array, 
+    FUN.VALUE = logical(1), 
+    USE.NAMES = FALSE
+  )
+  x[, !cols_array, drop = FALSE]
+}
+
 list1 <- function(x){
   if (length(x) == 1) {
     list(x)
@@ -29,6 +53,14 @@ genId <- function(bytes = 12) {
   ), width = 2), collapse = "")
 }
 
+genSerieId <- function() {
+  paste0("serie_", genId(4))
+}
+
+genDataId <- function() {
+  paste0("data_", genId(4))
+}
+
 to_camel_case <- function(x) {
   gsub("_([a-z])", "\\U\\1", x, perl = TRUE)
 }
@@ -112,9 +144,9 @@ eval_mapping <- function(data, mapping, convert_date = FALSE) {
 #' @importFrom stats complete.cases
 eval_mapping_ <- function(data, mapping, na_rm = FALSE) {
   mapdata <- lapply(mapping, eval_tidy, data = data)
+  mapdata <- as.data.frame(mapdata, check.names = FALSE)
   if (na_rm) {
-    index <- complete.cases(mapdata)
-    mapdata <- lapply(mapdata, `[`, index)
+    mapdata <- mapdata[complete.cases(mapdata), , drop = FALSE]
   }
   if (inherits(mapdata$x, "factor"))
     mapdata$x <- as.character(mapdata$x)
@@ -286,8 +318,9 @@ tooltip_key_default <- function() {
 
 
 get_aes_data <- function(mapdata, aesthetics) {
-  mapaes <- dropNullsOrEmpty(mapdata[aesthetics])
-  if (length(mapaes) > 0) {
+  mapdata <- as.list(mapdata)
+  if (is_named(mapdata)) {
+    mapaes <- dropNullsOrEmpty(mapdata[aesthetics])
     unlist(mapaes, use.names = FALSE)
   } else {
     unlist(lapply(mapdata, get_aes_data, aesthetics))

diff --git a/R/vchart.R b/R/vchart.R
@@ -41,6 +41,7 @@ vchart <- function(data = NULL,
       specs = list(data = data, ...)
     )
   }
+  attr(x, "TOJSON_ARGS") <- list(dataframe = "rows")
   createWidget(
     name = "vchart",
     x = x,

diff --git a/data-raw/browsers.R b/data-raw/browsers.R
@@ -9,7 +9,7 @@ head(browsers)
 
 
 vchart(browsers) %>%
-  v_pie(aes(browserName, value, player = date), dataserie_id = "my_id") %>%
+  v_pie(aes(browserName, value, player = date), serie_id = "my_id") %>%
   v_specs(
     customMark = list(
       list(
@@ -77,7 +77,7 @@ vchart(subset(browsers, date == 2010)) %>%
   v_pie(aes(browserName, value, player = date))
 
 vchart(subset(browsers, date == 2010)) %>%
-  v_pie(aes(browserName, value), dataserie_id = "browser") %>%
+  v_pie(aes(browserName, value), serie_id = "browser") %>%
   v_specs(
     player = list(
       auto = FALSE,

diff --git a/examples/axes.R b/examples/axes.R
@@ -64,8 +64,8 @@ vchart() %>%
 
 # Use secondary axes
 vchart() %>%
-  v_line(aes(x = month.name, y = sample(5:25, 12)), dataserie_id = "serie_left") %>%
-  v_line(aes(x = month.name, y = sample(5:25 * 100, 12)), dataserie_id = "serie_right") %>%
+  v_line(aes(x = month.name, y = sample(5:25, 12)), serie_id = "serie_left") %>%
+  v_line(aes(x = month.name, y = sample(5:25 * 100, 12)), serie_id = "serie_right") %>%
   v_specs_axes(position = "left", seriesId = "serie_left") %>%
   v_specs_axes(position = "right", type = "linear", seriesId = "serie_right")
 

diff --git a/examples/v_area.R b/examples/v_area.R
@@ -7,8 +7,8 @@ vchart(eco2mix) %>%
 
 # Two areas
 vchart(eco2mix, aes(date)) %>%
-  v_area(aes(y = solar)) %>%
-  v_area(aes(y = wind))
+  v_area(aes(y = wind)) %>%
+  v_area(aes(y = solar))
 
 # Line chart with discrete x axis
 vchart(data.frame(month = month.abb, value = sample(1:50, 12))) %>%

diff --git a/examples/v_hist.R b/examples/v_hist.R
@@ -35,5 +35,9 @@ vchart(penguins) %>%
       style = list(opacity = 0.5)
     )
   ) %>%
-  v_specs_colors("#ffa232", "#b34df2", "#33a2a2")
+  v_scale_color_manual(c(
+    Adelie = "#ffa232",
+    Chinstrap = "#33a2a2",
+    Gentoo = "#b34df2"
+  ))
 
diff --git a/inst/htmlwidgets/vchart.js b/inst/htmlwidgets/vchart.js
diff --git a/man/v_area.Rd b/man/v_area.Rd
diff --git a/man/v_bar.Rd b/man/v_bar.Rd
diff --git a/man/v_boxplot.Rd b/man/v_boxplot.Rd
diff --git a/man/v_circlepacking.Rd b/man/v_circlepacking.Rd
diff --git a/man/v_gauge.Rd b/man/v_gauge.Rd
diff --git a/man/v_heatmap.Rd b/man/v_heatmap.Rd