Allow passing any polygon #12

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)
+}

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)
 }

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)
   }

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))
   )

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")))
+
+
+})