compareMultiple ouputs a long form of agreements by pair of workflows…

… for each intersected geometries.

workflowAgreeAreas outputs the areas summed on where any pair of workflows agreee / disagree
To do : compute the summed areas when pairs of LCZ values agree / disagree

DESCRIPTION

@@ -23,6 +23,8 @@ Imports: RColorBrewer,
           rlang,
           grDevices,
           DescTools,
+          caret,
+          confintr,
           methods
 Suggests: 
     tinytest,

NAMESPACE

@@ -4,19 +4,29 @@ export(CohenKappa)
 export(LCZareas)
 export(areColors)
 export(compareLCZ)
+export(compareMultipleLCZ)
+export(concatAlocationWorkflows)
+export(concatIntersectedLocations)
 export(confidSensib)
+export(createIntersect)
 export(fetchLCZ)
 export(groupLCZ)
 export(importLCZgc)
 export(importLCZraster)
 export(importLCZvect)
+export(importLCZvectFromFile)
+export(importLCZvectFromSf)
 export(importQualVar)
+export(intersectAlocation)
 export(levCol)
+export(loadMultipleSf)
 export(matConfLCZ)
 export(matConfLCZGlob)
+export(multipleCramer)
 export(produceAnalysis)
 export(showLCZ)
 export(standLevCol)
+export(workflowAgreeAreas)
 import(RColorBrewer)
 import(cowplot)
 import(dplyr)
@@ -29,6 +39,8 @@ import(sf)
 import(tidyr)
 import(units)
 import(utils)
+importFrom(caret,dummyVars)
+importFrom(confintr,cramersv)
 importFrom(forcats,fct_recode)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,geom_sf)

R/compareMultipleLCZ.R

@@ -1,8 +1,6 @@
 #' Compares several sets of geographical classifications, especially Local Climate Zones classifications
-#' @param sfList a list which contains the classifications to compare, as sf objects
-#' @param LCZcolumns a vector which contains, for eacfh sf of sfList, the name of the column of the classification to compare
-#' @param refCrs a number which indicates which sf object from sfList will provide the CRS in which all the sf objects will be projected before comparison
-#' By defautl it is set to an empty string and no ID is loaded.
+#' @param sfInt an sf objects with intersected geometries and the LCZ columns for each workflow LCZ
+#' @param LCZcolumns a vector which contains, the name of the columns of the classification to compare
 #' @param sfWf a vector of strings which contains the names of the workflows used to produce the sf objects
 #' @param trimPerc this parameters indicates which percentile to drop out of the smallest geometries resulting 
 #' from the intersection of the original sf geometries intersection. 
@@ -18,36 +16,46 @@
 #' @export
 #' @examples
 #' 
-compareMultipleLCZ<-function(sfList, LCZcolumns, refCrs=NULL, sfWf=NULL, trimPerc=0.05){
-  echInt<-createIntersect(sfList = sfList, columns = LCZcolumns , refCrs= refCrs, sfWf = sfWf)
-  print(nrow(echInt))
-  echInt <- echInt %>% subset(area>quantile(echInt$area, probs=trimPerc) & !is.na(area))
-  echIntnogeom<-st_drop_geometry(echInt)
-  for (i in 1:(length(sfList) - 1)) {
-    for(j in (i+1):length(sfList)){
-      compName<-paste0(i,"_",j)
+compareMultipleLCZ<-function(sfInt, LCZcolumns, sfWf=NULL, trimPerc=0.05){
+  if (is.null(LCZcolumns)) { 
+    LCZcolumns<-names(sfInt)[!names(sfInt)%in%c("area", "geometry")]
+  }
+  sfInt <- sfInt %>% subset(area>quantile(sfInt$area, probs=trimPerc) & !is.na(area))
+  sfIntnogeom<-st_drop_geometry(sfInt)
+
+  if (is.null(sfWf) | length(sfWf)!=length(LCZcolumns)){sfWf<-LCZcolumns}
+
+  for (i in 1:(length(LCZcolumns) - 1)) {
+    for(j in (i+1):length(LCZcolumns)){
+      compName<-paste0(sfWf[i],"_",sfWf[j])
       print(compName)
-      echIntnogeom[,compName]<-echIntnogeom[,i] == echIntnogeom[,j]
+      sfIntnogeom[,compName]<-sfIntnogeom[ , LCZcolumns[i]] == sfIntnogeom[ , LCZcolumns[j]]
     }
   }
-  rangeCol<-(length(sfList)+3):ncol(echIntnogeom)
+  rangeCol<-(length(LCZcolumns)+2):ncol(sfIntnogeom)
   print(rangeCol)
-  # print(names(echIntnogeom[,rangeCol]))
-  echIntnogeom$nbAgree<-apply(echIntnogeom[,rangeCol],MARGIN=1,sum)
-  echIntnogeom$maxAgree<-apply(
-    X = echIntnogeom[,1:length(sfList)], MARGIN = 1, function(x) max(table(x) ))
-  echInt<-cbind(echIntnogeom,echInt$geometry)  %>% st_as_sf()
-  echInt
-  echIntLong<-pivot_longer(st_drop_geometry(echInt),cols=rangeCol, names_to = "whichWfs", values_to = "agree")
-  echIntLong$LCZref<-substr(echIntLong$whichWfs,start = 1, stop=1 )
-  print(head(echIntLong[,c(1,2,9:10)]))
-  whichLCZagree <- names(echIntLong)[as.numeric(echIntLong$LCZref)]
-  indRow<- seq_len(nrow(echIntLong))
+  # print(names(sfIntnogeom[,rangeCol]))
+  sfIntnogeom$nbAgree<-apply(
+     X = sfIntnogeom[,rangeCol],MARGIN=1,sum)
+  sfIntnogeom$maxAgree<-apply(
+    X = sfIntnogeom[,1:length(LCZcolumns)], MARGIN = 1, function(x) max(table(x) ))
+ print(head(sfIntnogeom))
+
+  # long format
+  sfIntLong<-pivot_longer(sfIntnogeom, cols=names(sfIntnogeom)[rangeCol], names_to = "whichWfs", values_to = "agree")
+
+  # Get the reference LCZ column on which 2 wf agree
+
+  whichLCZagree <- gsub( x = sfIntLong$whichWfs, pattern = "(.*)(_)(.*)", replacement = "\\1")
+  indRow<- seq_len(nrow(sfIntLong))
   z<-data.frame(indRow, whichLCZagree)
-  echIntLong$LCZvalue<-apply(z, 1, function(x) unlist(st_drop_geometry(echIntLong)[x[1], x[2]]))
-  print(head(echIntLong[,c(1,2,9:11)]))
-
-  output<-list(echInt=echInt, echIntLong=echIntLong)
+  print(head(z))
+  sfIntLong$LCZvalue<-apply(z, 1, function(x) unlist(st_drop_geometry(sfIntLong)[x[1], x[2]]))
+  print(head(sfIntLong[,c(1,2,9:11)]))
+  sfInt<-cbind(sfIntnogeom,sfInt$geometry)  %>% st_as_sf()
+
+
+  output<-list(sfInt=sfInt, sfIntLong=sfIntLong)
 }
 
 

R/concatAlocationWorkflows.R

@@ -0,0 +1,35 @@
+#' Take sf files with an lcz_primary column, and concatenates them in a single sf object, 
+#' adding a column for location and workflow names 
+#' @param sfList the list of LCZ sf objects 
+#' @param workflowNames sets the names of workflows and define the name of the files which will be loaded and intersected
+#' @param location the name of the location at which all LCZ are created
+#' @importFrom ggplot2 geom_sf guides ggtitle aes
+#' @import sf dplyr cowplot forcats units tidyr RColorBrewer utils grDevices rlang
+#' @return returns graphics of comparison and an object called matConfOut which contains :
+#' matConfLong, a confusion matrix in a longer form, 
+#' matConfPlot is a ggplot2 object showing the confusion matrix.
+#' percAgg is the general agreement between the two sets of LCZ, expressed as a percentage of the total area of the study zone
+#' pseudoK is a heuristic estimate of a Cohen's kappa coefficient of agreement between classifications
+#' If saveG is not an empty string, graphics are saved under "saveG.png"
+#' @export
+#' @examples
+concatAlocationWorkflows<-function(sfList, location, refCrs = 1){
+  if (is.null(location)){
+    location<- sfList[[1]]["location"][1]
+  }
+  concatDf<-data.frame(
+    matrix(ncol=4, nrow=0)
+  )
+  names(concatDf)<-c("lcz_primary", "location", "wf", "geometry")
+refCrs<-st_crs(sfList[[refCrs]]$geometry)
+  for (i in 1:length(sfList)){
+    inSf<-st_transform(
+            sfList[[i]],
+            crs = refCrs)
+    concatDf<-rbind(concatDf,inSf)
+  }
+  concatSf<-st_as_sf(concatDf)
+  rm(concatDf) ; gc()
+  concatSf<-mutate(concatSf, area = st_area(concatSf), .before = geometry)
+return(concatSf)
+}

R/concatIntersectedLocations.R

@@ -0,0 +1,32 @@
+#' In a given directory (or a list of directories) the function looks for LCZ datafiles, intersects them and return a datasets with intersected geometries and LCZ values for each workflow
+#' @param dirList the list of directories for which the different LCZ files will be intersected
+#' @param workflowNames sets the names of workflows and define the name of the files which will be loaded and intersected
+#' @param for each diretory from dirList, a location name must be fed to the function
+#' @importFrom ggplot2 geom_sf guides ggtitle aes
+#' @import sf dplyr cowplot forcats units tidyr RColorBrewer utils grDevices rlang
+#' @return returns graphics of comparison and an object called matConfOut which contains :
+#' matConfLong, a confusion matrix in a longer form, 
+#' matConfPlot is a ggplot2 object showing the confusion matrix.
+#' percAgg is the general agreement between the two sets of LCZ, expressed as a percentage of the total area of the study zone
+#' pseudoK is a heuristic estimate of a Cohen's kappa coefficient of agreement between classifications
+#' If saveG is not an empty string, graphics are saved under "saveG.png"
+#' @export
+#' @examples
+#' 
+concatIntersectedLocations<-function(dirList, locations, workflowNames = c("osm","bdt","iau","wudapt")){
+  concatIntersectedDf<-data.frame(
+    matrix(ncol=length(workflowNames)+3, nrow=0)
+  )
+  names(concatIntersectedDf)<-c(workflowNames,"area", "location", "geometry")
+
+  for (i in 1:length(dirList)){
+    print(locations[i])
+    concatIntersectedDf<-rbind(concatIntersectedDf,
+                               intersectAlocation(
+                                 dirPath = dirList[i], workflowNames = workflowNames, location = locations[i])
+    )
+  }
+  concatIntersectedDf$location<-factor(concatIntersectedDf$location)
+  concatIntersectedSf<-concatIntersectedDf %>% st_as_sf()
+  return(concatIntersectedSf)
+}

R/importLCZvect.R

@@ -1,3 +1,4 @@
+
 #' 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
@@ -24,18 +25,10 @@
 #' and if specified, columns for the IDs of the geoms and the confidence value of the LCZ levels.
 #' @export
 #' @examples 
-#' redonBDTex<-importLCZvect(dirPath=paste0(system.file("extdata", package = "lczexplore"),
+#' 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")
-#' 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){
+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)
@@ -54,8 +47,8 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column
     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 { 
+              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)[,]}
     }
@@ -68,11 +61,107 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column
               are you sure you meant ",
               paste(badCol),"?")
     if (prod(inCol)==0){ stop(colErr) }
-       
+
   }
-  
+
   }
+  return(sfFile)
+}
+
+
+#' 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
+#' @param file is the name of the file from which the LCZ are imported
+#' @param column indicates the name of the column containing LCZ values. 
+#' LCZ values are expected to be of a standard LCZ format (1 to 17, or 1 to 10 and 101 to 107 or 1 to G),
+#' else, use the importQualVar function
+#' @param geomID is the name of the column containing the ID of each geom to load. 
+#' If an empty string, no column is loaded.
+#' @param confid is the name of the column containing a confidence indicator to filter geoms,
+#' for instance the uniqueness of the LCZ level of each geom
+#' @param output : if sfFile, the function returns an sfFile with the specified columns,
+#' if bBox, returns a bounding box one can use to crop a raster file or to intersect another sf file
+#' @param typeLevels the levels of the imported LCZ classification
+#' @param verbose if TRUE show the discrepancies between specified levels of LCZ and
+#' levels actually present in column
+#' @param drop : the default is TRUE, which means all the column are 
+#' dropped excepted those specified in previous parameters
+#' @import dplyr forcats rlang sf
+#' @importFrom terra crop
+#' @importFrom tidyr drop_na
+#' @importFrom terra rast
+#' @return returns an sf object containing at least the geoms and the LCZ values, 
+#' and if specified, columns for the IDs of the geoms and the confidence value of the LCZ levels.
+#' @export
+#' @examples 
+#' redonBDTex<-importLCZvect(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")
+#' 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,
+              are you sure you meant ",
+            paste(badCol),"?")
+  if (prod(inCol)==0){ stop(colErr)} else { sfFile<-sfIn[,colonnes]}
+  return(sfFile)
+}
+
 
+#' 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
+#' @param file is the name of the file from which the LCZ are imported
+#' @param column indicates the name of the column containing LCZ values. 
+#' LCZ values are expected to be of a standard LCZ format (1 to 17, or 1 to 10 and 101 to 107 or 1 to G),
+#' else, use the importQualVar function
+#' @param geomID is the name of the column containing the ID of each geom to load. 
+#' If an empty string, no column is loaded.
+#' @param confid is the name of the column containing a confidence indicator to filter geoms,
+#' for instance the uniqueness of the LCZ level of each geom
+#' @param output : if sfFile, the function returns an sfFile with the specified columns,
+#' if bBox, returns a bounding box one can use to crop a raster file or to intersect another sf file
+#' @param typeLevels the levels of the imported LCZ classification
+#' @param verbose if TRUE show the discrepancies between specified levels of LCZ and
+#' levels actually present in column
+#' @param drop : the default is TRUE, which means all the column are 
+#' dropped excepted those specified in previous parameters
+#' @import dplyr forcats rlang sf
+#' @importFrom terra crop
+#' @importFrom tidyr drop_na
+#' @importFrom terra rast
+#' @return returns an sf object containing at least the geoms and the LCZ values, 
+#' and if specified, columns for the IDs of the geoms and the confidence value of the LCZ levels.
+#' @export
+#' @examples 
+#' redonBDTex<-importLCZvect(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")
+#' 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){
+
+  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="")
+  }
+
+
   # if typeLevels is empty
   if (length(typeLevels)==1){
     typeLevels<-unique(subset(sfFile,select=all_of(column),drop=TRUE))
@@ -110,7 +199,8 @@ if (column!=""){
 
     sfFile <-
     sfFile%>%
-      mutate(!!column:=fct_recode(factor(subset(sfFile,select=column,drop=T),levels=typeLevels),!!!typeLevels)) %>%
+      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")}
@@ -127,4 +217,6 @@ if (column!=""){
       stop("Output must be sfFile to return geoms and LCZ or bBox to return the bounding box")}
 
     }
-}
+}
+
+

R/intersecAlocation.R

@@ -10,6 +10,9 @@
 #' @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",