Resolve "add population data"

Closes #3 (closed)

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/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}