From 8c92bcd95e5603bf3be7dfdac6be24472c40b7ca Mon Sep 17 00:00:00 2001 From: Evie Carter Date: Tue, 16 Apr 2024 14:11:44 +0100 Subject: [PATCH] changes to gData validity checks --- DESCRIPTION | 2 +- R/classes.R | 14 ++++-- R/connectivity.R | 4 +- tests/testthat/test_connectivity.R | 77 ++++++++++++++++++++++++++++-- 4 files changed, 86 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 45ba8d6..059a7e7 100644 --- a/DESCRIPTION +++ b/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 = "am315@cam.ac.uk", role = c("aut", "cre"))) diff --git a/R/classes.R b/R/classes.R index 8e2ab5c..5a2236e 100644 --- a/R/classes.R +++ b/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 diff --git a/R/connectivity.R b/R/connectivity.R index 7f6e24d..084c153 100644 --- a/R/connectivity.R +++ b/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) diff --git a/tests/testthat/test_connectivity.R b/tests/testthat/test_connectivity.R index 9198ce5..d07ee45 100644 --- a/tests/testthat/test_connectivity.R +++ b/tests/testthat/test_connectivity.R @@ -38,19 +38,90 @@ test_that("areConnected correctly returns neighbours",{ max_set <- keepMaxConnectedSet(worldgraph.10k) coords_max_set <- getCoords(max_set) - #Pass the node names to areConnected - (is this the behvious we wanted?) - expect_true(areConnected(x = max_set, nodes = rownames(coords_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 = rownames(coords_max_set)),"x is not a valid gGraph object") + 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) + + +})