From 04c5aef541f9972f2d04f2a9e263c2d43cba96ff Mon Sep 17 00:00:00 2001 From: pvictor Date: Mon, 18 Feb 2019 20:29:34 +0100 Subject: [PATCH] rlang::as_label --- NAMESPACE | 2 +- R/apex.R | 26 ++++++++++---- inst/examples/barcharts.R | 6 ++-- inst/examples/quick-apex.R | 71 ++++++++++++++++++++++++++++++++++++-- inst/examples/radial.R | 4 +-- 5 files changed, 94 insertions(+), 15 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index f82bbf4..d8c5659 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -43,7 +43,7 @@ importFrom(htmlwidgets,shinyRenderWidget) importFrom(htmlwidgets,shinyWidgetOutput) importFrom(htmlwidgets,sizingPolicy) importFrom(magrittr,"%>%") -importFrom(rlang,as_name) +importFrom(rlang,as_label) importFrom(rlang,eval_tidy) importFrom(stats,setNames) importFrom(utils,modifyList) diff --git a/R/apex.R b/R/apex.R index 78a5115..b7e287a 100644 --- a/R/apex.R +++ b/R/apex.R @@ -13,7 +13,7 @@ #' #' @export #' -#' @importFrom rlang eval_tidy as_name +#' @importFrom rlang eval_tidy as_label #' @importFrom utils modifyList #' apex <- function(data, mapping, type = "column", ..., auto_update = TRUE, width = NULL, height = NULL, elementId = NULL) { @@ -21,7 +21,7 @@ apex <- function(data, mapping, type = "column", ..., auto_update = TRUE, width "pie", "donut", "radialBar", "radar", "scatter", "bubble", "heatmap")) data <- as.data.frame(data) mapdata <- lapply(mapping, rlang::eval_tidy, data = data) - if (type %in% c("pie", "donut", "radialBar", "radar")) { + if (type %in% c("pie", "donut", "radialBar")) { opts <- list( chart = list(type = correct_type(type)), series = list1(mapdata$y), @@ -46,18 +46,19 @@ make_series <- function(mapdata, mapping, type) { mapdata <- as.data.frame(mapdata) series_names <- "Series" if (!is.null(mapping$y)) - series_names <- rlang::as_name(mapping$y) + series_names <- rlang::as_label(mapping$y) series <- list(list( name = series_names, data = parse_df(mapdata, add_names = names(mapping)) )) - if ("fill" %in% names(mapping)) { + if (is_grouped(names(mapping))) { + mapdata <- rename_aes(mapdata) series <- lapply( - X = unique(mapdata$fill), + X = unique(mapdata$group), FUN = function(x) { list( name = x, - data = parse_df(mapdata[mapdata$fill %in% x, ], add_names = names(mapping)) + data = parse_df(mapdata[mapdata$group %in% x, ], add_names = names(mapping)) ) } ) @@ -65,6 +66,19 @@ make_series <- function(mapdata, mapping, type) { series } +is_grouped <- function(x) { + any(c("colour", "fill", "group") %in% x) +} + +rename_aes <- function(mapping) { + if ("colour" %in% names(mapping)) { + names(mapping)[names(mapping) == "colour"] <- "group" + } + if ("fill" %in% names(mapping)) { + names(mapping)[names(mapping) == "fill"] <- "group" + } + mapping +} is_x_datetime <- function(mapdata) { inherits(mapdata$x, what = c("Date", "POSIXt")) diff --git a/inst/examples/barcharts.R b/inst/examples/barcharts.R index f4bc3ad..115794a 100644 --- a/inst/examples/barcharts.R +++ b/inst/examples/barcharts.R @@ -25,7 +25,7 @@ dat <- count(mpg, manufacturer) apexchart() %>% ax_chart(type = "bar") %>% - ax_plotOptions(bar = barOpts( + ax_plotOptions(bar = bar_opts( horizontal = FALSE, endingShape = "flat", columnWidth = "70%", @@ -57,7 +57,7 @@ dat <- count(mpg, manufacturer) apexchart() %>% ax_chart(type = "bar") %>% - ax_plotOptions(bar = barOpts( + ax_plotOptions(bar = bar_opts( horizontal = TRUE, dataLabels = list( position = "center" @@ -115,7 +115,7 @@ stacked <- count(mpg, manufacturer, year) apexchart() %>% ax_chart(type = "bar", stacked = FALSE) %>% - ax_plotOptions(bar = barOpts( + ax_plotOptions(bar = bar_opts( endingShape = "rounded" )) %>% ax_series( diff --git a/inst/examples/quick-apex.R b/inst/examples/quick-apex.R index 47baa40..15dbb94 100644 --- a/inst/examples/quick-apex.R +++ b/inst/examples/quick-apex.R @@ -33,6 +33,8 @@ n_manufac_year <- count(mpg, manufacturer, year) apex(data = n_manufac_year, type = "bar", mapping = aes(x = manufacturer, y = n, fill = year)) apex(data = n_manufac_year, type = "column", mapping = aes(x = manufacturer, y = n, fill = year)) +apex(data = n_manufac_year, type = "column", mapping = aes(x = manufacturer, y = n, fill = year)) %>% + ax_chart(stacked = TRUE) @@ -52,11 +54,13 @@ apex(data = economics, type = "spline", mapping = aes(x = date, y = uempmed)) apex(data = economics, type = "area", mapping = aes(x = date, y = uempmed)) -apex(data = economics_long, type = "line", mapping = aes(x = date, y = value01, fill = variable)) +apex(data = economics_long, type = "line", mapping = aes(x = date, y = value01, group = variable)) apex(data = economics_long, type = "spline", mapping = aes(x = date, y = value01, fill = variable)) apex(data = economics_long, type = "area", mapping = aes(x = date, y = value01, fill = variable)) - +apex(data = economics_long, type = "area", mapping = aes(x = date, y = value01, fill = variable)) %>% + ax_chart(stacked = TRUE) %>% + ax_dataLabels(enabled = FALSE) library(rte.data) @@ -71,11 +75,12 @@ apex(data = consumption, type = "line", mapping = aes(x = start_date, y = value, # Scatter & Bubble -------------------------------------------------------- +apex(data = iris, type = "scatter", mapping = aes(x = Sepal.Length, y = Sepal.Width)) apex(data = iris, type = "scatter", mapping = aes(x = Sepal.Length, y = Sepal.Width, fill = Species)) %>% ax_yaxis(min = min(iris$Sepal.Width)) -apex(data = iris, type = "scatter", mapping = aes(x = Sepal.Length, y = Sepal.Width, fill = Species, z = Petal.Length)) %>% +apex(data = iris, type = "scatter", mapping = aes(x = Sepal.Length, y = Sepal.Width, fill = Species, z = scales::rescale(Petal.Length))) %>% ax_yaxis(min = min(iris$Sepal.Width)) @@ -103,6 +108,15 @@ apex(data = fruits, type = "pie", mapping = aes(x = name, y = value)) apex(data = NULL, type = "radialBar", mapping = aes(x = "My value", y = 65)) +apex(data = NULL, type = "radialBar", mapping = aes(x = "My value", y = 65)) %>% + ax_plotOptions(radialBar = radialBar_opts( + startAngle = -90, endAngle = 90, + dataLabels = list( + name = list(offsetY = -50, fontSize = "32px"), + value = list(offsetY = -30, fontSize = "26px") + ) + )) + fruits <- data.frame( name = c('Apples', 'Oranges', 'Bananas', 'Berries'), value = c(44, 55, 67, 83) @@ -110,3 +124,54 @@ fruits <- data.frame( apex(data = fruits, type = "radialBar", mapping = aes(x = name, y = value)) + + + +# Radar ------------------------------------------------------------------- + +data("avengers", package = "billboarder") + +apex(data = avengers, type = "radar", mapping = aes(x = axis, y = value, group = group)) + + +apex(data = avengers_wide, type = "radar", mapping = aes(x = axis, y = `Captain America`)) + +apex(data = head(msleep), type = "radar", mapping = aes(x = name, y = sleep_total)) + + +mtcars$model <- rownames(mtcars) +apex(data = head(mtcars), type = "radar", mapping = aes(x = model, y = qsec)) + +new_mtcars <- reshape( + data = head(mtcars), + idvar = "model", + varying = list(c("drat", "wt")), + times = c("drat", "wt"), + direction = "long", + v.names = "value", + drop = c("mpg", "cyl", "hp", "dist", "qsec", "vs", "am", "gear", "carb") +) +apex(data = new_mtcars, type = "radar", mapping = aes(x = model, y = value, group = time)) + + + + + +# Heatmap ----------------------------------------------------------------- + +txhousing2 <- txhousing %>% + filter(city %in% head(unique(city)), year %in% c(2000, 2001)) %>% + # mutate(date = paste(year, month, sep = "-")) %>% + rename(val_med = median) + +apex(data = txhousing2, type = "heatmap", mapping = aes(x = date, y = scales::rescale(val_med), group = city)) %>% + ax_dataLabels(enabled = FALSE) %>% + ax_colors("#008FFB") + + + +quote(scales::rescale(volume)) + +as_name(quote(scales::rescale(volume))) + + diff --git a/inst/examples/radial.R b/inst/examples/radial.R index c7efb2e..1ba4872 100644 --- a/inst/examples/radial.R +++ b/inst/examples/radial.R @@ -23,7 +23,7 @@ library(apexcharter) apexchart() %>% ax_chart(type = "radialBar") %>% ax_plotOptions( - radialBar = radialBarOpts( + radialBar = radialBar_opts( hollow = list(size = "70%") ) ) %>% @@ -38,7 +38,7 @@ apexchart() %>% apexchart() %>% ax_chart(type = "radialBar") %>% ax_plotOptions( - radialBar = radialBarOpts( + radialBar = radialBar_opts( startAngle = -135, endAngle = 135, dataLabels = list(