Roll back changes to mapped_discrete

Author: thomasp85

NAMESPACE

@@ -4,20 +4,23 @@ S3method("$",ggproto)
 S3method("$",ggproto_parent)
 S3method("$<-",uneval)
 S3method("+",gg)
+S3method("[",mapped_discrete)
 S3method("[",uneval)
+S3method("[<-",mapped_discrete)
 S3method("[<-",uneval)
 S3method("[[",ggproto)
 S3method("[[<-",uneval)
 S3method(.DollarNames,ggproto)
+S3method(as.data.frame,mapped_discrete)
 S3method(as.list,ggproto)
 S3method(autolayer,default)
 S3method(autoplot,default)
+S3method(c,mapped_discrete)
 S3method(drawDetails,zeroGrob)
 S3method(element_grob,element_blank)
 S3method(element_grob,element_line)
 S3method(element_grob,element_rect)
 S3method(element_grob,element_text)
-S3method(format,ggplot2_mapped_discrete)
 S3method(format,ggproto)
 S3method(format,ggproto_method)
 S3method(fortify,"NULL")
@@ -139,31 +142,24 @@ S3method(scale_type,sfc)
 S3method(single_value,default)
 S3method(single_value,factor)
 S3method(summary,ggplot)
-S3method(vec_arith,ggplot2_mapped_discrete)
-S3method(vec_arith.ggplot2_mapped_discrete,MISSING)
-S3method(vec_arith.ggplot2_mapped_discrete,default)
-S3method(vec_arith.ggplot2_mapped_discrete,ggplot2_mapped_discrete)
-S3method(vec_arith.ggplot2_mapped_discrete,numeric)
-S3method(vec_arith.numeric,ggplot2_mapped_discrete)
-S3method(vec_cast,character.ggplot2_mapped_discrete)
-S3method(vec_cast,double.ggplot2_mapped_discrete)
-S3method(vec_cast,factor.ggplot2_mapped_discrete)
-S3method(vec_cast,ggplot2_mapped_discrete.double)
-S3method(vec_cast,ggplot2_mapped_discrete.factor)
-S3method(vec_cast,ggplot2_mapped_discrete.ggplot2_mapped_discrete)
-S3method(vec_cast,ggplot2_mapped_discrete.integer)
-S3method(vec_cast,ggplot2_mapped_discrete.logical)
-S3method(vec_cast,integer.ggplot2_mapped_discrete)
-S3method(vec_math,ggplot2_mapped_discrete)
-S3method(vec_ptype2,character.ggplot2_mapped_discrete)
-S3method(vec_ptype2,double.ggplot2_mapped_discrete)
-S3method(vec_ptype2,factor.ggplot2_mapped_discrete)
-S3method(vec_ptype2,ggplot2_mapped_discrete.character)
-S3method(vec_ptype2,ggplot2_mapped_discrete.double)
-S3method(vec_ptype2,ggplot2_mapped_discrete.factor)
-S3method(vec_ptype2,ggplot2_mapped_discrete.ggplot2_mapped_discrete)
-S3method(vec_ptype2,ggplot2_mapped_discrete.integer)
-S3method(vec_ptype2,integer.ggplot2_mapped_discrete)
+S3method(vec_cast,character.mapped_discrete)
+S3method(vec_cast,double.mapped_discrete)
+S3method(vec_cast,factor.mapped_discrete)
+S3method(vec_cast,integer.mapped_discrete)
+S3method(vec_cast,mapped_discrete.double)
+S3method(vec_cast,mapped_discrete.factor)
+S3method(vec_cast,mapped_discrete.integer)
+S3method(vec_cast,mapped_discrete.logical)
+S3method(vec_cast,mapped_discrete.mapped_discrete)
+S3method(vec_ptype2,character.mapped_discrete)
+S3method(vec_ptype2,double.mapped_discrete)
+S3method(vec_ptype2,factor.mapped_discrete)
+S3method(vec_ptype2,integer.mapped_discrete)
+S3method(vec_ptype2,mapped_discrete.character)
+S3method(vec_ptype2,mapped_discrete.double)
+S3method(vec_ptype2,mapped_discrete.factor)
+S3method(vec_ptype2,mapped_discrete.integer)
+S3method(vec_ptype2,mapped_discrete.mapped_discrete)
 S3method(widthDetails,titleGrob)
 S3method(widthDetails,zeroGrob)
 export("%+%")
@@ -692,7 +688,6 @@ export(update_geom_defaults)
 export(update_labels)
 export(update_stat_defaults)
 export(vars)
-export(vec_arith.ggplot2_mapped_discrete)
 export(waiver)
 export(wrap_dims)
 export(xlab)

R/scale-discrete-.r

@@ -141,98 +141,73 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete,
   }
 )
 
+# Can't use vctrs - vctrs is too restrictive for mapped_discrete
 new_mapped_discrete <- function(x = double()) {
   vec_assert(x, double())
-  obj <- new_vctr(x, class = "ggplot2_mapped_discrete")
-  # vctrs does not support inheriting from numeric base class
-  class(obj) <- c(class(obj), "numeric")
-  obj
+  class(x) <- c("mapped_discrete", "numeric")
+  x
 }
 mapped_discrete <- function(x = double()) {
   if (is.null(x)) return(NULL)
   x <- as.vector(x)
   new_mapped_discrete(vec_cast(x, double()))
 }
-is_mapped_discrete <- function(x) inherits(x, "ggplot2_mapped_discrete")
+is_mapped_discrete <- function(x) inherits(x, "mapped_discrete")
 #' @export
-format.ggplot2_mapped_discrete <- function(x, ...) format(vec_data(x), ...)
-#' @export
-vec_ptype2.ggplot2_mapped_discrete.ggplot2_mapped_discrete <- function(x, y, ...) new_mapped_discrete()
-#' @export
-vec_ptype2.ggplot2_mapped_discrete.double <- function(x, y, ...) new_mapped_discrete()
-#' @export
-vec_ptype2.double.ggplot2_mapped_discrete <- function(x, y, ...) new_mapped_discrete()
-#' @export
-vec_ptype2.ggplot2_mapped_discrete.integer <- function(x, y, ...) new_mapped_discrete()
+c.mapped_discrete <- function(..., recursive = FALSE) {
+  mapped_discrete(unlist(lapply(list(...), unclass)))
+}
 #' @export
-vec_ptype2.integer.ggplot2_mapped_discrete <- function(x, y, ...) new_mapped_discrete()
+`[.mapped_discrete` <- function(x, ..., drop = TRUE) {
+  mapped_discrete(NextMethod())
+}
 #' @export
-vec_ptype2.ggplot2_mapped_discrete.character <- function(x, y, ...) character()
+`[<-.mapped_discrete` <- function(x, ..., value) {
+  if (length(value) == 0) {
+    return(x)
+  }
+  value <- as.numeric(unclass(value))
+  mapped_discrete(NextMethod())
+}
 #' @export
-vec_ptype2.character.ggplot2_mapped_discrete <- function(x, y, ...) character()
+as.data.frame.mapped_discrete <- function (x, ...) {
+  as.data.frame.vector(x = unclass(x), ...)
+}
+
 #' @export
-vec_ptype2.ggplot2_mapped_discrete.factor <- function(x, y, ...) new_mapped_discrete()
+vec_ptype2.mapped_discrete.mapped_discrete <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_ptype2.factor.ggplot2_mapped_discrete <- function(x, y, ...) new_mapped_discrete()
+vec_ptype2.mapped_discrete.double <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.ggplot2_mapped_discrete.ggplot2_mapped_discrete <- function(x, to, ...) x
+vec_ptype2.double.mapped_discrete <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.ggplot2_mapped_discrete.integer <- function(x, to, ...) mapped_discrete(x)
+vec_ptype2.mapped_discrete.integer <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.integer.ggplot2_mapped_discrete <- function(x, to, ...) as.integer(vec_data(x))
+vec_ptype2.integer.mapped_discrete <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.ggplot2_mapped_discrete.double <- function(x, to, ...) new_mapped_discrete(x)
+vec_ptype2.mapped_discrete.character <- function(x, y, ...) character()
 #' @export
-vec_cast.double.ggplot2_mapped_discrete <- function(x, to, ...) vec_data(x)
+vec_ptype2.character.mapped_discrete <- function(x, y, ...) character()
 #' @export
-vec_cast.character.ggplot2_mapped_discrete <- function(x, to, ...) as.character(vec_data(x))
+vec_ptype2.mapped_discrete.factor <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.ggplot2_mapped_discrete.factor <- function(x, to, ...) mapped_discrete(unclass(x))
+vec_ptype2.factor.mapped_discrete <- function(x, y, ...) new_mapped_discrete()
 #' @export
-vec_cast.factor.ggplot2_mapped_discrete <- function(x, to, ...) factor(vec_data(x), ...)
+vec_cast.mapped_discrete.mapped_discrete <- function(x, to, ...) x
 #' @export
-vec_cast.ggplot2_mapped_discrete.logical <- function(x, to, ...) mapped_discrete(x)
-#' Utilities for working with discrete values mapped to numeric domain
-#'
-#' @param op The operator to apply
-#' @param x,y items to apply the operator to
-#' @param ... passed on
-#' @export vec_arith.ggplot2_mapped_discrete
-#' @method vec_arith ggplot2_mapped_discrete
-#'
-#' @keywords internal
+vec_cast.mapped_discrete.integer <- function(x, to, ...) mapped_discrete(x)
 #' @export
-vec_arith.ggplot2_mapped_discrete <- function(op, x, y, ...) {
-  UseMethod("vec_arith.ggplot2_mapped_discrete", y)
-}
+vec_cast.integer.mapped_discrete <- function(x, to, ...) as.integer(as.vector(x))
 #' @export
-#' @method vec_arith.ggplot2_mapped_discrete default
-vec_arith.ggplot2_mapped_discrete.default <- function(op, x, y, ...) {
-  stop_incompatible_op(op, x, y)
-}
+vec_cast.mapped_discrete.double <- function(x, to, ...) new_mapped_discrete(x)
 #' @export
-#' @method vec_arith.ggplot2_mapped_discrete ggplot2_mapped_discrete
-vec_arith.ggplot2_mapped_discrete.ggplot2_mapped_discrete <- function(op, x, y, ...) {
-  mapped_discrete(vec_arith_base(op, x, y))
-}
+vec_cast.double.mapped_discrete <- function(x, to, ...) as.vector(x)
 #' @export
-#' @method vec_arith.ggplot2_mapped_discrete numeric
-vec_arith.ggplot2_mapped_discrete.numeric <- function(op, x, y, ...) {
-  mapped_discrete(vec_arith_base(op, x, y))
-}
+vec_cast.character.mapped_discrete <- function(x, to, ...) as.character(as.vector(x))
 #' @export
-#' @method vec_arith.numeric ggplot2_mapped_discrete
-vec_arith.numeric.ggplot2_mapped_discrete <- function(op, x, y, ...) {
-  mapped_discrete(vec_arith_base(op, x, y))
-}
+vec_cast.mapped_discrete.factor <- function(x, to, ...) mapped_discrete(as.vector(unclass(x)))
 #' @export
-#' @method vec_arith.ggplot2_mapped_discrete MISSING
-vec_arith.ggplot2_mapped_discrete.MISSING <- function(op, x, y, ...) {
-  op_fn <- getExportedValue("base", op)
-  mapped_discrete(op_fn(vec_data(x)))
-}
+vec_cast.factor.mapped_discrete <- function(x, to, ...) factor(as.vector(x), ...)
 #' @export
-vec_math.ggplot2_mapped_discrete <- function(.fn, .x, ...) {
-  res <- vec_math_base(.fn, .x, ...)
-  if (is.numeric(res)) mapped_discrete(res) else res
-}
+vec_cast.mapped_discrete.logical <- function(x, to, ...) mapped_discrete(x)
+

man/vec_arith.ggplot2_mapped_discrete.Rd

@@ -23,8 +23,8 @@ test_that("position aesthetics are coerced to correct type", {
   l2 <- ggplot(df, aes(x, z)) + geom_point() + scale_x_discrete()
   d2 <- layer_data(l2, 1)
 
-  expect_s3_class(d2$x, "ggplot2_mapped_discrete")
-  expect_s3_class(d2$y, "ggplot2_mapped_discrete")
+  expect_s3_class(d2$x, "mapped_discrete")
+  expect_s3_class(d2$y, "mapped_discrete")
 })
 
 test_that("non-position aesthetics are mapped", {

tests/testthat/test-build.r

@@ -4,7 +4,7 @@ test_that("can do frequency polygon with categorical x", {
   p <- ggplot(df, aes(x)) + geom_freqpoly(stat = "count")
   d <- layer_data(p)
 
-  expect_s3_class(d$x, "ggplot2_mapped_discrete")
+  expect_s3_class(d$x, "mapped_discrete")
   expect_equal(d$x, mapped_discrete(1:3))
   expect_equal(d$y, 3:1)
 })

tests/testthat/test-geom-freqpoly.R

@@ -152,13 +152,13 @@ test_that("Aesthetics with no continuous interpretation fails when called", {
 
 test_that("mapped_discrete vectors behaves as predicted", {
   expect_null(mapped_discrete(NULL))
-  expect_s3_class(mapped_discrete(c(0, 3.5)), "ggplot2_mapped_discrete")
-  expect_s3_class(mapped_discrete(seq_len(4)), "ggplot2_mapped_discrete")
+  expect_s3_class(mapped_discrete(c(0, 3.5)), "mapped_discrete")
+  expect_s3_class(mapped_discrete(seq_len(4)), "mapped_discrete")
   expect_error(mapped_discrete(letters))
 
   x <- mapped_discrete(1:10)
-  expect_s3_class(x[2:4], "ggplot2_mapped_discrete")
-  expect_s3_class(c(x, x), "ggplot2_mapped_discrete")
+  expect_s3_class(x[2:4], "mapped_discrete")
+  expect_s3_class(c(x, x), "mapped_discrete")
   x[5:7] <- mapped_discrete(seq_len(3))
-  expect_s3_class(x, "ggplot2_mapped_discrete")
+  expect_s3_class(x, "mapped_discrete")
 })