diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 63fd3cb..d7fb845 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.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, 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/R/zoom.R b/R/zoom.R index c56323a..abd5fa8 100644 --- a/R/zoom.R +++ b/R/zoom.R @@ -92,7 +92,7 @@ NULL - +# nocov start ############## ## geo.zoomin @@ -331,7 +331,7 @@ geo.slide <- function() { - +# nocov end ############ diff --git a/tests/testthat/test_connectivity.R b/tests/testthat/test_connectivity.R new file mode 100644 index 0000000..d07ee45 --- /dev/null +++ b/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) + + +}) + + +