Merge branch 'master' into 2-add-hydrography-data

- map_so_ii
	- gestion des options, de l'aide
	- ajout de la légende pour theme hydro
- data.r
	- gestion de la fusion

0 errors  | 0 warnings  | 0 notes 

Refs #2

geau/DESCRIPTION

 Package: geau
 Title: Utilities very useful to share within geau-inondation team
-Version: 1.0.1.0
+Version: 1.0.2.0
 Authors@R: 
     person(given = "Frédéric",
            family = "Grelot",

geau/NAMESPACE

@@ -2,5 +2,6 @@
 
 export(add.inset)
 export(current_version)
+export(estimate_catnat_freq)
 export(kable_units)
 export(map_so_ii)

geau/R/data.r

@@ -50,13 +50,33 @@
 #' }
 "so_ii_limit"
 
-#' Flood frequency for the municipalities of so-ii
+#' Population for so-ii
 #'
-#' A dataset containing the flood frequency by year and so-ii municipality 
-#' according to the GASPAR database.
+#' A dataset containing the population of commune in so-ii according to INSEE.
 #'
-#' @format matrix 78 rows, 41 variables
-"so_ii_gaspar"
+#' @format numeric matrix
+#' \describe{
+#'   \item{row}{commune as in so_ii_scope}
+#'   \item{column}{year}
+#' }
+#'
+#' @source \url{https://www.insee.fr/fr/statistiques/2522602}
+"so_ii_population"
+
+#' Number of Cat Nat events for the municipalities of so-ii
+#'
+#' A dataset containing the number of Cat Nat events (linked to flood) by year
+#' and so-ii municipality according to the GASPAR database.
+#'
+#' @format array with 3 dimensions
+#' \describe{
+#'   \item{first}{commune as in so_ii_scope}
+#'   \item{second}{year of Cat Nat events}
+#'   \item{third}{type of hazard}
+#' }
+#'
+#' @source \url{https://www.georisques.gouv.fr/donnees/bases-de-donnees/base-gaspar} # nolint
+"so_ii_catnat"
 
 #' CLC information for so-ii
 #'
@@ -65,6 +85,13 @@
 #' @format sf object
 "so_ii_clc"
 
+#' Color and label for CLC
+#'
+#' A dataset proposing default colors and labels for plotting CLC
+#'
+#' @format data.frame 5 rows, 3 variables
+"clc_color"
+
 #' Hydrographic network within the so-ii perimeter
 #'
 #' A dataset containing the official hydrographic network from the BD TOPAGE
@@ -77,6 +104,6 @@
 #'      TOPAGE}
 #'   \item{degre}{character, level of detail to plot the hydrographic network}
 #' }
-#' 
+#'
 #' @source \url{http://bdtopage.eaufrance.fr/page/objectifs}
-"so_ii_hydro"
+"so_ii_hydro"
\ No newline at end of file

geau/R/estimate_catnat_freq.R

+#' @title Estimate frequency of Cat Nat events
+#' 
+#' @param commune factor, commune
+#' @param period POSIXct, a date for the event
+#' @param hazard factor, type of hazard
+#' @param period_format character, format to extract information from period
+#'
+#' @return array fivving frequency of Cat Nat events with 3 dimensions
+#'      (commune, period, hazard)
+#'
+#' @export
+#'
+#' @encoding UTF-8
+#' @author Frédéric Grelot
+#' @author David Nortes Martinez
+#' 
+#' @examples
+#' 
+#' \dontrun{
+#' # To be added (soon)
+#' }
+ 
+estimate_catnat_freq = function(
+    commune,
+    period,
+    hazard,
+    period_format = "%Y"
+) {
+    period = format(as.Date(period), period_format)
+    period_levels = switch(
+        EXPR = period_format,
+        "%Y" = formatC(
+            1982:as.integer(format(Sys.Date(),"%Y")),
+            width = 4, format = "d", flag = "0"
+        ),
+        "%m" = formatC(1:12, width = 2, format = "d", flag = "0"),
+        sort(unique(as.character(period)))
+    )
+    result = data.frame(
+        commune = commune,
+        period = factor(period, levels = period_levels),
+        hazard = hazard
+    )
+    result = table(result)
+    class(result) = "array"
+    return(result)
+}

geau/R/map_so_ii.r

 #' @title Plot a thematic map of so-ii
 #' 
+#' @details 
+#' For theme "catnat", detail must be chosen in c("inondation", "submersion",
+#'  "nappe").
+#' For theme "hydro" detail must be chosen in "0", "1", "2", "3" or "canal".
+#' 
 #' @param dataset sf objectf, data to be plotted
 #' @param dataset_legend list of parameters to be passed to legend
 #' @param theme character, choice for the theme (if any)
-#' @param bar logical, should a bar be plotted
+#' @param bar logical, should a bar be plotted for the dataset
 #' @param path character, the name of the file to save the plot
-#' @param gaspar_year character, the year chosen for gaspar theme
+#' @param legend_theme logical, should a legend be plotted for the theme
+#' @param year character, the year chosen for some themes (catnat, population)
 #' @param detail character, detail for theme, depends on theme
 #' @param ...  some parameters that will be used by plot (from sf)
 #'
 #' @return Nothing useful.
 #' 
-#' @details
-#' For theme "hydro" detail takes values "1", "2", "3" or "canal"
-#' 
 #' @export
 #'
 #' @encoding UTF-8
@@ -28,10 +31,11 @@
 map_so_ii = function(
     dataset,
     dataset_legend = NULL,
-    theme = c("", "clc", "gaspar", "hydro"),
+    theme = c("none", "clc", "catnat", "hydro"),
     bar = TRUE,
     path = NULL,
-    gaspar_year,
+    legend_theme = FALSE,
+    year,
     detail,
     ...
 ) {
@@ -58,18 +62,96 @@ map_so_ii = function(
             col = geau::so_ii_clc[["color"]],
             add = TRUE
         )
+
+        theme_legend = list(
+            title = "CLC (2018)",
+            legend = geau::clc_color[["label_fr"]],
+            x = "topright",
+            cex = .8,
+            bg = "white",
+            inset = 0.01,
+            fill = geau::clc_color[["color"]]
+        )
     }
 
-    if ("gaspar" %in% theme) {
+    if ("population" %in% theme) {
+        if (missing(year)) {
+            year = utils::tail(sort(colnames(geau::so_ii_population)), 1)
+        }
+        population_palette = scales::colour_ramp(c("white", "red"), alpha = .5)
+        color = matrix(
+            scales::cscale(
+                geau::so_ii_population,
+                population_palette,
+                trans = scales::log_trans()),
+            nrow = nrow(geau::so_ii_population),
+            dimnames = dimnames(geau::so_ii_population)
+        )
+        border = "grey80"
+        plot(
+            geau::so_ii_commune[["geometry"]],
+            border = border,
+            col = color[ , year],
+            add = TRUE
+        )
+
+        value_legend = c(100, 1000, 10000, 100000, 250000)
+        color_legend = scales::cscale(
+                c(range(geau::so_ii_population), value_legend),
+                population_palette,
+                trans = scales::log_trans()
+            )[-(1:2)]
+        text_legend = formatC(
+            as.integer(value_legend),
+            big.mark = " "
+        )
+
+        theme_legend = list(
+            title = sprintf("Population %s", year),
+            legend = rep("", length(text_legend)),
+            x = "topright",
+            cex = .8,
+            bg = "white",
+            inset = 0.01,
+            fill = color_legend,
+            border = border,
+            text.width = graphics::strwidth(utils::tail(text_legend, 1))
+        )
+    }
+
+    if ("catnat" %in% theme) {
+        if (missing(detail)) {
+            detail = dimnames(geau::so_ii_catnat)[["hazard"]]
+        }
+        detail = match.arg(
+            detail, 
+            dimnames(geau::so_ii_catnat)[["hazard"]],
+            several.ok = TRUE
+        )
         border = NA
         color = NA
-        if (!missing(gaspar_year)) {
+        if (!missing(year)) {
             border = "grey80"
+            catnat = apply(
+                geau::so_ii_catnat[, as.character(year), detail, drop = FALSE],
+                1:2,
+                sum
+            )
             color = ifelse(
-                geau::so_ii_gaspar[ , as.character(gaspar_year)] > 0,
+                catnat > 0,
                 scales::alpha("grey80", .5),
                 NA
             )
+            theme_legend = list(
+                title = sprintf("Cat-Nat %s", year),
+                legend = c("Sans d\u00e9claration", "Avec d\u00e9claration"),
+                x = "topright",
+                cex = .8,
+                bg = "white",
+                inset = 0.01,
+                fill = unique(color),
+                border = border
+            )
         }
 
         plot(
@@ -84,7 +166,10 @@ map_so_ii = function(
         if (missing(detail)) {
             detail = "0"
         }
-        detail = match.arg(detail, choices = c("0", "1", "2", "3", "canal"))
+        detail = match.arg(
+            as.character(detail),
+            choices = c("0", "1", "2", "3", "canal")
+        )
         if (detail == "canal") {
             selection  = geau::so_ii_hydro[["degre"]] == detail
             geometry = geau::so_ii_hydro[["geometry"]][selection]
@@ -92,15 +177,26 @@ map_so_ii = function(
             lwd = 1
         } else {
             selection  = geau::so_ii_hydro[["degre"]] <= detail
-            geometry = geau::so_ii_hydro[["geometry"]][]
+            geometry = geau::so_ii_hydro[["geometry"]][selection]
             color =  scales::alpha("blue", .3)
             lwd = 4 - as.numeric(geau::so_ii_hydro[["degre"]][selection])
         }
 
-        plot(geometry, col = color, lwd = lwd, add = TRUE) 
+        plot(geometry, col = color, lwd = lwd, add = TRUE)
+
+        theme_legend = list(
+            title = sprintf("R\u00e9seau hydrographique"),
+            legend = ifelse(detail == "canal", "canal", "cours d'eau"),
+            x = "topright",
+            cex = .8,
+            bg = "white",
+            inset = 0.01,
+            col = color,
+            lwd = 2
+        )
     }
 
-    plot(dataset[["geometry"]], add = TRUE, ...)
+    if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
 
     plot(geau::so_ii_limit, lwd = 2, add = TRUE)
 
@@ -124,5 +220,17 @@ map_so_ii = function(
         do.call(graphics::legend, dataset_legend)
     }
 
+    if (legend_theme == TRUE && exists("theme_legend")) {
+        temp = do.call(graphics::legend, theme_legend)
+        if (exists("text_legend")) {
+            graphics::text(
+                x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]],
+                y = temp[["text"]][["y"]],
+                labels = text_legend,
+                pos = 2
+            )
+        }
+    }
+
     return(invisible(NULL))
 }

geau/data-raw/so_ii_catnat.R

+# code to prepare `so_ii_catnat` dataset goes here
+
+so_ii_catnat = read.csv2(
+    geau::current_version("data-common/so-ii/gaspar", "catnat-")
+)
+
+alea_scope = c("inondation", "nappe", "submersion")
+so_ii_catnat = so_ii_catnat[ so_ii_catnat[["alea"]] %in% alea_scope, ]
+
+so_ii_catnat[["commune"]] = factor(
+    so_ii_catnat[["commune"]],
+    levels = so_ii_scope
+)
+so_ii_catnat[["alea"]] = factor(
+    so_ii_catnat[["alea"]],
+    levels = alea_scope
+)
+
+so_ii_catnat = estimate_catnat_freq(
+    so_ii_catnat[["commune"]],
+    so_ii_catnat[["date.start"]],
+    so_ii_catnat[["alea"]]
+)
+
+# updating datasets
+
+actual = setwd("geau")
+usethis::use_data(so_ii_catnat, internal = FALSE, overwrite = TRUE)
+setwd(actual)
\ No newline at end of file

geau/data-raw/so_ii_population.R

+# code to prepare `so_ii_population` dataset goes here
+
+so_ii_population = readxl::read_xlsx(
+    geau::current_version(
+        "data-common/data/INSEE/Population/Historique",
+        "base-pop-historique"
+    ),
+    sheet = 1,
+    skip = 5,
+)
+class(so_ii_population) = "data.frame"
+rownames(so_ii_population) = so_ii_population[["CODGEO"]]
+selection = grep(
+    "PMUN|PSCDC|PTOT",
+    colnames(so_ii_population),
+    value = TRUE
+)
+so_ii_population = as.matrix(
+    so_ii_population[geau::so_ii_scope, selection]
+)
+year = gsub("PMUN", "20", selection)
+year = gsub("PTOT", "19", year)
+year = gsub("1919", "19", year)
+year = gsub("1918", "18", year)
+dimnames(so_ii_population)[[2]] = year
+
+# updating datasets
+
+# actual = setwd(file.path(system.file(package = "geau"), ".."))
+actual = setwd("geau")
+usethis::use_data(so_ii_population, internal = FALSE, overwrite = TRUE)
+setwd(actual)

geau/data-raw/so_ii_scope.R

@@ -24,26 +24,40 @@ so_ii_limit = sf::st_union(so_ii_commune)
 so_ii_clc = readRDS("data-common/data/so-ii/so-ii_clc.rds")
 so_ii_clc = so_ii_clc["code_18"]
 names(so_ii_clc) = c("clc_2018", "geometry")
-color = scales::alpha(c("red3", "darkolivegreen3", "darkgreen", "#4C90B4", "lightblue"), .2)
+clc_color = data.frame(
+    color = scales::alpha(
+        c(
+            "red3",
+            "darkolivegreen3",
+            "darkgreen",
+            "#4C90B4",
+            "lightblue"
+        ),
+        .2
+    ),
+    label_fr = c(
+        "Zone urbaine",
+        "Zone agricole",
+        "Forêt, zone naturelle",
+        "Zone humide",
+        "Surface d'eau"
+    ),
+    label_uk = c(
+        "Urban area",
+        "Agricultural area",
+        "Forest, natural area",
+        "Humid area",
+        "Water surface"
+    )
+) 
 so_ii_clc[["color"]] = as.character(
     cut(
         as.integer(substr(so_ii_clc[["clc_2018"]], 1, 1)), 
         breaks = 5,
-        labels = color
+        labels = clc_color[["color"]]
     )
 )
 
-# code to prepare `so_ii_gaspar` dataset goes here
-
-so_ii_gaspar = read.csv2(
-    current_version("data-common/so-ii/gaspar", "catnat_year_n"),
-    header = TRUE,
-    row.names = 1
-)
-so_ii_gaspar = as.matrix(so_ii_gaspar)
-colnames(so_ii_gaspar) = gsub("^X", "", colnames(so_ii_gaspar))
-so_ii_gaspar = so_ii_gaspar[so_ii_scope, ]
-
 # updating datasets
 
 # actual = setwd(file.path(system.file(package = "geau"), ".."))
@@ -52,5 +66,5 @@ usethis::use_data(so_ii_scope, internal = FALSE, overwrite = TRUE)
 usethis::use_data(so_ii_commune, internal = FALSE, overwrite = TRUE)
 usethis::use_data(so_ii_limit, internal = FALSE, overwrite = TRUE)
 usethis::use_data(so_ii_clc, internal = FALSE, overwrite = TRUE)
-usethis::use_data(so_ii_gaspar, internal = FALSE, overwrite = TRUE)
+usethis::use_data(clc_color, internal = FALSE, overwrite = TRUE)
 setwd(actual)

geau/man/so_ii_gaspar.Rd → geau/man/clc_color.Rd

 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/data.r
 \docType{data}
-\name{so_ii_gaspar}
-\alias{so_ii_gaspar}
-\title{Flood frequency for the municipalities of so-ii}
+\name{clc_color}
+\alias{clc_color}
+\title{Color and label for CLC}
 \format{
-matrix 78 rows, 41 variables
+data.frame 5 rows, 3 variables
 }
 \usage{
-so_ii_gaspar
+clc_color
 }
 \description{
-A dataset containing the flood frequency by year and so-ii municipality
-according to the GASPAR database.
+A dataset proposing default colors and labels for plotting CLC
 }
 \keyword{datasets}

geau/man/estimate_catnat_freq.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/estimate_catnat_freq.R
+\encoding{UTF-8}
+\name{estimate_catnat_freq}
+\alias{estimate_catnat_freq}
+\title{Estimate frequency of Cat Nat events}
+\usage{
+estimate_catnat_freq(commune, period, hazard, period_format = "\%Y")
+}
+\arguments{
+\item{commune}{factor, commune}
+
+\item{period}{POSIXct, a date for the event}
+
+\item{hazard}{factor, type of hazard}
+
+\item{period_format}{character, format to extract information from period}
+}
+\value{
+array fivving frequency of Cat Nat events with 3 dimensions
+(commune, period, hazard)
+}
+\description{
+Estimate frequency of Cat Nat events
+}
+\examples{
+
+\dontrun{
+# To be added (soon)
+}
+}
+\author{
+Frédéric Grelot
+
+David Nortes Martinez
+}

geau/man/map_so_ii.Rd

@@ -8,10 +8,11 @@
 map_so_ii(
   dataset,
   dataset_legend = NULL,
-  theme = c("", "clc", "gaspar", "hydro"),
+  theme = c("none", "clc", "catnat", "hydro"),
   bar = TRUE,
   path = NULL,
-  gaspar_year,
+  legend_theme = FALSE,
+  year,
   detail,
   ...
 )
@@ -23,11 +24,13 @@ map_so_ii(
 
 \item{theme}{character, choice for the theme (if any)}
 
-\item{bar}{logical, should a bar be plotted}
+\item{bar}{logical, should a bar be plotted for the dataset}
 
 \item{path}{character, the name of the file to save the plot}
 
-\item{gaspar_year}{character, the year chosen for gaspar theme}
+\item{legend_theme}{logical, should a legend be plotted for the theme}
+
+\item{year}{character, the year chosen for some themes (catnat, population)}
 
 \item{detail}{character, detail for theme, depends on theme}
 
@@ -40,7 +43,9 @@ Nothing useful.
 Plot a thematic map of so-ii
 }
 \details{
-For theme "hydro" detail takes values "1", "2", "3" or "canal"
+For theme "catnat", detail must be chosen in c("inondation", "submersion",
+"nappe").
+For theme "hydro" detail must be chosen in "0", "1", "2", "3" or "canal".
 }
 \examples{
 

geau/man/so_ii_catnat.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.r
+\docType{data}
+\name{so_ii_catnat}
+\alias{so_ii_catnat}
+\title{Number of Cat Nat events for the municipalities of so-ii}
+\format{
+array with 3 dimensions
+\describe{
+\item{first}{commune as in so_ii_scope}
+\item{second}{year of Cat Nat events}
+\item{third}{type of hazard}
+}
+}
+\source{
+\url{https://www.georisques.gouv.fr/donnees/bases-de-donnees/base-gaspar} # nolint
+}
+\usage{
+so_ii_catnat
+}
+\description{
+A dataset containing the number of Cat Nat events (linked to flood) by year
+and so-ii municipality according to the GASPAR database.
+}
+\keyword{datasets}

geau/man/so_ii_population.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/data.r
+\docType{data}
+\name{so_ii_population}
+\alias{so_ii_population}
+\title{Population for so-ii}
+\format{
+numeric matrix
+\describe{
+\item{row}{commune as in so_ii_scope}
+\item{column}{year}
+}
+}
+\source{
+\url{https://www.insee.fr/fr/statistiques/2522602}
+}
+\usage{
+so_ii_population
+}
+\description{
+A dataset containing the population of commune in so-ii according to INSEE.
+}
+\keyword{datasets}

map/map-2020-07-20.rmd

+```{r data-recup}
+# Récupération des données (à faire une fois)
+
+## Récupération du périmètre (déjà pré-traité)
+soii = readRDS("data-common/data/so-ii/so-ii_perim.rds")
+
+## Récupération du périmètre dans France (déjà prétraité)
+soii_france = readRDS("data-common/data/so-ii/so-ii_france.rds")
+
+## Récupération de CLC (déjà pré-traité)
+soii_clc = readRDS("data-common/data/so-ii/so-ii_clc.rds")
+
+## Recupération des données du fond de carte
+# soii_osm = maptiles::get_tiles(soii, provider = "OpenStreetMap.MapnikBW", crop = TRUE, zoom = 11)
+# terra::writeRaster(soii_osm, "data-common/data/so-ii/so-ii_osm-bw.tif", overwrite = TRUE)
+soii_osm = terra::rast("data-common/data/so-ii/so-ii_osm-bw.tif")
+# credit = sprintf("Background from %s", maptiles::get_credit("OpenStreetMap"))
+```
+
+```{r rex-pauline}
+# Production d'une carte
+
+## Définition du nom du fichier de sauvegarde
+file_path = file.path("data-common/figure/so-ii/pdf/2021-07-20/rex-pauline.pdf")
+
+## Récupération des données propre à la carte en cours
+rex_agri = rio::import("data-common/table/so-ii/rex-agri-2014.ods", which = 1)
+## Transformation des données d'enquête en points géoréférencés
+rex_agri = sf::st_as_sf(rex_agri, coords = c("longitude", "latitude"), crs = "WGS84")
+
+# Génération de la carte
+
+## Ouverture du fichier de sauvegarde
+# png(file_path, height = 800, width = 800)
+pdf(file_path)
+
+## Initialisation de la carte avec le périmètre de so-ii
+par(mai = c(.65, .60, .50, .15))
+plot(soii, axes = TRUE)
+# terra::plotRGB(soii_osm, add = TRUE)
+plot(soii, lwd = 2, add = TRUE)
+
+## Ajout du fond CLC avec le niveau 1 du code_18
+color_clc = scales::alpha(c("red3", "darkolivegreen3", "darkgreen", "#4C90B4", "lightblue"), .2)
+color = as.character(cut(
+    as.integer(substr(soii_clc[["code_18"]], 1, 1)), 
+    breaks = 5,
+    labels = color_clc))
+plot(soii_clc$geometry, border = NA, col = color, add = TRUE)
+
+## Ajout des points d'enquête
+# plot(rex_agri$geometry, col = "red", bg = "red", pch = 21, cex = 1, add = TRUE)
+plot(rex_agri$geometry[rex_agri[["REX 2015"]],],
+    col = "black", bg = "black", cex = 1.4,
+    pch = 21, add = TRUE)
+plot(rex_agri$geometry[rex_agri[["REX 2019"]],],
+    col = "black", bg = "green", cex = 1.4,
+    pch = 21, add = TRUE)
+plot(rex_agri$geometry[rex_agri[["REX 2020"]],],
+    col = "black", bg = "orange", cex = 1.4, 
+    pch = 21, add = TRUE)
+
+## Ajout de l'échelle
+# raster::scalebar(10, type = "bar", divs = 4, below = "km")
+terra::sbar(10, c(3.55, 43.47), type = "bar", below = "km", label = c(0, 5, 10), cex = .8)
+
+## Ajout des crédits
+# text(3.55, 43.435, credit, adj = 0, cex = .8, font = 3)
+
+## Légende CLC
+legend("topright", cex = .8, bg = "white", inset = 0.01,
+    title = "Land Use (from CLC)",
+    legend = c(
+        "Urban area",
+        "Agricultural area",
+        "Forest, natural area",
+        "Humid area",
+        "Water surface"),
+    fill = color_clc)
+
+## Légende Carte en cours
+legend("bottomright", cex = .8, bg = "white", inset = 0.01,
+    title = "Farms surveyed in",
+    legend = c("2015", "2015 & 2019", "2015 & 2020"),
+    pch = 21,
+    col = "black",
+    pt.bg = c("black", "green", "orange"),
+    pt.cex = 1.4)
+
+## Ajout de l'encart
+# geau::add.inset(soii_france, col = c("white", "red"), border = c("lightgray", "red"), lwd = 2)
+
+## Fermeture du fichier de sauvegarde
+dev.off()  
+```
+