From cf0062c10414090dee0ad24b411663dca9313d47 Mon Sep 17 00:00:00 2001 From: MGousseff Date: Mon, 3 Jun 2024 17:20:51 +0200 Subject: [PATCH] Multiple comparison engaged : nb of workflow agreeing OK TO DO : - which LCZ agree most - which workflows are the most alike --- R/compareMultipleLCZ.R | 64 +++++++++++++++++++++++++++++++++++++ R/shinyGC/createIntersect.R | 39 ++++++++++++++++++++++ 2 files changed, 103 insertions(+) create mode 100644 R/compareMultipleLCZ.R create mode 100644 R/shinyGC/createIntersect.R diff --git a/R/compareMultipleLCZ.R b/R/compareMultipleLCZ.R new file mode 100644 index 0000000..43c8900 --- /dev/null +++ b/R/compareMultipleLCZ.R @@ -0,0 +1,64 @@ +compareMultipleLCZ<-function(sfList, columns, refCrs=NULL, sfWf=NULL, trimPerc=0.05){ + echInt<-createIntersec(sfList = sfList, columns = columns , refCrs= refCrs, sfWf = sfWf) + print(nrow(echInt)) + echInt$area<-st_area(echInt) + echInt <- echInt %>% subset(area>quantile(echInt$area, probs=trimPerc) & !is.na(area)) + print(nrow(echInt)) + echIntnogeom<-st_drop_geometry(echInt) + for (i in 1:(length(sfList) - 1)) { + for(j in (i+1):length(sfList)){ + compName<-paste0(i,"_",j) + print(compName) + echIntnogeom[,compName]<-echIntnogeom[,i] == echIntnogeom[,j] + } + } + rangeCol<-(length(listSfs)+3):ncol(echIntnogeom) + print(rangeCol) + # print(names(echIntnogeom[,rangeCol])) + echIntnogeom$nbAgree<-apply(echIntnogeom[,rangeCol],MARGIN=1,sum) + echInt<-cbind(echIntnogeom,echInt$geometry) %>% st_as_sf() + echInt + + return(echInt) + # print(length(listSfs)+2:(ncol(echInt)-1)) + # echInt +} + + + +# sfBDT_11_78030<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/BDT/2011/bdtopo_2_78030", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# class(sfBDT_11_78030) +# sfBDT_22_78030<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/BDT/2022/bdtopo_3_78030", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_OSM_11_Auffargis<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/OSM/2011/osm_Auffargis/", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_OSM_22_Auffargis<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/OSM/2022/osm_Auffargis/", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_WUDAPT_78030<-importLCZvect("/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/WUDAPT", +# file ="wudapt_78030.geojson", column="lcz_primary") +# +# sfList<-list(BDT11 = sfBDT_11_78030, BDT22 = sfBDT_22_78030, OSM11= sf_OSM_11_Auffargis, OSM22 = sf_OSM_22_Auffargis, +# WUDAPT = sf_WUDAPT_78030) +# showLCZ(sfList[[1]]) +# +# +# +# intersected<-createIntersec(sfList = sfList, columns = c(rep("LCZ_PRIMARY",4),"lcz_primary"), +# sfWf = c("BDT11","BDT22","OSM11","OSM22","WUDAPT")) +# +# +# test_list<-list(a=c(1,2),b="top",c=TRUE) +# length(test_list) +# for (i in test_list[2:3]) print(str(i)) + +multicompare_test<-compareMultipleLCZ(sfList = sfList, columns = c(rep("LCZ_PRIMARY",4),"lcz_primary"), + sfWf = c("BDT11","BDT22","OSM11","OSM22","WUDAPT"),trimPerc = 0.5) +multicompare_test + +plot1<-showLCZ(sf = multicompare_test, column="LCZBDT22", wf="22") +plot2<-showLCZ(sf = multicompare_test, column="LCZBDT11", wf="11") + +ggplot(data=multicompare_test) + + geom_sf(aes(fill=as.factor(nbAgree), color=after_scale(fill))) + diff --git a/R/shinyGC/createIntersect.R b/R/shinyGC/createIntersect.R new file mode 100644 index 0000000..aa6f182 --- /dev/null +++ b/R/shinyGC/createIntersect.R @@ -0,0 +1,39 @@ +createIntersec<-function(sfList, columns, refCrs=NULL, sfWf=NULL){ + echInt<-sfList[[1]] %>% select(columns[1]) + if (is.null(refCrs)){refCrs<-st_crs(echInt)} + for (i in 2:length(sfList)){ + sfProv<-sfList[[i]] %>% select(columns[i]) + if (st_crs(sfProv) != refCrs ) {sfProv<-st_transform(sfProv, crs=refCrs)} + echInt<-st_intersection(echInt,sfProv) + } + if (!is.null(sfWf) & length(sfWf) == length(sfList)){ + names(echInt)[1:(ncol(echInt)-1)]<-paste0("LCZ",sfWf) + } else { names(echInt)[1:(ncol(echInt)-1)]<-paste0("LCZ",1:length(sfList)) } + echInt +} + +# sfBDT_11_78030<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/BDT/2011/bdtopo_2_78030", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# class(sfBDT_11_78030) +# sfBDT_22_78030<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/BDT/2022/bdtopo_3_78030", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_OSM_11_Auffargis<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/OSM/2011/osm_Auffargis/", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_OSM_22_Auffargis<-importLCZvect(dirPath="/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/OSM/2022/osm_Auffargis/", +# file="rsu_lcz.fgb", column="LCZ_PRIMARY") +# sf_WUDAPT_78030<-importLCZvect("/home/gousseff/Documents/0_DocBiblioTutosPublis/0_ArticlesScientEtThèses/ArticleComparaisonLCZGCWUDAPTEXPERTS/WUDAPT", +# file ="wudapt_78030.geojson", column="lcz_primary") +# +# sfList<-list(BDT11 = sfBDT_11_78030, BDT22 = sfBDT_22_78030, OSM11= sf_OSM_11_Auffargis, OSM22 = sf_OSM_22_Auffargis, +# WUDAPT = sf_WUDAPT_78030) +# showLCZ(sfList[[1]]) +# +# +# +# intersected<-createIntersec(sfList = sfList, columns = c(rep("LCZ_PRIMARY",4),"lcz_primary"), +# sfWf = c("BDT11","BDT22","OSM11","OSM22","WUDAPT")) +# +# +# test_list<-list(a=c(1,2),b="top",c=TRUE) +# length(test_list) +# for (i in test_list[2:3]) print(str(i)) \ No newline at end of file