From 1f90bac9f2536632b25d576d13548d7f4cd58a30 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 16 Apr 2020 11:01:55 -0700 Subject: [PATCH 1/6] Update actions - add r-devel - use checkout@v2 - drop texlive workaround - use sysreqs as much as possible --- .github/workflows/cmd-check.yaml | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/.github/workflows/cmd-check.yaml b/.github/workflows/cmd-check.yaml index 38a03d2c..d8627426 100644 --- a/.github/workflows/cmd-check.yaml +++ b/.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: | From 1187c037ad91627605a534a7791be57fa877105b Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 23 Apr 2020 10:55:54 -0700 Subject: [PATCH 2/6] head method, tests --- NAMESPACE | 2 ++ R/utils-classes.R | 8 +++++++- tests/testthat/test-get-data.R | 2 +- tests/testthat/test-query-geodata-head-tail.R | 15 +++++++++++++++ 4 files changed, 25 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-query-geodata-head-tail.R diff --git a/NAMESPACE b/NAMESPACE index 26cefa64..06abad13 100644 --- a/NAMESPACE +++ b/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) @@ -79,3 +80,4 @@ importFrom(readxl,read_xls) importFrom(readxl,read_xlsx) importFrom(rlang,":=") importFrom(sf,read_sf) +importFrom(utils,head) diff --git a/R/utils-classes.R b/R/utils-classes.R index 9b550328..45bfc893 100644 --- a/R/utils-classes.R +++ b/R/utils-classes.R @@ -243,6 +243,13 @@ select.bcdc_promise <- function(.data, ...){ } +#' @importFrom utils head +#' @export +head.bcdc_promise <- function(x, n = 6L, ...) { + x$query_list <- c(x$query_list, COUNT = n) + x +} + #' Throw an informative error when attempting mutate on a Web Service call #' @@ -348,7 +355,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 diff --git a/tests/testthat/test-get-data.R b/tests/testthat/test-get-data.R index bada4859..018a27ad 100644 --- a/tests/testthat/test-get-data.R +++ b/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") }) diff --git a/tests/testthat/test-query-geodata-head-tail.R b/tests/testthat/test-query-geodata-head-tail.R new file mode 100644 index 00000000..df76d821 --- /dev/null +++ b/tests/testthat/test-query-geodata-head-tail.R @@ -0,0 +1,15 @@ +context("head and tail methods") + +record <- "76b1b7a3-2112-4444-857a-afccf7b20da8" + +test_that("head works", { + 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 = 1) %>% + collect() + expect_equal(nrow(d2), 1L) +}) From 31373b8f7f32fa4c940bdc9162a6b50a197efcb8 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 23 Apr 2020 12:31:03 -0700 Subject: [PATCH 3/6] add tail method, use sort for head and tail, add tests --- NAMESPACE | 2 ++ R/utils-classes.R | 29 ++++++++++++++--- tests/testthat/test-query-geodata-head-tail.R | 32 +++++++++++++++++-- 3 files changed, 56 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 06abad13..d4c67e8a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,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) @@ -81,3 +82,4 @@ importFrom(readxl,read_xlsx) importFrom(rlang,":=") importFrom(sf,read_sf) importFrom(utils,head) +importFrom(utils,tail) diff --git a/R/utils-classes.R b/R/utils-classes.R index 45bfc893..5faa0251 100644 --- a/R/utils-classes.R +++ b/R/utils-classes.R @@ -57,7 +57,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) @@ -246,7 +246,26 @@ select.bcdc_promise <- function(.data, ...){ #' @importFrom utils head #' @export head.bcdc_promise <- function(x, n = 6L, ...) { - x$query_list <- c(x$query_list, COUNT = n) + 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 } @@ -273,7 +292,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) } @@ -307,8 +326,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) diff --git a/tests/testthat/test-query-geodata-head-tail.R b/tests/testthat/test-query-geodata-head-tail.R index df76d821..6ab9139a 100644 --- a/tests/testthat/test-query-geodata-head-tail.R +++ b/tests/testthat/test-query-geodata-head-tail.R @@ -1,15 +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 = 1) %>% + head(n = 3) %>% collect() - expect_equal(nrow(d2), 1L) + 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]] + ) }) From 148ccb044699c64a09ca21dfab312a201b891223 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 23 Apr 2020 12:31:30 -0700 Subject: [PATCH 4/6] Ensure print method reports correct n if head or tail used --- R/utils-classes.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/utils-classes.R b/R/utils-classes.R index 5faa0251..e8481518 100644 --- a/R/utils-classes.R +++ b/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 From 4e0a1e4ed3bf9007903162d65bb78cee13ad7a0a Mon Sep 17 00:00:00 2001 From: Sam Albers Date: Thu, 23 Apr 2020 13:58:00 -0700 Subject: [PATCH 5/6] update NEWS --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 70022e57..b265114f 100644 --- a/NEWS.md +++ b/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) # bcdata 0.1.2 From 1157fe3171becb1bb4467d892ca7028c1a0114a3 Mon Sep 17 00:00:00 2001 From: Andy Teucher Date: Thu, 23 Apr 2020 14:39:58 -0700 Subject: [PATCH 6/6] Update NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index b265114f..006e3ea7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +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) +* Add `head` and `tail` methods for `bcdc.promise` objects. Thanks to @hgriesbauer for the suggestion! (#182, #186) # bcdata 0.1.2