From a6989a4c27fa257ac611a887dcbe153e8ea63b5a Mon Sep 17 00:00:00 2001 From: MGousseff Date: Fri, 6 Dec 2024 12:12:43 +0100 Subject: [PATCH] before a checkbuilt --- R/createIntersect.R | 3 +- R/intersecAlocation.R | 35 +++++++++++++++++ inst/tinytest/test_multipleCramer.R | 61 ++++++++++++++++++++++++++--- 3 files changed, 92 insertions(+), 7 deletions(-) create mode 100644 R/intersecAlocation.R diff --git a/R/createIntersect.R b/R/createIntersect.R index a4e00a0..49340b3 100644 --- a/R/createIntersect.R +++ b/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) } diff --git a/R/intersecAlocation.R b/R/intersecAlocation.R new file mode 100644 index 0000000..1a98cec --- /dev/null +++ b/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) +} + diff --git a/inst/tinytest/test_multipleCramer.R b/inst/tinytest/test_multipleCramer.R index a260ea4..3186bca 100644 --- a/inst/tinytest/test_multipleCramer.R +++ b/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)