test select data

R/layers.R

@@ -40,7 +40,7 @@ v_bar <- function(vc,
   data_id <- data_id %||% genDataId()
   vc <- .vchart_specs(
     vc, "data",
-    list(list(id = data_id, values = filter_player_value(mapdata)))
+    list(list(id = data_id, values = filter_values(mapdata)))
   )
   serie <- list_(
     type = "bar",
@@ -86,6 +86,9 @@ v_bar <- function(vc,
   if (has_player(mapdata)) {
     vc <- v_default_player(vc, mapdata, data_id)
   }
+  if (has_select(mapdata)) {
+    vc <- v_default_select(vc, mapdata, data_id)
+  }
   return(vc)
 }
 
@@ -134,12 +137,7 @@ v_line <- function(vc,
   data_id <- data_id %||% genDataId()
   vc <- .vchart_specs(
     vc, "data",
-    list(
-      list(
-        id = data_id,
-        values = mapdata
-      )
-    )
+    list(list(id = data_id, values = filter_values(mapdata)))
   )
   serie <- list_(
     type = "line",
@@ -166,6 +164,9 @@ v_line <- function(vc,
     vc <- v_specs_legend(vc, visible = TRUE)
   }
   vc <- v_scale_y_continuous(vc)
+  if (has_select(mapdata)) {
+    vc <- v_default_select(vc, mapdata, data_id)
+  }
   return(vc)
 }
 
@@ -457,7 +458,7 @@ v_scatter <- function(vc,
   data_id <- data_id %||% genDataId()
   vc <- .vchart_specs(
     vc, "data",
-    list(list(id = data_id, values = filter_player_value(mapdata)))
+    list(list(id = data_id, values = filter_values(mapdata)))
   )
   shapeField <- NULL
   if (has_name(mapping, "shape"))
@@ -614,7 +615,7 @@ v_pie <- function(vc,
   data_id <- data_id %||% genDataId()
   vc <- .vchart_specs(
     vc, "data",
-    list(list(id = data_id, values = filter_player_value(mapdata)))
+    list(list(id = data_id, values = filter_values(mapdata)))
   )
   serie <- list_(
     type = "pie",

R/select.R

@@ -0,0 +1,24 @@
+
+
+
+v_default_select <- function(vc,
+                             mapdata,
+                             data_id,
+                             fun_values = identity,
+                             ...) {
+  mapdata <- split(mapdata, as.character(mapdata$select))
+  vc$x$select <- list(
+    dataId = data_id,
+    data = mapdata,
+    config = list(
+      data = lapply(
+        X = names(mapdata),
+        FUN = function(x) {
+          list(text = x, value = x)
+        }
+      )
+    )
+  )
+  return(vc)
+}
+

R/utils.R

@@ -100,11 +100,18 @@ create_values <- function(data, .names = NULL) {
 has_player <- function(x) {
   isTRUE(attr(x, "player"))
 }
-filter_player_value <- function(mapdata) {
+has_select <- function(x) {
+  isTRUE(attr(x, "select"))
+}
+filter_values <- function(mapdata) {
   if (has_player(mapdata)) {
     player1 <- mapdata$player[1]
     mapdata <- mapdata[mapdata$player == player1, , drop = FALSE]
   }
+  if (has_select(mapdata)) {
+    select1 <- mapdata$select[1]
+    mapdata <- mapdata[mapdata$select == select1, , drop = FALSE]
+  }
   return(mapdata)
 }
 
@@ -177,6 +184,9 @@ eval_mapping_ <- function(data, mapping, na_rm = FALSE) {
   if (has_name(mapdata, "player")) {
     attr(mapdata, "player") <- TRUE
   }
+  if (has_name(mapdata, "select")) {
+    attr(mapdata, "select") <- TRUE
+  }
   attr(mapdata, "scale_x") <- scale_x
   attr(mapdata, "scale_y") <- scale_y
   attr(mapdata, "scale_colour") <- scale_colour

examples/select.R

@@ -0,0 +1,15 @@
+
+library(vchartr)
+
+vchart(electricity_mix) %>% 
+  v_bar(aes(source, generation, select = country)) 
+
+
+data("economics_long", package = "ggplot2")
+vchart(economics_long) %>% 
+  v_line(aes(date, value, select = variable)) %>%
+  v_scale_x_date(
+    date_breaks = 5,
+    min = "1967-07-01",
+    max = "2015-04-01"
+  )