single_value is required and error in StatSummarize

jtlandis · Jan 8, 2024 · b61d7db · b61d7db
1 parent 28948d1
commit b61d7db
Show file tree

Hide file tree

Showing 4 changed files with 22 additions and 12 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -11,6 +11,8 @@ S3method(ggside_coord,CoordFixed)
 S3method(ggside_coord,CoordSide)
 S3method(ggside_coord,CoordTrans)
 S3method(ggside_coord,default)
+S3method(single_value,default)
+S3method(single_value,factor)
 export(GeomXsideabline)
 export(GeomXsidebar)
 export(GeomXsideboxplot)

diff --git a/R/side-layer.R b/R/side-layer.R
@@ -124,14 +124,13 @@ new_ggside_layer <- function(layer, side, remap, constructor) {
                                           data <- call_parent_method
                                           data_map(data, !!side, !!remap)
                                         }),
-    # map_statistic = new_ggproto_fun(layer$map_statistic,
-    #                                 {
-    #                                   # browser()
-    #                                   # old_nms <- names(self$stat$default_aes)
-    #                                   # names(self$stat$default_aes) <- rename_side(names(self$stat$default_aes), !!side)
-    #                                   data <- call_parent_method
-    #                                   data
-    #                                 }),
+    map_statistic = new_ggproto_fun(layer$map_statistic,
+                                    {
+                                      # old_nms <- names(self$stat$default_aes)
+                                      # names(self$stat$default_aes) <- rename_side(names(self$stat$default_aes), !!side)
+                                      data <- call_parent_method
+                                      data
+                                    }),
     compute_geom_1 = new_ggproto_fun(layer$compute_geom_1,
                                      {
                                        data <- parse_side_aes(data)

diff --git a/R/stats.r b/R/stats.r
@@ -57,7 +57,6 @@ StatSummarise <- ggplot2::ggproto("StatSummarise",
                                                          fun = NULL, args = list()) {
                                   #
                                   if (empty(data)) return(data_frame0())
-                                  #browser()
 
                                   if(is.null(fun)) {
                                     warn("fun is NULL, using length as default")
@@ -69,7 +68,7 @@ StatSummarise <- ggplot2::ggproto("StatSummarise",
                                     self$compute_group(data = group, fun = fun, args = args)
                                   })
 
-                                  vec_rbind(stats)
+                                  vec_rbind(!!!stats)
                                 },
                                 compute_group = function(self, data, scales,  fun = NULL, args = args){
 
@@ -125,7 +124,6 @@ StatSummarize <- ggplot2::ggproto("StatSummarize",
                                                            fun = NULL, args = list()) {
                                     #
                                     if (empty(data)) return(data_frame0())
-                                    #browser()
 
                                     if(is.null(fun)) {
                                       warn("fun is NULL, using length as default")
@@ -137,7 +135,7 @@ StatSummarize <- ggplot2::ggproto("StatSummarize",
                                       self$compute_group(data = group, fun = fun, args = args)
                                     })
 
-                                    vec_rbind(stats)
+                                    vec_rbind(!!!stats)
                                   },
                                   compute_group = function(self, data, scales,  fun = NULL, args = args){
 

diff --git a/R/utils-ggplot2-reimpl-.R b/R/utils-ggplot2-reimpl-.R
@@ -232,6 +232,17 @@ data_frame0 <- function(...) {
   data_frame(..., .name_repair = "minimal")
 }
 
+single_value <- function (x, ...) {
+  UseMethod("single_value")
+}
+#' @export
+single_value.default <-function (x, ...) {
+  identical(attr(x, "n"), 1L)
+}
+#' @export
+single_value.factor <- function (x, ...) {
+  identical(levels(x), "1")
+}
 
 # Adapted from plyr:::id_vars
 # Create a unique id for elements in a single vector