geau Version 1.0.10.0

0 errors  | 0 warnings  | 0 notes 

map_so_ii
	- theme catnat
		- affichage de la somme des arretés
		- gestion des périodes pour year
	- theme onrn
		- améloiration de la légende
	- theme population
		- gestion des périodes pour year

Refs #9

geau/DESCRIPTION

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

geau/R/map_so_ii.r

@@ -4,11 +4,11 @@
 #' \subsection{detail specification}{
 #' For the specification of detail, it depends on the theme chosen.
 #' \itemize{
+#'   \item{\strong{catchment}: detail must be chosen in "none", "1", "2", "3"
+#'      for levels of detail. If missing, "1" will be 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.}
@@ -18,15 +18,22 @@
 #'      everything is plotted.}
 #'   \item{\strong{onrn}: detail must be chosen in "n_catnat", "freq_sin",
 #'      "cost", "cost_hab", "cost_mean", "ratio", "balance", "ppri_year".}
+#'   \item{\strong{population}: detail must be chosen in "absolute",
+#'      "relative". It used only when more than one year is provided to plot
+#'      aither absolute or relative evolution.}
 #' }
 #' }
 #' \subsection{year specification}{
 #' For the specification of year, it depends on the theme chosen.
 #' \itemize{
-#'   \item{\strong{catnat}: year corresponds to the year of data. If missing,
-#'      nothing is plotted.}
+#'   \item{\strong{catnat}: year corresponds to the year of data. If 2 or more
+#'      years are given, the sum of the period corresponding to the range of
+#'      given years is plotted. If missing, the whole available period is
+#'      plotted.}
 #'   \item{\strong{population}: year corresponds to the year of data. If
-#'      missing, last available year is plotted.}
+#'      missing, last available year is plotted. If 2 or more years are
+#'      provided an analysis of the evolution between the range of given
+#'      years is plotted.}
 #' }
 #' }
 #' 
@@ -90,7 +97,7 @@ map_so_ii = function(
         "collectivity" = map_theme_collectivity(detail, theme_legend),
         "hydro" = map_theme_hydro(detail, theme_legend),
         "onrn" = map_theme_onrn(detail, theme_legend),
-        "population" = map_theme_population(year, theme_legend),
+        "population" = map_theme_population(detail, year, theme_legend),
         NULL
     )
 
@@ -187,44 +194,27 @@ map_theme_catnat = function(detail, year, add_legend) {
         several.ok = TRUE
     )
 
-    theme_legend = NULL
-    border = NA
-    color = NA
-    if (!missing(year)) {
-        border = "grey80"
-        color_none = color
-        color_with = scales::alpha("grey80", .5)
-        legend_title  = switch(
-            EXPR = as.character(length(detail)),
-            "3" = "Cat Nat",
-            sprintf("Cat Nat [%s]", paste(sort(detail), collapse = " & "))
-        )
-        year = match.arg(
-            as.character(year),
-            dimnames(geau::so_ii_catnat)[["period"]]
-        )
-        catnat = apply(
-            geau::so_ii_catnat[, year, detail, drop = FALSE],
-            1:2,
-            sum
-        )
-        color = ifelse(
-            catnat > 0,
-            color_with,
-            color_none
-        )
-        theme_legend = list(
-            title = sprintf("%s %s", legend_title, year),
-            legend = c("Sans d\u00e9claration", "Avec d\u00e9claration"),
-            x = "topright",
-            cex = .8,
-            bg = "white",
-            inset = 0.01,
-            fill = c(color_none, color_with),
-            border = border
-        )
+    if (missing(year)) {
+        year = range(dimnames(geau::so_ii_catnat)[["period"]])
     }
+    year = match.arg(
+        as.character(year),
+        dimnames(geau::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],
+        1,
+        sum
+    )
 
+    border = "grey80"
+    catnat_palette = scales::colour_ramp(c("white", "grey50"), alpha = .5)
+    color = scales::cscale(
+        c(0, catnat),
+        catnat_palette
+    )[-1]
     plot(
         geau::so_ii_collectivity[["geometry"]],
         border = border,
@@ -232,6 +222,34 @@ map_theme_catnat = function(detail, year, add_legend) {
         add = TRUE
     )
 
+    legend_title = sprintf(
+        "Cat Nat %s",
+        if (length(detail) == 3) "" else paste(sort(detail), collapse = " & ")
+    )
+    legend_title = sprintf(
+        "%s [%s]",
+        legend_title,
+        if (length(year) == 1) year else paste(range(year), collapse = "-")
+    )
+
+    value_legend = unique(sort(c(min(catnat), round(seq(0, max(catnat), length.out = 5)))))
+    color_legend = scales::cscale(
+        value_legend,
+        catnat_palette
+    )
+
+    theme_legend = list(
+        title = legend_title,
+        legend = value_legend,
+        x = "topright",
+        cex = .8,
+        bg = "white",
+        inset = 0.01,
+        fill = color_legend,
+        border = border,
+        text.width = max(graphics::strwidth(value_legend))
+    )
+
     if (add_legend == TRUE) {
         return(theme_legend)
     } else {
@@ -461,6 +479,7 @@ map_theme_onrn = function(detail, add_legend) {
             as.integer(signif(round(value_legend), 2)),
             big.mark = " "
         )
+        text.width = max(graphics::strwidth(text_legend))
     }
     color_legend = scales::cscale(
             c(onrn_range, value_legend),
@@ -472,7 +491,7 @@ map_theme_onrn = function(detail, add_legend) {
     }
     title_onrn = switch(
         EXPR = detail,
-        "n_catnat"  = "N arr\u00eat\u00e9s Cat-Nat (ONRN)",
+        "n_catnat"  = "Arr\u00eat\u00e9s Cat-Nat [1982-2021]",
         "freq_sin"  = "Sinistre / Risque [1995-2018]",
         "cost"      = "Co\u00fbt cumul\u00e9 (\u20AC) [1995-2018]",
         "cost_hab"  = "Co\u00fbt / hab (\u20ac) [1995-2018]",
@@ -493,7 +512,10 @@ map_theme_onrn = function(detail, add_legend) {
         fill = color_legend,
         border = border
     )
-
+    if (detail %in% c("balance", "cost")) {
+        theme_legend[["text.width"]] = max(graphics::strwidth(text_legend))
+    }
+    
     if (add_legend == TRUE) {
         return(theme_legend)
     } else {
@@ -501,58 +523,191 @@ map_theme_onrn = function(detail, add_legend) {
     }
 }
 
-map_theme_population = function(year, add_legend) {
+map_theme_population = function(detail, year, add_legend) {
     if (missing(year)) {
         year = utils::tail(sort(colnames(geau::so_ii_population)), 1)
     }
     year = match.arg(
         as.character(year),
-        sort(colnames(geau::so_ii_population))
-    )
-    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)
+        sort(colnames(geau::so_ii_population)),
+        several.ok = TRUE
     )
+
     border = "grey80"
-    plot(
-        geau::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])
-    value_legend = unique(c(
-        min_pop,
-        10^(ceiling(log(min_pop)/log(10)):floor(log(max_pop)/log(10))),
-        max_pop
-    ))
-    color_legend = scales::cscale(
-            c(range(geau::so_ii_population), value_legend),
-            population_palette,
-            trans = scales::log_trans()
+
+    if (length(year) == 1) {
+        pop_palette = scales::colour_ramp(c("white", "red"), alpha = .5)
+        color = matrix(
+            scales::cscale(
+                geau::so_ii_population,
+                pop_palette,
+                trans = scales::log_trans()),
+            nrow = nrow(geau::so_ii_population),
+            dimnames = dimnames(geau::so_ii_population)
+        )
+
+        plot(
+            geau::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])
+        base = 10
+
+        value_legend = unique(c(
+            min_pop,
+            base^(ceiling(log(min_pop)/log(base)):floor(log(max_pop)/log(base))),
+            max_pop
+        ))
+        color_legend = scales::cscale(
+                c(range(geau::so_ii_population), value_legend),
+                pop_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 = text_legend,
+            x = "topright",
+            cex = .8,
+            bg = "white",
+            inset = 0.01,
+            fill = color_legend,
+            border = border,
+            text.width = max(graphics::strwidth(text_legend))
+        )
+    }
+    
+    if (length(year) > 1) {
+        if (missing(detail)) {
+            detail = "absolute"
+        }
+        detail = match.arg(as.character(detail), c("absolute", "relative"))
+        year = range(year)
+
+        pop_palette = scales::colour_ramp(
+            c("red", "white", "green"),
+            alpha = .5
+        )
+        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]]
+        )
+        range_data = max(abs(range(pop_data))) * c(-1, 1)
+        pop_trans = switch(
+            EXPR = detail,
+            "absolute"  = scales::modulus_trans(0.2),
+            "relative"  = scales::modulus_trans(0.1),
+            NULL
+        )
+        color = scales::cscale(
+            c(range_data, pop_data),
+            pop_palette,
+            trans = pop_trans
         )[-(1:2)]
-    text_legend = formatC(
-        as.integer(value_legend),
-        big.mark = " "
-    )
+        plot(
+            geau::so_ii_collectivity[["geometry"]],
+            border = border,
+            col = color,
+            add = TRUE
+        )
 
-    theme_legend = list(
-        title = sprintf("Population %s", year),
-        legend = 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))
-    )
+        max_pop = max(pop_data)
+        min_pop = min(pop_data)
+
+        if (detail == "absolute") {
+            range_pop = max(abs(c(max_pop, min_pop)))
+            base = max(10, 10^floor(ceiling(log(range_pop)/log(10)) / 2))
+
+            if (sign(min_pop) == -1) {
+                value_legend = c(
+                    -base^(floor(log(abs(min_pop))/log(base)):1),
+                    base^(1:floor(log(max_pop)/log(base)))
+                )
+                value_legend = value_legend[
+                    value_legend < max_pop &
+                    value_legend > min_pop &
+                    abs(value_legend) >= base
+                ]
+                value_legend = sort(c(0, range(pop_data), value_legend))
+            } else {
+                value_legend = unique(c(
+                    min_pop,
+                    base^(ceiling(log(min_pop)/log(base)):floor(log(max_pop)/log(base))),
+                    max_pop
+                ))
+            }
+            color_legend = scales::cscale(
+                c(range_data, value_legend),
+                pop_palette,
+                trans = pop_trans
+            )[-(1:2)]
+            text_legend = formatC(
+                as.integer(value_legend),
+                big.mark = " "
+            )
+            title_legend = sprintf("Population \u00e9volution [%s-%s]", year[1], year[2])
+        }
+
+        if (detail == "relative") {
+            max_pop = max(pop_data) * 100
+            min_pop = min(pop_data) * 100
+            range_pop = max(abs(c(max_pop, min_pop)))
+            base = max(10, 10^floor(ceiling(log(range_pop)/log(10)) / 2))
+
+            if (sign(min_pop) == -1) {
+                value_legend = unique(c(
+                    min_pop,
+                    -base^(floor(log(abs(min_pop))/log(base)):0),
+                    0,
+                    base^(0:floor(log(max_pop)/log(base))),
+                    max_pop
+                ))
+            } else {
+                value_legend = unique(c(
+                    min_pop,
+                    base^(ceiling(log(min_pop)/log(base)):floor(log(max_pop)/log(base))),
+                    max_pop
+                ))
+            }
+            color_legend = scales::cscale(
+                    c(range_data, value_legend / 100),
+                    pop_palette,
+                    trans = pop_trans
+                )[-(1:2)]
+            text_legend = sprintf(
+                "%s %%",
+                formatC(
+                    signif(value_legend, 3),
+                    digits = 2, format = "f", flag = "+",
+                    big.mark = " "
+                )
+            )
+            title_legend = sprintf("Population \u00e9volution [%s-%s]", year[1], year[2])
+        }
+
+        theme_legend = list(
+            title = title_legend,
+            legend = text_legend,
+            x = "topright",
+            cex = .8,
+            bg = "white",
+            inset = 0.01,
+            fill = color_legend,
+            border = border,
+            text.width = max(graphics::strwidth(text_legend))
+        )
+    }
 
     if (add_legend == TRUE) {
         return(theme_legend)

geau/man/map_so_ii.Rd

@@ -47,11 +47,11 @@ Plot a thematic map of so-ii
 \subsection{detail specification}{
 For the specification of detail, it depends on the theme chosen.
 \itemize{
+\item{\strong{catchment}: detail must be chosen in "none", "1", "2", "3"
+for levels of detail. If missing, "1" will be 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.}
@@ -61,15 +61,22 @@ hydrographic elements. If missing, "none" will be chosen, and
 everything is plotted.}
 \item{\strong{onrn}: detail must be chosen in "n_catnat", "freq_sin",
 "cost", "cost_hab", "cost_mean", "ratio", "balance", "ppri_year".}
+\item{\strong{population}: detail must be chosen in "absolute",
+"relative". It used only when more than one year is provided to plot
+aither absolute or relative evolution.}
 }
 }
 \subsection{year specification}{
 For the specification of year, it depends on the theme chosen.
 \itemize{
-\item{\strong{catnat}: year corresponds to the year of data. If missing,
-nothing is plotted.}
+\item{\strong{catnat}: year corresponds to the year of data. If 2 or more
+years are given, the sum of the period corresponding to the range of
+given years is plotted. If missing, the whole available period is
+plotted.}
 \item{\strong{population}: year corresponds to the year of data. If
-missing, last available year is plotted.}
+missing, last available year is plotted. If 2 or more years are
+provided an analysis of the evolution between the range of given
+years is plotted.}
 }
 }
 }