summarisedRSUS modified for summed areas, concatenate functions modif…

…ied for "Unclassified" RSUs TO DO : finish matConfPlot to include the margins and inject it in compareLCZ (and compareMultiple ?)
MGousseff · Jan 31, 2025 · 51fb434 · 51fb434
1 parent 368e5fe
commit 51fb434
Show file tree

Hide file tree

Showing 20 changed files with 367 additions and 290 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -5,6 +5,7 @@ export(LCZareas)
 export(addMissingRSUs)
 export(areColors)
 export(barplotLCZaLocation)
+export(checkDirSlash)
 export(compareLCZ)
 export(compareMultipleLCZ)
 export(concatAllLocationsAllWfs)
@@ -25,7 +26,9 @@ export(levCol)
 export(loadMultipleSfs)
 export(matConfLCZ)
 export(matConfLCZGlob)
+export(matConfPlot)
 export(multipleCramer)
+export(plotSummarisedRSUs)
 export(produceAnalysis)
 export(showLCZ)
 export(standLevCol)

diff --git a/R/checkDirSlash.R b/R/checkDirSlash.R
@@ -0,0 +1,15 @@
+#' Simply adds a slash at then end of a directory path if there is none.  
+#' @param dirPath is a directory pas as a string
+#' @importFrom ggplot2 geom_sf guides ggtitle aes
+#' @return the same string if it ended with a slash, else the string with a slash at its end
+#' @export
+#' @examples
+#' grr<-"test"
+#' checkDirSlash(grr)
+checkDirSlash<-function(dirPath){
+  if ( substring(dirPath, nchar(dirPath), nchar(dirPath)) != "/"){
+    dirPath<-paste0(dirPath, "/")
+  }
+  return(dirPath)
+}
+
diff --git a/R/concatIntersectedLocations.R b/R/concatIntersectedLocations.R
@@ -26,7 +26,7 @@ concatIntersectedLocations<-function(dirList, locations, workflowNames = c("osm"
                                  dirPath = dirList[i], workflowNames = workflowNames, location = locations[i])
     )
   }
-  concatIntersectedDf$location<-factor(concatIntersectedDf$location)
+  concatIntersectedDf$location<-factor(concatIntersectedDf$location, levels = typeLevelsDefault)
   concatIntersectedSf<-concatIntersectedDf %>% st_as_sf()
 
   return(concatIntersectedSf)

diff --git a/R/importLCZvect.R b/R/importLCZvect.R
@@ -1,4 +1,3 @@
-
 #' Imports Local Climate Zone classifications from a standard geographical file (tested : geojson, shp, more to come)
 #'
 #' @param dirPath is the path of the directory of the file
@@ -28,42 +27,42 @@
 #' redonBDTex<-importLCZvectFromFile(dirPath=paste0(system.file("extdata", package = "lczexplore"),
 #' "/bdtopo_2_2/Redon"), file="rsu_lcz.geojson", column="LCZ_PRIMARY",
 #' geomID="ID_RSU",confid="LCZ_UNIQUENESS_VALUE")
-importLCZvectFromFile<-function(dirPath, file="rsu_lcz.geojson", column, geomID="", confid="", verbose = TRUE, drop = TRUE){
-  if (!file.exists(dirPath)){stop(message="The directory set in dirPath doesn't seem to exist")}
+importLCZvectFromFile <- function(dirPath, file = "rsu_lcz.geojson", column, geomID = "", confid = "", verbose = TRUE, drop = TRUE) {
+  if (!file.exists(dirPath)) { stop(message = "The directory set in dirPath doesn't seem to exist") }
 
-  fileName<-paste0(dirPath,"/",file)
+  fileName <- paste0(dirPath, "/", file)
   # select only the needed column, that is the unempty strings among column, geomID and confid
-  colonnes<-c(geomID,column,confid)
-  colonnes<-colonnes[sapply(colonnes,nchar)!=0]
+  colonnes <- c(geomID, column, confid)
+  colonnes <- colonnes[sapply(colonnes, nchar) != 0]
 
   # Check if all the desired columns are present in the source file and only loads the file if the columns exist
   ### DOESN'T WORK WITH flatgeobuffer
-  nom<-gsub(pattern="(.+?)(\\.[^.]*$|$)",x=file,replacement="\\1")
-  extension<-gsub(pattern="(.+?)(\\.[^.]*$|$)",x=file,replacement="\\2")
-  if (extension != ".fgb"){ # Some metadata for fgb files do not specify table/layer names
-    query<-paste0("select * from ",nom," limit 0") # So this query wouldn't work with such fgb files
-    sourceCol<-st_read(dsn=fileName, query=query, quiet=!verbose) %>% names
-    inCol<-colonnes%in%sourceCol
-    badCol<-colonnes[!inCol]
-    colErr<-c("It seems that some of the columns you try to import do not exist in the source file,
+  nom <- gsub(pattern = "(.+?)(\\.[^.]*$|$)", x = file, replacement = "\\1")
+  extension <- gsub(pattern = "(.+?)(\\.[^.]*$|$)", x = file, replacement = "\\2")
+  if (extension != ".fgb") { # Some metadata for fgb files do not specify table/layer names
+    query <- paste0("select * from ", nom, " limit 0") # So this query wouldn't work with such fgb files
+    sourceCol <- st_read(dsn = fileName, query = query, quiet = !verbose) %>% names
+    inCol <- colonnes %in% sourceCol
+    badCol <- colonnes[!inCol]
+    colErr <- c("It seems that some of the columns you try to import do not exist in the source file,
               are you sure you meant ",
-              paste(badCol),"?")
-    if (prod(inCol)==0){ 
-      
-      
+                paste(badCol), "?")
+    if (prod(inCol) == 0) {
+
+
       stop(colErr) } else {
-      if (drop== TRUE) {sfFile<-sf::st_read(dsn=fileName,quiet=!verbose)[,colonnes] } else {
-        sfFile<-sf::st_read(dsn=fileName,quiet=!verbose)[,]}
+      if (drop == TRUE) { sfFile <- sf::st_read(dsn = fileName, quiet = !verbose)[, colonnes] } else {
+        sfFile <- sf::st_read(dsn = fileName, quiet = !verbose)[,] }
     }
-  } else {if (extension == ".fgb") {
-    sfFile<-sf::st_read(dsn=fileName,quiet=!verbose)[,]
-    sourceCol<-names(sfFile)
-    inCol<-colonnes%in%sourceCol
-    badCol<-colonnes[!inCol]
-    colErr<-c("It seems that some of the columns you try to import do not exist in the source file,
+  } else { if (extension == ".fgb") {
+    sfFile <- sf::st_read(dsn = fileName, quiet = !verbose)[,]
+    sourceCol <- names(sfFile)
+    inCol <- colonnes %in% sourceCol
+    badCol <- colonnes[!inCol]
+    colErr <- c("It seems that some of the columns you try to import do not exist in the source file,
               are you sure you meant ",
-              paste(badCol),"?")
-    if (prod(inCol)==0){ stop(colErr) }
+                paste(badCol), "?")
+    if (prod(inCol) == 0) { stop(colErr) }
 
   }
 
@@ -103,16 +102,16 @@ importLCZvectFromFile<-function(dirPath, file="rsu_lcz.geojson", column, geomID=
 #' geomID="ID_RSU",confid="LCZ_UNIQUENESS_VALUE")
 #' redonBDTex2<-importLCZvectFromSf(sfIn = redonBDTex , column="LCZ_PRIMARY",
 #'                                  geomID="ID_RSU",confid="LCZ_UNIQUENESS_VALUE")
-importLCZvectFromSf<-function(sfIn, column, geomID="", confid=""){
-  colonnes<-c(geomID,column,confid)
-  colonnes<-colonnes[sapply(colonnes,nchar)!=0]
-  sourceCol<-names(sfIn)
-  inCol<-colonnes%in%sourceCol
-  badCol<-colonnes[!inCol]
-  colErr<-c("It seems that some of the columns you try to import do not exist in the source file,
+importLCZvectFromSf <- function(sfIn, column, geomID = "", confid = "") {
+  colonnes <- c(geomID, column, confid)
+  colonnes <- colonnes[sapply(colonnes, nchar) != 0]
+  sourceCol <- names(sfIn)
+  inCol <- colonnes %in% sourceCol
+  badCol <- colonnes[!inCol]
+  colErr <- c("It seems that some of the columns you try to import do not exist in the source file,
               are you sure you meant ",
-            paste(badCol),"?")
-  if (prod(inCol)==0){ stop(colErr)} else { sfFile<-sfIn[,colonnes]}
+              paste(badCol), "?")
+  if (prod(inCol) == 0) { stop(colErr) } else { sfFile <- sfIn[, colonnes] }
   return(sfFile)
 }
 
@@ -147,79 +146,76 @@ importLCZvectFromSf<-function(sfIn, column, geomID="", confid=""){
 #' "/bdtopo_2_2/Redon"), file="rsu_lcz.geojson", column="LCZ_PRIMARY",
 #' geomID="ID_RSU",confid="LCZ_UNIQUENESS_VALUE")
 #' showLCZ(redonBDTex)
-importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column="LCZ_PRIMARY",
-                       geomID="", confid="",
-                       typeLevels=c("1"="1","2"="2","3"="3","4"="4","5"="5","6"="6","7"="7","8"="8",
-                                 "9"="9","10"="10",
-                                 "101"="101","102"="102","103"="103","104"="104", "105"="105","106"="106","107"="107",
-                                 "101"="11","102"="12","103"="13","104"="14", "105"="15", "106"="16","107"="17",
-                                  "101"="A","102"="B","103"="C","104"="D","105"="E","106"="F","107"="G"),
-                       drop=T, verbose=FALSE, sfIn = NULL){
+importLCZvect <- function(dirPath, file = "rsu_lcz.geojson", output = "sfFile", column = "LCZ_PRIMARY",
+                    geomID = "", confid = "",
+                    typeLevels =  typeLevelsDefault,
+                    drop = T, verbose = FALSE, sfIn = NULL, naAsUnclassified = TRUE) {
 
-  if (is.null(sfIn)){
-  sfFile<-importLCZvectFromFile(
-    dirPath = dirPath, file = file, column = column, geomID = geomID, confid = confid,
-  drop = drop, verbose = verbose)
+  if (is.null(sfIn)) {
+    sfFile <- importLCZvectFromFile(
+      dirPath = dirPath, file = file, column = column, geomID = geomID, confid = confid,
+      drop = drop, verbose = verbose)
   } else {
-    sfFile<-importLCZvectFromSf(sfIn, column, geomID="", confid="")
+    sfFile <- importLCZvectFromSf(sfIn, column, geomID = "", confid = "")
   }
-  
-  
+
+
   # if typeLevels is empty
-  if (length(typeLevels)==1){
-    typeLevels<-unique(subset(sfFile,select=all_of(column),drop=TRUE))
-    names(typeLevels)<-typeLevels
+  if (length(typeLevels) == 1) {
+    typeLevels <- unique(subset(sfFile, select = all_of(column), drop = TRUE))
+    names(typeLevels) <- typeLevels
   }
 
-  # if typeLevels is not specified it will be set to default and we need to capture this later
-  # typeLevelsDefault<-c("1"="1","2"="2","3"="3","4"="4","5"="5","6"="6","7"="7","8"="8",
-  #                   "9"="9","10"="10","101"="101","102"="102","103"="103","104"="104",
-  #                   "105"="105","106"="106","107"="107","101"="11","102"="12","103"="13","104"="14",
-  #                   "105"="15", "106"="16","107"="17")
-# Select columns from original file
-if (column!=""){
-   prov<-as.character(unique((st_drop_geometry(subset(sfFile,select=column,drop=T))))) %>% as.character
-  names(prov)<-prov
-  if( prod(prov%in%typeLevels)==0 ) {
-    if (verbose==TRUE){
+  if (column != "") {
+    prov <- as.character(unique((st_drop_geometry(subset(sfFile, select = column, drop = T))))) %>% as.character
+    names(prov) <- prov
+    if (prod(prov %in% typeLevels) == 0) {
+      if (verbose == TRUE) {
         print("levels in typeLevels are : ")
         print(typeLevels)
         print("levels in original data set are ")
-        print(unique(subset(sfFile,select=column,drop=T)))
+        print(unique(subset(sfFile, select = column, drop = T)))
       }
-      warning("The levels you specified with the typeLevels argument don't cover the LCZ values in your source file.
-              Some geoms have been dropped,this could seriously alter your analysis, please check the levels or enter an empty string as typeLevels")
+      warning(
+        paste0("The levels you specified with the typeLevels argument don't cover the LCZ values in your source file. \n",
+               "Some geoms have been dropped, this could seriously alter your analysis, \n",
+               "please check the levels or enter an empty string as typeLevels")
+      )
 
     }
- if( sum(prov%in%typeLevels)==0 ){
+    if (sum(prov %in% typeLevels) == 0) {
       stop(
-        paste0("none of the levels present in ",column,
+        paste0("none of the levels present in ", column,
                " is covered by the levels you specified.",
                "Check your choice of column and your choice of levels",
                " If you let typeLevels set by default, ", column,
                " must contain LCZ types in a standard format"))
     }
 
     sfFile <-
-    sfFile%>%
-      mutate(!!column:=fct_recode(
-        factor(subset(sfFile,select=column,drop=T),levels=typeLevels),!!!typeLevels)) %>%
-      drop_na(column)
-    }
-  else {stop("You must specify the column containing the LCZ")}
+      sfFile %>%
+        mutate(!!column := fct_recode(
+          factor(subset(sfFile, select = column, drop = T), levels = typeLevels), !!!typeLevels))  #%>%
+        # 
+    if (naAsUnclassified){ sfFile[[column]]<- forcats::fct_na_value_to_level(sfFile[[column]], "Unclassified") }
+    else { sfFile <- drop_na(sfFile, column)}
+  }
+  else { stop("You must specify the column containing the LCZ") }
 
 
   #sfFile <- sfFile%>% mutate(!!column:=fct_recode(subset(sfFile,select=column,drop=T),!!!typeLevels))
 
-  if(output=="sfFile"){return(sfFile)} else {
-    if(output=="bBox"){ 
-      bBox<-st_bbox(sfFile,crs=st_crs(sfFile)) %>% st_as_sfc %>% st_make_valid(geos_keep_collapsed = FALSE)
-
+  if (output == "sfFile") { return(sfFile) } else {
+    if (output == "bBox") {
+      bBox <- st_bbox(sfFile, crs = st_crs(sfFile)) %>%
+        st_as_sfc %>%
+        st_make_valid(geos_keep_collapsed = FALSE)
+
       return(bBox) }
     else {
-      stop("Output must be sfFile to return geoms and LCZ or bBox to return the bounding box")}
+      stop("Output must be sfFile to return geoms and LCZ or bBox to return the bounding box") }
 
-    }
+  }
 }
 
 
diff --git a/R/internalData.R b/R/internalData.R
@@ -1,11 +1,17 @@
-colorMap<-c("#8b0101","#cc0200","#fc0001","#be4c03","#ff6602","#ff9856",
-            "#fbed08","#bcbcba","#ffcca7","#57555a","#006700","#05aa05",
-            "#648423","#bbdb7a","#010101","#fdf6ae","#6d67fd", "ghostwhite")
-names(colorMap)<-as.character(c(1:10,101:107, "Unclassified"))
-etiquettes<-c("LCZ 1: Compact high-rise","LCZ 2: Compact mid-rise","LCZ 3: Compact low-rise",
-              "LCZ 4: Open high-rise","LCZ 5: Open mid-rise","LCZ 6: Open low-rise",
-              "LCZ 7: Lightweight low-rise","LCZ 8: Large low-rise",
-              "LCZ 9: Sparsely built","LCZ 10: Heavy industry",
-              "LCZ A: Dense trees", "LCZ B: Scattered trees",
-              "LCZ C: Bush,scrub","LCZ D: Low plants",
-              "LCZ E: Bare rock or paved","LCZ F: Bare soil or sand","LCZ G: Water", "Unclassified")
+colorMapDefault <- c("#8b0101", "#cc0200", "#fc0001", "#be4c03", "#ff6602", "#ff9856",
+              "#fbed08", "#bcbcba", "#ffcca7", "#57555a", "#006700", "#05aa05",
+              "#648423", "#bbdb7a", "#010101", "#fdf6ae", "#6d67fd", "ghostwhite")
+names(colorMapDefault) <- as.character(c(1:10, 101:107, "Unclassified"))
+etiquettesDefault <- c("LCZ 1: Compact high-rise", "LCZ 2: Compact mid-rise", "LCZ 3: Compact low-rise",
+                "LCZ 4: Open high-rise", "LCZ 5: Open mid-rise", "LCZ 6: Open low-rise",
+                "LCZ 7: Lightweight low-rise", "LCZ 8: Large low-rise",
+                "LCZ 9: Sparsely built", "LCZ 10: Heavy industry",
+                "LCZ A: Dense trees", "LCZ B: Scattered trees",
+                "LCZ C: Bush,scrub", "LCZ D: Low plants",
+                "LCZ E: Bare rock or paved", "LCZ F: Bare soil or sand", "LCZ G: Water", "Unclassified")
+
+typeLevelsDefault <- c("1" = "1", "2" = "2", "3" = "3", "4" = "4", "5" = "5", "6" = "6", "7" = "7", "8" = "8",
+                "9" = "9", "10" = "10",
+                "101" = "101", "102" = "102", "103" = "103", "104" = "104", "105" = "105", "106" = "106", "107" = "107",
+                "101" = "11", "102" = "12", "103" = "13", "104" = "14", "105" = "15", "106" = "16", "107" = "17",
+                "101" = "A", "102" = "B", "103" = "C", "104" = "D", "105" = "E", "106" = "F", "107" = "G", "Unclassified" = "Unclassified")
diff --git a/R/intersecAlocation.R → R/intersectAlocation.R b/R/intersecAlocation.R → R/intersectAlocation.R
@@ -9,28 +9,21 @@
 #' the values of workflownames, and the LCZ columns are expected to be lcz_primary (but lower and upper cases are accepted)
 #' @export
 #' @examples
-intersectAlocation<-function(dirPath, workflowNames = c("osm","bdt","iau","wudapt"), location){
-  lastPos<-nchar(dirPath)
-  if(substr(dirPath, start = lastPos, stop = lastPos)!="/"){dirPath<-paste0(dirPath,"/")}
-
-  typeLevels<-c("1"="1","2"="2","3"="3","4"="4","5"="5","6"="6","7"="7","8"="8",
-                "9"="9","10"="10",
-                "101"="101","102"="102","103"="103","104"="104", "105"="105","106"="106","107"="107",
-                "101"="11","102"="12","103"="13","104"="14", "105"="15", "106"="16","107"="17",
-                "101"="A","102"="B","103"="C","104"="D","105"="E","106"="F","107"="G")
-  sfList<-list()
-  for (i in workflowNames){
-    inName<-paste0(dirPath, i, "_lcz.fgb")
-    inSf<-read_sf(inName)
-    names(inSf)<-tolower(names(inSf))
-    inSf<-select(inSf,lcz_primary) %>% mutate(
-      lcz_primary=factor(lcz_primary, levels = typeLevels))
-    sfList[[i]]<-inSf
-    # sfName<-paste0(zoneName,i)
-    # assign(sfName,inSf)    
-    # print(summary(inSf))
-  }
-intersecSf<-createIntersect(sfList=sfList, columns=rep("lcz_primary", length(workflowNames)),
+intersectAlocation<-function(dirPath, workflowNames = c("osm","bdt","iau","wudapt"), location,
+                             addMissingRSUs = TRUE,
+                             missingGeomsWf="iau", refWf = NULL, refLCZ = "Unclassified",
+                             residualLCZvalue = "Unclassified",
+                             column = "lcz_primary"){
+  dirPath<-checkDirSlash(dirPath)
+  zoneSfPath<-paste0(dirPath, "zone.fgb")
+  zoneSf<-read_sf(zoneSfPath)
+
+  sfList<-loadMultipleSfs(dirPath = dirPath, workflowNames = c("osm","bdt","iau","wudapt"), location = location )
+  sfList<-addMissingRSUs(sfList = sfList,
+                         missingGeomsWf="iau", zoneSf =zoneSf, refWf = refWf, refLCZ = refLCZ,
+                         residualLCZvalue = residualLCZvalue,
+                         column = "lcz_primary", location = aLocation)
+  intersecSf<-createIntersect(sfList=sfList, columns=rep("lcz_primary", length(workflowNames)),
                               refCrs=NULL, sfWf=workflowNames, minZeroArea=0.0001)
   if ("character"%in%class(location)) {intersecSf$location<-location}
 return(intersecSf)

diff --git a/R/loadMultipleSfs.R b/R/loadMultipleSfs.R
@@ -19,7 +19,8 @@ loadMultipleSfs<-function(dirPath, workflowNames = c("osm","bdt","iau","wudapt")
                 "101"="101","102"="102","103"="103","104"="104", "105"="105","106"="106","107"="107",
                 "101"="11","102"="12","103"="13","104"="14", "105"="15", "106"="16","107"="17",
                 "101"="A","102"="B","103"="C","104"="D","105"="E","106"="F","107"="G")
-
+  dirPath<-checkDirSlash(dirPath)
+  print(dirPath)
   sfList<-list()
   for (i in workflowNames){
     inName<-paste0(dirPath, i, "_lcz.fgb")

diff --git a/R/matConfPlot.R b/R/matConfPlot.R
@@ -21,10 +21,10 @@
 #'
 #' @examples
 #'
-matConfPlot <- function(matConfLong,
+matConfPlot <- function(matConf,
                         column1 = "lcz_primary", column2 = "lcz_primary.1", agreeColumn = "agree",
                         wf1 = "reference", wf2 = "alternative", plotNow = TRUE, saveG = NULL) {
-  outPlot <- ggplot(matConfLong) +
+  outPlot <- ggplot(matConfLong$matConf) +
     geom_tile(aes(x = .data[[column1]], y = .data[[column2]], fill = .data[[agreeColumn]]),
               color = "white", lwd = 1.2, linetype = 1) +
     scale_fill_gradient2(low = "lightgrey", mid = "cyan", high = "blue",