diff --git a/geau/DESCRIPTION b/geau/DESCRIPTION index 4fcb4ddff47937e8af395bf91b7f8670635e9896..f5e3174b19de938b56a11cfad52f2ec3f27179fc 100644 --- a/geau/DESCRIPTION +++ b/geau/DESCRIPTION @@ -1,6 +1,6 @@ Package: geau Title: Utilities very useful to share within geau-inondation team -Version: 1.0.5.0 +Version: 1.0.6.0 Authors@R: c( person(given = "Frédéric", diff --git a/geau/R/data.r b/geau/R/data.r index 52896c81d1c949cb9f60246a05250a8d161c206a..7528b6f313e944575e18c91854743041aa3057ca 100644 --- a/geau/R/data.r +++ b/geau/R/data.r @@ -117,4 +117,24 @@ #' } #' #' @source \url{http://bdtopage.eaufrance.fr/page/objectifs} -"so_ii_hydro" \ No newline at end of file +"so_ii_hydro" + +#' Catchment areas of interest within the so-ii perimeter +#' +#' A dataset containing the official catchments areas of interest from the BD +#' TOPAGE within the so-ii perimeter. For degre = 3, the data are basically +#' what is found in BD TOPAGE. For degres 1 and 2, the data result from +#' sf::st_union of data of degre 3 to give a more synthetic representation. +#' +#' @format sf data.frame 15 rows, 4 variables +#' \describe{ +#' \item{id}{id, from BD TOPAGE (corresponding to CdOh) or NA when catchment +#' is constructed by so-ii team.} +#' \item{name}{character, name of the catchment area in BD TOPAGE, or given +#' name for catchments constructed by so-ii team.} +#' \item{degre}{factor, importance of the catchment used to plot the +#' catchment areas with different levels of detail ("1", "2", "3").} +#' } +#' +#' @source \url{http://bdtopage.eaufrance.fr/page/objectifs} +"so_ii_catchment" \ No newline at end of file diff --git a/geau/R/map_so_ii.r b/geau/R/map_so_ii.r index 7d8be39e4c6db955f86e137d40f2d58f2d8ba915..66e247c4a8452e50b11b0fefb3e05913f01059d9 100644 --- a/geau/R/map_so_ii.r +++ b/geau/R/map_so_ii.r @@ -7,6 +7,8 @@ #' \item{\strong{catnat}: detail must be chosen in "inondation", #' "submersion", or "nappe". If missing all type will be chosen and #' aggregated before plotting.} +#' \item{\strong{catchment}: detail must be chosen in "none", "1", "2", "3" +#' for levels of detail. If missing, "1" will be chosen.} #' \item{\strong{collectivity}: detail must be chosen in "none", "syble", #' "symbo", "epci" or "syndicate". If missing, "none" will be chosen, #' and only the boundaries of collectivities are plotted.} @@ -53,7 +55,7 @@ map_so_ii = function( dataset, dataset_legend = NULL, - theme = c("none", "collectivity", "clc", "catnat", "hydro", "population"), + theme = c("none", "collectivity", "catchment", "catnat", "clc", "hydro", "population"), bar = TRUE, path = NULL, legend_theme = FALSE, @@ -280,6 +282,36 @@ map_so_ii = function( plot(geometry, col = color, lwd = lwd, border = border, add = TRUE) } + if ("catchment" %in% theme) { + if (missing(detail)) { + detail = "1" + } + detail = match.arg( + as.character(detail), + choices = levels(geau::so_ii_catchment[["degre"]]) + ) + selection = geau::so_ii_catchment[["degre"]] == detail + geometry = geau::so_ii_catchment[["geometry"]][selection] + catchment = as.factor(geau::so_ii_catchment[["catchment_name"]][selection]) + color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3) + color = color_legend[catchment] + border = "grey80" + lwd = 2 + theme_legend = list( + title = sprintf("Bassin versant"), + legend = levels(catchment), + x = "topright", + cex = .8, + bg = "white", + inset = 0.01, + fill = color_legend, + border = border + ) + if (detail == "3") rm(theme_legend) + + plot(geometry, border = border, col = color, lwd = lwd, add = TRUE) + } + if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...) plot(geau::so_ii_limit, lwd = 2, add = TRUE) diff --git a/geau/data-raw/so_ii_catchment.R b/geau/data-raw/so_ii_catchment.R new file mode 100644 index 0000000000000000000000000000000000000000..fa2e210d604c20a14397a25ee97e07a9d6fd2e35 --- /dev/null +++ b/geau/data-raw/so_ii_catchment.R @@ -0,0 +1,16 @@ +# code to prepare `so_ii_catchment` dataset goes here + +file_dir = geau::current_version( + "data-common/so-ii/topage", + pattern = "^[0-9-]+$" +) +so_ii_catchment = sf::st_read(file.path(file_dir, "bassin_versant.shp")) +names(so_ii_catchment) = c("id", "catchment_name", "degre", "geometry") +Encoding(so_ii_catchment[["catchment_name"]]) = "UTF-8" +so_ii_catchment[["degre"]] = factor(so_ii_catchment[["degre"]]) + +# updating datasets + +actual = setwd("geau") +usethis::use_data(so_ii_catchment, internal = FALSE, overwrite = TRUE) +setwd(actual) diff --git a/geau/data/so_ii_catchment.rda b/geau/data/so_ii_catchment.rda new file mode 100644 index 0000000000000000000000000000000000000000..4b567b77c387dae46c70acbd261594288a68f480 Binary files /dev/null and b/geau/data/so_ii_catchment.rda differ diff --git a/geau/man/map_so_ii.Rd b/geau/man/map_so_ii.Rd index 1f525ed2f3d8b9fc658d96f87672f73fe84a3e6c..63263ef27e28e12b0f64d7351fd4254be0512250 100644 --- a/geau/man/map_so_ii.Rd +++ b/geau/man/map_so_ii.Rd @@ -8,7 +8,8 @@ map_so_ii( dataset, dataset_legend = NULL, - theme = c("none", "collectivity", "clc", "catnat", "hydro", "population"), + theme = c("none", "collectivity", "catchment", "catnat", "clc", "hydro", + "population"), bar = TRUE, path = NULL, legend_theme = FALSE, @@ -49,6 +50,8 @@ For the specification of detail, it depends on the theme chosen. \item{\strong{catnat}: detail must be chosen in "inondation", "submersion", or "nappe". If missing all type will be chosen and aggregated before plotting.} +\item{\strong{catchment}: detail must be chosen in "none", "1", "2", "3" +for levels of detail. If missing, "1" will be chosen.} \item{\strong{collectivity}: detail must be chosen in "none", "syble", "symbo", "epci" or "syndicate". If missing, "none" will be chosen, and only the boundaries of collectivities are plotted.} diff --git a/geau/man/so_ii_catchment.Rd b/geau/man/so_ii_catchment.Rd new file mode 100644 index 0000000000000000000000000000000000000000..0cfe4ebe5646c2bb3ef083c5be367f97a8bbdcf7 --- /dev/null +++ b/geau/man/so_ii_catchment.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.r +\docType{data} +\name{so_ii_catchment} +\alias{so_ii_catchment} +\title{Catchment areas of interest within the so-ii perimeter} +\format{ +sf data.frame 15 rows, 4 variables +\describe{ +\item{id}{id, from BD TOPAGE (corresponding to CdOh) or NA when catchment +is constructed by so-ii team.} +\item{name}{character, name of the catchment area in BD TOPAGE, or given +name for catchments constructed by so-ii team.} +\item{degre}{factor, importance of the catchment used to plot the +catchment areas with different levels of detail ("1", "2", "3").} +} +} +\source{ +\url{http://bdtopage.eaufrance.fr/page/objectifs} +} +\usage{ +so_ii_catchment +} +\description{ +A dataset containing the official catchments areas of interest from the BD +TOPAGE within the so-ii perimeter. For degre = 3, the data are basically +what is found in BD TOPAGE. For degres 1 and 2, the data result from +sf::st_union of data of degre 3 to give a more synthetic representation. +} +\keyword{datasets} diff --git a/map_so_ii.rmd b/map_so_ii.rmd index 7938eb84adfed38244d9f737d3513649ca2a4cf9..0cfa10c89ae8443831d48ce1ca32ec023bb98560 100644 --- a/map_so_ii.rmd +++ b/map_so_ii.rmd @@ -7,7 +7,11 @@ map_so_ii(theme = "collectivity", detail = "symbo") map_so_ii(theme = "clc") map_so_ii(theme = "population") map_so_ii(theme = "catnat", year = 2019) +map_so_ii(theme = "hydro") map_so_ii(theme = "hydro", detail = 3) +map_so_ii(theme = "catchment") +map_so_ii(theme = "catchment", detail = 2, legend_theme = TRUE) +map_so_ii(theme = "catchment", detail = 3) # Can only work if data-common is a symbolic link diff --git a/script/topage.R b/script/topage.R index 86e617b727536ae1590b49e905e76f5fc5a49c52..72984ddd0e6f65d3bdc88b55b1aab74d034c8715 100644 --- a/script/topage.R +++ b/script/topage.R @@ -1,9 +1,12 @@ -# Functions +# Libraries -# Data library(geau) library(sf) +# Waterbody + +## Data + waterbody = sf::st_read(geau::current_version("data-common/data/topage/plan_eau", "shp")) waterbody = sf::st_transform(waterbody, crs = st_crs(geau::so_ii_limit)) waterbody = waterbody[ @@ -13,5 +16,75 @@ waterbody = waterbody[ names(waterbody) = c("id", "name", "geometry") waterbody = sf::st_intersection(waterbody, geau::so_ii_limit) -# Save +## Save + sf::st_write(waterbody, "data-common/so-ii/topage/2021-09/plan_eau.shp", append = FALSE) + +# Catchment + +## Functions + +prepare_catchment = function (sf_data, name, degre) { + selection = sf_data[[sprintf("detail_%s", degre)]] == name + sf::st_sf( + "id" = NA, + "catchment_name" = name, + "degre" = degre, + "geometry" = sf::st_union(sf_data[selection, ]) + ) +} + +## Data + +input_dir = geau::current_version("data-common/data/topage/bassin_versant") +catchment = sf::st_read(file.path(input_dir, "06_Rhone-Mediterranee_BassinVersantTopographique.shp")) +classification = read.csv2(geau::current_version("data-common/so-ii/topage", "bassin")) + +## Treatments + +### CRS + +if (!sf::st_crs(catchment) == sf::st_crs(geau::so_ii_limit)) { + catchment = sf::st_transform(catchment, crs = sf::st_crs(geau::so_ii_limit)) +} + +### Selection & renaming + +selection_col = c("CdOH", "geometry") +selection_row = classification[["id"]] + +catchment = catchment[catchment[["CdOH"]] %in% unlist(unname(selection_row)), selection_col] +names(catchment) = c("id", "geometry") +catchment = merge(catchment, classification) + +### Making catchments + +detail_1 = do.call(rbind, + lapply( + unique(catchment[[sprintf("detail_%s", 1)]]), + prepare_catchment, + sf_data = catchment, + degre = 1 + ) +) +detail_2 = do.call(rbind, + lapply( + unique(catchment[[sprintf("detail_%s", 2)]]), + prepare_catchment, + sf_data = catchment, + degre = 2 + ) +) +detail_3 = catchment[c("id", "catchment_name")] +detail_3[["degre"]] = "3" +detail_3 = detail_3[names(detail_1)] + +catchment = do.call(rbind, list(detail_1, detail_2, detail_3)) + +### Save + +sf::st_write( + catchment, + "data-common/so-ii/topage/2021-09/bassin_versant.shp", + append = FALSE +)