roads: Road Network Projection

# commenting to avoid R cmd warnings due to missing testing packages
# if(FALSE){
#   library(terra)
#   library(dplyr)
#   library(sf)
#   #library(roads)
#   library(igraph)
#   library(ggplot2)
#   devtools::document();devtools::load_all()
# 
#   ## colours for displaying weight raster
#   if(requireNamespace("viridis", quietly = TRUE)){
#     # Use colour blind friendly palette if available
#     rastColours <- c('grey50', viridis::viridis(20))
#   } else {
#     rastColours <- c('grey50', terrain.colors(20))
#   }
# 
#   CLUSexample <- prepExData(CLUSexample)
# 
#   weightRaster <- 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(weightRaster))
# 
# 
#   landings <- roads::CLUSexample$landings
# 
#   ## plot example scenario
#   plot(weightRaster, col = rastColours, main = 'Example Scenario')
#   plot(roadsLine, add = TRUE)
#   plot(landings, add = TRUE, pch = 19)
#   points(x=5.6,y=4.5,pch=19,xpd=TRUE)
#   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(weightRaster=weightRaster)
# 
#   g1$g = getGraph(sim,"queen")
#   gNew$g = 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$g = getGraph(sim,"octagon")
#   gNew$g = 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 <- "~/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"))
# 
#   base_point <- c((1881188-159588)/2, (1748188-173788)/2)
#   the_res <- res(landscape)[1]
#   ext_100 <- ext(c(base_point, base_point+100*the_res)[c(1,3,2,4)])
#   landscape_100 <- list(weightRaster=crop(landscape, ext_100))
#   ext_500 <- ext(c(base_point, base_point+500*the_res)[c(1,3,2,4)])
#   landscape_500 <- list(weightRaster=crop(landscape, ext_500))
#   ext_1000 <- ext(c(base_point, base_point+1000*the_res)[c(1,3,2,4)])
#   landscape_1000 <- list(weightRaster=crop(landscape, ext_1000))
#   ext_2000 <- ext(c(base_point, base_point+200*the_res)[c(1,3,2,4)])
#   landscape_2000 <- list(weightRaster=crop(landscape, ext_2000))
# 
#   rr = getGraph(landscape_100,neighb,method="old",weightFunction=gradePenaltyFn,limitWeight=65000)
# 
#   neighb  ="octagon"
#   bm <- bench::mark(min_iterations = 1, check = FALSE,
#                     old_100 = getGraph(landscape_100,neighb,method="old"),
#                     dem_100 = getGraph(landscape_100,neighb,method="old",weightFunction = gradePenaltyFn),
#                     gdistance_100 = getGraph(landscape_100,neighb,method="gdistance"),
#                     old_500 = getGraph(landscape_500,neighb,method="old"),
#                     dem_500 = getGraph(landscape_500,neighb,method="old",weightFunction=gradePenaltyFn),
#                     gdistance_500 = getGraph(landscape_500,neighb,method="gdistance"),
#                     old_1000 = getGraph(landscape_1000,neighb,method="old"),
#                     dem_1000 = getGraph(landscape_1000,neighb,method="old",weightFunction=gradePenaltyFn),
#                     gdistance_1000 = getGraph(landscape_1000,neighb,method="gdistance"),
#                     old_2000 = getGraph(landscape_2000,neighb,method="old"),
#                     dem_2000 = getGraph(landscape_2000,neighb,method="old",weightFunction=gradePenaltyFn),
#                     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,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,
#                                                           "(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))+
#     geom_col()+
#     #bench::scale_x_bench_expr()+
#     bench::scale_y_bench_bytes(base=NULL)+
#     coord_flip()+
#     scale_x_discrete(limits =
#                        unique(names(bm$expression),
#                               invert = TRUE, value = TRUE))+
#     labs(x = "method & landscape width",y="memory allocation")
# 
# }
#