Merge pull request #186 from bcgov/head-method

Head method

.github/workflows/cmd-check.yaml

@@ -18,6 +18,7 @@ jobs:
         config:
         - { os: windows-latest, r: '3.6', args: "'--no-manual'"}
         - { os: macOS-latest, r: '3.6', args: "c('--no-manual', '--test-dontrun')", sf_args: "--with-proj-lib=/usr/local/lib/"}
+        - { os: macOS-latest, r: 'devel', args: "c('--no-manual', '--test-dontrun')", sf_args: "--with-proj-lib=/usr/local/lib/"}
         - { os: ubuntu-16.04, r: '3.4', args: "'--no-manual'"}
         - { os: ubuntu-16.04, r: '3.5', args: "'--no-manual'"}
         - { os: ubuntu-16.04, r: '3.6'}
@@ -27,7 +28,7 @@ jobs:
       CRAN: ${{ matrix.config.cran }}
 
     steps:
-      - uses: actions/checkout@v1
+      - uses: actions/checkout@v2
 
       - uses: r-lib/actions/setup-r@master
         with:
@@ -38,13 +39,6 @@ jobs:
       - uses: r-lib/actions/setup-tinytex@master
         if: contains(matrix.config.args, 'no-manual') == false
 
-      - name: Install texlive-scripts
-        # work around https://github.com/yihui/tinytex/issues/173 to make sure
-        # fonts are installed for building manual
-        if: contains(matrix.config.args, 'no-manual') == false
-        run: |
-          tlmgr install texlive-scripts
-
       - name: Cache R packages
         uses: actions/cache@v1
         with:
@@ -59,13 +53,21 @@ jobs:
 
       - name: Install system dependencies
         if: runner.os == 'Linux'
+        env:
+          RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
         run: |
-          sudo add-apt-repository -y ppa:ubuntugis/ubuntugis-unstable
-          sudo apt-get -y update
-          sudo apt-get -y install libgdal-dev gdal-bin libgeos-dev \
-          libgeos++-dev libproj-dev libudunits2-dev \
-          libcurl4-openssl-dev libssl-dev libprotobuf-dev protobuf-compiler \
-          libprotoc-dev libxml2 libxml2-dev git-core
+          Rscript -e "remotes::install_github('r-hub/sysreqs')"
+          sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
+          sudo -s eval "$sysreqs"
+
+          # install spatial dependencies
+          sudo add-apt-repository ppa:ubuntugis/ubuntugis-unstable
+          sudo apt update
+          sudo apt install \
+            libudunits2-dev \
+            libgdal-dev \
+            libgeos-dev \
+            libproj-dev
 
       - name: Install dependencies
         run: |

NAMESPACE

@@ -17,6 +17,7 @@ S3method(bcdc_tidy_resources,character)
 S3method(bcdc_tidy_resources,default)
 S3method(collect,bcdc_promise)
 S3method(filter,bcdc_promise)
+S3method(head,bcdc_promise)
 S3method(mutate,bcdc_promise)
 S3method(print,bcdc_promise)
 S3method(print,bcdc_query)
@@ -28,6 +29,7 @@ S3method(show_query,bcdc_sf)
 S3method(sql_escape_ident,DummyCQL)
 S3method(sql_escape_string,DummyCQL)
 S3method(sql_translate_env,DummyCQL)
+S3method(tail,bcdc_promise)
 export("%>%")
 export(BBOX)
 export(CONTAINS)
@@ -79,3 +81,5 @@ importFrom(readxl,read_xls)
 importFrom(readxl,read_xlsx)
 importFrom(rlang,":=")
 importFrom(sf,read_sf)
+importFrom(utils,head)
+importFrom(utils,tail)

NEWS.md

@@ -2,6 +2,7 @@
 
 * Geometry predicates can now take a `bbox` object as well as an `sf*` object (#176)
 * Rename `selectable` column from `bcdc_describe_feature` to `sticky` and modify corresponding docs and tests (#180)
+* Add `head` and `tail` methods for `bcdc.promise` objects. Thanks to @hgriesbauer for the suggestion! (#182, #186)
 
 # bcdata 0.1.2
 

R/utils-classes.R

@@ -46,6 +46,12 @@ print.bcdc_promise <- function(x, ...) {
   catch_wfs_error(cc)
 
   number_of_records <- bcdc_number_wfs_records(x$query_list, x$cli)
+
+  if (!is.null(x$query_list$count)) {
+    # head or tail have updated the count
+    number_of_records <- x$query_list$count
+  }
+
   parsed <- bcdc_read_sf(cc$parse("UTF-8"))
   fields <- ncol(parsed) - 1
 
@@ -57,7 +63,7 @@ print.bcdc_promise <- function(x, ...) {
   cat_line(glue::glue("Querying {col_red(name)} record"))
 
   cat_bullet(glue::glue("Using {col_blue('collect()')} on this object will return {col_green(number_of_records)} features ",
-                 "and {col_green(fields)} fields"))
+                        "and {col_green(fields)} fields"))
   cat_bullet("At most six rows of the record are printed here")
   cat_rule()
   print(parsed)
@@ -243,6 +249,32 @@ select.bcdc_promise <- function(.data, ...){
 
 }
 
+#' @importFrom utils head
+#' @export
+head.bcdc_promise <- function(x, n = 6L, ...) {
+  sorting_col <- pagination_sort_col(x$cols_df)
+  x$query_list <- c(
+    x$query_list,
+    count = n,
+    sortBy = sorting_col
+  )
+  x
+}
+
+#' @importFrom utils tail
+#' @export
+tail.bcdc_promise <- function(x, n = 6L, ...) {
+  number_of_records <- bcdc_number_wfs_records(x$query_list, x$cli)
+  sorting_col <- pagination_sort_col(x$cols_df)
+  x$query_list <- c(
+    x$query_list,
+    count = n,
+    sortBy = sorting_col,
+    startIndex = number_of_records - n
+  )
+  x
+}
+
 
 #' Throw an informative error when attempting mutate on a Web Service call
 #'
@@ -266,7 +298,7 @@ mutate.bcdc_promise <- function(.data, ...){
   dots <- rlang::exprs(...)
 
   stop(glue::glue(
-  "You must type collect() before using mutate() on a WFS. \nAfter using collect() add this mutate call::
+    "You must type collect() before using mutate() on a WFS. \nAfter using collect() add this mutate call::
     mutate({dots}) "), call. = FALSE)
 }
 
@@ -300,8 +332,8 @@ collect.bcdc_promise <- function(x, ...){
 
   if (number_of_records < 10000) {
     cc <- tryCatch(cli$post(body = query_list, encode = "form"),
-             error = function(e) {
-               stop("There was an issue processing this request.
+                   error = function(e) {
+                     stop("There was an issue processing this request.
                      Try reducing the size of the object you are trying to retrieve.", call. = FALSE)})
 
     catch_wfs_error(cc)
@@ -348,7 +380,6 @@ collect.bcdc_promise <- function(x, ...){
 
 }
 
-
 #' Show SQL and URL used for Web Service request from B.C. Data Catalogue
 #'
 #' Display Web Service query SQL

tests/testthat/test-get-data.R

@@ -42,7 +42,7 @@ test_that("bcdc_get_data works with slug and full url with corresponding resourc
 test_that("bcdc_get_data works with a non-wms record with only one resource",{
   skip_if_net_down()
   skip_on_cran()
-  name <- "criminal-code-traffic-offences"
+  name <- "ee9d4ee0-6a34-4dff-89e0-9add9a969168" # "criminal-code-traffic-offences"
   expect_is(bcdc_get_data(name), "tbl")
 })
 

tests/testthat/test-query-geodata-head-tail.R

@@ -0,0 +1,43 @@
+context("head and tail methods")
+library(dplyr)
+
+record <- "76b1b7a3-2112-4444-857a-afccf7b20da8"
+resource <- "4d0377d9-e8a1-429b-824f-0ce8f363512c"
+
+test_that("head works", {
+  skip_if_net_down()
+  skip_on_cran()
+  promise <- bcdc_query_geodata(record) %>%
+    head()
+  expect_is(promise, "bcdc_promise")
+  collected <- collect(promise)
+  expect_equal(nrow(collected), 6L)
+  d2 <- bcdc_query_geodata(record) %>%
+                 head(n = 3) %>%
+      collect()
+  expect_equal(nrow(d2), 3L)
+  col <- pagination_sort_col(bcdc_describe_feature(record))
+  expect_equal(
+    d2[[col]],
+    head(arrange(bcdc_get_data(record, resource = resource), .data[[col]]), 3L)[[col]]
+  )
+})
+
+test_that("tail works", {
+  skip_if_net_down()
+  skip_on_cran()
+  promise <- bcdc_query_geodata(record) %>%
+    tail()
+  expect_is(promise, "bcdc_promise")
+  collected <- collect(promise)
+  expect_equal(nrow(collected), 6L)
+  d2 <- bcdc_query_geodata(record) %>%
+    tail(n = 3) %>%
+    collect()
+  expect_equal(nrow(d2), 3L)
+  col <- pagination_sort_col(bcdc_describe_feature(record))
+  expect_equal(
+    d2[[col]],
+    tail(arrange(bcdc_get_data(record, resource = resource), .data[[col]]), 3L)[[col]]
+  )
+})