diff --git a/.gitignore b/.gitignore index 9c8f510de..b4e10aeda 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,8 @@ .Rhistory **/.cache **/.config +scripts/1_IAvH_functions/01_pp.R +scripts/1_IAvH_functions/01_pp.yml +scripts/IAvH_inputs/p&p_collection/metadata.json +scripts/IAvH_inputs/p&p_collection/metadata.csv +*.tif diff --git a/http-proxy/conf.d/ngnix.conf b/http-proxy/conf.d/ngnix.conf index 4f2a946e1..02a2adf3e 100644 --- a/http-proxy/conf.d/ngnix.conf +++ b/http-proxy/conf.d/ngnix.conf @@ -2,6 +2,8 @@ server { listen 80; + client_max_body_size 8M; + add_header Access-Control-Allow-Origin "localhost:3000"; server_name boninabox.com; location /script/ { diff --git a/pipelines/01_pp.R b/pipelines/01_pp.R new file mode 100644 index 000000000..b2678d569 --- /dev/null +++ b/pipelines/01_pp.R @@ -0,0 +1,97 @@ +### funci?n check_collections + +# Cargar librerias +packages_list<-list("magrittr", "terra", "raster") +invisible(lapply(packages_list, library, character.only = TRUE)) + +# Organizar directorios +args <- commandArgs(trailingOnly=TRUE) +outputFolder <- args[1] + +# Cargar archivos de entrada +input <- rjson::fromJSON(file=file.path(outputFolder, "input.json")) + +dir_wkt<- input$dir_wkt_polygon +dir_colection<- input$dir_colection + +epsg_polygon<- input$epsg_polygon +resolution<- input$resolution +folder_output<- input$folder_output + +wkt_polygon<- readLines(dir_wkt) +layers <- list.files(dir_colection, "\\.tif$", recursive = TRUE, full.names = TRUE) +json_colleciton_file <- list.files(dir_colection, "\\.json$", recursive = TRUE, full.names = TRUE) +meadata_collecion_file <- list.files(dir_colection, "\\.csv$", recursive = TRUE, full.names = TRUE) +metadata<- read.csv(meadata_collecion_file) + +# Especificar carpea donmde guardar resultados +folder_results<- paste0(dirname(dirname(dirname(outputFolder))), "/", folder_output) +dir.create(folder_results) + + +# Especificar info area de estudio +vector_polygon<- terra::vect(wkt_polygon, crs= sf::st_crs(epsg_polygon)$proj4string ) %>% terra::as.polygons() +crs_polygon<- terra::crs(vector_polygon) +box_polygon<- sf::st_bbox(vector_polygon) + + +# Alinear con colecci?on +stac_collection<- gdalcubes::create_image_collection(files= layers, format= json_colleciton_file) + +# Cargar cubo +cube_collection<- gdalcubes::cube_view(srs = crs_polygon, extent = list(t0 = gdalcubes::extent(stac_collection)$t0, t1 = gdalcubes::extent(stac_collection)$t1, + left = box_polygon[1], right = box_polygon[3], + top = box_polygon[4], bottom = box_polygon[2]), + dx = resolution, dy = resolution, dt = "P1Y", aggregation = "first", resampling = "first", keep.asp= F) + +cube <- gdalcubes::raster_cube(stac_collection, cube_collection) + +# Cortar cubo por area de estudio +cube_mask<- gdalcubes::filter_geom(cube, geom= wkt_polygon, srs = crs_polygon ) + + +# Convertir cubo a raster +cube_stars <- stars::st_as_stars(cube_mask) %>% terra::rast() %>% setNames(names(cube)) + +collection_rast<- lapply(cube_stars, function(x) { if(any( is.na(summary(raster::raster(x))) )){NULL}else{x} } ) %>% + {Filter(function(x) !is.null(x), .)} %>% {setNames(., unlist(sapply(., function(x) names(x))) )} %>% terra::rast() + +# estimar metricas de area +data_sum<- terra::freq(collection_rast, usenames=T) %>% dplyr::mutate(area_m2= count*resolution) %>% dplyr::select(-count) %>% + dplyr::rename(collection= layer) %>% dplyr::mutate(layer= sapply(.$collection, function(x) stringr::str_split(x, "_B*time")[[1]][1]) ) %>% + list(metadata) %>% plyr::join_all() %>% dplyr::group_by(layer) %>% dplyr::mutate(porcentaje= area_m2/sum(area_m2) ) + +data_sum$periodo<- unlist(strsplit(data_sum$layer, "_") %>% sapply(function(x) paste(x[c(2:3)], collapse = "_")), recursive = T) + +names(data_sum)<-c("collection", "value", "area", "layer", "key", "percentage", "period") + + + +# partir y guardar raster acorde a los valores +setwd(folder_results) +saveraster<- lapply( seq(nrow(data_sum)), function(i) { + + x<- data_sum[i, ] + + raster_val<- collection_rast[x$layer] + raster_val[!raster_val %in% x$value]= NA + raster_val[raster_val %in% x$value]= 1 + + terra::writeRaster(raster_val, paste0(x$layer, "_class_",x$class, ".tif"), overwrite=T) + +} ) + + + + +# guardar tabla resumen +setwd(folder_results) +write.csv(data_sum,"data_summ.csv") + +# Imprimir resultado en logs +print(data_sum) + +## Imprimir resultado - Formao json +output <- list("folder_output" = folder_results) +jsonData <- rjson::toJSON(output, indent=2) +write(jsonData, file.path(outputFolder,"output.json")) \ No newline at end of file diff --git a/pipelines/01_pp.yml b/pipelines/01_pp.yml new file mode 100644 index 000000000..ff5535dc9 --- /dev/null +++ b/pipelines/01_pp.yml @@ -0,0 +1,35 @@ +script: 01_pp.R +description: "This sample script shows how it works." +external_link: https://github.com/GEO-BON/biab-2.0 +inputs: + dir_wkt_polygon: + label: dir_wkt_polygon + description: dir_wkt_polygon + type: text + example: '/scripts/IAvH_inputs/wkt_polygon_test.txt' + epsg_polygon: + label: epsg_polygon + description: epsg_polygon + type: numeric + example: 3395 + dir_colection: + label: dir_colection + description: dir_colection + type: text + example: '/scripts/IAvH_inputs/p&p_collection' + resolution: + label: resolution + description: value in meters + type: numeric + example: 1000 + folder_output: + label: folder_output + description: folder_output + type: text + example: 'p_p_studyarea_1000m2' + +outputs: + folder_output: + label: folder_output + description: folder_output + type: text \ No newline at end of file diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2000_12_31-pp_2000_2005.tfw b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2000_12_31-pp_2000_2005.tfw new file mode 100644 index 000000000..31f93607a --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2000_12_31-pp_2000_2005.tfw @@ -0,0 +1,6 @@ +0.0002500000 +0.0000000000 +0.0000000000 +-0.0002500000 +-79.0074509690 +12.4582381791 diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2005_12_31-pp_2000_2005.tfw b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2005_12_31-pp_2000_2005.tfw new file mode 100644 index 000000000..31f93607a --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2005_12_31-pp_2000_2005.tfw @@ -0,0 +1,6 @@ +0.0002500000 +0.0000000000 +0.0000000000 +-0.0002500000 +-79.0074509690 +12.4582381791 diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2010_12_31-pp_2006_2010.tfw b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2010_12_31-pp_2006_2010.tfw new file mode 100644 index 000000000..31f93607a --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2010_12_31-pp_2006_2010.tfw @@ -0,0 +1,6 @@ +0.0002500000 +0.0000000000 +0.0000000000 +-0.0002500000 +-79.0074509690 +12.4582381791 diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2015_12_31-pp_2011_2015.tfw b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2015_12_31-pp_2011_2015.tfw new file mode 100644 index 000000000..31f93607a --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2015_12_31-pp_2011_2015.tfw @@ -0,0 +1,6 @@ +0.0002500000 +0.0000000000 +0.0000000000 +-0.0002500000 +-79.0074509690 +12.4582381791 diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2021_12_31-pp_2016_2021.tfw b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2021_12_31-pp_2016_2021.tfw new file mode 100644 index 000000000..31f93607a --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/Colombia_pp-2021_12_31-pp_2016_2021.tfw @@ -0,0 +1,6 @@ +0.0002500000 +0.0000000000 +0.0000000000 +-0.0002500000 +-79.0074509690 +12.4582381791 diff --git a/scripts/lossPersistence/input/Colombia_pp_collection/catalog.json b/scripts/lossPersistence/input/Colombia_pp_collection/catalog.json new file mode 100644 index 000000000..b89e5238f --- /dev/null +++ b/scripts/lossPersistence/input/Colombia_pp_collection/catalog.json @@ -0,0 +1,177 @@ +{ + "id": "Colombia_pp", + "type": "Collection", + "description": "Collection format for Biotablero (IAvH, 2022)", + "pattern": ".+\\.tif", + "images": { + "pattern": ".*(Colombia_pp-.{4}_.{2}_.{2}-.*)\\.tif" + }, + "datetime": { + "pattern": ".*Colombia_pp-(.{4}_.{2}_.{2})-.*\\.tif", + "format": "%Y_%m_%d" + }, + "features": { + "Colombia_pp-2005_12_31-pp_2000_2005": { + "id": "Colombia_pp-2005_12_31-pp_2000_2005", + "pattern": ".+Colombia_pp-2005_12_31-pp_2000_2005+.*\\.tif", + "assets": { + "Colombia_pp-2005_12_31-pp_2000_2005": { + "href": "Colombia_pp-2005_12_31-pp_2000_2005.tif", + "classes": { + "period_layer": ["2000-2005", "2000-2005", "2000-2005"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2010_12_31-pp_2006_2010": { + "id": "Colombia_pp-2010_12_31-pp_2006_2010", + "pattern": ".+Colombia_pp-2010_12_31-pp_2006_2010+.*\\.tif", + "assets": { + "Colombia_pp-2010_12_31-pp_2006_2010": { + "href": "Colombia_pp-2010_12_31-pp_2006_2010.tif", + "classes": { + "period_layer": ["2006-2010", "2006-2010", "2006-2010"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2015_12_31-pp_2011_2015": { + "id": "Colombia_pp-2015_12_31-pp_2011_2015", + "pattern": ".+Colombia_pp-2015_12_31-pp_2011_2015+.*\\.tif", + "assets": { + "Colombia_pp-2015_12_31-pp_2011_2015": { + "href": "Colombia_pp-2015_12_31-pp_2011_2015.tif", + "classes": { + "period_layer": ["2011-2015", "2011-2015", "2011-2015"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2021_12_31-pp_2016_2021": { + "id": "Colombia_pp-2021_12_31-pp_2016_2021", + "pattern": ".+Colombia_pp-2021_12_31-pp_2016_2021+.*\\.tif", + "assets": { + "Colombia_pp-2021_12_31-pp_2016_2021": { + "href": "Colombia_pp-2021_12_31-pp_2016_2021.tif", + "classes": { + "period_layer": ["2016-2021", "2016-2021", "2016-2021"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + } + }, + "bands": { + "Colombia_pp-2005_12_31-pp_2000_2005": { + "id": "Colombia_pp-2005_12_31-pp_2000_2005", + "pattern": ".+Colombia_pp-2005_12_31-pp_2000_2005+.*\\.tif", + "assets": { + "Colombia_pp-2005_12_31-pp_2000_2005": { + "href": "Colombia_pp-2005_12_31-pp_2000_2005.tif", + "classes": { + "period_layer": ["2000-2005", "2000-2005", "2000-2005"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2010_12_31-pp_2006_2010": { + "id": "Colombia_pp-2010_12_31-pp_2006_2010", + "pattern": ".+Colombia_pp-2010_12_31-pp_2006_2010+.*\\.tif", + "assets": { + "Colombia_pp-2010_12_31-pp_2006_2010": { + "href": "Colombia_pp-2010_12_31-pp_2006_2010.tif", + "classes": { + "period_layer": ["2006-2010", "2006-2010", "2006-2010"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2015_12_31-pp_2011_2015": { + "id": "Colombia_pp-2015_12_31-pp_2011_2015", + "pattern": ".+Colombia_pp-2015_12_31-pp_2011_2015+.*\\.tif", + "assets": { + "Colombia_pp-2015_12_31-pp_2011_2015": { + "href": "Colombia_pp-2015_12_31-pp_2011_2015.tif", + "classes": { + "period_layer": ["2011-2015", "2011-2015", "2011-2015"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + }, + "Colombia_pp-2021_12_31-pp_2016_2021": { + "id": "Colombia_pp-2021_12_31-pp_2016_2021", + "pattern": ".+Colombia_pp-2021_12_31-pp_2016_2021+.*\\.tif", + "assets": { + "Colombia_pp-2021_12_31-pp_2016_2021": { + "href": "Colombia_pp-2021_12_31-pp_2016_2021.tif", + "classes": { + "period_layer": ["2016-2021", "2016-2021", "2016-2021"], + "col": ["#c65453", "#92ab58", "#c5b599"], + "value": [0, 1, 2], + "classes": ["Perdida", "Persistencia", "No Bosque"] + } + } + }, + "bbox": [-180, -90, 180, 90], + "properties": { + "proj:epsg": null, + "resolution": [300, 300] + } + } + } +} diff --git a/scripts/lossPersistence/pp.R b/scripts/lossPersistence/pp.R new file mode 100644 index 000000000..14a0b8a3a --- /dev/null +++ b/scripts/lossPersistence/pp.R @@ -0,0 +1,273 @@ +# Instalar librerias necesarias +packagesPrev<- installed.packages()[,"Package"] +packagesNeed<- list("magrittr", "terra", "raster", "sf", "fasterize", "pbapply", "gdalUtilities") +lapply(packagesNeed, function(x) { if ( ! x %in% packagesPrev ) { install.packages(x, force=T)} }) + +# Cargar librerias +packagesList<-list("magrittr", "terra", "raster") +lapply(packagesList, library, character.only = TRUE) + +# Definir output +Sys.setenv(outputFolder = "/path/to/output/folder") +# outputFolder<- {x<- this.path::this.path(); paste0(gsub("/scripts.*", "/output", x), gsub("^.*/scripts", "", x) ) } %>% list.files(full.names = T) %>% {.[which.max(sapply(., function(info) file.info(info)$mtime))]} + +# Definir input +input <- rjson::fromJSON(file=file.path(outputFolder, "input.json")) # Cargar input +input<- lapply(input, function(x) if( grepl("/", x) ){ + sub("/output/.*", "/output", outputFolder) %>% dirname() %>% file.path(x) %>% {gsub("//+", "/", .)} }else{x} ) # Ajuste input 1 + +# Correr codigo +# Definir area de estudio +ext_WKT_area<- tools::file_ext(input$WKT_area) +dir_wkt<- if(ext_WKT_area %in% "txt"){ readLines(input$WKT_area) }else{ input$WKT_area } +crs_polygon<- terra::crs( paste0("+init=epsg:", input$epsg) ) %>% as.character() +vector_polygon<- terra::vect(dir_wkt, crs= crs_polygon ) %>% sf::st_as_sf() + +# Ajustar resolucion +resolution_crs<- raster::raster(raster::extent(seq(4)),crs= paste0("+init=epsg:", 3395), res= input$resolution) %>% + raster::projectRaster( crs = crs_polygon) %>% raster::res() +box_polygon<- sf::st_bbox(vector_polygon) %>% sf::st_as_sfc() %>% sf::st_bbox() + +# crear raster base +rasterbase<- raster::raster( raster::extent(box_polygon),crs= crs_polygon, res= resolution_crs) + +# cargar area de estudio +tf_sp<- tempfile(fileext = '.shp'); sf::st_write(vector_polygon, tf_sp); tf<- tempfile(fileext = '.tif') +t_file<- terra::writeStart(rasterbase, filename = tf, overwrite=T); terra::writeStop(t_file); +gdalUtilities::gdal_rasterize(at=T, src_datasource= tf_sp, tf, burn = 1 ) +study_area<- terra::rast(t_file) + +box_study_area<- terra::ext(study_area) %>% sf::st_bbox() +dim_study_area<- dim(study_area) + +# Cargar coleccion + if( startsWith(input$collection_path, "http://") ){ # Cuando proviene de una coleccion en linea + RSTACQuery<- rstac::stac(input$collection_path) + box_4326 <- sf::st_as_sfc(box_polygon) %>% sf::st_transform(4326) %>% sf::st_bbox() + STACItemCollection <- rstac::stac_search(q= RSTACQuery, collections = "chelsa-clim" , bbox = box_4326) %>% rstac::get_request() + assets<- unlist(lapply(STACItemCollection$features,function(y){names(y$assets)})) %>% unique() + image_collection <- gdalcubes::stac_image_collection(STACItemCollection$features, asset_names = assets ) + + } else { # Cuando proviene de una coleccion local + layers_collection <- list.files(input$collection_path, "\\.tif$", recursive = TRUE, full.names = TRUE) + json_colleciton_file <- list.files(input$collection_path, "\\.json$", recursive = TRUE, full.names = TRUE) + STACItemCollection <- rjson::fromJSON(file= json_colleciton_file) + image_collection <- gdalcubes::create_image_collection(files= layers_collection, format= json_colleciton_file) + } + +# Cargar assests metadata +assets_metadata<- STACItemCollection$features %>% purrr::map("assets") %>% {setNames(unlist(., recursive = F), sapply(., function(y) names(y)))} + + +# Redondear temporaldiad del cubo +type_period<- tryCatch({ sub(".*P", "", input$time_period) %>% {period= as.numeric(gsub("([0-9]+).*$", "\\1", .)); type= gsub(period,"", .); list(type=type, period=period) } +}, error= function(e){ list(type=type, period=period) }) + +t0<- gdalcubes::extent(image_collection)$t0 +t1<- gdalcubes::extent(image_collection)$t1 + +t0<-if(!input$time_start %in% "NA"){ tryCatch(as.Date(input$time_start), error= function(e){t0}) }else{t0} +t0<- (if(type_period$type == "Y"){ lubridate::floor_date(as.Date(t0), lubridate::years(type_period$period)) +} else if (type_period$type == "M") { lubridate::floor_date(as.Date(t0), months(type_period$period) ) +} else if( type_period$type == "D"){ lubridate::floor_date(as.Date(t0), lubridate::days(type_period$period) ) + } else{as.Date(t0)}) %>% paste0("T00:00:00") + +t1<-if(!input$time_start %in% "NA"){ tryCatch(as.Date(input$time_end), error= function(e){t1}) }else{t1} +t1<- (if(type_period$type == "Y"){ lubridate::ceiling_date(as.Date(t1), lubridate::years(type_period$period)) +} else if (type_period$type == "M") { lubridate::ceiling_date(as.Date(t1), months(type_period$period) ) +} else if( type_period$type == "D"){ lubridate::ceiling_date(as.Date(t1), lubridate::days(type_period$period) ) +} else{as.Date(t1)}) %>% paste0("T00:00:00") + + + +# Establecer cube view +cube_collection<- gdalcubes::cube_view(srs = crs_polygon, extent = list(t0 = t0, t1 = t1, + left = box_study_area[1], right = box_study_area[3], + top = box_study_area[4], bottom = box_study_area[2]), + nx = dim_study_area[1], ny = dim_study_area[2], dt = "P1Y",aggregation = "near", resampling = "first", + keep.asp= F) + +# Crear cubo +cube <- gdalcubes::raster_cube(image_collection, cube_collection) + +# Descargar cubo +fn = tempfile(fileext = ".nc"); gdalcubes::write_ncdf(cube, fn) +nc <- ncdf4::nc_open(fn); vars <- names(nc$var) + +# Ordenar temporalidad del cubo +cube_times<- as.data.frame(gdalcubes::dimension_bounds(cube)[["t"]]) +cube_times + +nc_times<- if(nrow(cube_times)<2){"X0"}else{ paste0("X", ncdf4::ncvar_get(nc, "time_bnds")[1,]) } +time_collection<- as.data.frame(gdalcubes::dimension_bounds(cube)[["t"]]) %>% dplyr::mutate(time_id= nc_times, dim3=seq(nrow(.))) + + +# Organizar cubo como raster +terra_mask<- pbapply::pblapply(vars[5:length(vars)], function(x){ print(x) + + # Dimensiones de la capa + dims_var <- ncdf4::ncvar_get(nc= nc, varid= x, collapse_degen = F) + + # Validar si la capa esta vacia + key<- as.data.frame(which(!is.na(dims_var), arr.ind = TRUE)) + + if(nrow(key)>0){ + + # Cargar capa raster + key2<- {if(nrow(cube_times)<2){ dplyr::mutate(key, time_id= "X0") }else{ key }} %>% {list(., time_collection)} %>% plyr::join_all() + + stack_var<- terra::rast(dims_var) %>% setNames(nc_times) + terra::crs(stack_var)<- terra::crs(study_area) + terra::ext(stack_var)<- terra::ext(study_area) + + times<- unique(key2$time_id) + layer <- stack_var [[ times ]] %>% terra::mask(study_area) + + # Organizar metadatos de la capa + metadata_band<- assets_metadata[[x]] + metadata_assest<- metadata_band %>% { .[!c(names(.) %in% c("type", "raster:bands"))] } %>% + lapply(function(z) if(length(z)>1){if(class(z) %in% "list"){data.frame(z)}else{NULL} + }else{z} ) %>% {Filter(function(x) !is.null(x), .)} + check_data<- names(metadata_assest)[!sapply(metadata_assest, function(x) class(x) %in% "data.frame")] + for(j in check_data){ metadata_assest[[j]]<- data.frame(metadata_assest[j])} + + + # Organizar cuando hay "value" en metadata + which_values<- unlist(sapply(metadata_assest, function(x) "value" %in% names(x))) + metadata_assest2<- metadata_assest[which(!which_values)] + suppressMessages({metadata_assest2<- dplyr::bind_cols(metadata_assest2) %>% dplyr::mutate(layer= x)}) + + # Organizar informacion de la capa + info_layer<- dplyr::distinct(key2[, c("start", "end")]) %>% dplyr::distinct() %>% + dplyr::mutate(period= paste(start, end, sep="_"), layer= x) %>% + list(metadata_assest2) %>% plyr::join_all() %>% + dplyr::mutate(layer= gsub( "[[:punct:]]", "_", paste(x, period, sep = "_") ) ) %>% + dplyr::mutate(file= paste0(layer, ".tif") ) %>% + dplyr::relocate("layer", .before = 1) + + # Organizar nombre de la capa + names(layer)<- info_layer$layer + + # Organizar datos de la capa + data_layer<- setNames(as.data.frame(layer), "value") %>% dplyr::mutate(layer= names(layer)) %>% dplyr::relocate("layer", .before = 1) %>% + dplyr::distinct() %>% list(info_layer) %>% plyr::join_all() + + # Asignar "value" a los datos + if(sum(which_values)>0){ + metadata_values<- metadata_assest[which(which_values)][[1]]; class_names<- names(metadata_values) %>% {.[!. %in% "value"]} + data_layer2<- list(metadata_values, data_layer) %>% plyr::join_all() %>% + dplyr::mutate_all(~ ifelse(is.na(.), unique(.[!is.na(.)]), .)) + if(length(class_names)>0){data_layer<- dplyr::relocate(data_layer2, class_names, .after = "value")} + } + + + + + + list(layer=layer, info_layer= info_layer, data_layer= data_layer) + + } else {NULL} + +}) %>% {Filter(function(x) !is.null(x), .)} + + + + +# Tabla de informacion +dir_info_layer<- file.path(outputFolder, "info_layer.csv") +info_layers<- purrr::map(terra_mask, "info_layer") %>% plyr::rbind.fill() +write.csv(info_layers, dir_info_layer) + +# Tabla de datos +dir_data_layer<- file.path(outputFolder, "data_layer.csv") +data_layers<- purrr::map(terra_mask, "data_layer") %>% plyr::rbind.fill() +write.csv(data_layers, dir_data_layer) + +# Guardar layers +terra_mask_layers<- purrr::map(terra_mask, "layer") %>% # Anadir layer area de estudio + {c(., list(area= study_area ))} %>% terra::rast() + + +dir_stack<- file.path(outputFolder, "dir_stack") +unlink(dir_stack, recursive = TRUE); dir.create(dir_stack); setwd(dir_stack) + +setwd(dir_stack) +lapply(terra_mask_layers, function(x) + terra::writeRaster(x, paste0(names(x), ".tif"), gdal=c("COMPRESS=DEFLATE", "TFW=YES"), filetype = "GTiff", overwrite = TRUE )) + + +# Exportar area rasterizada 4326 +dir_area_4326<- file.path(outputFolder, "dir_area_4326.tif") +area_4326<- terra::project(terra_mask_layers$area, paste0("+init=epsg:", 4326) ) +terra::writeRaster(area_4326, dir_area_4326, gdal=c("COMPRESS=DEFLATE", "TFW=YES"), filetype = "GTiff", overwrite = TRUE ) + + + +# Estimar frecuencias de layers +layers<- terra_mask_layers +name_layers<- data.frame(layer_id= names(layers)) %>% dplyr::mutate(layer= seq(nrow(.))) +freq_layers<- terra::freq(layers) %>% list(name_layers) %>% plyr::join_all() %>% + plyr::mutate(area = count*( prod(input$resolution, input$resolution) /10000 ) ) %>% + dplyr::select(- c("layer", "count")) %>% dplyr::rename(layer= layer_id) + + + +# Asignar atributos a layer +data_areas<- list(data_layers, dplyr::filter(freq_layers, !layer %in% "area")) %>% plyr::join_all() %>% + dplyr::mutate(area= ifelse(is.na(area), 0, area)) %>% dplyr::mutate(classes= gsub(" ", "_", tolower(classes))) + + +data_areas2<- data_areas %>% + dplyr::group_by(period_layer) %>% dplyr::mutate(percentage= area/ sum(area)) %>% + dplyr::mutate(period= period_layer, key= tolower(classes)) %>% + as.data.frame() %>% dplyr::select(c(period, classes, layer, value, area, percentage, col, key)) %>% + dplyr::relocate(c("layer", "value", "col", "key", "classes", "period", "area", "percentage"),.before = 1) + + +# Tabla de areas +dir_data_areas<- file.path(outputFolder, "data_areas.csv") +write.csv(data_areas2, dir_data_areas) + +# Tabla de areas json +table_pp<- jsonlite::toJSON(data_areas2) + + +# Exportar imagenes de los raster +dir_png<- file.path(outputFolder, "dir_png") +unlink(dir_png, recursive = TRUE); dir.create(dir_png); setwd(dir_png) + + +saveraster<- lapply( seq(nrow(data_areas)), function(i) { print(i) + + x<- data_areas[i, ] + + raster_val<- terra_mask_layers[x$layer] + raster_val[!raster_val %in% x$value]= NA + raster_val[raster_val %in% x$value]= 1 + + # colorear plot y exportar con buena resolucion + r<- raster(raster_val) + + setwd(dir_png) + png( paste0( paste(c("forestLP", x$period_layer, x$classes), collapse = "-") , ".png"), + width = 1000, height = 1000, units = "px", res=300 ) + + plot.new() + par(mar=c(0,0,0,0), oma=c(0,0,0,0), bg=NA) + plot.new() + + plot.window(xlim= raster::extent(r)[1:2], ylim= raster::extent(r)[3:4], xaxs="i",yaxs="i") + plot(r, axes=F, legend=F, add=T, col= x$col) + + dev.off(); + + +} ) + + +# Exportar output final +output<- list( area_stack= dir_area_4326, dir_stack= dir_stack, dir_png=dir_png, dir_info_layer= dir_info_layer, + dir_data_layer=dir_data_layer, dir_data_areas= dir_data_areas, table_pp=table_pp) + +setwd(outputFolder) +jsonlite::write_json(output, "output.json", auto_unbox = TRUE, pretty = TRUE) \ No newline at end of file diff --git a/scripts/lossPersistence/pp.yml b/scripts/lossPersistence/pp.yml new file mode 100644 index 000000000..e755614b1 --- /dev/null +++ b/scripts/lossPersistence/pp.yml @@ -0,0 +1,70 @@ +script: pp.R +description: "This sample script shows how it works." +external_link: https://github.com/GEO-BON/biab-2.0 +inputs: + WKT_area: + label: WKT_area + description: WKT_area + type: text + example: 'MULTIPOLYGON (((-74.51422355910061 6.287998672327671,-74.28889444279572 6.249776453227831,-74.33011318358322 6.072279835991389,-74.29439027490073 6.066817465067729,-74.24767570200825 5.982143668342713,-74.24767570200825 5.8919926391689925,-74.48124856647063 5.867403444598711,-74.53620688752059 5.973948731032553,-74.69283810251301 5.982143668342713,-74.59940895672806 6.085935520826565,-74.51422355910061 6.287998672327671)))' + collection_path: + label: dir_collection + description: dir_collection + type: text + example: '/scripts/lossPersistence/input/Colombia_pp_collection' + epsg: + label: epsg + description: epsg + type: int + example: 4326 + resolution: + label: resolution + description: resolution + type: int + example: 1000 + time_period: + label: time_period + description: time_period + type: text + example: 'P1Y' + time_start: + label: time_start + description: time_start + type: text + example: 'NA' + time_end: + label: time_end + description: time_end + type: text + example: 'NA' + +outputs: + area_stack: + label: area_stack + description: area_stack + type: image/tiff;application=geotiff + dir_stack: + label: dir_stack + description: dir_stack + type: text + dir_png: + label: dir_png + description: dir_png + type: text + dir_info_layer: + label: dir_info_layer + description: dir_info_layer + type: text/csv + dir_data_layer: + label: dir_data_layer + description: dir_data_layer + type: text/csv + dir_data_areas: + label: dir_data_areas + description: dir_data_areas + type: text/csv + table_pp: + label: table_pp + description: table_pp + type: text +