From 7193c37b50d3abfb01e162c0b24218afe4749142 Mon Sep 17 00:00:00 2001 From: salvafern Date: Wed, 6 Apr 2022 15:07:43 +0000 Subject: [PATCH] Allow passing any polygon #12 --- R/eurobis_occurrences.R | 27 +++++++++++++++++++---- R/map.R | 28 +++++++++++++----------- tests/testthat/test-map.R | 2 +- tests/testthat/test-viewparams.R | 32 ++++++++++++++++++--------- tests/testthat/test-wfsrequest.R | 37 ++++++++++++++++++++++++++++++-- 5 files changed, 96 insertions(+), 30 deletions(-) diff --git a/R/eurobis_occurrences.R b/R/eurobis_occurrences.R index 16593f3..c4143a6 100644 --- a/R/eurobis_occurrences.R +++ b/R/eurobis_occurrences.R @@ -16,7 +16,7 @@ #' @export #' #' @examples -#' test <- eurobis_occurrences("basic", dasid = 8045) +#' test <- eurobis_occurrences("basic", dasid = 8045, mrgid = c(5688, 5686)) #' test <- eurobis_occurrences("full", dasid = 8045) #' test <- eurobis_occurrences("full_and_parameters", dasid = 8045) #' test <- eurobis_occurrences("basic", dasid = 8045, scientificname = "Zostera marina") @@ -51,6 +51,8 @@ eurobis_occurrences <- function(type, paging = paging, paging_length = paging_length, ...) + eurobis_data <- eurobis_sf_df_handler(eurobis_data) + return(eurobis_data) } @@ -111,6 +113,23 @@ eurobis_wfs_find_layer <- function(wfs_client, type){ } - - - +# Handle sf and data.frame objects +eurobis_sf_df_handler <- function(sf_df){ + stopifnot(is(sf_df, c("sf", "data.frame"))) + + names(sf_df) <- tolower(names(sf_df)) + + is_not_sf <- !is(sf_df, c("sf")) + + if(is.data.frame(sf_df) & is_not_sf){ + coords_exists <- "decimallatitude" %in% names(sf_df) & "decimallatitude" %in% names(sf_df) + stopifnot(coords_exists) + + if(coords_exists){ + sf_df <- sf::st_as_sf(sf_df, coords = c("decimallongitude", "decimallatitude"), crs = 4326) + } + + } + + return(sf_df) +} diff --git a/R/map.R b/R/map.R index 8075cef..7a2a57f 100644 --- a/R/map.R +++ b/R/map.R @@ -11,10 +11,10 @@ #' - eez_iho = Intersection of the EEZ and IHO areas #' #' @examples -#' eurobis_mr_map('eez') -#' eurobis_mr_map('iho') -#' eurobis_mr_map('eez_iho') -eurobis_mr_map <- function(layer = 'eez'){ +#' eurobis_map_mr('eez') +#' eurobis_map_mr('iho') +#' eurobis_map_mr('eez_iho') +eurobis_map_mr <- function(layer = 'eez'){ mr_wms <- "http://geo.vliz.be/geoserver/MarineRegions/wms?" # Assertions @@ -44,28 +44,30 @@ eurobis_mr_map <- function(layer = 'eez'){ #' @return #' @export #' -#' @examples wkt <- eurobis_draw_bbox() -eurobis_draw_bbox <- function(){ +#' @examples wkt <- eurobis_map_draw() +eurobis_map_draw <- function(){ if(!interactive()) NULL base_map <- eurobis_base_map() %>% add_labels() - rectangle <- mapedit::editMap( + polygon <- mapedit::editMap( base_map, editorOptions = list( polylineOptions = FALSE, markerOptions = FALSE, circleOptions = FALSE, - circleMarkerOptions = FALSE, polygonOptions = FALSE, + circleMarkerOptions = FALSE, singleFeature = TRUE ), - title = "Draw a rectangle", + title = "Click on the toolbar on the left to start drawing your area of interest. Click Done when you have finished.", crs = 4326 )$all # Assertions - if(is.null(rectangle)) stop("No bounding box was created") - if(nrow(rectangle) > 1) stop("Only one bounding box supported") + if(is.null(polygon)) stop("No polygon was created") + if(nrow(polygon) > 1){ + polygon <- sf::st_combine(polygon) + } - wkt <- sf::st_as_text(sf::st_geometry(rectangle)) + wkt <- sf::st_as_text(sf::st_geometry(polygon)) message(wkt) return(wkt) @@ -96,7 +98,7 @@ add_labels <- function(map){ emodnet_labels <- "https://tiles.emodnet-bathymetry.eu/osm/labels/inspire_quad/{z}/{x}/{y}.png" map %>% leaflet::addTiles(urlTemplate = emodnet_labels, - options = tileOptions(tms = FALSE) + options = leaflet::tileOptions(tms = FALSE) ) %>% leaflet::setView(15, 45, zoom = 2) } diff --git a/tests/testthat/test-map.R b/tests/testthat/test-map.R index 929a8b3..2606701 100644 --- a/tests/testthat/test-map.R +++ b/tests/testthat/test-map.R @@ -7,7 +7,7 @@ test_that("Maps work", { expect_true(base_is_leaflet) for(mr in c("eez", "iho", "eez_iho")){ - mr_map <- eurobis_mr_map(mr) + mr_map <- eurobis_map_mr(mr) mr_is_leaflet <- "leaflet" %in% class(mr_map) expect_true(mr_is_leaflet) } diff --git a/tests/testthat/test-viewparams.R b/tests/testthat/test-viewparams.R index d8fb899..b24e51b 100644 --- a/tests/testthat/test-viewparams.R +++ b/tests/testthat/test-viewparams.R @@ -5,8 +5,18 @@ test_that("viewParams are build correctly", { # Geo wkt <- 'POLYGON((-2 52,-2 58,9 58,9 52,-2 52))' + wkt_collection <- 'GEOMETRYCOLLECTION (POLYGON ((-2 52, -2 58, 9 58, 9 52, -2 52)), POLYGON ((-2 52, -2 58, 9 58, 9 52, -2 52)))' + wkt_wrong_geom <- 'GEOMETRYCOLLECTION (POINT (-2 52), POLYGON ((-2 52, -2 58, 9 58, 9 52, -2 52)))' + + polygon_fine <- sf::st_as_sfc(wkt) + polygon_collection <- sf::st_geometrycollection( + list( + sf::st_point(c(1, 0)), + sf::st_polygon(list(matrix(c(5.5, 7, 7, 6, 5.5, 0, 0, -0.5, -0.5, 0), ncol = 2))) + ) + ) - geo_ok_both <- is.character(build_filter_geo(mrgid = 8364, bbox = wkt)) + geo_ok_both <- is.character(build_filter_geo(mrgid = 8364, polygon = wkt)) expect_true(geo_ok_both) geo_ok_mrgid <- is.character(build_filter_geo(mrgid = 8364)) @@ -15,20 +25,22 @@ test_that("viewParams are build correctly", { geo_ok_mrgids <- is.character(build_filter_geo(mrgid = c(8364, 8365))) expect_true(geo_ok_mrgids) - geo_ok_wkt <- is.character(build_filter_geo(bbox = wkt)) + geo_ok_wkt <- is.character(build_filter_geo(polygon = wkt)) expect_true(geo_ok_wkt) - expect_error(build_filter_geo(bbox = "This is not WKT")) + expect_error(build_filter_geo(polygon = "This is not WKT")) + + geo_ok_polygon <- is.character(build_filter_geo(polygon = polygon_fine)) + expect_true(geo_ok_polygon) + + geo_ok_polygon_collection <- is.character(build_filter_geo(polygon = polygon_collection)) + expect_true(geo_ok_polygon_collection) test_df <- sf::st_as_sf(data.frame(wkt = wkt), wkt = "wkt") - expect_error(build_filter_geo(bbox = test_df)) + expect_error(build_filter_geo(polygon = test_df)) sf::st_crs(test_df) <- 4326 - geo_ok_sf <- is.character(build_filter_geo(bbox = test_df)) + geo_ok_sf <- is.character(build_filter_geo(polygon = test_df)) expect_true(geo_ok_sf) - test_bbox <- sf::st_bbox(test_df) - geo_ok_bbox <- is.character(build_filter_geo(test_bbox)) - expect_true(geo_ok_bbox) - # Dates date_ok_char <- is.character(build_filter_time("1990-01-01", "2020-01-01")) expect_true(date_ok_char) @@ -53,7 +65,7 @@ test_that("viewParams are build correctly", { # All together is_character <- is.character( - build_viewparams(mrgid = 8364, bbox = wkt, + build_viewparams(mrgid = 8364, polygon = wkt, dasid = 216, startdate = "2000-01-01", enddate = "2022-01-31", aphiaid = c(104108, 148947)) ) diff --git a/tests/testthat/test-wfsrequest.R b/tests/testthat/test-wfsrequest.R index 8849056..7e74f9a 100644 --- a/tests/testthat/test-wfsrequest.R +++ b/tests/testthat/test-wfsrequest.R @@ -1,3 +1,36 @@ -test_that("multiplication works", { - expect_equal(2 * 2, 4) +test_that("eurobis_occurrences", { + skip_if_offline() + skip_on_cran() + skip_on_ci() + + + test1 <- eurobis_occurrences("basic", dasid = 8045) + test2 <- eurobis_occurrences("full", dasid = 8045) + test3 <- eurobis_occurrences("full_and_parameters", dasid = 8045) + + test <- list(test1, test2, test3) + + for(i in 1:length(test)){ + is_sf_df <- is(test[[i]], c("sf", "data.frame")) + expect_true(is_sf_df) + } + + #' test <- eurobis_occurrences("basic", dasid = 8045, scientificname = "Zostera marina") + #' test <- eurobis_occurrences("basic", dasid = 8045, scientificname = c("Zostera marina", "foo")) + #' test <- eurobis_occurrences("basic", dasid = 8045, scientificname = "foo") + #' test <- eurobis_occurrences("basic", dasid = 8045, scientificname = "Zostera marina", aphiaid = 145795) + }) + + +test_that("sf handler works fine", { + skip_if_offline() + skip_on_cran() + skip_on_ci() + + test <- eurobis_occurrences("basic", dasid = 8045) + test_handler <- eurobis_sf_df_handler(test) + expect_true(is(test_handler, c("sf"))) + + +}) \ No newline at end of file