Merge branch '3-add-population-data' into 'master'

Resolve "add population data"

Closes #3

See merge request !4

Passage en version 1.0.2.0
0 errors  | 0 warnings  | 0 notes 

- population dataset
- catnat dataset remplace gaspar dataset
- clc_color dataset
- map_so_ii amélioré
   - gestion des year et des hazard pour les thèmes
   - gestion des légendes pour les thèmes

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,17 +50,44 @@
 #' }
 "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}
+"so_ii_catnat"
 
 #' CLC information for so-ii
 #'
 #' A dataset containing the 2018 version of CLC information for so-ii
 #'
 #' @format sf object
-"so_ii_clc"
\ No newline at end of file
+"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"
\ 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 
+#' hazard must be chosen in c("inondation", "submersion", "nappe").
+#' 
 #' @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 hazard character, type of hazard chosen (if any). See details.
 #' @param ...  some parameters that will be used by plot (from sf)
 #'
 #' @return Nothing useful.
@@ -24,10 +29,12 @@
 map_so_ii = function(
     dataset,
     dataset_legend = NULL,
-    theme = c("clc", "gaspar"),
+    theme = "clc",
     bar = TRUE,
     path = NULL,
-    gaspar_year,
+    legend_theme = FALSE,
+    year,
+    hazard,
     ...
 ) {
 
@@ -52,18 +59,101 @@ 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) {
         border = NA
         color = NA
-        if (!missing(gaspar_year)) {
+        if (!missing(year)) {
             border = "grey80"
+            if (missing(hazard)) {
+                hazard = dimnames(geau::so_ii_catnat)[["hazard"]]
+            } else {
+                hazard = intersect(
+                    hazard,
+                    dimnames(geau::so_ii_catnat)[["hazard"]]
+                )
+                if (length(hazard) == 0) {
+                    hazard = dimnames(geau::so_ii_catnat)[["hazard"]]
+                }
+            }
+
+            catnat = apply(
+                geau::so_ii_catnat[, as.character(year), hazard, 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(
@@ -98,5 +188,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,12 @@
 map_so_ii(
   dataset,
   dataset_legend = NULL,
-  theme = c("clc", "gaspar"),
+  theme = "clc",
   bar = TRUE,
   path = NULL,
-  gaspar_year,
+  legend_theme = FALSE,
+  year,
+  hazard,
   ...
 )
 }
@@ -22,11 +24,15 @@ 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{hazard}{character, type of hazard chosen (if any). See details.}
 
 \item{...}{some parameters that will be used by plot (from sf)}
 }
@@ -36,6 +42,9 @@ Nothing useful.
 \description{
 Plot a thematic map of so-ii
 }
+\details{
+hazard must be chosen in c("inondation", "submersion", "nappe").
+}
 \examples{
 
 \dontrun{

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}
+}
+\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_so_ii.rmd

@@ -16,13 +16,17 @@ pch = 21
 # Legend definition
 dataset_legend = list(
     title = "Enquêtes du REX 19 septembre 2020",
-    legend = c("Agriculteurs", "Habitants membre ROI"),
-    pch = 21,
+    legend = c("Agriculteur", "Habitant"),
+    pch = pch,
     pt.bg = c("deeppink4", "cornflowerblue"),
-    pt.cex = 1.4
+    pt.cex = cex
 )
 
-map_so_ii(dataset, dataset_legend, path = "toto.pdf", bg = bg, cex = cex, col = col, pch = pch)
-map_so_ii(dataset, dataset_legend, path = "toto.png", bg = bg, cex = cex, col = col, pch = pch)
-map_so_ii(dataset, dataset_legend, path = "toto.pdf", bg = bg, pch = 22)
-map_so_ii(dataset, dataset_legend, path = "toto.pdf", bg = bg, pch = 22, theme = "gaspar")
\ No newline at end of file
+map_so_ii(dataset, dataset_legend, bg = bg, pch = pch, theme = "clc", legend_theme = TRUE)
+map_so_ii(dataset, dataset_legend, bg = bg, pch = pch, theme = "catnat", year = 2020, legend_theme = TRUE)
+map_so_ii(dataset, dataset_legend, bg = bg, pch = pch, theme = "catnat", year = 2020, hazard = "nappe", legend_theme = TRUE)
+map_so_ii(dataset, dataset_legend, bg = bg, pch = pch, theme = "population", legend_theme = TRUE)
+
+map_so_ii(dataset, dataset_legend, path = "rex-clc.pdf", bg = bg, pch = pch, theme = "clc", year = 2020, legend_theme = TRUE)
+map_so_ii(dataset, dataset_legend, path = "rex-catnat.pdf", bg = bg, pch = pch, theme = "catnat", year = 2020, legend_theme = TRUE)
+map_so_ii(dataset, dataset_legend, path = "rex-population.pdf", bg = bg, pch = pch, theme = "population", legend_theme = TRUE)
\ No newline at end of file

script/gaspar.R

+# Functions
+
+plot_chronicle = function(catnat, file_path = "catnat-chronicle.pdf") {
+    year.month = format(catnat[["date.start"]], "%Y-%m")
+    n.ym = table(year.month)
+    d.ym = as.Date(paste(names(n.ym), "01", sep = "-"))
+
+    pdf(file_path, width = 20, height = 10)
+    plot(d.ym, as.integer(n.ym), type = "h", xaxt = "n", xlab = "", ylab = "n", col = "royalblue3")
+    axis.Date(1, format = "%Y-%m", las = 2, at = d.ym)
+    axis.Date(1, format = "%Y-%m", las = 2, label = FALSE,
+        at = seq(range(d.ym)[1], range(d.ym)[2], by = "month"))
+    dev.off()
+}
+
+plot_month = function(catnat, file_path = "catnat-month.pdf") {
+    month = format(seq(as.Date("2020-01-01"), length.out = 12, by = "month"), "%m")
+    month = table(factor(format(catnat[["date.start"]], "%m"), levels = month))
+
+    pdf(file_path, width = 20, height = 10)
+    barplot(height = month, ylab = "n", xlab = "month", col = "royalblue3")
+    dev.off()
+}
+
+# Data
+
+## Preparing files & version (today)
+
+today = as.character(Sys.Date())
+dir.create("data-common/data/gaspar/archive", showWarnings = FALSE)
+archive = sprintf("data-common/data/gaspar/archive/gaspar-%s", today)
+
+## Download uptodate data
+
+utils::download.file(
+    url = "https://files.georisques.fr/GASPAR/gaspar.zip",
+    destfile = file.path(sprintf("%s.zip", archive)),
+    method = "wget")
+
+utils::unzip(sprintf("%s.zip", archive), exdir = archive)
+unlink(archive, recursive = TRUE)
+catnat = rio::import(file.path(archive, "catnat_gaspar.csv"))[-c(1, 10)]
+
+## Formating data + scope
+
+names(catnat) = c(
+    "commune",
+    "commune_name",
+    "alea_code",
+    "alea_jo",
+    "date.start",
+    "date.end",
+    "date.arrete",
+    "date.jo"
+)
+# write.csv2(unique(catnat[c("alea_code", "alea")]), "lib_risque_jo.csv", row.names = FALSE)
+# catnat = catnat[ grep("nondation", catnat[["alea"]]), ]
+
+so_ii_scope = geau::so_ii_scope
+catnat_so_ii = merge(
+    catnat[ catnat[["commune"]] %in% so_ii_scope, ],
+    read.csv2("data-common/so-ii/gaspar/catnat_alea_jo.csv")
+)
+write.csv2(
+    catnat_so_ii, 
+    sprintf("data-common/so-ii/gaspar/catnat-%s.csv", today),
+    row.names = FALSE
+)
+
+alea_scope = c("inondation", "nappe", "submersion")
+catnat_so_ii = catnat_so_ii[ catnat_so_ii[["alea"]] %in% alea_scope, ]
+catnat_so_ii[["commune"]] = factor(
+    catnat_so_ii[["commune"]],
+    levels = so_ii_scope
+)
+catnat_so_ii[["alea"]] = factor(
+    catnat_so_ii[["alea"]],
+    levels = alea_scope
+)
+# Treatments
+
+plot_chronicle(catnat, "figure/catnat-france-chronicle.pdf")
+plot_month(catnat, "figure/catnat-france-month.pdf")
+
+plot_chronicle(catnat_so_ii, "catnat-so-ii-chronicle.pdf")
+plot_month(catnat_so_ii, "catnat-so-ii-month.pdf")
+
+write.csv2(catnat_year, sprintf("data-common/so-ii/gaspar/catnat_year_n-%s.csv", today))
+write.csv2(catnat_month, sprintf("data-common/so-ii/gaspar/catnat_month_n-%s.csv", today))
\ No newline at end of file