From 955bebe43d2a1766a5a5d8cc40156b4d94262064 Mon Sep 17 00:00:00 2001 From: Evie Carter Date: Tue, 19 Mar 2024 14:02:30 +0000 Subject: [PATCH 1/5] added tests for areNeighbours --- tests/testthat/test_connectivity.R | 32 ++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 tests/testthat/test_connectivity.R diff --git a/tests/testthat/test_connectivity.R b/tests/testthat/test_connectivity.R new file mode 100644 index 0000000..9680dc4 --- /dev/null +++ b/tests/testthat/test_connectivity.R @@ -0,0 +1,32 @@ +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 corectly 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 corectly identified + V3 <- c("6303","6304") + V4 <- c("6303","6305") + out4 <- areNeighbours(V1,V2,worldgraph.40k@graph) + + expect_false(out4[[1]]) + expect_true(out4[[2]]) + + +}) From 20d9af38c2496ed7de1a5eb65f9ab4b4987c02c5 Mon Sep 17 00:00:00 2001 From: Evie Carter Date: Mon, 8 Apr 2024 13:16:16 +0100 Subject: [PATCH 2/5] Test for areConnected --- tests/testthat/test_connectivity.R | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test_connectivity.R b/tests/testthat/test_connectivity.R index 9680dc4..9198ce5 100644 --- a/tests/testthat/test_connectivity.R +++ b/tests/testthat/test_connectivity.R @@ -11,7 +11,7 @@ test_that("areNeighbours correctly returns neighbours",{ #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 corectly identified + #Test vectors of neighbours are correctly identified V1 <- c(6303,6304) V2 <- c(6303,6305) out3 <- areNeighbours(V1,V2,worldgraph.40k@graph) @@ -20,7 +20,7 @@ test_that("areNeighbours correctly returns neighbours",{ expect_false(out3[[1]]) expect_true(out3[[2]]) - #Test vectors of neighbours are corectly identified + #Test vectors of neighbours are correctly identified V3 <- c("6303","6304") V4 <- c("6303","6305") out4 <- areNeighbours(V1,V2,worldgraph.40k@graph) @@ -30,3 +30,27 @@ test_that("areNeighbours correctly returns neighbours",{ }) + + +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 behvious we wanted?) + expect_true(areConnected(x = max_set, nodes = rownames(coords_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") + + +}) + + + + + + + From 8c92bcd95e5603bf3be7dfdac6be24472c40b7ca Mon Sep 17 00:00:00 2001 From: Evie Carter Date: Tue, 16 Apr 2024 14:11:44 +0100 Subject: [PATCH 3/5] 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) + + +}) From c88a0562cebb8b78adc9296b905a5d238cf52941 Mon Sep 17 00:00:00 2001 From: Andrea Manica Date: Tue, 23 Apr 2024 13:14:11 +0100 Subject: [PATCH 4/5] add codecov to this branch --- .github/workflows/test-coverage.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 63fd3cb..2e6da8b 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] From c07656ee352f880e5f2e32727e0f62993723ce7a Mon Sep 17 00:00:00 2001 From: Andrea Manica Date: Tue, 23 Apr 2024 13:44:25 +0100 Subject: [PATCH 5/5] exclude codecov of interactive functions --- .github/workflows/test-coverage.yaml | 2 ++ R/zoom.R | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/test-coverage.yaml b/.github/workflows/test-coverage.yaml index 2e6da8b..d7fb845 100644 --- a/.github/workflows/test-coverage.yaml +++ b/.github/workflows/test-coverage.yaml @@ -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/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 ############