First version passing R CMD check

DESCRIPTION

@@ -7,8 +7,8 @@ Description: Chart generalizes plot generation in R, being with base R plot
 Authors@R: c(person("Philippe", "Grosjean", role = c("aut", "cre"),
   email = "phgrosjean@sciviews.org"))
 Maintainer: Philippe Grosjean <phgrosjean@sciviews.org>
-Depends: R (>= 3.3.0)
-Imports: ggplot2
+Depends: R (>= 3.3.0), ggplot2
+Imports: stats, rlang, plyr
 Suggests: covr, knitr, testthat
 Encoding: UTF-8
 ByteCompile: yes

NAMESPACE

@@ -0,0 +1,14 @@
+# Generated by roxygen2: do not edit by hand
+
+S3method(chart,default)
+export(chart)
+export(f_aes)
+import(ggplot2)
+importFrom(plyr,rename)
+importFrom(rlang,abort)
+importFrom(rlang,f_env)
+importFrom(rlang,f_lhs)
+importFrom(rlang,f_rhs)
+importFrom(rlang,is_true)
+importFrom(rlang,warn)
+importFrom(stats,as.formula)

R/chart-package.R

@@ -11,7 +11,9 @@
 #' @name chart-package
 #'
 #' @import ggplot2
-#' @importFrom grid grid.convert
+#' @importFrom rlang abort warn f_env f_lhs f_rhs is_true
+#' @importFrom stats as.formula
+#' @importFrom plyr rename
 NULL
 
 
@@ -20,44 +22,43 @@ NULL
 `%is%` <- function(x, what) # This is more expressive!
   inherits(x, what)
 
+is_call <- is.call
+
+as_call <- as.call
+
+is_name <- is.name
+
 is_null <- is.null # rlang::is_null is much slower!
 
-child_env <- function(.parent, ...) {
-  # A faster child_env() than rlang::child_env(), but that does not convert
-  # .parent and ignores ...
-  new.env(parent = .parent)
+is_factor <- is.factor
+
+is_character <- is.character
+
+is_logical <- is.logical
+
+as_list <- as.list
+
+as_formula <- as.formula
+
+# ggplot2:::is.discrete is not exported. So, I have to clone it here
+.is_discrete <- function(x) {
+  is_factor(x) || is_character(x) || is_logical(x)
 }
 
-# rlang proposes invoke() in place of do.call(), but it is 100x slower! So:
-do_call <- function(what, ...)
-  do.call(what, ...)
-
-# rlang::env_parent(env, n = 1) is supposed to replace parent.env(), but it is
-# 25x time slower, and we don't need to specify something else than n = 1 here.
-# So, we redefine it simply for speed as:
-env_parent <- function(env)
-  parent.env(env)
-
-# rlang uses ctxt_frame() and call_frame() in place of base::parent.frame() but
-# it appears more complex for simple use. Hence call_frame(2)$env is the same as
-# parent.frame()... But there is caller_env() as shortcut for the same purpose!
-
-# Again, rlang::is_function is 10x slower than base::is.function(), so:
-is_function <- is.function
-
-# The as_character() and as_string() in rlang are difficult to understand. Here
-# we simply want a function that (tries) to convert anything into character, as
-# as.character() does. So, it is called as_chr()
-as_chr <- as.character
-
-# rlang uses env_has() and env_get() in place of exists() and get(), but with
-# the environment as first argument (and also cannot specify mode). It can
-# extract environments from objects like formulas or quosures, but then, they
-# are more than 10x slower than exists() or get() (and get0()). So, for now, I
-# stick with exists()/get() in my code...
-
-# Further base/utils functions rename for consistent snake_case notation...
-is_chr <- is.character
-is_env <- is.environment
-stop_if_not <- stopifnot
-capture_output <- capture.output
+# ggplot2:::rename_aes() is unfortunately not exported...
+# This is a copy from ggplot2 2.2.1
+.rename_aes <- function(x) {
+  full <- match(names(x), .all_aesthetics)
+  names(x)[!is.na(full)] <- .all_aesthetics[full[!is.na(full)]]
+  plyr::rename(x, .base_to_ggplot, warn_missing = FALSE)
+}
+
+.all_aesthetics <- c("adj", "alpha", "angle", "bg", "cex", "col", "color",
+  "colour", "fg", "fill", "group", "hjust", "label", "linetype", "lower", "lty",
+  "lwd", "max", "middle", "min", "pch", "radius", "sample", "shape", "size",
+  "srt", "upper", "vjust", "weight", "width", "x", "xend", "xmax", "xmin",
+  "xintercept", "y", "yend", "ymax", "ymin", "yintercept", "z")
+
+.base_to_ggplot <- c(col = "colour", color = "colour", pch = "shape",
+  cex = "size", lty = "linetype", lwd = "size", srt = "angle", adj = "hjust",
+  bg = "fill", fg = "colour", min = "ymin", max = "ymax")

R/chart.R

@@ -1,4 +1,3 @@
-library(rlang)
 #' Create charts
 #'
 #' `chart()` provides a unified interface for base plots, lattice and ggplot2.
@@ -14,7 +13,7 @@ library(rlang)
 #'
 #' @details ....
 #' @export
-#' @name quosure
+#' @name chart
 #' @seealso [f_aes()], [ggplot()]
 #' @keywords hplot
 #' @concept R plots with graphics, lattice or ggplot2
@@ -24,27 +23,26 @@ chart <- function(data, ..., type = NULL, env = parent.frame()) {
   UseMethod("chart")
 }
 
-
 #' @export
 #' @rdname chart
 chart.default <- function(data, specif = NULL, formula = NULL, mapping = NULL, ...,
 type = NULL, env = parent.frame()) {
   if (!missing(specif)) {
-    if (inherits(specif, "formula")) {
+    if (specif %is% 'formula') {
       formula <- specif
-    } else if (inherits(specif, "uneval")) {
+    } else if (specif %is% 'uneval') {
       mapping <- specif
-    } else stop("'specif' must be either a formula or aes()/f_aes()")
+    } else abort("'specif' must be either a formula or aes()/f_aes()")
   }
   # Resolve formula first, if specified
-  if (!is.null(formula)) {
-    args <- as.list(match.call())[-1]
+  if (!is_null(formula)) {
+    args <- as_list(match.call())[-1]
     args$data <- NULL
     args$specif <- NULL
     args$formula <- NULL
     args$mapping <- NULL
     args$env <- NULL
-    aes <- ggplot2:::rename_aes(.f_to_aes(formula, args, with.facets = TRUE))
+    aes <- .rename_aes(.f_to_aes(formula, args, with.facets = TRUE))
     # If mapping is provided, use it to append (and possibly replace) formula items
     #    if (!is.null(mapping))
   }
@@ -55,22 +53,22 @@ type = NULL, env = parent.frame()) {
   # Create ggplot object
   p <- ggplot(data = data, mapping = aes, environment = env)
   # Add facets, if provided
-  if (!is.null(facets)) {
-    if (is.null(f_lhs(facets))) {# facets like ~var
+  if (!is_null(facets)) {
+    if (is_null(f_lhs(facets))) {# facets like ~var
       p <- p + facet_wrap(facets)
     } else {# facets like var1 ~ var2
       p <- p + facet_grid(facets)
     }
   }
   # If type =="auto", automatically add a layer, like qplot() does
-  if (!is.null(type)) {
+  if (!is_null(type)) {
     if (type == "auto") {
       aes_names <- names(aes)
       if ("sample" %in% aes_names) {
         p <- p + geom_qq()
       } else if (!'y' %in% aes_names) {
         x <- eval(aes$x, p$data, env)
-        if (ggplot2:::is.discrete(x)) {
+        if (.is_discrete(x)) {
           p <- p + geom_bar()
         } else {
           p <- p + geom_histogram() # TODO: select adequate bins!
@@ -81,7 +79,7 @@ type = NULL, env = parent.frame()) {
       } else {
         p <- p + geom_point()
       }
-    } else warning("Only type = NULL or type = 'auto' are recognized. Argument ignored")
+    } else warn("Only type = NULL or type = 'auto' are recognized. Argument ignored")
     # TODO: use geom_<type>() instead
   }
   p

R/f_aes.R

@@ -14,13 +14,13 @@
 #' @examples
 #' # TODO...
 f_aes <- function(formula, ..., with.facets = FALSE) {
-  args <- as.list(match.call())[-1]
+  args <- as_list(match.call())[-1]
   args$formula <- NULL
-  ggplot2:::rename_aes(.f_to_aes(formula, args, with.facets = with.facets))
+  .rename_aes(.f_to_aes(formula, args, with.facets = with.facets))
 }
 
 .f_get_args <- function(expr, args = list(x = expr), replace = FALSE) {
-  if (!is.call(expr) || length(expr) < 2)
+  if (!is_call(expr) || length(expr) < 2)
     return(args)
 
   # Check if operator is like `%name=%` or `%name =%`
@@ -53,22 +53,22 @@ f_aes <- function(formula, ..., with.facets = FALSE) {
 
 .f_to_aes <- function(formula, args = list(), with.facets = FALSE) {
   if (missing(formula))
-    stop("'formula' must be provided")
+    abort("'formula' must be provided")
   # Convert formula into x and y aes() arguments
   x <- f_rhs(formula)
   y <- f_lhs(formula)
   # Possibly get facets from y ~ x | facets
-  if (is.call(x) && x[[1]] == '|') {# Extract facets as a formula
+  if (is_call(x) && x[[1]] == '|') {# Extract facets as a formula
     # If facets already exists, do not replace it (provided in the args)
     if (all(names(args) != "facets")) {
       facets <- x[[3]]
       # Could be either w, or w * z
-      if (is.name(facets)) {
-        facets <- as.call(list(quote(`~`), facets))
-      } else if (is.call(facets) && facets[[1]] == '*') {
+      if (is_name(facets)) {
+        facets <- as_call(list(quote(`~`), facets))
+      } else if (is_call(facets) && facets[[1]] == '*') {
         facets[[1]] <- quote(`~`)
       }
-      args$facets <- as.formula(facets, env = f_env(formula))
+      args$facets <- as_formula(facets, env = f_env(formula))
     }
     x <- x[[2]]
   }
@@ -79,8 +79,8 @@ f_aes <- function(formula, ..., with.facets = FALSE) {
   # Further decompose 'x' to get col, size, fill, alpha, ... from formula
   args <- .f_get_args(args$x, args, replace = FALSE)
   # Are we autorized to use facetting in the formula?
-  if (!isTRUE(with.facets) && !is.null(args$facets))
-    stop("Facets are specified but are not autorized in this context (use + facet_grid() or + facte_wrap() instead)")
+  if (!is_true(with.facets) && !is_null(args$facets))
+    abort("Facets are specified but are not autorized in this context (use + facet_grid() or + facet_wrap() instead)")
   # The result of aes() in an 'uneval' object
   class(args) <- "uneval"
   args

chart.Rproj

@@ -12,8 +12,10 @@ Encoding: UTF-8
 RnwWeave: knitr
 LaTeX: XeLaTeX
 
+AutoAppendNewline: Yes
 StripTrailingWhitespace: Yes
 
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace,vignette

vignettes/chart_rationale.R

@@ -0,0 +1,6 @@
+## ----setup, include = FALSE----------------------------------------------
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+

vignettes/chart_tutorial.R

@@ -0,0 +1,6 @@
+## ----setup, include = FALSE----------------------------------------------
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>"
+)
+