Restricts calls to sf

NAMESPACE

@@ -26,6 +26,7 @@ export(get_network_by_id_indiv)
 export(search_datasets)
 export(search_interactions)
 export(search_networks)
+export(search_networks_sf)
 export(search_nodes)
 export(search_references)
 export(search_taxonomy)

NEWS.md

@@ -1,12 +1,16 @@
 # rmangal 1.9.1.9000
 
-* Revisions see https://github.com/ropensci/software-review/issues/332
-* add summary method
-* `mg_to_igraph` is now `as.igraph()`
-* vignette now includes examples to use tigygraph and ggraph
-* pkgdown website is now deployed by Travis CI
+* Revisions see https://github.com/ropensci/software-review/issues/332;
+* add summary method [#87];
+* `mg_to_igraph` is now `as.igraph()`;
+* `search_references()` has been rewritten [#85];
+* vignette now includes examples to use `tigygraph` and `ggraph`;
+* pkgdown website is now deployed by Travis CI;
+* `geom` column has been removed from `mgSearchInteractions` objects;
+* `sf` features are only used in `search_networks_sf()` and when argument `as_sf` is set to `TRUE` [#];
+* query with spatial (`sf`) objects are handle in `query_networks_sf()` that is now exported.
 
 # rmangal 1.9.1
 
-* Version submitted to ROpenSci
+* Version submitted to ROpenSci for review;
 * Added a `NEWS.md` file to track changes to the package.

R/get_network_by_id.R

@@ -4,20 +4,21 @@
 #' @param id a single ID network (`numeric`).
 #' @param x an object of class `mgNetwork` or `mgNetworksCollection`.
 #' @param object object of of class `mgNetwork` or `mgNetworksCollection`.
+#' @param as_sf a logical. Should networks metadata be converted into an sf object? Note that to use this feature `sf` must be installed.
 #' @param ... ignored.
 #' @param verbose a logical. Should extra information be reported on progress?
 #'
 #' @rdname get_network_by_id
 #'
 #' @return
-#' A `mgNetwork` object includes:
-#' * network: a `list` of all generic information on the network
-#' * nodes: a `data.frame` of all nodes with taxonomic information
-#' * interactions: a `data.frame` of all ecological interactions, with the attribute used to describe the interaction
-#' * dataset: `list` information pertaining to the dataset the network is associated with
-#' * reference: `list` information about the original publication
+#' A `mgNetwork` object includes five data frame:
+#' * network: includes all generic information on the network (if `as_sf=TRUE` then it is an object of class `sf`);
+#' * nodes: information pertaining to nodes (includes taxonomic information);
+#' * interactions: includes ecological interactions and their attributes;
+#' * dataset: information pertaining to the original dataset;
+#' * reference: details about the original publication.
 #'
-#' A summary method is available return for all `mgNetwork` object the following network properties:
+#' A summary method is available for objects of class `mgNetwork` object and returns the following network properties:
 #' * the number of nodes;
 #' * the number of edges;
 #' * the connectance;
@@ -29,31 +30,29 @@
 #' nets <- get_network_by_id(id = c(18, 23))
 #' @export
 
-get_network_by_id <- function(ids, verbose = TRUE) {
+get_network_by_id <- function(ids, as_sf = FALSE, verbose = TRUE) {
     if (length(ids) > 1) {
       structure(
-        lapply(ids, get_network_by_id_indiv, verbose = verbose),
-        class= "mgNetworksCollection"
+        lapply(ids, get_network_by_id_indiv, as_sf = as_sf, verbose = verbose),
+        class = "mgNetworksCollection"
       )
     } else {
       if (!length(ids)) return(data.frame())
-      get_network_by_id_indiv(ids, verbose = verbose)
+      get_network_by_id_indiv(ids, as_sf = as_sf, verbose = verbose)
     }
 }
 
 
 #' @describeIn get_network_by_id Retrieve a network by its  collection of networks (default).
 #' @export
-get_network_by_id_indiv <- function(id, verbose = TRUE) {
-  stopifnot(grepl("^[0-9]+$", id))
-  stopifnot(!is.null(id))
-  stopifnot(length(id) == 1)
+get_network_by_id_indiv <- function(id, as_sf = FALSE, verbose = TRUE) {
+
+  id <- as.numeric(id)
+  stopifnot(length(id) == 1 & !is.na(id))
 
-  # Object S3 declaration
-  # if (verbose) cat("Retrieving network id", id, "\n")
   mg_network <- structure(list(network =
     resp_to_spatial(get_singletons(endpoints()$network, ids = id,
-    verbose = verbose)$body)), class = "mgNetwork")
+    verbose = verbose)$body, as_sf = as_sf)), class = "mgNetwork")
 
   if (is.null(mg_network$network))
     stop(sprintf("network id %s not found", id))

R/search_interactions.R

@@ -18,7 +18,7 @@
 #' All networks in which interactions are involved are also attached to the `data.frame`.
 #'
 #' @details
-#' Names of the list should match one of the column names within the table. 
+#' Names of the list should match one of the column names within the table.
 #' For the `interaction` table, those are:
 #' - id: unique identifier of the interaction
 #' - attr_id: identifier of a specific attribute
@@ -56,7 +56,7 @@ search_interactions <- function(query, type = NULL, expand_node = FALSE,
 
     # Get interactions based on the type
     interactions <- resp_to_spatial(get_gen(endpoints()$interaction,
-      query = query, verbose = verbose)$body, ...)
+      query = query, verbose = verbose, ...)$body, keep_geom = FALSE)
 
     if (is.null(interactions)) {
       if (verbose) message("No interactions found.")

R/search_networks.R

@@ -16,7 +16,7 @@
 #' An object of class `mgSearchNetworks`, which is a `data.frame` object with all networks informations
 #'
 #' @details
-#' Names of the list should match one of the column names within the table. 
+#' Names of the list should match one of the column names within the table.
 #' For the `networks` table, those are
 #' - id: unique identifier of the network
 #' - all_interactions: false interaction can be considered as real false interaction
@@ -31,7 +31,7 @@
 #' @examples
 #' mg_insect <- search_networks(query="insect%")
 #' \donttest{
-#' # Retrieve the search results 
+#' # Retrieve the search results
 #' nets_insect <- get_collection(mg_insect)
 #' # Spatial query
 #' library(USAboundaries)
@@ -48,8 +48,6 @@
 
 search_networks <- function(query, verbose = TRUE, ...) {
 
-  if ("sf" %in% class(query))
-    return(search_networks_sf(query, verbose, ...))
   query <- handle_query(query, c("id", "public", "all_interactions", "dataset_id"))
 
   networks <- resp_to_spatial(get_gen(endpoints()$network, query = query,
@@ -67,17 +65,18 @@ search_networks <- function(query, verbose = TRUE, ...) {
   networks
 }
 
-#' @describeIn search_networks Search network within a spatial object passed as an argument.
+#' @describeIn search_networks Search networks within a spatial object passed as an argument. Note that `sf` must be installed to use this function.
+#' @export
 search_networks_sf <- function(query_sf, verbose = TRUE, ...) {
-  stopifnot("sf" %in% class(query_sf))
 
-  if (!("sf" %in% row.names(utils::installed.packages())))
-    stop("Package sf is not installed.")
+  stopifnot("sf" %in% class(query_sf))
+  stop_if_missing_sf()
 
-  # API doesn't allow spatial search yet, so we sort with sf package
+  # API doesn't allow spatial search yet, so we used sf
   sp_networks_all <- resp_to_spatial(
-      get_gen(endpoints()$network, verbose = verbose, ...)$body)
-  # Set to WGS 84 / World Mercator, a planar CRS
+      get_gen(endpoints()$network, verbose = verbose, ...)$body,
+      as_sf = TRUE)
+  # sf_networks_all to WGS 84 / World Mercator, a planar CRS
   id <- unlist(sf::st_contains(
         sf::st_transform(query_sf, crs = 3395),
         sf::st_transform(sp_networks_all, crs = 3395)))

R/zzz.R

@@ -81,37 +81,80 @@ fill_df <- function(x, nms) {
   x
 }
 
-## Response => spatial
-resp_to_spatial <- function(x) {
+
+# hh <- resp_to_spatial2(gg)
+resp_to_spatial <- function(x, as_sf = FALSE, keep_geom = TRUE) {
   if (is.null(x)) {
     x
   } else {
      dat <- do.call(rbind, lapply(null_to_na(x),
         function(y) as.data.frame(
           y[names(y) != "geom"], stringsAsFactors = FALSE)
         ))
-      spd <- lapply(lapply(x, function(y) y[names(y) == "geom"]), switch_sf)
-      sf::st_sf(dat, geom = spd, crs = 4326, stringsAsFactors = FALSE)
+      if (keep_geom) {
+        dat <- cbind(dat, do.call(rbind, lapply(x, handle_geom)))
+      } else dat
+      if (as_sf) resp_to_sf(dat) else dat
+  }
+}
+
+handle_geom <- function(x) {
+  # print(x$geom)
+  if (is.null(x$geom)) {
+    data.frame(
+      geom_type = NA_character_,
+      geom_lon = NA_real_,
+      geom_lat = NA_real_
+    )
+  } else {
+    tmp <- matrix(unlist(x$geom$coordinates), ncol = 2, byrow = TRUE)
+    # names(tmp) <- paste0("geom_", c("lon", "lat"))
+    out <- data.frame(
+      geom_type = x$geom$type,
+      stringsAsFactors = FALSE
+    )
+    out$geom_lon <- list(tmp[,1])
+    out$geom_lat <- list(tmp[,2])
+    out
   }
 }
 
+## Response => spatial -- sf required
+resp_to_sf <- function(dat) {
+  stop_if_missing_sf()
+  if (nrow(dat) == 1) {
+    spd <- switch_sf(dat)
+  } else spd <- apply(dat, 1, switch_sf)
+  sf::st_sf(
+   dat[names(dat)[!grepl("geom_", names(dat))]], geom = sf::st_sfc(spd),
+    crs = 4326, stringsAsFactors = FALSE
+   )
+}
+
 ## Build sf object based on geom.type
-switch_sf <- function(tmp) {
-  if (!length(tmp$geom)) {
-    # if NULL
+switch_sf <- function(x) {
+  if (is.na(x$geom_type)) {
     sf::st_point(matrix(NA_real_, ncol = 2))
   } else {
-    co <- matrix(unlist(tmp$geom$coordinates), ncol = 2, byrow = TRUE)
+    co <- cbind(
+        as.numeric(unlist(x$geom_lon)),
+        as.numeric(unlist(x$geom_lat))
+    )
     # print(co)
     switch(
-      tmp$geom$type,
+      x$geom_type,
       Point = sf::st_point(co),
       Polygon = sf::st_polygon(list(co)),
       stop("Only `Point` and `Polygon` are supported.")
     )
   }
 }
 
+stop_if_missing_sf <- function() {
+  if (!("sf" %in% row.names(utils::installed.packages())))
+    stop("Package sf is not installed.")
+}
+
 
 
 #' Get entries based on foreign key

README.md

@@ -42,7 +42,7 @@ R> library("rmangal")
 
 ## How to use `rmangal`
 
-There are [five `search_*()` functions](file:///home/steve/Documents/Git/mangal/rmangal/docs/reference/index.html#section-explore-database) to explore the content of Mangal, for
+There are [seven `search_*()` functions](file:///home/steve/Documents/Git/mangal/rmangal/docs/reference/index.html#section-explore-database) to explore the content of Mangal, for
 instance `search_datasets()`:
 
 ```r

tests/testthat/test-get_collection.R

@@ -3,17 +3,23 @@ context("get_collection")
 res0 <- get_collection(c(1035:1036))
 res1 <- get_collection(search_networks(query='insect%'))
 res2 <- get_collection(search_datasets(query='lagoon%'))
+res3 <- get_collection(search_datasets(query='lagoon%'), as_sf = TRUE)
 resw <- get_collection(NULL)
+net18 <- get_network_by_id(id = 18, as_sf = TRUE)
 
 test_that("expected behavior", {
   expect_equal(res0[[1]]$network$network_id, 1035)
+  expect_equal(class(res0), "mgNetworksCollection")
   expect_equal(class(res1), "mgNetworksCollection")
-  expect_equal(class(res1), "mgNetworksCollection")
-  expect_equal(class(res1), "mgNetworksCollection")
+  expect_equal(class(res2), "mgNetworksCollection")
+  expect_equal(class(res3), "mgNetworksCollection")
+  expect_equal(class(net18), "mgNetwork")
+  expect_true(all("sf" == lapply(res3, function(x) class(x$network)[1])))
+  expect_equal(class(net18$network), c("sf", "data.frame"))
   expect_equal(length(res0), 2)
   expect_equal(length(res1), 14)
   expect_equal(length(res2), 3)
   expect_identical(resw, data.frame())
-  expect_error(get_collection("onlydigitsallowed"))
+  expect_error(suppressWarnings(get_collection("hh")))
 }
 )

tests/testthat/test-search_datasets.R

@@ -1,7 +1,7 @@
-context("search_dataset")
+context("test search_datasets")
 
 # number of variables (columns)
-nvr <- 11
+nvr <- 10
 
 res1 <- search_datasets(query = "lagoon")
 res2 <- search_datasets(query = list(name = "kemp_1977"))

tests/testthat/test-search_interactions.R

@@ -1,20 +1,19 @@
 context("search_interactions")
 
-
 res1 <- search_interactions(type = "competition")
 res2 <- search_interactions(type = "competition", expand_node = TRUE)
 res3 <- search_interactions(list(network_id = 926))
 res4 <- search_interactions(list(network_id = 926), expand_node = TRUE)
 test_that("expected behavior", {
   expect_identical(search_interactions("wrong"), data.frame())
-  expect_equal(dim(res1), c(12, 20))
-  expect_equal(class(res1), c("sf", "data.frame", "mgSearchInteractions"))
-  expect_equal(class(res3), c("sf", "data.frame", "mgSearchInteractions"))
+  expect_equal(dim(res1), c(12, 19))
+  expect_equal(class(res1), c("data.frame", "mgSearchInteractions"))
+  expect_equal(class(res3), c("data.frame", "mgSearchInteractions"))
   # this may change if we merge data frames
-  expect_equal(dim(res2), c(12, 56))
-  expect_equal(dim(res3), c(34, 20))
+  expect_equal(dim(res2), c(12, 55))
+  expect_equal(dim(res3), c(34, 19))
   expect_true(all(res3$network_id == 926))
-  expect_equal(dim(res4), c(34, 58))
+  expect_equal(dim(res4), c(34, 57))
   expect_true(all(res4$network_id == 926))
 })