extract_data from existing chart

dreamRs · Sep 4, 2024 · 7b95d3a · 7b95d3a
1 parent 5531db2
commit 7b95d3a
Show file tree

Hide file tree

Showing 5 changed files with 18 additions and 32 deletions.
diff --git a/R/facets.R b/R/facets.R
@@ -44,8 +44,8 @@ v_facet_wrap <- function(vc,
   vc$x$specs$indicator <- create_indicator(facets_values, label_fun = labeller)
   vc$x$specs$data <- create_facet_data(vc, facet = facets_values)
   vc$x$specs$series <- create_facet_series(vc, facet = facets_values)
-  x <- get_aes_data(vc$x$mapdata, c("x", "xmin", "xmax"))
-  y <- get_aes_data(vc$x$mapdata, c("y", "ymin", "ymax"))
+  x <- get_aes_data(extract_data(vc), c("x", "xmin", "xmax"))
+  y <- get_aes_data(extract_data(vc), c("y", "ymin", "ymax"))
   vc$x$specs$axes <- c(
     create_axis_x(vc, x = x, facet = facets_values, free = scales %in% c("free", "free_x"), last_row = get_last_row(mat)),
     create_axis_y(vc, y = y, facet = facets_values, free = scales %in% c("free", "free_y"), first_col = mat[, 1])

diff --git a/R/layers.R b/R/layers.R
@@ -35,7 +35,6 @@ v_bar <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "bar")
   serie_id <- serie_id %||% genSerieId()
   data_id <- data_id %||% genDataId()
@@ -130,7 +129,6 @@ v_line <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "line")
   if (is.null(name)) {
     if (!is.null(mapping$y)) {
@@ -220,7 +218,6 @@ v_smooth <- function(vc,
     ) +
     scale_color_identity()
   mapdata <- layer_data(p, i = 1L)
-  vc$x$mapdata <- c(vc$x$mapdata, list(as.list(mapdata)))
   vc$x$type <- c(vc$x$type, "smooth")
   vc$x$mapping <- NULL
   serie_id <- serie_id %||% genSerieId()
@@ -291,7 +288,6 @@ v_area <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "area")
   if (is.null(name)) {
     if (!is.null(mapping$y)) {
@@ -382,7 +378,6 @@ v_hist <- function(vc,
   p <- p + ggplot2::geom_histogram(bins = bins, binwidth = binwidth) +
     ggplot2::scale_fill_identity()
   mapdata <- ggplot2::layer_data(p, i = 1L)
-  vc$x$mapdata <- c(vc$x$mapdata, as.list(mapdata))
   vc$x$type <- c(vc$x$type, "hist")
   serie_id <- serie_id %||% genSerieId()
   data_id <- data_id %||% genDataId()
@@ -460,7 +455,6 @@ v_scatter <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping, na_rm = TRUE)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "scatter")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -620,7 +614,6 @@ v_pie <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping, na_rm = TRUE)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "pie")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -675,7 +668,6 @@ v_radar <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping, na_rm = TRUE)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "radar")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -741,7 +733,6 @@ v_circlepacking <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "circlepacking")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -844,7 +835,6 @@ v_treemap <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "treemap")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -924,7 +914,6 @@ v_heatmap <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "heatmap")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -1029,7 +1018,6 @@ v_wordcloud <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping(data, rename_aes_lvl(mapping))
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "wordcloud")
   if (is.null(name) & !is.null(mapping$word))
     name <- rlang::as_label(mapping$word)
@@ -1189,7 +1177,6 @@ v_gauge <- function(vc,
   data <- get_data(vc, data)
   mapping <- get_mapping(vc, mapping)
   mapdata <- eval_mapping_(data, mapping, na_rm = TRUE)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- "gauge"
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -1251,7 +1238,6 @@ v_progress <- function(vc,
     }
   }
   mapdata <- eval_mapping_(data, mapping, na_rm = TRUE)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "progress")
   if (is.null(name) & !is.null(mapping$y))
     name <- rlang::as_label(mapping$y)
@@ -1335,7 +1321,6 @@ v_boxplot <- function(vc,
     vc <- rlang::exec(v_scatter, !!!args_outliers)
   }
   mapdata <- dropColumns(mapdata)
-  vc$x$mapdata <- c(vc$x$mapdata, list(mapdata))
   vc$x$type <- c(vc$x$type, "boxplot")
   serie_id <- serie_id %||% genSerieId()
   data_id <- data_id %||% genDataId()

diff --git a/R/scales.R b/R/scales.R
@@ -95,12 +95,8 @@ v_scale_date <- function(vc,
     "left" = "y"
   )
 
-  if (!is.null(vc$x$mapdata[[aesthetic]])) {
-    x <- vc$x$mapdata[[aesthetic]]
-  } else {
-    x <- unlist(lapply(vc$x$mapdata, `[[`, aesthetic))
-  }
-
+  x <- get_aes_data(extract_data(vc), aesthetic)
+
   if (is.null(date_labels))
     date_labels <- "YYYY-MM-DD"
   if (is.null(date_labels_tooltip))
@@ -289,11 +285,7 @@ v_scale_datetime <- function(vc,
     "left" = "y"
   )
 
-  if (!is.null(vc$x$mapdata[[aesthetic]])) {
-    x <- vc$x$mapdata[[aesthetic]]
-  } else {
-    x <- unlist(lapply(vc$x$mapdata, `[[`, aesthetic))
-  }
+  x <- get_aes_data(extract_data(vc), aesthetic)
 
   if (is.null(date_labels))
     date_labels <- "YYYY-MM-DD HH:mm"
@@ -519,7 +511,7 @@ v_scale_continuous <- function(vc,
   if (aesthetic == "y" & is.null(args$nice))
     args$nice <- TRUE
 
-  x <- get_aes_data(vc$x$mapdata, c(aesthetic, paste0(aesthetic, c("min", "max"))))
+  x <- get_aes_data(extract_data(vc), c(aesthetic, paste0(aesthetic, c("min", "max"))))
 
   breaks_min <- if (!is.null(min)) {
     as.numeric(min)

diff --git a/R/utils.R b/R/utils.R
@@ -327,3 +327,15 @@ get_aes_data <- function(mapdata, aesthetics) {
   }
 }
 
+
+
+extract_data <- function(vc) {
+  lapply(
+    X = vc$x$specs$data,
+    FUN = function(x) {
+      x$values
+    }
+  )
+}
+
+
diff --git a/R/vchart.R b/R/vchart.R
@@ -31,11 +31,8 @@ vchart <- function(data = NULL,
       specs = list(type = "common"),
       data = data,
       mapping = mapping,
-      mapdata = list(),
       ...
     )
-    if (!is.null(mapping) & !is.null(data))
-      x$mapdata <- c(x$mapdata, list(eval_mapping_(as.data.frame(data), mapping)))
   } else {
     x <- list(
       specs = list(data = data, ...)