From d9349265f10b3c19b02379693acaf18b724dff82 Mon Sep 17 00:00:00 2001 From: pvictor Date: Mon, 23 Sep 2024 08:37:10 +0200 Subject: [PATCH] more examples + player fix --- R/layers.R | 24 ++++++------------------ R/specs.R | 18 ++++++------------ R/utils.R | 11 +++++++---- examples/custom_mark.R | 34 ++++++++++++++++++++++++++++++++++ examples/player.R | 11 +++++++++++ man/v_specs_custom_mark.Rd | 36 ++++++++++++++++++++++++++++++++++++ man/v_specs_player.Rd | 13 ++++++++----- 7 files changed, 108 insertions(+), 39 deletions(-) create mode 100644 examples/custom_mark.R create mode 100644 examples/player.R diff --git a/R/layers.R b/R/layers.R index 6e170a8..ec120d9 100644 --- a/R/layers.R +++ b/R/layers.R @@ -40,12 +40,7 @@ v_bar <- 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_player_value(mapdata))) ) serie <- list_( type = "bar", @@ -462,12 +457,7 @@ v_scatter <- 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_player_value(mapdata))) ) shapeField <- NULL if (has_name(mapping, "shape")) @@ -527,6 +517,9 @@ v_scatter <- function(vc, if (identical(scale_size, "continuous")) { vc <- v_scale_size(vc) } + if (has_player(mapdata)) { + vc <- v_default_player(vc, mapdata, data_id) + } return(vc) } @@ -621,12 +614,7 @@ v_pie <- 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_player_value(mapdata))) ) serie <- list_( type = "pie", diff --git a/R/specs.R b/R/specs.R index 6131a22..de75742 100644 --- a/R/specs.R +++ b/R/specs.R @@ -333,15 +333,7 @@ v_specs_axes <- function(vc, #' @return A [vchart()] `htmlwidget` object. #' @export #' -#' @examples -#' library(vchartr) -#' data("mpg", package = "ggplot2") -#' -#' vchart(table(Class = mpg$class, Year = mpg$year)) %>% -#' v_bar(aes(Class, Freq, fill = Year)) %>% -#' v_specs_tooltip( -#' visible = FALSE -#' ) +#' @example examples/player.R v_specs_player <- function(vc, ...) { vc <- .vchart_specs( vc, @@ -355,8 +347,9 @@ v_specs_player <- function(vc, ...) { v_default_player <- function(vc, mapdata, data_id, - fun_values = create_values, + fun_values = identity, ...) { + mapdata <- split(mapdata, as.character(mapdata$player)) v_specs_player( vc, auto = FALSE, @@ -367,7 +360,7 @@ v_default_player <- function(vc, position = "middle", type = "discrete", specs = lapply( - X = mapdata, + X = unname(mapdata), FUN = function(dat) { list( data = list( @@ -390,7 +383,8 @@ v_default_player <- function(vc, #' #' @return A [vchart()] `htmlwidget` object. #' @export -#' +#' +#' @example examples/custom_mark.R v_specs_custom_mark <- function(vc, ...) { vc <- .vchart_specs2( vc, diff --git a/R/utils.R b/R/utils.R index 2bf7081..ea72acb 100644 --- a/R/utils.R +++ b/R/utils.R @@ -100,6 +100,13 @@ create_values <- function(data, .names = NULL) { has_player <- function(x) { isTRUE(attr(x, "player")) } +filter_player_value <- function(mapdata) { + if (has_player(mapdata)) { + player1 <- mapdata$player[1] + mapdata <- mapdata[mapdata$player == player1, , drop = FALSE] + } + return(mapdata) +} create_chart <- function(type, specs, @@ -168,10 +175,6 @@ eval_mapping_ <- function(data, mapping, na_rm = FALSE) { mapdata$y <- as.numeric(mapdata$y) } if (has_name(mapdata, "player")) { - mapdata <- lapply( - X = unname(split(as.data.frame(mapdata), as.character(mapdata$player))), - FUN = as.list - ) attr(mapdata, "player") <- TRUE } attr(mapdata, "scale_x") <- scale_x diff --git a/examples/custom_mark.R b/examples/custom_mark.R new file mode 100644 index 0000000..45d153e --- /dev/null +++ b/examples/custom_mark.R @@ -0,0 +1,34 @@ + +library(vchartr) + +world_electricity %>% + subset(type == "detail") %>% + vchart() %>% + v_bar( + aes(source, generation, player = year), + direction = "h", + data_id = "mydata" + ) %>% + v_specs_custom_mark( + type = "text", + dataId = "mydata", + style = list( + textBaseline = "bottom", + fontSize = 60, + textAlign = "right", + fontWeight = 700, + text = JS("datum => datum.player"), + x = JS( + "(datum, ctx) => {", + " return ctx.vchart.getChart().getCanvasRect().width - 50;", + "}" + ), + y = JS( + "(datum, ctx) => {", + " return ctx.vchart.getChart().getCanvasRect().height - 150;", + "}" + ), + fill = "grey", + fillOpacity = 0.5 + ) + ) diff --git a/examples/player.R b/examples/player.R new file mode 100644 index 0000000..d1b4ac1 --- /dev/null +++ b/examples/player.R @@ -0,0 +1,11 @@ + +library(vchartr) + +world_electricity %>% + subset(type == "detail") %>% + vchart() %>% + v_bar( + aes(source, generation, player = year) + ) + + diff --git a/man/v_specs_custom_mark.Rd b/man/v_specs_custom_mark.Rd index 87e73d7..370a16f 100644 --- a/man/v_specs_custom_mark.Rd +++ b/man/v_specs_custom_mark.Rd @@ -18,3 +18,39 @@ A \code{\link[=vchart]{vchart()}} \code{htmlwidget} object. \description{ Add custom mark to chart } +\examples{ + +library(vchartr) + +world_electricity \%>\% + subset(type == "detail") \%>\% + vchart() \%>\% + v_bar( + aes(source, generation, player = year), + direction = "h", + data_id = "mydata" + ) \%>\% + v_specs_custom_mark( + type = "text", + dataId = "mydata", + style = list( + textBaseline = "bottom", + fontSize = 60, + textAlign = "right", + fontWeight = 700, + text = JS("datum => datum.player"), + x = JS( + "(datum, ctx) => {", + " return ctx.vchart.getChart().getCanvasRect().width - 50;", + "}" + ), + y = JS( + "(datum, ctx) => {", + " return ctx.vchart.getChart().getCanvasRect().height - 150;", + "}" + ), + fill = "grey", + fillOpacity = 0.5 + ) + ) +} diff --git a/man/v_specs_player.Rd b/man/v_specs_player.Rd index 860984e..f74056e 100644 --- a/man/v_specs_player.Rd +++ b/man/v_specs_player.Rd @@ -19,12 +19,15 @@ A \code{\link[=vchart]{vchart()}} \code{htmlwidget} object. Set player options } \examples{ + library(vchartr) -data("mpg", package = "ggplot2") -vchart(table(Class = mpg$class, Year = mpg$year)) \%>\% - v_bar(aes(Class, Freq, fill = Year)) \%>\% - v_specs_tooltip( - visible = FALSE +world_electricity \%>\% + subset(type == "detail") \%>\% + vchart() \%>\% + v_bar( + aes(source, generation, player = year) ) + + }