From cdddfe15bda0a74089234f1b162f83acf4ae53c5 Mon Sep 17 00:00:00 2001 From: Pedro Aphalo Date: Wed, 8 Nov 2023 01:10:49 +0200 Subject: [PATCH] Vignette update --- R/position-nudge-stack.R | 23 +--- man/position_stacknudge.Rd | 15 --- vignettes/grammar-extensions.R | 16 +++ vignettes/grammar-extensions.Rmd | 40 +++++- vignettes/grammar-extensions.html | 201 +++++++++++++++++------------- 5 files changed, 170 insertions(+), 125 deletions(-) diff --git a/R/position-nudge-stack.R b/R/position-nudge-stack.R index ee0447a..847cb68 100644 --- a/R/position-nudge-stack.R +++ b/R/position-nudge-stack.R @@ -132,21 +132,6 @@ #' scale_fill_grey(start = 0.7, end = 0.3) + #' facet_wrap(facets = vars(Container)) #' -#' ggplot(birch_dw.df, -#' aes(y = dry.weight * 1e-3, x = Density, fill = Part)) + -#' stat_summary(geom = "col", fun = mean, -#' position = "stack", alpha = 0.7, width = 0.67) + -#' # error bars for each stack bar -#' stat_summary(geom = "linerange", fun.data = mean_cl_normal, -#' position = position_stack_minmax(x = -0.1)) + -#' # error bar for the total -#' stat_summary(data = birch.df, aes(y = (dwstem + dwroot) * 1e-3, fill = NULL), -#' geom = "linerange", linewidth = 0.75, -#' position = position_nudge(x = 0.1), fun.data = mean_cl_normal) + -#' labs(y = "Seedling dry mass (g)") + -#' scale_fill_grey(start = 0.7, end = 0.3) + -#' facet_wrap(facets = vars(Container)) -#' position_stacknudge <- function(vjust = 1, @@ -166,16 +151,12 @@ position_stacknudge <- none = function(x) {1}, split = sign, split.y = function(x) {1}, - split.x = sign, - center = sign, - function(x) {1}), + split.x = sign), .fun_y = switch(direction, none = function(x) {1}, split = sign, split.x = function(x) {1}, - split.y = sign, - center = sign, - function(x) {1}), + split.y = sign), kept.origin = kept.origin, vjust = vjust, reverse = reverse diff --git a/man/position_stacknudge.Rd b/man/position_stacknudge.Rd index a9751ca..c2c8018 100644 --- a/man/position_stacknudge.Rd +++ b/man/position_stacknudge.Rd @@ -170,21 +170,6 @@ ggplot(birch_dw.df, scale_fill_grey(start = 0.7, end = 0.3) + facet_wrap(facets = vars(Container)) -ggplot(birch_dw.df, - aes(y = dry.weight * 1e-3, x = Density, fill = Part)) + - stat_summary(geom = "col", fun = mean, - position = "stack", alpha = 0.7, width = 0.67) + - # error bars for each stack bar - stat_summary(geom = "linerange", fun.data = mean_cl_normal, - position = position_stack_minmax(x = -0.1)) + - # error bar for the total - stat_summary(data = birch.df, aes(y = (dwstem + dwroot) * 1e-3, fill = NULL), - geom = "linerange", linewidth = 0.75, - position = position_nudge(x = 0.1), fun.data = mean_cl_normal) + - labs(y = "Seedling dry mass (g)") + - scale_fill_grey(start = 0.7, end = 0.3) + - facet_wrap(facets = vars(Container)) - } \seealso{ \code{\link[ggplot2]{position_nudge}}, diff --git a/vignettes/grammar-extensions.R b/vignettes/grammar-extensions.R index 9a17ed9..7b1d8f9 100644 --- a/vignettes/grammar-extensions.R +++ b/vignettes/grammar-extensions.R @@ -749,6 +749,22 @@ ggplot(data = df, aes(x1, x2, group = grp)) + theme(legend.position = "none") +## ----------------------------------------------------------------------------- +ggplot(birch_dw.df, + aes(y = dry.weight * 1e-3, x = Density, fill = Part)) + + stat_summary(geom = "col", fun = mean, + position = "stack", alpha = 0.7, width = 0.67) + + # error bars for each stack bar + stat_summary(geom = "linerange", fun.data = mean_cl_normal, + position = position_stack_minmax(x = -0.1)) + + # error bar for the total + stat_summary(data = birch.df, aes(y = (dwstem + dwroot) * 1e-3, fill = NULL), + geom = "linerange", linewidth = 0.75, + position = position_nudge(x = 0.1), fun.data = mean_cl_normal) + + labs(y = "Seedling dry mass (g)") + + scale_fill_grey(start = 0.7, end = 0.3) + + facet_wrap(facets = vars(Container)) + ## ----------------------------------------------------------------------------- jitter <- position_jitter(width = 0.2, height = 2, seed = 123) diff --git a/vignettes/grammar-extensions.Rmd b/vignettes/grammar-extensions.Rmd index ee62a26..52c118a 100644 --- a/vignettes/grammar-extensions.Rmd +++ b/vignettes/grammar-extensions.Rmd @@ -292,7 +292,7 @@ lines, or with respect to a polynomial or smoothing spline fitted on-the-fly to the the observations. A limitation of 'ggplot2' is that only one position function can be used -in a layer. This makes it difficult to add text labels to stacked or +in a layer. This makes it difficult to add data labels to stacked or dodged bars or columns, or the labelling of points that have been jittered. The solution provided by 'ggpp' are wrappers on these position functions from 'ggplot2'. These wrappers add support for nudging. @@ -333,10 +333,10 @@ There is a storage-use cost in saving the original position, by making the consideration when `data` has many rows. In such cases, when a counterpart position function that does not keep the original coordinates exists, it is wise not to use the new "keep" position functions in combination with geometries that -cannot make use of the additional information stored by them. When using those -new position functions with no counterpart in 'ggplot2' the keeping of the -original position can be disabled by passing `kept.position = "none"` when they -are called. +cannot make use of the additional information stored by them. Alternatively, and +when using those new position functions with no counterpart in 'ggplot2' the +keeping of the original position can be disabled by passing `kept.position = +"none"` as an additional argument when they are called. ## Local density of observations @@ -1894,6 +1894,36 @@ Here we nudge the labels down from the top of each stacked bar with `vjust = 1`. ``` +### position_stack_minmax() + +Functions `position_stack()` and `position_stack_nudge()` displace the position +of a variable mapped to only one of `y`, `ymax` or `ymin`. So they cannot +be used with geometries `geom_linerange()`, `geom_pointrange()` or +`geom_errorbar()`. `position_stack_minmax()` can be used with these geometries +as it displaces `y`, `ymin` and `ymax` together by the same distance. Like +`position_stack_nudge()` it also supports nudging. Thus, this new position +functions makes it possible to add error bars to each member of stacked +colums, the corresponding error bar. As nudging is also supported, it is +possible as shown below, to also an additional error bar for the total quantity +represented by the stacked bars. + +```{r} +ggplot(birch_dw.df, + aes(y = dry.weight * 1e-3, x = Density, fill = Part)) + + stat_summary(geom = "col", fun = mean, + position = "stack", alpha = 0.7, width = 0.67) + + # error bars for each stack bar + stat_summary(geom = "linerange", fun.data = mean_cl_normal, + position = position_stack_minmax(x = -0.1)) + + # error bar for the total + stat_summary(data = birch.df, aes(y = (dwstem + dwroot) * 1e-3, fill = NULL), + geom = "linerange", linewidth = 0.75, + position = position_nudge(x = 0.1), fun.data = mean_cl_normal) + + labs(y = "Seedling dry mass (g)") + + scale_fill_grey(start = 0.7, end = 0.3) + + facet_wrap(facets = vars(Container)) +``` + ### position_jitternudge() When combining jitter and nudge, we can nudge away from the jittered positions diff --git a/vignettes/grammar-extensions.html b/vignettes/grammar-extensions.html index 083745c..3213d37 100644 --- a/vignettes/grammar-extensions.html +++ b/vignettes/grammar-extensions.html @@ -12,7 +12,7 @@ - + Extensions to the Grammar of Graphics @@ -339,9 +339,9 @@

Extensions to the Grammar of Graphics

-

Package ‘ggpp’ 0.5.4.9010

+

Package ‘ggpp’ 0.5.5

Pedro J. Aphalo

-

2023-11-05

+

2023-11-08

@@ -411,6 +411,7 @@

2023-11-05

  • position_dodgenudge()
  • position_stacknudge()
  • position_fillnudge()
    • +
  • position_stack_minmax()
  • position_jitternudge()
  • position_jitter_keep()
    • @@ -708,7 +709,7 @@

    Positioning data labels

    respect to a polynomial or smoothing spline fitted on-the-fly to the the observations.

    A limitation of ‘ggplot2’ is that only one position function can be -used in a layer. This makes it difficult to add text labels to stacked +used in a layer. This makes it difficult to add data labels to stacked or dodged bars or columns, or the labelling of points that have been jittered. The solution provided by ‘ggpp’ are wrappers on these position functions from ‘ggplot2’. These wrappers add support for nudging.

    @@ -810,10 +811,11 @@

    Positioning data labels

    many rows. In such cases, when a counterpart position function that does not keep the original coordinates exists, it is wise not to use the new “keep” position functions in combination with geometries that cannot -make use of the additional information stored by them. When using those -new position functions with no counterpart in ‘ggplot2’ the keeping of -the original position can be disabled by passing -kept.position = "none" when they are called.

    +make use of the additional information stored by them. Alternatively, +and when using those new position functions with no counterpart in +‘ggplot2’ the keeping of the original position can be disabled by +passing kept.position = "none" as an additional argument +when they are called.

    Local density of observations

    @@ -2204,6 +2206,37 @@

    position_fillnudge()

    theme(legend.position = "none")

    +
    +

    position_stack_minmax()

    +

    Functions position_stack() and +position_stack_nudge() displace the position of a variable +mapped to only one of y, ymax or +ymin. So they cannot be used with geometries +geom_linerange(), geom_pointrange() or +geom_errorbar(). position_stack_minmax() can +be used with these geometries as it displaces y, +ymin and ymax together by the same distance. +Like position_stack_nudge() it also supports nudging. Thus, +this new position functions makes it possible to add error bars to each +member of stacked colums, the corresponding error bar. As nudging is +also supported, it is possible as shown below, to also an additional +error bar for the total quantity represented by the stacked bars.

    +
    ggplot(birch_dw.df,
+       aes(y = dry.weight * 1e-3, x = Density, fill = Part)) +
+  stat_summary(geom = "col", fun = mean,
+               position = "stack", alpha = 0.7, width = 0.67) +
+  # error bars for each stack bar
+  stat_summary(geom = "linerange", fun.data = mean_cl_normal,
+               position = position_stack_minmax(x = -0.1)) +
+  # error bar for the total
+  stat_summary(data = birch.df, aes(y = (dwstem + dwroot) * 1e-3, fill = NULL),
+               geom = "linerange", linewidth = 0.75,
+               position = position_nudge(x = 0.1), fun.data = mean_cl_normal) +
+  labs(y = "Seedling dry mass (g)") +
+  scale_fill_grey(start = 0.7, end = 0.3) +
+  facet_wrap(facets = vars(Container))
    +

    +

    position_jitternudge()

    When combining jitter and nudge, we can nudge away from the jittered @@ -2212,42 +2245,42 @@

    position_jitternudge()

    nad the direction of the nudge is on either side of the original position with direction = "split", with nudging depending on the direction the jitter has moved the point.

    -
     jitter <- position_jitter(width = 0.2, height = 2, seed = 123)
-
- jitter_nudge <- position_jitternudge(width = 0.2, height = 2,
-                                      seed = 123, x = 0.1,
-                                      direction = "split",
-                                      nudge.from = "jittered")
- ggplot(mpg[1:20, ],
-        aes(cyl, hwy, label = drv)) +
-   geom_point(position = jitter) +
-   geom_text_s(position = jitter_nudge)
    -

    -

    In this second example, the nudging is away from the original -x-position and the jittered y-position, which gives -vertically aligned labels.

    -
    jitter <- position_jitter(width = 0.2, height = 2, seed = 123)
+
     jitter <- position_jitter(width = 0.2, height = 2, seed = 123)
 
-jitter_nudge <- position_jitternudge(width = 0.2, height = 2,
-                                      seed = 123, x = 0.35,
+ jitter_nudge <- position_jitternudge(width = 0.2, height = 2,
+                                      seed = 123, x = 0.1,
                                       direction = "split",
-                                      nudge.from = "original.x")
+                                      nudge.from = "jittered")
  ggplot(mpg[1:20, ],
         aes(cyl, hwy, label = drv)) +
    geom_point(position = jitter) +
    geom_text_s(position = jitter_nudge)
    
+
    
+
    In this second example, the nudging is away from the original
+x-position and the jittered y-position, which gives
+vertically aligned labels.
    
+
    jitter <- position_jitter(width = 0.2, height = 2, seed = 123)
+
+jitter_nudge <- position_jitternudge(width = 0.2, height = 2,
+                                      seed = 123, x = 0.35,
+                                      direction = "split",
+                                      nudge.from = "original.x")
+ ggplot(mpg[1:20, ],
+        aes(cyl, hwy, label = drv)) +
+   geom_point(position = jitter) +
+   geom_text_s(position = jitter_nudge)

    position_jitter_keep()

    With no nudging but keeping the original positions we show how points have moved with jitter.

    -
     ggplot(mpg[1:20, ],
-        aes(cyl, hwy, label = drv)) +
-   geom_point() +
-   geom_point_s(position =
-                position_jitter_keep(width = 0.3, height = 2, seed = 123),
-                color = "red")
    +
     ggplot(mpg[1:20, ],
+        aes(cyl, hwy, label = drv)) +
+   geom_point() +
+   geom_point_s(position =
+                position_jitter_keep(width = 0.3, height = 2, seed = 123),
+                color = "red")

    @@ -2255,52 +2288,52 @@

    position_jitter_keep()

    Appendix A: More on density filtering

    We define a function to simplify the generation of random data sets based on different probability distributions.

    -
    make_data_tbl <- function(nrow = 100, rfun = rnorm, ...) {
-  if (nrow %% 2) {
-    nrow <- nrow + 1
-  }
-  
-  set.seed(1001)
-  
-  tibble::tibble(
-    x = rfun(nrow, ...),
-    y = rfun(nrow, ...),
-    group = rep(c("A", "B"), c(nrow / 2, nrow / 2))
-  )
-}
    +
    make_data_tbl <- function(nrow = 100, rfun = rnorm, ...) {
+  if (nrow %% 2) {
+    nrow <- nrow + 1
+  }
+  
+  set.seed(1001)
+  
+  tibble::tibble(
+    x = rfun(nrow, ...),
+    y = rfun(nrow, ...),
+    group = rep(c("A", "B"), c(nrow / 2, nrow / 2))
+  )
+}

    In all the examples in this vignette we use colors to demonstrate which data points are selected, but any other suitable aesthetic and discrete scale can be used instead. With keep.sparse = FALSE we keep 1/3 of the observations in the denser region of the plot. Although here we first plot all data points and later overplot the selected ones this is not necessary.

    -
    ggplot(data = make_data_tbl(300), aes(x, y)) +
-  geom_point() +
-  stat_dens2d_filter(colour = "red", 
-                     keep.sparse = FALSE, 
-                     keep.fraction = 1/3)
    -

    -

    Here we highlight the observations split in three group equal groups, -each of a different density of observations.

    ggplot(data = make_data_tbl(300), aes(x, y)) +
   geom_point() +
   stat_dens2d_filter(colour = "red", 
                      keep.sparse = FALSE, 
-                     keep.fraction = 1/3)+
-  stat_dens2d_filter(colour = "blue", 
-                     keep.fraction = 1/3)
    + keep.fraction = 1/3)     +

    +

    Here we highlight the observations split in three group equal groups, +each of a different density of observations.

    +
    ggplot(data = make_data_tbl(300), aes(x, y)) +
+  geom_point() +
+  stat_dens2d_filter(colour = "red", 
+                     keep.sparse = FALSE, 
+                     keep.fraction = 1/3)+
+  stat_dens2d_filter(colour = "blue", 
+                     keep.fraction = 1/3)

    The algorithm seems to work well also with other distributions, in this example the uniform distribution.

    -
    ggplot(data = make_data_tbl(300, rfun = runif), aes(x, y)) +
-  geom_point() +
-  stat_dens2d_filter(colour = "red", keep.fraction = 1/2)
    +
    ggplot(data = make_data_tbl(300, rfun = runif), aes(x, y)) +
+  geom_point() +
+  stat_dens2d_filter(colour = "red", keep.fraction = 1/2)

    One example with the gamma distribution, which is asymmetric.

    -
    ggplot(data = make_data_tbl(300, rfun = rgamma, shape = 2), 
-       aes(x, y)) +
-  geom_point() +
-  stat_dens2d_filter(colour = "red", keep.fraction = 1/3)
    +
    ggplot(data = make_data_tbl(300, rfun = rgamma, shape = 2), 
+       aes(x, y)) +
+  geom_point() +
+  stat_dens2d_filter(colour = "red", keep.fraction = 1/3)

    @@ -2311,12 +2344,12 @@

    Time series

    Here we use in the examples objects of class ts but several other classes are supported as try.xts() is used internally. The first example is a quarterly series.

    -
    class(austres)
    +
    class(austres)
    ## [1] "ts"
    -
    austres.df <- try_tibble(austres)
-class(austres.df)
    +
    austres.df <- try_tibble(austres)
+class(austres.df)
    ## [1] "tbl_df"     "tbl"        "data.frame"
    -
    head(austres.df, 4)
    +
    head(austres.df, 4)
    ## # A tibble: 4 × 2
 ##   time            x
 ##   <date>      <dbl>
@@ -2326,8 +2359,8 @@ 
    Time series
    
 ## 4 1972-01-01 13254.

    The next chunk demonstrates that numeric times are expressed as decimal years in the returned data frame.

    -
    austres.df <- try_tibble(austres, as.numeric = TRUE)
-head(austres.df, 4)
    +
    austres.df <- try_tibble(austres, as.numeric = TRUE)
+head(austres.df, 4)
    ## # A tibble: 4 × 2
 ##    time      x
 ##   <dbl>  <dbl>
@@ -2336,12 +2369,12 @@ 
    Time series
    
 ## 3 1972. 13198.
 ## 4 1972  13254.

    This second example is for a series of yearly values.

    -
    class(lynx)
    +
    class(lynx)
    ## [1] "ts"
    -
    lynx.df <- try_tibble(lynx)
-class(lynx.df)
    +
    lynx.df <- try_tibble(lynx)
+class(lynx.df)
    ## [1] "tbl_df"     "tbl"        "data.frame"
    -
    head(lynx.df, 3)
    +
    head(lynx.df, 3)
    ## # A tibble: 3 × 2
 ##   time           x
 ##   <date>     <dbl>
@@ -2350,8 +2383,8 @@ 
    Time series
    
 ## 3 1823-01-01   585

    Above there is a small rounding error of 1 s for these old dates. We can correct this by rounding to year.

    -
    lynx.df <- try_tibble(lynx, "year")
-head(lynx.df, 3)
    +
    lynx.df <- try_tibble(lynx, "year")
+head(lynx.df, 3)
    ## # A tibble: 3 × 2
 ##   time           x
 ##   <date>     <dbl>
@@ -2360,14 +2393,14 @@ 
    Time series
    
 ## 3 1823-01-01   585

    In addition we can convert the POSIXct values into numeric values in calendar years plus a decimal fraction.

    -
    lynx_n.df <- try_tibble(lynx, "year", as.numeric = TRUE)
-lapply(lynx_n.df, "class")
    +
    lynx_n.df <- try_tibble(lynx, "year", as.numeric = TRUE)
+lapply(lynx_n.df, "class")
    ## $time
 ## [1] "numeric"
 ## 
 ## $x
 ## [1] "numeric"
    -
    head(lynx_n.df, 3)
    +
    head(lynx_n.df, 3)
    ## # A tibble: 3 × 2
 ##    time     x
 ##   <dbl> <dbl>
@@ -2379,7 +2412,7 @@ 
    Time series
    
 
    Other classes
    
 
    try_tibble() attempts to handle gracefully objects that
 are not time series.
    
-
    try_tibble(1:5)
    
+
    try_tibble(1:5)
    
 
    ## # A tibble: 5 × 1
 ##       x
 ##   <int>
@@ -2388,7 +2421,7 @@ 
    Other classes
    
 ## 3     3
 ## 4     4
 ## 5     5
    
-
    try_tibble(letters[1:5])
    
+
    try_tibble(letters[1:5])
    
 
    ## # A tibble: 5 × 1
 ##   x    
 ##   <chr>
@@ -2397,7 +2430,7 @@ 
    Other classes
    
 ## 3 c    
 ## 4 d    
 ## 5 e
    
-
    try_tibble(factor(letters[1:5]))
    
+
    try_tibble(factor(letters[1:5]))
    
 
    ## # A tibble: 5 × 1
 ##   x    
 ##   <fct>
@@ -2406,7 +2439,7 @@ 
    Other classes
    
 ## 3 c    
 ## 4 d    
 ## 5 e
    
-
    try_tibble(list(x = rep(1,5), y = 1:5))
    
+
    try_tibble(list(x = rep(1,5), y = 1:5))
    
 
    ## # A tibble: 5 × 2
 ##       x     y
 ##   <dbl> <int>
@@ -2415,7 +2448,7 @@ 
    Other classes
    
 ## 3     1     3
 ## 4     1     4
 ## 5     1     5
    
-
    try_tibble(data.frame(x = rep(1,5), y = 1:5))
    
+
    try_tibble(data.frame(x = rep(1,5), y = 1:5))
    
 
    ## # A tibble: 5 × 2
 ##       x     y
 ##   <dbl> <int>
@@ -2424,7 +2457,7 @@ 
    Other classes
    
 ## 3     1     3
 ## 4     1     4
 ## 5     1     5
    
-
    try_tibble(matrix(1:10, ncol = 2))
    
+
    try_tibble(matrix(1:10, ncol = 2))
    
 
    ## # A tibble: 5 × 2
 ##      V1    V2
 ##   <int> <int>