so.ii Version 1.0.16.0

- renommage de la library en so.ii
- ajout de la fonction plot_legend pour générer des légendes indépendamment des cartes

dev/package.development.R

-package = "geau" ; devtools::document(package) ; devtools::load_all(package)
+package = "so.ii" ; devtools::document(package) ; devtools::load_all(package)
 
 ### Vignettes
 # setwd(package):usethis::use_vignette(package);setwd("..")
@@ -15,4 +15,4 @@ devtools::build(package, path = "library", vignettes = TRUE)
 
 ### install -> sudo
 # devtools::install_local(package)
-sudo su - -c "R -e \"devtools::install_gitlab('geau-inondation/geau-utility',  subdir = 'geau', host = 'gitlab.irstea.fr', upgrade = 'never', auth_token = 'rCEfcrjoms9UNykCuM5c')\""  # nolint
+sudo su - -c "R -e \"devtools::install_gitlab('geau-inondation/geau-utility',  subdir = 'so.ii', host = 'gitlab.irstea.fr', upgrade = 'never', auth_token = 'rCEfcrjoms9UNykCuM5c')\""  # nolint
\ No newline at end of file

map/map_so_ii.rmd

 
 ```{r library}
 library(sf)
-library(geau)
+library(so.ii)
 ```
 
 ```{r update-theme}
@@ -12,22 +12,46 @@ map_so_ii(theme = "collectivity", path = sprintf(path, "collectivity"))
 map_so_ii(theme = "collectivity", theme_legend = TRUE, detail = "syndicate", path = sprintf(path, "syndicate"))
 map_so_ii(theme = "collectivity", theme_legend = TRUE, detail = "epci", path = sprintf(path, "epci"))
 map_so_ii(theme = "clc", theme_legend = TRUE, path = sprintf(path, "clc"))
-map_so_ii(theme = "population", theme_legend = TRUE, path = sprintf(path, "population"))
+map_so_ii(theme = "population", main = "population [2019]", theme_legend = TRUE, path = sprintf(path, "population"))
 map_so_ii(theme = "population", year = 1931, theme_legend = TRUE, path = sprintf(path, "population-1931"))
 map_so_ii(theme = "population", year = 2018:2019, theme_legend = TRUE, path = sprintf(path, "population-last"))
 map_so_ii(theme = "population", year = 2014:2019, theme_legend = TRUE, path = sprintf(path, "population-last-5"))
-map_so_ii(theme = "catnat", theme_legend = TRUE, path = sprintf(path, "catnat"))
-map_so_ii(theme = "catnat", year = 2000:2019, theme_legend = TRUE, path = sprintf(path, "catnat-2000-2019"))
-map_so_ii(theme = "catnat", year = 2021, theme_legend = TRUE, path = sprintf(path, "catnat-2021"))
+
+
 map_so_ii(so_ii_hydro[as.character(so_ii_hydro$degre) <= 1, ], col = scales::colour_ramp(c("white", "blue"))(.5), border = NA, theme = "catchment", theme_legend = TRUE, path = sprintf(path, "catchment"))
 map_so_ii(so_ii_hydro[as.character(so_ii_hydro$degre) <= 2, ], col = scales::colour_ramp(c("white", "blue"))(.5), border = NA, theme = "catchment", detail = 2, theme_legend = TRUE, path = sprintf(path, "catchment_sub"))
-map_so_ii(theme = "onrn", detail = "freq_sin", theme_legend = TRUE, path = sprintf(path, "freq_sin"))
-map_so_ii(theme = "onrn", detail = "cost", theme_legend = TRUE, path = sprintf(path, "cost"))
-map_so_ii(theme = "onrn", detail = "cost_hab", theme_legend = TRUE, path = sprintf(path, "cost_hab"))
-map_so_ii(theme = "onrn", detail = "cost_mean", theme_legend = TRUE, path = sprintf(path, "cost_mean"))
-map_so_ii(theme = "onrn", detail = "ratio", theme_legend = TRUE, path = sprintf(path, "ratio"))
-map_so_ii(theme = "onrn", detail = "balance", theme_legend = TRUE, path = sprintf(path, "balance"))
-map_so_ii(theme = "onrn", detail = "ppri_year", theme_legend = TRUE, path = sprintf(path, "ppri_year"))
+
+# Cat-Nat
+period = range(dimnames(so_ii_catnat)[["period"]])
+map_so_ii(
+    theme = "catnat",
+    main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
+    theme_legend = TRUE,
+    path = sprintf(path, "catnat"))
+period = range(2000:2019)
+map_so_ii(
+    theme = "catnat",
+    year = period,
+    main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
+    theme_legend = TRUE,
+    path = sprintf(path, "catnat-2000-2019"))
+period = 2021
+map_so_ii(
+    theme = "catnat",
+    year = period
+    main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
+    theme_legend = TRUE,
+    path = sprintf(path, "catnat-2021"))
+
+# ONRN
+
+map_so_ii(theme = "onrn", main = "sinistre / risque", detail = "freq_sin", theme_legend = TRUE, path = sprintf(path, "freq_sin"))
+map_so_ii(theme = "onrn", main = "€ somme", detail = "cost", theme_legend = TRUE, path = sprintf(path, "cost"))
+map_so_ii(theme = "onrn", main = "€ / habitant", detail = "cost_hab", theme_legend = TRUE, path = sprintf(path, "cost_hab"))
+map_so_ii(theme = "onrn", main = "€ / sinistre", detail = "cost_mean", theme_legend = TRUE, path = sprintf(path, "cost_mean"))
+map_so_ii(theme = "onrn", main = "sinistre / prime", detail = "ratio", theme_legend = TRUE, path = sprintf(path, "ratio"))
+map_so_ii(theme = "onrn", main = "sinistre - prime", detail = "balance", theme_legend = TRUE, path = sprintf(path, "balance"))
+map_so_ii(theme = "onrn", main = "PPRI", detail = "ppri_year", theme_legend = TRUE, path = sprintf(path, "ppri_year"))
 ```
 
 ```{r update-rex-example}

geau/DESCRIPTION → so.ii/DESCRIPTION

-Package: geau
-Title: Utilities very useful to share within geau-inondation team
-Version: 1.0.15.0
+Package: so.ii
+Title: Utilities very useful to share within so_ii team
+Version: 1.0.16.0
 Authors@R:
     c(
         person(given = "Frédéric",

geau/NAMESPACE → so.ii/NAMESPACE

@@ -6,3 +6,4 @@ export(estimate_catnat_freq)
 export(format_presence)
 export(kable_units)
 export(map_so_ii)
+export(plot_legend)

geau/R/map_so_ii.r → so.ii/R/map_so_ii.r

@@ -110,11 +110,14 @@ map_so_ii = function(
     theme = match.arg(theme)
 
     if (!is.null(path)) {
+        width = 18
+        height = 18
         switch(
             EXPR = tolower(tools::file_ext(path)),
-            "pdf" = grDevices::cairo_pdf(path),
-            "png" = grDevices::png(path),
-            "svg" = grDevices::svg(path),
+            "pdf" = grDevices::cairo_pdf(path, width = width / 2.54, height = height / 2.54),
+            "png" = grDevices::png(path, width = width, height = height, units = "cm"),
+            "jpg" = grDevices::jpeg(path, width = width, height = height, units = "cm"),
+            "svg" = grDevices::svg(path, width = width / 2.54, height = height / 2.54),
             stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
         )
         on.exit(grDevices::dev.off())
@@ -122,7 +125,7 @@ map_so_ii = function(
 
     ## Init map
     graphics::par(mai = c(.65, .60, .50, .15))
-    plot(geau::so_ii_limit, axes = TRUE, main = list(...)[["main"]], cex.main = 3)
+    plot(so.ii::so_ii_limit, axes = TRUE, main = list(...)[["main"]], cex.main = 2.5)
 
     ## Plot theme if any, return theme_legend
     theme_legend = switch(
@@ -142,7 +145,7 @@ map_so_ii = function(
     if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
 
     ## Make so_ii_limit visible
-    plot(geau::so_ii_limit, lwd = 2, add = TRUE)
+    plot(so.ii::so_ii_limit, lwd = 2, add = TRUE)
 
     ## Plot bar
     if (bar == TRUE) {
@@ -192,12 +195,12 @@ map_theme_catchment = function(detail, add_legend) {
     }
     detail = match.arg(
         as.character(detail), 
-        choices = levels(geau::so_ii_catchment[["degre"]])
+        choices = levels(so.ii::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])
+    selection  = so.ii::so_ii_catchment[["degre"]] == detail
+    geometry = so.ii::so_ii_catchment[["geometry"]][selection]
+    catchment = as.factor(so.ii::so_ii_catchment[["catchment_name"]][selection])
     color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3)
     color = color_legend[catchment]
     border = "grey80"
@@ -223,25 +226,25 @@ map_theme_catchment = function(detail, add_legend) {
 
 map_theme_catnat = function(detail, year, add_legend) {
     if (missing(detail)) {
-        detail = dimnames(geau::so_ii_catnat)[["hazard"]]
+        detail = dimnames(so.ii::so_ii_catnat)[["hazard"]]
     }
     detail = match.arg(
         detail, 
-        dimnames(geau::so_ii_catnat)[["hazard"]],
+        dimnames(so.ii::so_ii_catnat)[["hazard"]],
         several.ok = TRUE
     )
 
     if (missing(year)) {
-        year = range(dimnames(geau::so_ii_catnat)[["period"]])
+        year = range(dimnames(so.ii::so_ii_catnat)[["period"]])
     }
     year = match.arg(
         as.character(year),
-        dimnames(geau::so_ii_catnat)[["period"]],
+        dimnames(so.ii::so_ii_catnat)[["period"]],
         several.ok = TRUE
     )
     year = as.character(seq(min(year), max(year)))
     catnat = apply(
-        geau::so_ii_catnat[, year, detail, drop = FALSE],
+        so.ii::so_ii_catnat[, year, detail, drop = FALSE],
         1,
         sum
     )
@@ -253,7 +256,7 @@ map_theme_catnat = function(detail, year, add_legend) {
         catnat_palette
     )[-1]
     plot(
-        geau::so_ii_collectivity[["geometry"]],
+        so.ii::so_ii_collectivity[["geometry"]],
         border = border,
         col = color,
         add = TRUE
@@ -296,20 +299,20 @@ map_theme_catnat = function(detail, year, add_legend) {
 
 map_theme_clc = function(add_legend) {
     plot(
-        geau::so_ii_clc[["geometry"]],
+        so.ii::so_ii_clc[["geometry"]],
         border = NA,
-        col = geau::so_ii_clc[["color"]],
+        col = so.ii::so_ii_clc[["color"]],
         add = TRUE
     )
 
     theme_legend = list(
         title = "CLC (2018)",
-        legend = geau::clc_color[["label_fr"]],
+        legend = so.ii::clc_color[["label_fr"]],
         x = "topright",
         cex = .8,
         bg = "white",
         inset = 0.01,
-        fill = geau::clc_color[["color"]]
+        fill = so.ii::clc_color[["color"]]
     )
 
     if (add_legend == TRUE) {
@@ -341,13 +344,13 @@ map_theme_collectivity = function(detail, add_legend)  {
         fill = color,
         border = border
     )
-    geometry = geau::so_ii_collectivity[["geometry"]]
+    geometry = so.ii::so_ii_collectivity[["geometry"]]
     plot(geometry, border = border, col = color, add = TRUE)
     
     if (detail %in% c("syble", "syndicate")) {
         color_legend = scales::alpha("orange", .3)
         color = ifelse(
-            geau::so_ii_collectivity[["syble"]],
+            so.ii::so_ii_collectivity[["syble"]],
             color_legend,
             NA
         )
@@ -358,7 +361,7 @@ map_theme_collectivity = function(detail, add_legend)  {
     if (detail %in% c("symbo", "syndicate")) {
         color_legend = scales::alpha("green", .3)
         color = ifelse(
-            geau::so_ii_collectivity[["symbo"]],
+            so.ii::so_ii_collectivity[["symbo"]],
             color_legend,
             NA
         )
@@ -367,7 +370,7 @@ map_theme_collectivity = function(detail, add_legend)  {
         theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend) 
     }
     if (detail == "epci") {
-        epci = as.factor(geau::so_ii_collectivity[["epci_name"]])
+        epci = as.factor(so.ii::so_ii_collectivity[["epci_name"]])
         color_legend = grDevices::hcl.colors(nlevels(epci), "Lisbon", alpha = .3)
         color = color_legend[epci]
         plot(geometry, border = border, col = color, add = TRUE)
@@ -390,14 +393,14 @@ map_theme_hydro = function(detail, add_legend) {
         as.character(detail),
         choices = c(
             "none",
-            levels(geau::so_ii_hydro[["degre"]]),
-            levels(geau::so_ii_hydro[["type"]])
+            levels(so.ii::so_ii_hydro[["degre"]]),
+            levels(so.ii::so_ii_hydro[["type"]])
         )
     )
     color = scales::alpha("blue", .3)
     bg = scales::alpha("blue", .3)
     border = NA
-    selection = seq(nrow(geau::so_ii_hydro))
+    selection = seq(nrow(so.ii::so_ii_hydro))
     theme_legend = list(
         title = sprintf("R\u00e9seau hydrographique"),
         legend = "\u00e9l\u00e9ment du r\u00e9seau",
@@ -408,15 +411,15 @@ map_theme_hydro = function(detail, add_legend) {
         col = color,
         lwd = 1
     )
-    if (detail %in% levels(geau::so_ii_hydro[["type"]])) {
-        selection  = as.character(geau::so_ii_hydro[["type"]]) == detail
+    if (detail %in% levels(so.ii::so_ii_hydro[["type"]])) {
+        selection  = as.character(so.ii::so_ii_hydro[["type"]]) == detail
         theme_legend[["legend"]] = detail
     }
-    if (detail %in% levels(geau::so_ii_hydro[["degre"]])) {
-        selection  = as.character(geau::so_ii_hydro[["degre"]]) <= detail
+    if (detail %in% levels(so.ii::so_ii_hydro[["degre"]])) {
+        selection  = as.character(so.ii::so_ii_hydro[["degre"]]) <= detail
     }
-    geometry = geau::so_ii_hydro[["geometry"]][selection]
-    lwd = 4 - as.numeric(geau::so_ii_hydro[["degre"]][selection])
+    geometry = so.ii::so_ii_hydro[["geometry"]][selection]
+    lwd = 4 - as.numeric(so.ii::so_ii_hydro[["degre"]][selection])
 
     plot(geometry, col = color, lwd = lwd, border = border, add = TRUE)
 
@@ -433,7 +436,7 @@ map_theme_onrn = function(detail, add_legend) {
     }
     detail = match.arg(
         as.character(detail),
-        sort(colnames(geau::so_ii_onrn)[1:8])
+        sort(colnames(so.ii::so_ii_onrn)[1:8])
     )
 
     onrn_palette = switch(
@@ -463,12 +466,12 @@ map_theme_onrn = function(detail, add_legend) {
     onrn_range = switch(
         EXPR = detail,
         "ratio"     = c(0, 4),
-        "balance"   = max(abs(range(geau::so_ii_onrn[["balance"]]))) * c(-1, 1),
+        "balance"   = max(abs(range(so.ii::so_ii_onrn[["balance"]]))) * c(-1, 1),
         NULL
     )
 
     color = scales::cscale(
-        c(onrn_range, geau::so_ii_onrn[[detail]]),
+        c(onrn_range, so.ii::so_ii_onrn[[detail]]),
         onrn_palette,
         trans = onrn_trans)
     if (length(onrn_range) > 0) {
@@ -476,15 +479,15 @@ map_theme_onrn = function(detail, add_legend) {
     }
     border = "grey80"
     plot(
-        geau::so_ii_collectivity[["geometry"]],
+        so.ii::so_ii_collectivity[["geometry"]],
         border = border,
         col = color,
         add = TRUE
     )
 
-    if (sprintf("%s_min", detail) %in% names(geau::so_ii_onrn)) {
+    if (sprintf("%s_min", detail) %in% names(so.ii::so_ii_onrn)) {
         selection = c(detail, sprintf("%s_min", detail), sprintf("%s_max", detail))
-        temp = unique(geau::so_ii_onrn[selection])
+        temp = unique(so.ii::so_ii_onrn[selection])
         temp = temp[order(temp[[detail]]), ]
         text_legend = gsub("0 - 0", "0",
             sprintf(
@@ -498,8 +501,8 @@ map_theme_onrn = function(detail, add_legend) {
     if (detail %in% c("n_catnat", "ppri_year")) {
         value_legend = round(
             seq(
-                min(geau::so_ii_onrn[[detail]], na.rm = TRUE),
-                max(geau::so_ii_onrn[[detail]], na.rm = TRUE),
+                min(so.ii::so_ii_onrn[[detail]], na.rm = TRUE),
+                max(so.ii::so_ii_onrn[[detail]], na.rm = TRUE),
                 length.out = 5
             )
         )
@@ -508,8 +511,8 @@ map_theme_onrn = function(detail, add_legend) {
     if (detail %in% c("balance")) {
         value_legend = unique(
             c(
-                seq(min(geau::so_ii_onrn[[detail]]), 0, length.out = 4),
-                seq(0, max(geau::so_ii_onrn[[detail]]), length.out = 4)
+                seq(min(so.ii::so_ii_onrn[[detail]]), 0, length.out = 4),
+                seq(0, max(so.ii::so_ii_onrn[[detail]]), length.out = 4)
             )
         )
         text_legend = formatC(
@@ -574,11 +577,11 @@ map_theme_osm = function() {
 
 map_theme_population = function(detail, year, add_legend) {
     if (missing(year)) {
-        year = utils::tail(sort(colnames(geau::so_ii_population)), 1)
+        year = utils::tail(sort(colnames(so.ii::so_ii_population)), 1)
     }
     year = match.arg(
         as.character(year),
-        sort(colnames(geau::so_ii_population)),
+        sort(colnames(so.ii::so_ii_population)),
         several.ok = TRUE
     )
 
@@ -588,21 +591,21 @@ map_theme_population = function(detail, year, add_legend) {
         pop_palette = scales::colour_ramp(c("white", "red"), alpha = .5)
         color = matrix(
             scales::cscale(
-                geau::so_ii_population,
+                so.ii::so_ii_population,
                 pop_palette,
                 trans = scales::log_trans()),
-            nrow = nrow(geau::so_ii_population),
-            dimnames = dimnames(geau::so_ii_population)
+            nrow = nrow(so.ii::so_ii_population),
+            dimnames = dimnames(so.ii::so_ii_population)
         )
 
         plot(
-            geau::so_ii_collectivity[["geometry"]],
+            so.ii::so_ii_collectivity[["geometry"]],
             border = border,
             col = color[ , year],
             add = TRUE
         )
-        max_pop = max(geau::so_ii_population[ , year])
-        min_pop = min(geau::so_ii_population[ , year])
+        max_pop = max(so.ii::so_ii_population[ , year])
+        min_pop = min(so.ii::so_ii_population[ , year])
         base = 10
 
         value_legend = unique(c(
@@ -611,7 +614,7 @@ map_theme_population = function(detail, year, add_legend) {
             max_pop
         ))
         color_legend = scales::cscale(
-                c(range(geau::so_ii_population), value_legend),
+                c(range(so.ii::so_ii_population), value_legend),
                 pop_palette,
                 trans = scales::log_trans()
             )[-(1:2)]
@@ -646,11 +649,11 @@ map_theme_population = function(detail, year, add_legend) {
         )
         pop_data = switch(
             EXPR = detail,
-            "absolute" = geau::so_ii_population[ , year[2]] -
-                geau::so_ii_population[ , year[1]],
-            "relative"  = (geau::so_ii_population[ , year[2]] -
-                geau::so_ii_population[ , year[1]]) /
-                geau::so_ii_population[ , year[1]]
+            "absolute" = so.ii::so_ii_population[ , year[2]] -
+                so.ii::so_ii_population[ , year[1]],
+            "relative"  = (so.ii::so_ii_population[ , year[2]] -
+                so.ii::so_ii_population[ , year[1]]) /
+                so.ii::so_ii_population[ , year[1]]
         )
         range_data = max(abs(range(pop_data))) * c(-1, 1)
         pop_trans = switch(
@@ -665,7 +668,7 @@ map_theme_population = function(detail, year, add_legend) {
             trans = pop_trans
         )[-(1:2)]
         plot(
-            geau::so_ii_collectivity[["geometry"]],
+            so.ii::so_ii_collectivity[["geometry"]],
             border = border,
             col = color,
             add = TRUE

so.ii/R/plot_legend.r

+#' @title Plot a legend independently of a map
+#'
+#' @details
+#' \subsection{path specification}{
+#' Depending on the extension a device is chosen.
+#' \itemize{
+#'   \item{\strong{pdf}: grDevices::cairo_pdf}
+#'   \item{\strong{png}: grDevices::png}
+#'   \item{\strong{svg}: grDevices::svg}
+#' }
+#' If path is NULL, standard plotting is used. If an extension is not managed,
+#' an error is raised.
+#' }
+#'
+#' @param dataset_legend list of parameters to be passed to legend
+#' @param path character, the name of the file to save the plot. Graphical
+#'  device is chosen depending on extension. See details.
+#' @param horiz logical, should the legend be horizontal
+#' @param add logical, should the legend be added to the current plot
+#'
+#' @return Nothing useful.
+#'
+#' @export plot_legend
+#'
+#' @encoding UTF-8
+#' @author Frédéric Grelot
+#'
+#' @examples
+#'
+#' dataset_legend = list(
+#'  title = "Beatutiful legend",
+#'  legend = c("red circle", "black square", "blue diamond"),
+#'  pch = 21:23,
+#'  pt.bg = c("red", "black", "blue")
+#' )
+#' plot_legend(dataset_legend)
+#' plot_legend(dataset_legend, horiz = FALSE)
+
+plot_legend = function(dataset_legend, path = NULL, horiz = TRUE, add = FALSE) {
+    dataset_legend[["horiz"]] = horiz
+
+    if (add == FALSE) {
+        if (!is.null(path)) {
+            switch(
+                EXPR = tolower(tools::file_ext(path)),
+                "pdf" = grDevices::cairo_pdf(path),
+                "png" = grDevices::png(path),
+                "jpg" = grDevices::jpeg(path),
+                "svg" = grDevices::svg(path),
+                stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
+            )
+            on.exit(grDevices::dev.off())
+
+            dataset_legend[["x"]] = "center"
+            graphics::par(mai = c(0, 0, 0, 0))
+            plot(NULL, axes = FALSE, ann = FALSE, xlim = 0:1, ylim = 0:1)
+            dimension = do.call(graphics::legend, dataset_legend)
+            grDevices::dev.off()
+
+            width = dimension[["rect"]][["w"]]
+            height = dimension[["rect"]][["h"]]
+            switch(
+                EXPR = tolower(tools::file_ext(path)),
+                "pdf" = grDevices::cairo_pdf(path, width = width * 7.5, height = height * 7.5),
+                "png" = grDevices::png(path, width = round(width * 500), height = round(height * 500)),
+                "jpg" = grDevices::jpeg(path, width = round(width * 500), height = round(height * 500)),
+                "svg" = grDevices::svg(path, width = width * 7.5, height = height * 7.5)
+            )
+        }
+
+        old_par = graphics::par(mai = c(0, 0, 0, 0))
+        dataset_legend[["x"]] = "center"
+        plot(NULL, axes = FALSE, ann = FALSE, xlim = 0:1, ylim = 0:1)
+    }
+    do.call(graphics::legend, dataset_legend)
+}
\ No newline at end of file