diff --git a/DESCRIPTION b/DESCRIPTION index 21fc2e97..744fc7e2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,7 @@ Language: en-US Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.2 Imports: cli, dplyr, diff --git a/NAMESPACE b/NAMESPACE index ab10489e..896243be 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -30,6 +30,7 @@ S3method(key,cubble_df) S3method(key_data,cubble_df) S3method(key_vars,cubble_df) S3method(mutate,spatial_cubble_df) +S3method(mutate,temporal_cubble_df) S3method(print,cubble_df) S3method(rename,spatial_cubble_df) S3method(rename,temporal_cubble_df) diff --git a/R/dplyr.R b/R/dplyr.R index 6e6e3de2..a163181a 100644 --- a/R/dplyr.R +++ b/R/dplyr.R @@ -43,11 +43,11 @@ #' cb_long |> arrange(prcp) #' #' # summarise - summarise.spatial_cubble_df, summarise.temporal_cubble_df -#' cb_long |> -#' group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> +#' cb_long |> +#' group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> #' summarise(tmax = mean(tmax)) -#' cb_long |> -#' mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> +#' cb_long |> +#' mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> #' summarise(t = mean(tmax), .by = first_5) #' #' # select - select.spatial_cubble_df, select.temporal_cubble_df @@ -99,11 +99,10 @@ #' # group_by & ungroup - #' (res <- cb_nested |> mutate(group1 = c(1, 1, 2)) |> group_by(group1)) #' res |> ungroup() -#' (res2 <- res |> face_temporal() |> unfold(group1) |> group_by(group1)) +#' (res2 <- res |> face_temporal()) #' res2 |> ungroup() -#' res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> -#' group_by(first_5) |> -#' ungroup(group1) +#' res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> +#' group_by(first_5) arrange.temporal_cubble_df <- function(.data, ...){ out <- NextMethod() dplyr_reconstruct(out, .data) @@ -427,6 +426,15 @@ mutate.spatial_cubble_df <- function(.data, ...){ dplyr_reconstruct(res, data) } +#' @export +#' @rdname dplyr +mutate.temporal_cubble_df <- function(.data, ...){ + data <- .data + class(.data) <- setdiff(class(.data), cb_temporal_cls) + res <- NextMethod() + dplyr_reconstruct(res, data) +} + #' @export #' @rdname dplyr diff --git a/man/cubble-package.Rd b/man/cubble-package.Rd index 2e12fbe0..28a10b6e 100644 --- a/man/cubble-package.Rd +++ b/man/cubble-package.Rd @@ -3,7 +3,6 @@ \docType{package} \name{cubble-package} \alias{cubble-package} -\alias{_PACKAGE} \title{cubble: A Vector Spatio-Temporal Data Structure for Data Analysis} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} @@ -20,14 +19,14 @@ Useful links: } \author{ -\strong{Maintainer}: H. Sherry Zhang \email{huize.zhang@monash.edu} (\href{https://orcid.org/0000-0002-7122-1463}{ORCID}) +\strong{Maintainer}: H. Sherry Zhang \email{huizezhangsh@gmail.com} (\href{https://orcid.org/0000-0002-7122-1463}{ORCID}) Authors: \itemize{ \item Dianne Cook \email{dicook@monash.edu} (\href{https://orcid.org/0000-0002-3813-7155}{ORCID}) \item Ursula Laa \email{ursula.laa@boku.ac.at} (\href{https://orcid.org/0000-0002-0249-6439}{ORCID}) \item Nicolas Langrené \email{nicolas.langrene@csiro.au} (\href{https://orcid.org/0000-0001-7601-4618}{ORCID}) - \item Patricia Menéndez \email{patricia.menendez@monash.edu} (\href{https://orcid.org/0000-0003-0701-6315}{ORCID}) + \item Patricia Menéndez \email{patricia.menendez@unimelb.edu.au} (\href{https://orcid.org/0000-0003-0701-6315}{ORCID}) } } diff --git a/man/dplyr.Rd b/man/dplyr.Rd index 8a124dbb..a49c4f71 100644 --- a/man/dplyr.Rd +++ b/man/dplyr.Rd @@ -23,6 +23,7 @@ \alias{dplyr_reconstruct.spatial_cubble_df} \alias{dplyr_reconstruct.temporal_cubble_df} \alias{mutate.spatial_cubble_df} +\alias{mutate.temporal_cubble_df} \alias{filter.spatial_cubble_df} \alias{arrange.spatial_cubble_df} \title{\code{dplyr} methods} @@ -71,6 +72,8 @@ bind_cols.temporal_cubble_df(..., .name_repair) \method{mutate}{spatial_cubble_df}(.data, ...) +\method{mutate}{temporal_cubble_df}(.data, ...) + \method{filter}{spatial_cubble_df}(.data, ...) \method{arrange}{spatial_cubble_df}(.data, ...) @@ -177,11 +180,11 @@ cb_nested |> arrange(wmo_id) cb_long |> arrange(prcp) # summarise - summarise.spatial_cubble_df, summarise.temporal_cubble_df -cb_long |> - group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> +cb_long |> + group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> summarise(tmax = mean(tmax)) -cb_long |> - mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> +cb_long |> + mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> summarise(t = mean(tmax), .by = first_5) # select - select.spatial_cubble_df, select.temporal_cubble_df @@ -233,9 +236,8 @@ cb_long |> rowwise() # group_by & ungroup - (res <- cb_nested |> mutate(group1 = c(1, 1, 2)) |> group_by(group1)) res |> ungroup() -(res2 <- res |> face_temporal() |> unfold(group1) |> group_by(group1)) +(res2 <- res |> face_temporal()) res2 |> ungroup() -res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> - group_by(first_5) |> - ungroup(group1) +res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> + group_by(first_5) } diff --git a/man/glyph.Rd b/man/glyph.Rd index 0dd2eec9..24d4a534 100644 --- a/man/glyph.Rd +++ b/man/glyph.Rd @@ -81,20 +81,59 @@ the plot data. The return value must be a \code{data.frame}, and will be used as the layer data. A \code{function} can be created from a \code{formula} (e.g. \code{~ head(.x, 10)}).} -\item{stat}{The statistical transformation to use on the data for this -layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the -stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than -\code{"stat_count"})} - -\item{position}{Position adjustment, either as a string naming the adjustment -(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a -position adjustment function. Use the latter if you need to change the -settings of the adjustment.} - -\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}. These are -often aesthetics, used to set an aesthetic to a fixed value, like -\code{colour = "red"} or \code{size = 3}. They may also be parameters -to the paired geom/stat.} +\item{stat}{The statistical transformation to use on the data for this layer. +When using a \verb{geom_*()} function to construct a layer, the \code{stat} +argument can be used the override the default coupling between geoms and +stats. The \code{stat} argument accepts the following: +\itemize{ +\item A \code{Stat} ggproto subclass, for example \code{StatCount}. +\item A string naming the stat. To give the stat as a string, strip the +function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, +give the stat as \code{"count"}. +\item For more information and other ways to specify the stat, see the +\link[ggplot2:layer_stats]{layer stat} documentation. +}} + +\item{position}{A position adjustment to use on the data for this layer. This +can be used in various ways, including to prevent overplotting and +improving the display. The \code{position} argument accepts the following: +\itemize{ +\item The result of calling a position function, such as \code{position_jitter()}. +This method allows for passing extra arguments to the position. +\item A string naming the position adjustment. To give the position as a +string, strip the function name of the \code{position_} prefix. For example, +to use \code{position_jitter()}, give the position as \code{"jitter"}. +\item For more information and other ways to specify the position, see the +\link[ggplot2:layer_positions]{layer position} documentation. +}} + +\item{...}{Other arguments passed on to \code{\link[ggplot2:layer]{layer()}}'s \code{params} argument. These +arguments broadly fall into one of 4 categories below. Notably, further +arguments to the \code{position} argument, or aesthetics that are required +can \emph{not} be passed through \code{...}. Unknown arguments that are not part +of the 4 categories below are ignored. +\itemize{ +\item Static aesthetics that are not mapped to a scale, but are at a fixed +value and apply to the layer as a whole. For example, \code{colour = "red"} +or \code{linewidth = 3}. The geom's documentation has an \strong{Aesthetics} +section that lists the available options. The 'required' aesthetics +cannot be passed on to the \code{params}. Please note that while passing +unmapped aesthetics as vectors is technically possible, the order and +required length is not guaranteed to be parallel to the input data. +\item When constructing a layer using +a \verb{stat_*()} function, the \code{...} argument can be used to pass on +parameters to the \code{geom} part of the layer. An example of this is +\code{stat_density(geom = "area", outline.type = "both")}. The geom's +documentation lists which parameters it can accept. +\item Inversely, when constructing a layer using a +\verb{geom_*()} function, the \code{...} argument can be used to pass on parameters +to the \code{stat} part of the layer. An example of this is +\code{geom_area(stat = "density", adjust = 0.5)}. The stat's documentation +lists which parameters it can accept. +\item The \code{key_glyph} argument of \code{\link[ggplot2:layer]{layer()}} may also be passed on through +\code{...}. This can be one of the functions described as +\link[ggplot2:draw_key]{key glyphs}, to change the display of the layer in the legend. +}} \item{x_major, x_minor, y_major, y_minor}{The name of the variable (as a string) for the major and minor x and y axes. Together, each unique diff --git a/tests/testthat/_snaps/dplyr.md b/tests/testthat/_snaps/dplyr.md index ba6896f7..f0ea331f 100644 --- a/tests/testthat/_snaps/dplyr.md +++ b/tests/testthat/_snaps/dplyr.md @@ -606,24 +606,26 @@ --- Code - (res2 <- group_by(unfold(face_temporal(res), group1), group1)) + (res2 <- face_temporal(res)) + Message + Adding missing grouping variables: `group1` Output # cubble: key: id [3], index: date, long form, groups: group1 [2] # temporal: 2020-01-01 -- 2020-01-10 [1D], no gaps # spatial: long [dbl], lat [dbl], elev [dbl], name [chr], wmo_id [dbl], group1 # [dbl] - id date prcp tmax tmin group1 - - 1 ASN00086038 2020-01-01 0 26.8 11 1 - 2 ASN00086038 2020-01-02 0 26.3 12.2 1 - 3 ASN00086038 2020-01-03 0 34.5 12.7 1 - 4 ASN00086038 2020-01-04 0 29.3 18.8 1 - 5 ASN00086038 2020-01-05 18 16.1 12.5 1 - 6 ASN00086038 2020-01-06 104 17.5 11.1 1 - 7 ASN00086038 2020-01-07 14 20.7 12.1 1 - 8 ASN00086038 2020-01-08 0 26.4 16.4 1 - 9 ASN00086038 2020-01-09 0 33.1 17.4 1 - 10 ASN00086038 2020-01-10 0 34 19.6 1 + group1 id date prcp tmax tmin + + 1 1 ASN00086038 2020-01-01 0 26.8 11 + 2 1 ASN00086038 2020-01-02 0 26.3 12.2 + 3 1 ASN00086038 2020-01-03 0 34.5 12.7 + 4 1 ASN00086038 2020-01-04 0 29.3 18.8 + 5 1 ASN00086038 2020-01-05 18 16.1 12.5 + 6 1 ASN00086038 2020-01-06 104 17.5 11.1 + 7 1 ASN00086038 2020-01-07 14 20.7 12.1 + 8 1 ASN00086038 2020-01-08 0 26.4 16.4 + 9 1 ASN00086038 2020-01-09 0 33.1 17.4 + 10 1 ASN00086038 2020-01-10 0 34 19.6 # i 20 more rows --- @@ -635,17 +637,17 @@ # temporal: 2020-01-01 -- 2020-01-10 [1D], no gaps # spatial: long [dbl], lat [dbl], elev [dbl], name [chr], wmo_id [dbl], group1 # [dbl] - id date prcp tmax tmin group1 - - 1 ASN00086038 2020-01-01 0 26.8 11 1 - 2 ASN00086038 2020-01-02 0 26.3 12.2 1 - 3 ASN00086038 2020-01-03 0 34.5 12.7 1 - 4 ASN00086038 2020-01-04 0 29.3 18.8 1 - 5 ASN00086038 2020-01-05 18 16.1 12.5 1 - 6 ASN00086038 2020-01-06 104 17.5 11.1 1 - 7 ASN00086038 2020-01-07 14 20.7 12.1 1 - 8 ASN00086038 2020-01-08 0 26.4 16.4 1 - 9 ASN00086038 2020-01-09 0 33.1 17.4 1 - 10 ASN00086038 2020-01-10 0 34 19.6 1 + group1 id date prcp tmax tmin + + 1 1 ASN00086038 2020-01-01 0 26.8 11 + 2 1 ASN00086038 2020-01-02 0 26.3 12.2 + 3 1 ASN00086038 2020-01-03 0 34.5 12.7 + 4 1 ASN00086038 2020-01-04 0 29.3 18.8 + 5 1 ASN00086038 2020-01-05 18 16.1 12.5 + 6 1 ASN00086038 2020-01-06 104 17.5 11.1 + 7 1 ASN00086038 2020-01-07 14 20.7 12.1 + 8 1 ASN00086038 2020-01-08 0 26.4 16.4 + 9 1 ASN00086038 2020-01-09 0 33.1 17.4 + 10 1 ASN00086038 2020-01-10 0 34 19.6 # i 20 more rows diff --git a/tests/testthat/_snaps/sf.md b/tests/testthat/_snaps/sf.md index 85b6a6af..9239d9ef 100644 --- a/tests/testthat/_snaps/sf.md +++ b/tests/testthat/_snaps/sf.md @@ -14,3 +14,19 @@ 2 ASN00086077 145. -38.0 12.1 moora~ 94870 (145.0964 -37.98) 3 ASN00086282 145. -37.7 113. melbo~ 94866 (144.8321 -37.6655) +--- + + Code + make_spatial_sf(rename(climate_mel, x = long, y = lat)) + Message + CRS missing: using OGC:CRS84 (WGS84) as default + Output + # cubble: key: id [3], index: date, nested form, [sf] + # spatial: [144.8321, -37.98, 145.0964, -37.6655], WGS 84 + # temporal: date [date], prcp [dbl], tmax [dbl], tmin [dbl] + id x y elev name wmo_id ts geometry + + 1 ASN00086038 145. -37.7 78.4 essen~ 95866 (144.9066 -37.7276) + 2 ASN00086077 145. -38.0 12.1 moora~ 94870 (145.0964 -37.98) + 3 ASN00086282 145. -37.7 113. melbo~ 94866 (144.8321 -37.6655) + diff --git a/tests/testthat/test-dplyr.R b/tests/testthat/test-dplyr.R index 635f678c..c264673f 100644 --- a/tests/testthat/test-dplyr.R +++ b/tests/testthat/test-dplyr.R @@ -17,13 +17,13 @@ test_that("dplyr verbs work", { # summarise - summarise.spatial_cubble_df, summarise.temporal_cubble_df expect_snapshot( - cb_long |> - group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> + cb_long |> + group_by(first_5 = ifelse(lubridate::day(date) <=5, 1, 2 )) |> summarise(tmax = mean(tmax)) ) expect_snapshot( - cb_long |> - mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> + cb_long |> + mutate(first_5 = ifelse(lubridate::day(date) <=5, 1, 2)) |> summarise(t = mean(tmax), .by = first_5) ) @@ -77,9 +77,8 @@ test_that("dplyr verbs work", { # group_by & ungroup - expect_snapshot((res <- cb_nested |> mutate(group1 = c(1, 1, 2)) |> group_by(group1))) expect_snapshot(res |> ungroup()) - expect_snapshot((res2 <- res |> face_temporal() |> unfold(group1) |> group_by(group1))) + expect_snapshot((res2 <- res |> face_temporal())) expect_snapshot(res2 |> ungroup()) - res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> - group_by(first_5) |> - ungroup(group1) + res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> + group_by(first_5) })