diff --git a/R/importLCZraster.R b/R/importLCZraster.R index 0bb3bf2..7d944c1 100644 --- a/R/importLCZraster.R +++ b/R/importLCZraster.R @@ -5,13 +5,15 @@ #' A future version may include the world data once a strategy is defined to deal with CRS. #' #' @param dirPath is the path to the directory where the -#' @param fileName is by default \'EU_LCZ_map.tif\' but can be changed for test prurposes. Will be useful when other zones will be added -#' @param column indicates the name of the column containing LCZ values, all other +#' @param fileName is the name of the raster file (tif or geotif), by default \'EU_LCZ_map.tif\' . +#' Will be useful when other zones will be added +#' @param column indicates the name of the column which will contain the LCZ in the output file #' @param typeLevels indicates a named vector of the unique values contained in column, #' @param zone set to europe by default, may include world once a strategy is defined -#' @param bBox bBox is the bounding box needed to crop the wudapt tiff file. -#' It can be produced bu the importLCZvect function. It can either be of class bBox or of class sfc -#' @return an sf file containing the geom and LCZ levels from the WUDAPT Europe tiff within the bBox bounding box +#' @param bBox bBox is the bounding box needed to crop the raster tiff file. +#' It can be produced by the importLCZvect function if one has a vect map o the same zone, +#' it can be a set of coordinates. It can either be of class bBox or of class sfc. +#' @return an sf file containing the geom and LCZ levels from the raster within the bBox bounding box #' @import sf dplyr forcats #' @importFrom terra crop #' @importFrom terra rast @@ -25,21 +27,22 @@ #' redonWudapt<-importLCZraster(system.file("extdata", package = "lczexplore"), #' fileName="redonWudapt.tif",bBox=redonBbox) #' -#' # another way to get the bounding box when one explores a given city would be the use of the +#' # Another way to get the bounding box when one explores a given city would be the use of the #' # getbb() function from the osmdata package. -#' # This exaample requires the osmdata package and therefore is not executed here +#' # This example requires the osmdata package and therefore is not executed here #' # redonBbox<-osmdata::getbb("Redon") #' # redonWudapt<-importLCZraster(system.file("extdata", package = "lczexplore"), #' # fileName="redonWudapt.tif",bBox=redonBbox) #' -#' # another way to get the bounding box when one doesn't want to compare to a vector map is to enter it's coordinates +#' # another way to get the bounding box when one doesn't want +#' # to compare to a vector map is to enter it's coordinates #' # and feed them to st_bbox() of the sf package. #' #' # the following example can only be executed when user has downloaded #' # CONUS-wide LCZ map and Training Areas on WUDAPT website #' # sanDiegobBoxCoord<-st_sf(a=1:2, geom=st_sfc( -#' #st_point(c(-117.175198,32.707289)), -#' #st_point(c(-117.112198,32.750900)),crs = 4326 +#' # st_point(c(-117.175198,32.707289)), +#' # st_point(c(-117.112198,32.750900)),crs = 4326 #' #)) #' #sanDiegoBbox<-st_bbox(sanDiegobBoxCoord) #' #sanDiegoWudapt<-importLCZraster( @@ -115,4 +118,4 @@ importLCZraster<-function(dirPath,zone="europe",bBox,fileName="EU_LCZ_map.tif", -} \ No newline at end of file +} diff --git a/R/importLCZvect.R b/R/importLCZvect.R index 730f8fe..6d2b443 100644 --- a/R/importLCZvect.R +++ b/R/importLCZvect.R @@ -51,7 +51,9 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column 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<-sf::st_read(dsn=fileName,quiet=!verbose)[,colonnes] } + 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 typeLevels is empty if (length(typeLevels)==1){ @@ -60,20 +62,16 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column } # 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") + # 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!=""){ - if(drop==T){sfFile<-subset(sfFile,select=colonnes)} - - - 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 ") @@ -83,7 +81,7 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column Some geoms have been dropped,this could seriously alter your analysis, 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, " is covered by the levels you specified.", @@ -92,7 +90,6 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", 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)) %>% @@ -104,8 +101,9 @@ importLCZvect<-function(dirPath, file="rsu_lcz.geojson", output="sfFile", column #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 - return(bBox)} + if(output=="bBox"){ + bBox<-st_bbox(sfFile,crs=st_crs(sfFile)) %>% st_as_sfc + return(bBox) } else { stop("Output must be sfFile to return geoms and LCZ or bBox to return the bounding box")} diff --git a/R/shinyGC/app.R b/R/shinyGC/app.R new file mode 100644 index 0000000..f94ffd4 --- /dev/null +++ b/R/shinyGC/app.R @@ -0,0 +1,272 @@ +library(shiny) +library(shinyFiles) +library(ggplot2) +library(lczexplore) +library(magrittr) +library(osmdata) +library(sf) +#devtools::install_github("elipousson/getdata") +library(getdata) + + +# Define UI for app that draws a histogram ---- +ui <- fluidPage( + h1(" This application helps build a configuration file to feed to geoclimate"), + h2(" The OSM workflow allows to run GeoClimate on any given city."), + h2("For BD TOPO workflows, the user has to provide a path to the input data"), + h2(" It is not possible to build a configuration files using bounding box coordinates yet."), + + tabsetPanel( + ############################################ + ## + ## Tab to create the config file + ## + ############################################ + tabPanel("Create your GeoClimate configuration JSON file", + + # Sidebar layout with input and output definitions ---- + sidebarLayout( + + # Sidebar panel for inputs ---- + sidebarPanel( + shinyDirButton(id = "outFolder", + label = "Output folder for GeoClimates results", + title = "Select the folder where GeoClimates will output its results"), + + selectInput(inputId="wf", label="Workflow", + choices = list(OpenStreetMap="OSM","BD TOPO V2"="BDTOPO_V2","BD TOPO V3"="BDTOPO_V3"), + selected=list(OpenStreetMap="OSM")), + + conditionalPanel( + condition='input.wf!="OSM"', + shinyDirButton("BDTinFolder", + label = "BD_TOPO folder", + title = "Choose in which folder are the BD_TOPO files"), + checkboxInput("forceSRID",label="Force SRID of BD TOPO inputs to 2154",value=FALSE), + textInput(inputId="inseeCode", label="Enter Insee code of your location (town)", value = "29162") + ), + + conditionalPanel( + condition='input.wf=="OSM"', + textInput(inputId="location",label="Enter your locations here", + value="Allaire",placeholder="A town name or some coordinates") + ), + + checkboxGroupInput(inputId="rsuIndics",label = "Choose the indicators to compute at RSU scale", + choices=c("LCZ","TEB","UTRF"),selected=c("LCZ")), + fluidRow( + column( width = 4, checkboxInput(inputId = "svfSimple", + label = "Use simplified algorithm for sky view factor", + value = TRUE)), + column(width = 4, checkboxInput(inputId = "EstimateHeight", label = "Estimate missing building heights", value = TRUE)) + ), + + checkboxGroupInput(inputId="gridIndics",label = "Choose the indicators to compute at grid scale", + choices=c("BUILDING_FRACTION", + "BUILDING_HEIGHT", + "WATER_FRACTION", + "VEGETATION_FRACTION", + "ROAD_FRACTION", + "IMPERVIOUS_FRACTION", + "LCZ_FRACTION"), + selected=c("BUILDING_FRACTION" + )), + numericInput(inputId="xGridSize", label="Choose the x size for the grid", value = 100, min = 10, max = 1000, step = 10), + numericInput(inputId="yGridSize", label="Choose the y size for the grid", value = 100, min = 10, max = 1000, step = 10), + shinyDirButton("configDirOut", + label = "Folder to export config File", + title = "Choose in which folder to export the config file"), + textInput(inputId="configOutFile", + label="Name your configuration file (without extension)", + value=""), + actionButton(inputId="writeConfigFile",label="Export your parameters to JSON config File") + ) + + + , + + # Main panel for displaying config file ---- + mainPanel( + titlePanel(title="Here is the content of the JSON configuration file you are building"), + + verbatimTextOutput("configJSON") + + + ) + ) + ), + + ############################################ + ## + ## tab to call geoclimate and show results + ## + ############################################ + tabPanel("Call the system to launch Geoclimate with your configuration file and parameters", + sidebarLayout( + sidebarPanel( + shinyFilesButton(id="jarFile",title="Path to geoclimate jarfile", + label="Path to geoclimate jarfile", + multiple=FALSE,filters=list("jar files"=c("jar"))), + + actionButton(inputId = "runGC",label = "Run GeoClimate with these parameters"), + verbatimTextOutput("outMessage", placeholder = TRUE), + actionButton(inputId = "showPlot", label = "View the outputs once GeoClimate executed successfully "), + actionButton(inputId = "showSourceData", label = "View the source data used to compute the LCZ ")), + + mainPanel( + verbatimTextOutput("folderImport"), + plotOutput("LCZplot"), + plotOutput("sourceDataPlot") + ) + + ) + ) + ) +) + +# Define server logic required to draw a histogram ---- +server <- function(input, output,session) { +# Choose the folder where results of geoclimate will be put + + shinyFiles::shinyDirChoose(input, 'outFolder', roots=getVolumes()(), + defaultPath = "", allowDirCreate = TRUE ) + outFolder<-reactive({ + gsub( + "//","/", + parseDirPath(roots=getVolumes()(), selection=input$outFolder)) }) + + shinyFiles::shinyDirChoose(input, id="BDTinFolder", roots=getVolumes()(), defaultPath = "" ) + + BDTinFolder<-reactive({ + BDTinFolder<-gsub( + "//","/", parseDirPath(roots=getVolumes()(), + selection = input$BDTinFolder)) + print(BDTinFolder) + }) + + # prepare export of configuration file + + shinyFiles::shinyDirChoose(input, 'configDirOut', roots=getVolumes()(), + defaultPath = "", allowDirCreate = TRUE ) + configOutFolder<-reactive({ + gsub( + "//","/", + parseDirPath(roots=getVolumes()(), selection=input$configDirOut) + ) + }) + + + #output$outMessage<-renderText({ BDTinFolder() }) + + output$configJSON<-renderText({ + geoClimateConfigFile( + wf = input$wf, + outFolder = gsub("//","/",outFolder()) , + locations = input$location, + forceSRID=input$forceSRID, + svfSimplified = input$svfSimple, + estimatedHeight = input$EstimateHeight, + grid_x_size = input$xGridSize, + grid_y_size = input$yGridSize, + rsuIndics = input$rsuIndics, + gridIndics = input$gridIndics, + BDTinseeCode = input$inseeCode, + BDTinFolder= BDTinFolder(), + outConfigDir=configOutFolder(), + outConfigFile = input$configOutFile, + writeNow=FALSE) + }) + +observeEvent( + input$writeConfigFile, { + geoClimateConfigFile( + wf = input$wf, + outFolder = gsub("//","/",outFolder()) , + locations = input$location, + forceSRID=input$forceSRID, + rsuIndics = input$rsuIndics, + grid_x_size = input$xGridSize, + grid_y_size = input$yGridSize, + gridIndics = input$gridIndics, + BDTinseeCode = input$inseeCode, + BDTinFolder= BDTinFolder(), + outConfigDir=configOutFolder(), + outConfigFile = input$configOutFile, + writeNow=TRUE) + } +) + + +shinyFiles::shinyFileChoose(input, 'jarFile', roots=getVolumes()(), + defaultPath = "/" ) +jarFilePath<-reactive({ + if (!is.null(input$jarFile)) { + gsub( + "//","/", + parseFilePaths(roots=getVolumes()(), input$jarFile)$datapath) + } + }) + +output$outMessage<-renderText({jarFilePath()}) + +observeEvent( + input$runGC, { + geoClimateCall(jarFilePath=jarFilePath(), + configFilePath=paste0(configOutFolder(),"/",input$configOutFile,".json"), + wf=input$wf) + } +) + + ############################################ + ## + ## Visualize GC outputs + ## + ############################################ + + wf<- reactive({input$wf}) + + LCZpath<-reactive({if ( wf() == "OSM"){ paste0(outFolder(),"/osm_",input$location,"/") } else + if (wf() == "BDTOPO_V2") {paste0(outFolder(),"/bdtopo_2_",input$inseeCode,"/") }}) + + output$folderImport<-renderText({ + LCZpath() + }) + +observeEvent( + input$showPlot,{ + sf1<-importLCZvect(dirPath=LCZpath()) + print(summary(sf1)) + LCZplot<-showLCZ(sf1) + output$LCZplot<-renderPlot({ + LCZplot + }) +}) + +observeEvent( + input$showSourceData,{ + zone<-read_sf(paste0(LCZpath(),"zone.geojson")) + buildings<-read_sf(paste0(LCZpath(),"/building.geojson")) %>% st_intersection(zone) + roads<-read_sf(paste0(LCZpath(),"/road.geojson")) %>% st_intersection(zone) + vegetation<-read_sf(paste0(LCZpath(),"/vegetation.geojson")) %>% st_intersection(zone) + water<-read_sf(paste0(LCZpath(),"/water.geojson")) %>% st_intersection(zone) + + + + sourceDataPlot<-ggplot()+ + geom_sf(data=vegetation,aes(),fill="#bbdb7a")+ + geom_sf(data=water,aes(),fill="blue")+ + geom_sf(data=roads,aes(),fill="black")+ + geom_sf(data=buildings,aes(),fill="grey") + + + output$sourceDataPlot<-renderPlot({ + sourceDataPlot + }) + + + }) + + +} + +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/R/shinyGC/launchShinyGC.R b/R/shinyGC/launchShinyGC.R new file mode 100644 index 0000000..b5427f1 --- /dev/null +++ b/R/shinyGC/launchShinyGC.R @@ -0,0 +1 @@ +shiny::runApp("/home/gousseff/Documents/2_CodesSources/R/lczexploreCleanOrbisgis/lczexplore/R/shinyGC/") diff --git a/R/showLCZ.R b/R/showLCZ.R index af9c694..51f332e 100644 --- a/R/showLCZ.R +++ b/R/showLCZ.R @@ -15,7 +15,7 @@ #' in your dataset and colors associated to these levels when not in the standard representation. You can pas your levels through a vector and you colors through another vector called colors. #' For more details about this, read the "lcz_explore_alter" vignette. #' @import sf ggplot2 dplyr cowplot forcats grDevices -#' @return no object is returned, but plots of the LCZ levels are produced +#' @return return the plot of the LCZ levels #' @export #' @examples #' # On original LCZ levels, use the \'standard\' value for the \'repr\' argument. @@ -159,9 +159,15 @@ showLCZ<-function(sf, title="", wf="",column="LCZ_PRIMARY", ggtitle(wtitre) } - if (repr=="standard"){print(pstandard)} + if (repr=="standard"){ + print(pstandard) + return(pstandard) + } else { - if (repr=="alter"){print(palter)} + if (repr=="alter"){ + print(palter) + return(palter) + } else {stop("the repr argument must be \"standard\" or \"alter\" ")} } diff --git a/inst/tinytest/test_importLCZvect.R b/inst/tinytest/test_importLCZvect.R index 4d18238..7efec9c 100644 --- a/inst/tinytest/test_importLCZvect.R +++ b/inst/tinytest/test_importLCZvect.R @@ -98,4 +98,11 @@ expect_warning(importLCZvect(dirPath=paste0(system.file("extdata", package = "lc "9"="9","10"="10","101"="101","102"="102","103"="103","104"="104", "105"="105","106"="106","101"="11","102"="12","103"="13","104"="14", "105"="15", "106"="16","107"="17"),drop=T), - "The levels you specified with the typeLevels argument don't cover the LCZ values") \ No newline at end of file + "The levels you specified with the typeLevels argument don't cover the LCZ values") + + +# test if the drop argument allows to keep or drop comun other than specified +test<-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",drop=FALSE) +expect_equal("LCZ_SECONDARY"%in%names(test),TRUE) \ No newline at end of file diff --git a/man/importLCZraster.Rd b/man/importLCZraster.Rd index abd3c35..b5c896d 100644 --- a/man/importLCZraster.Rd +++ b/man/importLCZraster.Rd @@ -27,9 +27,10 @@ importLCZraster( \item{bBox}{bBox is the bounding box needed to crop the wudapt tiff file. It can be produced bu the importLCZvect function. It can either be of class bBox or of class sfc} -\item{fileName}{is by default \'EU_LCZ_map.tif\' but can be changed for test prurposes. Will be useful when other zones will be added} +\item{fileName}{is the name of the raster file (tif or geotif), by default \'EU_LCZ_map.tif\' . +Will be useful when other zones will be added} -\item{column}{indicates the name of the column containing LCZ values, all other} +\item{column}{indicates the name of the column which will contain the LCZ in the output file} \item{typeLevels}{indicates a named vector of the unique values contained in column,} } @@ -50,6 +51,17 @@ redonBbox<-importLCZvect(dirPath=paste0(system.file("extdata", package = "lczexp redonWudapt<-importLCZraster(system.file("extdata", package = "lczexplore"), fileName="redonWudapt.tif",bBox=redonBbox) +# another way to get the bounding box when one explores a given city would be the use of the +# getbb() function from the osmdata package. +# This exaample requires the osmdata package and therefore is not executed here +# redonBbox<-osmdata::getbb("Redon") +# redonWudapt<-importLCZraster(system.file("extdata", package = "lczexplore"), +# fileName="redonWudapt.tif",bBox=redonBbox) + +# another way to get the bounding box when one doesn't want +#to compare to a vector map is to enter it's coordinates +# and feed them to st_bbox() of the sf package. + # the following example can only be executed when user has downloaded # CONUS-wide LCZ map and Training Areas on WUDAPT website # sanDiegobBoxCoord<-st_sf(a=1:2, geom=st_sfc( diff --git a/man/showLCZ.Rd b/man/showLCZ.Rd index 70c80dd..2a39594 100644 --- a/man/showLCZ.Rd +++ b/man/showLCZ.Rd @@ -41,7 +41,7 @@ in your dataset and colors associated to these levels when not in the standard r For more details about this, read the "lcz_explore_alter" vignette.} } \value{ -no object is returned, but plots of the LCZ levels are produced +return the plot of the LCZ levels } \description{ Produces a simple representation of the LCZ contained in an sf file.