diff --git a/R/getGraph.R b/R/getGraph.R index 534d6be..9930ae1 100644 --- a/R/getGraph.R +++ b/R/getGraph.R @@ -22,7 +22,7 @@ #' @param neighbourhood neighbourhood type #' @noRd -getGraph<- function(sim, neighbourhood,method="gdistance"){ +getGraph<- function(sim, neighbourhood,method="old"){ #sim = list(costSurface=costRaster);neighbourhood="octagon" #gdistance method takes more time and less memory. See testAltGraphFns in RoadPaper repo for details. if(method=="gdistance"){ diff --git a/tests/testthat/test-AltGraphFns.R b/tests/testthat/test-AltGraphFns.R index c9abddb..9ec8829 100644 --- a/tests/testthat/test-AltGraphFns.R +++ b/tests/testthat/test-AltGraphFns.R @@ -7,7 +7,7 @@ if(FALSE){ library(igraph) library(ggplot2) devtools::document();devtools::load_all() - + ## colours for displaying cost raster if(requireNamespace("viridis", quietly = TRUE)){ # Use colour blind friendly palette if available @@ -15,19 +15,19 @@ if(FALSE){ } else { rastColours <- c('grey50', terrain.colors(20)) } - + CLUSexample <- prepExData(CLUSexample) - + costRaster <- CLUSexample$cost roadsLine <- sf::st_sfc(geometry = sf::st_linestring( matrix(c(0.5, 4.5, 4.5, 4.5), ncol = 2, byrow = T) )) %>% sf::st_as_sf(crs = sf::st_crs(costRaster)) - - + + landings <- roads::CLUSexample$landings - + ## plot example scenario plot(costRaster, col = rastColours, main = 'Example Scenario') plot(roadsLine, add = TRUE) @@ -36,38 +36,38 @@ if(FALSE){ text(x=5.8,y=4.5,labels='landing',adj=c(0,0.4),xpd=TRUE) lines(x=c(5.3,5.6),y=c(4.2,4.2),lwd=2,xpd=TRUE) text(x=5.75,y=4.2,labels='roads',adj=c(0,0.3),xpd=TRUE) - + sim = list(costSurface=costRaster) - + g1 = getGraph(sim,"queen") gNew = getGraph(sim,"queen",method="gdistance") igraph::identical_graphs(g1$g,gNew$g,attrs=F) - + edge_attr(g1$g,"weight")=round(edge_attr(g1$g,"weight"),5) edge_attr(gNew$g,"weight")=round(edge_attr(gNew$g,"weight"),5) - + edge_attr(g1$g,"weight")==edge_attr(gNew$g,"weight") igraph::identical_graphs(g1$g,gNew$g,attrs=T) #queen and rook methods yield identical graphs, up to rounding errors. - + g1 = getGraph(sim,"octagon") gNew = getGraph(sim,"octagon",method="gdistance") igraph::identical_graphs(g1$g,gNew$g,attrs=F) - + edge_attr(g1$g,"weight")=round(edge_attr(g1$g,"weight"),0) edge_attr(gNew$g,"weight")=round(edge_attr(gNew$g,"weight"),0) - + edge_attr(g1$g,"weight")==edge_attr(gNew$g,"weight") igraph::identical_graphs(g1$g,gNew$g,attrs=T) #octagon methods yield similar but not identical graphs because gdistance::geoCorrection #method accounts for lengths of diagonals and other geographic distortions on the grid. - + #speed/memory benchmarking - data_path_raw <- "~/gitprojects/RoadPaper/analysis/data/raw_data/" - out_path <- "~/gitprojects/RoadPaper/analysis/figures/" - + data_path_raw <- "~/Documents/gitprojects/RoadPaper/analysis/data/raw_data/" + out_path <- "~/Documents/gitprojects/RoadPaper/analysis/figures/" + landscape <- rast(paste0(data_path_raw, "cost_surface_bc_ha.tif")) - + str(landscape) base_point <- c((1881188-159588)/2, (1748188-173788)/2) the_res <- res(landscape)[1] @@ -79,48 +79,49 @@ if(FALSE){ landscape_1000 <- list(costSurface=crop(landscape, ext_1000)) ext_2000 <- ext(c(base_point, base_point+2000*the_res)[c(1,3,2,4)]) landscape_2000 <- list(costSurface=crop(landscape, ext_2000)) - + + neighb ="rook" bm <- bench::mark(min_iterations = 1, check = FALSE, - old_100 = getGraph(landscape_100,"octagon",method="old"), - gdistance_100 = getGraph(landscape_100,"octagon",method="gdistance"), - old_500 = getGraph(landscape_500,"octagon",method="old"), - gdistance_500 = getGraph(landscape_500,"octagon",method="gdistance"), - old_1000 = getGraph(landscape_1000,"octagon",method="old"), - gdistance_1000 = getGraph(landscape_1000,"octagon",method="gdistance"), - old_2000 = getGraph(landscape_2000,"octagon",method="old"), - gdistance_2000 = getGraph(landscape_2000,"octagon",method="gdistance") + old_100 = getGraph(landscape_100,neighb,method="old"), + gdistance_100 = getGraph(landscape_100,neighb,method="gdistance"), + old_500 = getGraph(landscape_500,"rook",method="old"), + gdistance_500 = getGraph(landscape_500,neighb,method="gdistance"), + old_1000 = getGraph(landscape_1000,"rook",method="old"), + gdistance_1000 = getGraph(landscape_1000,neighb,method="gdistance"), + old_2000 = getGraph(landscape_2000,"rook",method="old"), + gdistance_2000 = getGraph(landscape_2000,neighb,method="gdistance") ) - + bm - + # this one is supposed to tell us about max RAM used over the whole calculation - ram_use <- peakRAM::peakRAM(old_100 = getGraph(landscape_100,"octagon",method="old"), - gdistance_100 = getGraph(landscape_100,"octagon",method="gdistance"), - old_500 = getGraph(landscape_500,"octagon",method="old"), - gdistance_500 = getGraph(landscape_500,"octagon",method="gdistance"), - old_1000 = getGraph(landscape_1000,"octagon",method="old"), - gdistance_1000 = getGraph(landscape_1000,"octagon",method="gdistance"), - old_2000 = getGraph(landscape_2000,"octagon",method="old"), - gdistance_2000 = getGraph(landscape_2000,"octagon",method="gdistance")) - - ram_use %>% + ram_use <- peakRAM::peakRAM(old_100 = getGraph(landscape_100,neighb,method="old"), + gdistance_100 = getGraph(landscape_100,neighb,method="gdistance"), + old_500 = getGraph(landscape_500,neighb,method="old"), + gdistance_500 = getGraph(landscape_500,neighb,method="gdistance"), + old_1000 = getGraph(landscape_1000,neighb,method="old"), + gdistance_1000 = getGraph(landscape_1000,neighb,method="gdistance"), + old_2000 = getGraph(landscape_2000,neighb,method="old"), + gdistance_2000 = getGraph(landscape_2000,neighb,method="gdistance")) + + ram_use %>% ggplot(aes(Function_Call, Peak_RAM_Used_MiB))+ geom_col()+ scale_x_discrete(limits = unique(ram_use$Function_Call, - invert = TRUE, value = TRUE), - labels = paste0(stringr::str_extract(ram_use$Function_Call, + invert = TRUE, value = TRUE), + labels = paste0(stringr::str_extract(ram_use$Function_Call, "(method=\")(.*)\"", group = 2), "_", stringr::str_extract(ram_use$Function_Call, "\\d\\d*")))+ coord_flip() - + plot(bm,type="boxplot")+ scale_x_discrete(limits = unique(names(bm$expression), invert = TRUE, value = TRUE))+ xlab("method & landscape width")+ylab("processing time") - + bm %>% mutate(x = names(expression), mem = mem_alloc) %>% ggplot(aes(x, mem_alloc))+ @@ -132,7 +133,7 @@ if(FALSE){ unique(names(bm$expression), invert = TRUE, value = TRUE))+ labs(x = "method & landscape width",y="memory allocation") - + }