before a checkbuilt

R/createIntersect.R

@@ -21,7 +21,8 @@ createIntersect<-function(sfList, columns, refCrs=NULL, sfWf=NULL, minZeroArea=0
   if (!is.null(sfWf) & length(sfWf) == length(sfList)){
     names(sfInt)[1:(ncol(sfInt)-1)]<-sfWf
   } else { names(sfInt)[1:(ncol(sfInt)-1)]<-paste0("LCZ",1:length(sfList)) }
-  sfInt$area<-units::drop_units(st_area(sfInt$geometry))
+  sfInt<-mutate(sfInt, area = units::drop_units(st_area(sfInt$geometry)),
+                                         .before=geometry)
   sfInt<-sfInt[sfInt$area>minZeroArea,]
   return(sfInt) 
 }

R/intersecAlocation.R

@@ -0,0 +1,35 @@
+#' Intersects several sf files for a given location identified by a given directory path and name 
+#' @param dirPath is the directory where the original data are
+#' @param workflowNames are the names of the workflows : they are used to identify the files
+#' @importFrom ggplot2 geom_sf guides ggtitle aes
+#' @import sf dplyr cowplot forcats units tidyr RColorBrewer utils grDevices rlang
+#' @return an sf file with values of LCZ from all the input 
+#' are assigned to geometries resulting from intersection of all input geometries
+#' @details This function is not generic, it expects the data files to be named wf_rsu_lcz; wf varying among 
+#' 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){
+  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)),
+                              refCrs=NULL, sfWf=workflowNames, minZeroArea=0.0001)
+  if ("character"%in%class(location)) {intersecSf$location<-location}
+return(intersecSf)
+}
+

inst/tinytest/test_multipleCramer.R

@@ -27,7 +27,7 @@ summary(intersected$area)
 min(intersected$area)
 intersected[intersected$area==0,]
 
-testVs<-multipleCramer(intersected, columns = names(intersected)[names(intersected)!="geometry" &names(intersected)!="area"], 
+testVs<-multipleCramer(intersected, columns = names(intersected)[names(intersected)!="geometry" &names(intersected)!="area"],
                        nbOutAssociations = 30)
 testVs$signifAssoc
 testVs$cramerLong %>% head(10)
@@ -36,7 +36,8 @@ intersectedDf<-st_drop_geometry(intersected)
 str(intersectedDf)
 summary(intersectedDf$area)
 min(intersectedDf$area)
-dataTest<-intersectedDf[ ,-6]
+names(intersectedDf)
+dataTest<-intersectedDf[ ,names(intersectedDf)!="area"]
 dataTest <- as.data.frame(lapply(X = dataTest, factor))
 summary(dataTest)
 str(dataTest)
@@ -51,10 +52,58 @@ weightsNo107<-(intersectedDf$area/sum(intersectedDf$area))[
   apply(dataTest, 1, function(x) all(x!="107"))]
 length(weightsNo107)
 
-auffargisMCANo107<-MCA(X = dataTestNo107[,names(dataTest)!="area"], ncp = 5) #, row.w = weightsNo107)
-plot.MCA(auffargisMCANo107, invisible= c("ind"))
-auffargisMCANo107Weights<-MCA(X = dataTestNo107[,names(dataTest)!="area"], ncp = 5, row.w = weightsNo107)
-plot.MCA(auffargisMCANo107Weights, invisible= c("ind"))
+auffargisMCANo107<-MCA(X = dataTestNo107[,names(dataTest)!="area"], ncp = 10, graph = FALSE)
+# plot.MCA(auffargisMCANo107, invisible= c("ind"))
+auffargisMCANo107Weights<-MCA(X = dataTestNo107[,names(dataTest)!="area"], ncp = 10, row.w = weightsNo107, graph = FALSE)
+# plot.MCA(auffargisMCANo107Weights, invisible= c("ind"))
+# plot.MCA(auffargisMCANo107Weights, invisible= c("ind"), axes=c(3,4))
+# plot.MCA(auffargisMCANo107Weights, invisible= c("ind"), axes=c(5,6))
+
+
+fviz_mca_var(
+  auffargisMCANo107Weights,
+  choice = c("var.cat"),
+  axes = c(1, 2),
+  geom = c("point", "text"),
+  repel = TRUE,
+  col.var = "red",
+  alpha.var = 1,
+  shape.var = 17,
+  col.quanti.sup = "blue",
+  col.quali.sup = "darkgreen",
+  map = "symmetric",
+  select.var = list(name = NULL, cos2 = NULL, contrib = NULL)
+)
+
+fviz_mca_var(
+  auffargisMCANo107Weights,
+  choice = c("var.cat"),
+  axes = c(3, 4),
+  geom = c("point", "text"),
+  repel = TRUE,
+  col.var = "red",
+  alpha.var = 1,
+  shape.var = 17,
+  col.quanti.sup = "blue",
+  col.quali.sup = "darkgreen",
+  map = "symmetric",
+  select.var = list(name = NULL, cos2 = NULL, contrib = NULL)
+)
+
+fviz_mca_var(
+  auffargisMCANo107Weights,
+  choice = c("var.cat"),
+  axes = c(5, 6),
+  geom = c("point", "text"),
+  repel = TRUE,
+  col.var = "red",
+  alpha.var = 1,
+  shape.var = 17,
+  col.quanti.sup = "blue",
+  col.quali.sup = "darkgreen",
+  map = "symmetric",
+  select.var = list(name = NULL, cos2 = NULL, contrib = NULL)
+)
 
 
 str(auffargisMCANo107)