Merge pull request #23 from EvolEcolGroup/test_connectivity

Test connectivity functions

.github/workflows/test-coverage.yaml

@@ -2,7 +2,7 @@
 # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches: [main, master, dev]
+    branches: [main, master, dev, test_connectivity]
   pull_request:
     branches: [main, master, dev]
 
@@ -29,6 +29,8 @@ jobs:
       - name: Test coverage
         run: |
           covr::codecov(
+            covr.exclude_start = rex::rex("#", any_spaces, "nocov", any_spaces, "start"),
+            covr.exclude_end = rex::rex("#", any_spaces, "nocov", any_spaces, "end"),
             type = "all",
             quiet = FALSE,
             clean = FALSE,

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: geoGraph
 Type: Package
 Title: Walking Through the Geographic Space Using Graphs
-Version: 1.1.1.9003
+Version: 1.1.1.9004
 Authors@R: c(
     person("Thibaut", "Jombart", role = "aut"),
     person("Andrea", "Manica", email = "[email protected]", role = c("aut", "cre")))

R/classes.R

@@ -225,17 +225,21 @@ setClass(
   x <- object
   Ncoords <- nrow(x@coords)
   Nnodes <- length(x@nodes.id)
-
-  ## dim matching
-  if (Ncoords != Nnodes) {
-    cat("\n Number of coordinates and of nodes do not match.")
-    return(FALSE)
+
+  if(x@gGraph.name == "" ){
+    stop("x is not associated with a gGraph object.")
   }
 
   ## gGraph object
   if (!exists(x@gGraph.name, envir = .GlobalEnv)) {
     warning(paste("The gGraph object", x@gGraph.name, "is missing."))
   }
+
+  ## dim matching
+  if (Ncoords != Nnodes) {
+    cat("\n Number of coordinates and of nodes do not match.")
+    return(FALSE)
+  }
 
   return(TRUE)
 } # end .gData.valid

R/connectivity.R

@@ -167,7 +167,7 @@ setMethod("isConnected", "gData", function(object, ...) {
 #' @export
 setMethod("isConnected", "gGraph", function(object, ...) {
   ## checks ##
-  if (!is.gGraph(object)) stop("'object' is not a valid gData object.")
+  if (!is.gGraph(object)) stop("'object' is not a valid gGraph object.")
 
   ## set args for areConnected ##
   myNodes <- getNodes(object)
@@ -193,7 +193,7 @@ setMethod("isConnected", "gGraph", function(object, ...) {
 isReachable <- function(x, loc) { # x is a gData object
   ## checks ##
   if (!is.gData(x)) stop("x is not a valid gData object.")
-  if (!exists(x@gGraph.name, envir = .GlobalEnv)) stop(paste("gGraph object", x@gGraph.name, "not found."))
+
   mygGraph <- get(x@gGraph.name, envir = .GlobalEnv)
 
 

R/zoom.R

@@ -92,7 +92,7 @@ NULL
 
 
 
-
+# nocov start
 
 ##############
 ## geo.zoomin
@@ -331,7 +331,7 @@ geo.slide <- function() {
 
 
 
-
+# nocov end
 
 
 ############

tests/testthat/test_connectivity.R

@@ -0,0 +1,127 @@
+test_that("areNeighbours correctly returns neighbours",{
+
+  #Test that neighbour nodes are correctly identified
+  out <- areNeighbours(6303,6304,worldgraph.40k@graph)
+  expect_true(out[[1]])
+
+  #Test that non-neighbour nodes are correctly identified
+  out2 <- areNeighbours(6303,6306,worldgraph.40k@graph)
+  expect_false(out2[[1]])
+
+  #Test that vectors of different lengths throw an error 
+  expect_error(areNeighbours(c(6303,6304),6306,worldgraph.40k@graph),"V1 and V2 have different lengths.")
+
+  #Test vectors of neighbours are correctly identified
+  V1 <- c(6303,6304)
+  V2 <- c(6303,6305)
+  out3 <- areNeighbours(V1,V2,worldgraph.40k@graph)
+
+  #Expect false - the node is not its own neighbour
+  expect_false(out3[[1]])
+  expect_true(out3[[2]])
+
+  #Test vectors of neighbours are correctly identified
+  V3 <- c("6303","6304")
+  V4 <- c("6303","6305")
+  out4 <- areNeighbours(V1,V2,worldgraph.40k@graph)
+
+  expect_false(out4[[1]])
+  expect_true(out4[[2]])
+
+
+})
+
+
+test_that("areConnected correctly returns neighbours",{
+
+  #Test areConnected works with a gGraph and nodes set 
+  max_set <- keepMaxConnectedSet(worldgraph.10k)
+  coords_max_set <- getCoords(max_set)
+
+  #Pass the node names to areConnected - (is this the behviours we wanted?)
+  expect_true(areConnected(x = max_set, nodes = getNodes(max_set)))
+  expect_error(areConnected(x = max_set, nodes = coords_max_set),"Some specified nodes were not found in the gGraph object.")
+
+  #Check error if non gGraph object is passed
+  expect_error(areConnected(x = hgdp, nodes = getNodes(max_set)),"x is not a valid gGraph object")
+
+
+
+})
+
+
+
+
+
+test_that("isConnected works on a gGraph",{
+
+  max_set <- keepMaxConnectedSet(worldgraph.10k)
+  expect_true(isConnected(max_set))
+
+
+})
+
+
+test_that("isConnected works on a gData",{
+
+  # Select African populations Mandenka, Yoruba, and Biaka
+  hgdp_sub <- hgdp[c(29,30,31),]
+
+  #Check they are correctly identified as connected
+  expect_true(isConnected(hgdp_sub))
+
+  # But populations anywhere on the globe are also connected - is this the behavior we want?
+
+  # "AMERICA", "EUROPE", "CENTRAL_SOUTH_ASIA",  "AFRICA"  
+  hgdp_sub <- hgdp[c(24,1,13,27),]
+  expect_true(isConnected(hgdp_sub))
+
+})
+
+
+test_that("isReachable works with a gData object",{
+
+
+  # Select African populations Mandenka, Yoruba, and Biaka
+  hgdp_sub <- hgdp[c(29,30,31),]
+
+  #Get a location that is reachable 
+  location <- getCoords(hgdp[32,])
+
+  #Check these are reachable
+  expect_true(all(isReachable(x = hgdp_sub, loc = location)))
+
+  #Create a gGraph
+  max_set <- keepMaxConnectedSet(worldgraph.10k)
+
+  #Check error given when isReachable is not given a gData
+  expect_error(isReachable(x = max_set, loc = location),"x is not a valid gData object.")
+
+  #Create a new gData object
+  Bordeaux <- c(-1, 45)
+  Malaga <- c(-4, 37)
+  Zagreb <- c(16, 46)
+  cities.dat <- rbind.data.frame(Bordeaux, Malaga, Zagreb)
+  colnames(cities.dat) <- c("lon", "lat")
+  cities.dat$pop <- c(1e6, 5e5, 1.2e6)
+  row.names(cities.dat) <- c("Bordeaux", "Malaga", "Zagreb")
+  cities <- new("gData", coords = cities.dat[, 1:2], data = cities.dat[, 3, drop = FALSE])
+
+  #Pick a arbitrary location
+  location3 <- c(46,2)
+
+  #Check error is triggered if no corresponding gGraph for this gData object can be found
+  expect_error(isReachable(x = cities, loc = location3),"not associated with a gGraph object") 
+
+  #Pick a location 
+  location2 <- getCoords(hgdp[49,])
+
+  #Check this is false 
+  expect_warning(res <- isReachable(x = hgdp_sub, loc = location2),"The reference node is not connected to any node.") 
+  expect_false(res)
+
+
+})
+
+
+