convert examples to tests

.github/workflows/test-coverage.yaml

@@ -0,0 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+ push:
+ branches: [main, master]
+ pull_request:
+ branches: [main, master]
+
+name: test-coverage
+
+jobs:
+ test-coverage:
+ runs-on: ubuntu-latest
+ env:
+ GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
+ steps:
+ - uses: actions/checkout@v3
+
+ - uses: r-lib/actions/setup-r@v2
+ with:
+ use-public-rspm: true
+
+ - uses: r-lib/actions/setup-r-dependencies@v2
+ with:
+ extra-packages: any::covr
+ needs: coverage
+
+ - name: Test coverage
+ run: |
+ covr::codecov(
+ quiet = FALSE,
+ clean = FALSE,
+ install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
+ )
+ shell: Rscript {0}
+
+ - name: Show testthat output
+ if: always()
+ run: |
+ ## --------------------------------------------------------------------
+ find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+ shell: bash
+
+ - name: Upload test results
+ if: failure()
+ uses: actions/upload-artifact@v3
+ with:
+ name: coverage-test-failures
+ path: ${{ runner.temp }}/package

R/as_cubble.R → R/as-cubble.R

@@ -42,8 +42,8 @@
 #'}
 #'
 #' # don't have to supply coords if create from a sftime
-#' dt <- climate_flat %>%
-#' sf::st_as_sf(coords = c("long", "lat"), crs = sf::st_crs("OGC:CRS84")) %>%
+#' dt <- climate_flat |>
+#' sf::st_as_sf(coords = c("long", "lat"), crs = sf::st_crs("OGC:CRS84")) |>
 #' sftime::st_as_sftime()
 #' dt |> as_cubble(key = id, index = date)
 as_cubble <- function(data, key, index, coords, ...) {
@@ -80,7 +80,7 @@ as_cubble.tbl_df <- function(data, key, index, coords, ...) {
  if (length(listcol_var) == 0){
  all_vars <- find_invariant(data, !!key)
 
- data <- data %>%
+ data <- data |>
  tidyr::nest(ts = c(!!!all_vars$variant))
 
  } else{
@@ -144,19 +144,19 @@ as_cubble.ncdf4 <- function(data, key, index, coords, vars,
  # define dimension and grid
  dim_order <- c(length(long_raw), length(lat_raw) ,
  length(time_raw), length(var$name))
- latlong_grid <- tidyr::expand_grid(lat = lat_raw, long = long_raw) %>%
+ latlong_grid <- tidyr::expand_grid(lat = lat_raw, long = long_raw) |>
  dplyr::mutate(id = dplyr::row_number())
- mapping <- tidyr::expand_grid(var = var$name, time = time_raw) %>%
+ mapping <- tidyr::expand_grid(var = var$name, time = time_raw) |>
  tidyr::expand_grid(latlong_grid)
 
  # restructure data into flat
- data <- array(unlist(raw_data), dim = dim_order) %>%
- as.data.frame.table() %>%
- as_tibble() %>%
- dplyr::bind_cols(mapping) %>%
+ data <- array(unlist(raw_data), dim = dim_order) |>
+ as.data.frame.table() |>
+ as_tibble() |>
+ dplyr::bind_cols(mapping) |>
  dplyr::select(.data$id, .data$long, .data$lat,
- .data$time, .data$var, .data$Freq) %>%
- dplyr::arrange(.data$id) %>%
+ .data$time, .data$var, .data$Freq) |>
+ dplyr::arrange(.data$id) |>
  tidyr::pivot_wider(names_from = .data$var, values_from = .data$Freq)
 
  key <- "id"
@@ -186,9 +186,9 @@ as_cubble.stars <- function(data, key, index, coords, ...){
  longlat <- names(stars::st_dimensions(data))[1:2]
  time <- names(stars::st_dimensions(data))[3]
 
- as_tibble(data) %>%
+ as_tibble(data) |>
  mutate(id = as.integer(interaction(!!sym(longlat[[1]]),
- !!sym(longlat[[2]])))) %>%
+ !!sym(longlat[[2]])))) |>
  as_cubble(key = id, index = time, coords = longlat)
  }
 }
@@ -235,8 +235,8 @@ as_cubble.sftime <- function(data, key, index, coords, ...){
  coords <- enquo(coords)
 
  # here assume the geometry column in an sftime object is always sfc_POINT
- data <- data %>%
- mutate(long = sf::st_coordinates(.)[,1], lat = sf::st_coordinates(.)[,2])
+ data <- data |>
+ mutate(long = sf::st_coordinates(geometry)[,1], lat = sf::st_coordinates(geometry)[,2])
 
  if (quo_is_missing(coords)){
  coords <- quo(c("long", "lat"))
@@ -246,8 +246,8 @@ as_cubble.sftime <- function(data, key, index, coords, ...){
 
  all_vars <- data |> find_invariant(!!key)
  spatial <- data |> select(all_vars$invariant, -!!index) |> distinct()
- temporal <- as_tibble(data) %>%
- select(!!key, all_vars$variant, !!index) %>%
+ temporal <- as_tibble(data) |>
+ select(!!key, all_vars$variant, !!index) |>
  nest(ts = all_vars$variant)
  out <- spatial |> left_join(temporal, by = as_name(key))
 
@@ -257,7 +257,7 @@ as_cubble.sftime <- function(data, key, index, coords, ...){
 
 }
 
-globalVariables(c(".", "id"))
+globalVariables(c(".", "id", "geometry"))
 
 
 

R/check_key.R → R/check-key.R

@@ -38,7 +38,7 @@ check_key <- function(spatial, temporal, by = NULL) {
  slvl <- spatial[[by]]
  tlvl <- temporal[[by]]
  matched_tbl <-
- tibble::tibble(spatial = intersect(unique(tlvl), slvl)) %>%
+ tibble::tibble(spatial = intersect(unique(tlvl), slvl)) |> 
  mutate(temporal = spatial)
  if (nrow(matched_tbl) == 0) {
  matched_tbl <- tibble::tibble()

R/cubble-class.R

@@ -176,8 +176,8 @@ make_cubble <- function(spatial, temporal, by = NULL, key, index, coords,
  index <- as_name(index)
  }
 
- temporal <- temporal |> filter(!by %in% only_temporal) %>%
- select(as_name(index), setdiff(colnames(temporal), as_name(index)))
+ temporal <- temporal |> filter(!by %in% only_temporal) |>
+ select(dplyr::all_of(c(as_name(index), setdiff(colnames(temporal), as_name(index)))))
  out <- suppressMessages(
  dplyr::inner_join(spatial, temporal |> nest(ts = -by))
  )
@@ -252,7 +252,7 @@ validate_temporal_cubble <- function(data, args){
  }
 
  x <- as_tibble(data)
- dup_index <- split(x, x[[args$key]]) %>%
+ dup_index <- split(x, x[[args$key]]) |>
  map_lgl(~vec_duplicate_any(.x[[args$index]]))
  index_na <- any(is.na(x[[args$index]]))
 

R/data.R

@@ -47,7 +47,7 @@
 #' key = id, index = date, coords = c(long, lat)
 #' )
 #' identical(cb, climate_mel)
-#' cb2 <- climate_flat %>%
+#' cb2 <- climate_flat |> 
 #' as_cubble(key = id, index = date, coords = c(long, lat))
 #' identical(cb, climate_mel)
 "stations"

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
@@ -101,8 +101,8 @@
 #' res |> ungroup()
 #' (res2 <- res |> face_temporal() |> unfold(group1) |> group_by(group1))
 #' res2 |> ungroup()
-#' res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) %>%
-#' group_by(first_5) %>%
+#' res2 |> mutate(first_5 = ifelse(lubridate::day(date) <= 5, 1, 6)) |> 
+#' group_by(first_5) |> 
 #' ungroup(group1)
 arrange.temporal_cubble_df <- function(.data, ...){
  out <- NextMethod()

R/face-spatial-temporal.R

@@ -48,8 +48,8 @@ face_temporal.spatial_cubble_df <- function(data, col){
 
  # unnest the temporal variables
  if (is_tsibble) data$ts <- map(data$ts, tibble::as_tibble)
- out <- as_tibble(data) %>%
- dplyr::select(!!cur_key, !!col) %>%
+ out <- as_tibble(data) |>
+ dplyr::select(!!cur_key, !!col) |>
  tidyr::unnest(c(!!col))
 
  # organise spatial variables into `spatial`
@@ -93,7 +93,7 @@ face_spatial.temporal_cubble_df <- function(data) {
 
  tvars <- colnames(data)[colnames(data) != key_name]
  tvars <- tvars[!tvars %in% colnames(spatial)]
- unfoldd_var <- intersect(names(data), names(spatial)) %>%
+ unfoldd_var <- intersect(names(data), names(spatial)) |>
  setdiff(key_name)
 
  class(data) <- setdiff(class(data), cb_temporal_cls)

R/map-glyph.R → R/glyph.R

@@ -51,7 +51,7 @@
 #'
 #' # apply a re-scaling on Y and use polar coordinate
 #' p <-
-#' GGally::nasa %>%
+#' GGally::nasa |> 
 #' ggplot(aes(x_major = long, x_minor = day,
 #' y_major = lat, y_minor = ozone)) +
 #' geom_glyph_box(fill=NA) +
@@ -262,7 +262,7 @@ glyph_data_setup <- function(data, params){
  if (has_scale(params$x_scale)) {
  x_scale <- get_scale(params$x_scale)
  data <-
- data %>%
+ data |> 
  dplyr::mutate(
  x_minor = x_scale(.data$x_minor)
  )
@@ -271,7 +271,7 @@ glyph_data_setup <- function(data, params){
  if (has_scale(params$y_scale)) {
  y_scale <- get_scale(params$y_scale)
  data <-
- data %>%
+ data |> 
  dplyr::mutate(
  y_minor = y_scale(.data$y_minor)
  )
@@ -283,7 +283,7 @@ glyph_data_setup <- function(data, params){
  data[["x_minor"]] <- as.numeric(data[["x_minor"]])
  }
 
- data <- data %>%
+ data <- data |> 
  dplyr::mutate(
  polar = params$polar,
  width = ifelse(!is.rel(params$width), unclass(params$width),
@@ -299,14 +299,14 @@ glyph_data_setup <- function(data, params){
  theta <- 2 * pi * rescale01(data$x_minor)
  r <- rescale01(data$y_minor)
 
- data <- data %>%
+ data <- data |> 
  dplyr::mutate(x = .data$x_major + .data$width / 2 * r * sin(theta),
- y = .data$y_major + .data$height / 2 * r * cos(theta)) %>%
+ y = .data$y_major + .data$height / 2 * r * cos(theta)) |> 
  dplyr::arrange(.data$x_major, .data$x_minor)
 
  } else {
  if (isTRUE(params$global_rescale)) data <- data |> dplyr::ungroup()
- data <- data %>%
+ data <- data |> 
  dplyr::mutate(
  x = .data$x_major + rescale11(.data$x_minor) * .data$width / 2,
  y = .data$y_major + rescale11(.data$y_minor) * .data$height / 2)
@@ -327,10 +327,10 @@ calc_ref_line <- function(data, params){
  y = .data$y_major + .data$height / 4 * cos(theta)
  )
  } else{
- ref_line <- ref_line %>%
+ ref_line <- ref_line |> 
  dplyr::mutate(group = .data$group,
  x = .data$x_major + .data$width/ 2,
- y = .data$y_major) %>%
+ y = .data$y_major) |> 
  rbind(ref_line |> dplyr::mutate(group = .data$group,
  x = .data$x_major - .data$width / 2,
  y = .data$y_major))
@@ -341,7 +341,7 @@ calc_ref_line <- function(data, params){
 
 
 calc_ref_box <- function(data, params){
- ref_box <- data %>%
+ ref_box <- data |> 
  dplyr::mutate(xmin = .data$x_major - .data$width / 2,
  xmax = .data$x_major + .data$width / 2,
  ymin = .data$y_major - .data$height / 2,