add geom_hspan

NAMESPACE

@@ -70,6 +70,7 @@ export(geom_barchart)
 export(geom_boxplot2)
 export(geom_gof)
 export(geom_gof2)
+export(geom_hspan)
 export(geom_interval)
 export(geom_latFreq)
 export(geom_mk)
@@ -126,6 +127,7 @@ export(st_point2poly)
 export(stat_cut)
 export(stat_gof)
 export(stat_gof2)
+export(stat_hspan)
 export(stat_interval)
 export(stat_mk)
 export(stat_prob_2d)

R/examples/ex-geom_hspan.R

@@ -0,0 +1,10 @@
+library(ggplot2)
+library(data.table)
+
+d = data.table(x = 1:10, y = 1:10)
+d_span = data.table(xmin = c(1, 4), xmax = c(3, 5), group = 1:2)
+
+ggplot(d, aes(x, y)) + 
+  geom_point() + 
+  geom_hspan(data = d_span, aes(x = NULL, y = NULL, xmin = xmin, xmax = xmax, group = group), 
+    alpha = 0.2, fill = "yellow")

R/geom_hspan.R

@@ -0,0 +1,62 @@
+#' geom_hspan
+#'
+#' @description
+#' - `xmin`, `xmax`
+#' - `ymin`, `ymax`: optional 
+#' 
+#' @inheritParams ggplot2::geom_polygon
+#' 
+#' @example R/examples/ex-geom_hspan.R
+#' @export
+geom_hspan <- function(mapping = NULL, data = NULL,
+                       stat = "hspan", position = "identity",
+                       ...,
+                       ymin = -Inf, ymax = Inf, 
+                       na.rm = FALSE,
+                       show.legend = NA,
+                       inherit.aes = TRUE) {
+  layer(
+    data = data,
+    mapping = mapping,
+    stat = stat,
+    geom = GeomPolygon,
+    position = position,
+    show.legend = show.legend,
+    inherit.aes = inherit.aes,
+    params = list2(
+      ymin = ymin, ymax = ymax,
+      na.rm = na.rm,
+      ...
+    )
+  )
+}
+
+#' @import ggplot2
+StatHspan <- ggproto("StatHspan", Stat,
+  required_aes = c("xmin", "xmax"),
+  compute_group = function(data, scales, ymin = -Inf, ymax = Inf) {
+    # x = data$x
+    # n = nrow(data) # 需要是偶数
+    # xmin = x[seq(1, n, 2)]
+    # xmax = x[seq(2, n, 2)]
+    xmin = data$xmin
+    xmax = data$xmax
+    x = c(xmin, xmin, xmax, xmax, xmin)
+    y = c(ymin, ymax, ymax, ymin, ymin)
+    # cbind(dplyr::select(data[1, ], -x), x, y, row.names = NULL)
+    cbind(data, x, y, row.names = NULL)
+  }
+)
+
+#' @export
+stat_hspan <- function(mapping = NULL, data = NULL, geom = "polygon",
+                       position = "identity",
+                       ymin = -Inf, ymax = Inf, 
+                       na.rm = FALSE, show.legend = NA,
+                       inherit.aes = TRUE, ...) {
+  layer(
+    stat = StatSpike, data = data, mapping = mapping, geom = geom,
+    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
+    params = list(ymin = ymin, ymax = ymax, na.rm = na.rm, ...)
+  )
+}