diff --git a/geau/DESCRIPTION b/geau/DESCRIPTION
index 6d9acb06af656c0d7dca6b118d2c630950d0223c..e6a397ddec12c2042a2c3e7c7cba64f63b118a86 100644
--- a/geau/DESCRIPTION
+++ b/geau/DESCRIPTION
@@ -1,6 +1,6 @@
Package: geau
Title: Utilities very useful to share within geau-inondation team
-Version: 1.0.7.0
+Version: 1.0.8.0
Authors@R:
c(
person(given = "Frédéric",
diff --git a/geau/R/data.r b/geau/R/data.r
index 11d1c531360be2a0deba1b0c1ec2246b7595970d..0c159185b7c7fa469f84f4d2010d0c68b7f45c46 100644
--- a/geau/R/data.r
+++ b/geau/R/data.r
@@ -163,7 +163,7 @@
#'
#' A dataset containing the population of commune in so-ii according to INSEE.
#'
-#' @format numeric matrix
+#' @format numeric matrix 78 rows, 33 columns
#' \describe{
#' \item{row}{commune as in so_ii_scope}
#' \item{column}{year}
diff --git a/geau/R/map_so_ii.r b/geau/R/map_so_ii.r
index 5eb7b233cbf3b8b66f9064b5ad1b6e4c1fca97e7..14d4ceb4c92d9f9592f34dcbfc662685d4bd247d 100644
--- a/geau/R/map_so_ii.r
+++ b/geau/R/map_so_ii.r
@@ -42,7 +42,7 @@
#'
#' @return Nothing useful.
#'
-#' @export
+#' @export map_so_ii
#'
#' @encoding UTF-8
#' @author Frédéric Grelot
@@ -81,406 +81,477 @@ map_so_ii = function(
graphics::par(mai = c(.65, .60, .50, .15))
plot(geau::so_ii_limit, axes = TRUE)
- if ("catchment" %in% theme) {
- if (missing(detail)) {
- detail = "1"
- }
- detail = match.arg(
- as.character(detail),
- choices = levels(geau::so_ii_catchment[["degre"]])
+ ## Plot theme if any
+ theme_legend = switch(
+ EXPR = theme,
+ "catchment" = map_theme_catchment(detail, legend_theme),
+ "catnat" = map_theme_catnat(detail, year, legend_theme),
+ "clc" = map_theme_clc(legend_theme),
+ "collectivity" = map_theme_collectivity(detail, legend_theme),
+ "hydro" = map_theme_hydro(detail, legend_theme),
+ "onrn" = map_theme_onrn(detail, legend_theme),
+ "population" = map_theme_population(year, legend_theme),
+ )
+
+
+ if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
+
+ plot(geau::so_ii_limit, lwd = 2, add = TRUE)
+
+ if (bar == TRUE) {
+ terra::sbar(
+ 10, c(3.55, 43.47),
+ type = "bar",
+ below = "km",
+ label = c(0, 5, 10),
+ cex = .8
)
- selection = geau::so_ii_catchment[["degre"]] == detail
- geometry = geau::so_ii_catchment[["geometry"]][selection]
- catchment = as.factor(geau::so_ii_catchment[["catchment_name"]][selection])
- color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3)
- color = color_legend[catchment]
- border = "grey80"
- lwd = 2
- theme_legend = list(
- title = sprintf("Bassin versant"),
- legend = levels(catchment),
- x = "topright",
+ }
+
+ if (!is.null(dataset_legend)) {
+ dataset_legend = c(
+ x = "bottomright",
cex = .8,
bg = "white",
inset = 0.01,
- fill = color_legend,
- border = border
- )
- if (detail == "3") rm(theme_legend)
-
- plot(geometry, border = border, col = color, lwd = lwd, add = TRUE)
+ dataset_legend)
+ do.call(graphics::legend, dataset_legend)
}
- if ("catnat" %in% theme) {
- if (missing(detail)) {
- detail = dimnames(geau::so_ii_catnat)[["hazard"]]
+ if (legend_theme == TRUE && exists("theme_legend", inherits = FALSE)) {
+ if (!is.null(theme_legend[["text.width"]])) {
+ text_legend = theme_legend[["legend"]]
+ theme_legend[["legend"]] = rep("", length(text_legend))
}
- detail = match.arg(
- detail,
- dimnames(geau::so_ii_catnat)[["hazard"]],
- several.ok = TRUE
- )
- border = NA
- color = NA
- if (!missing(year)) {
- year = match.arg(
- as.character(year),
- dimnames(geau::so_ii_catnat)[["period"]]
- )
- border = "grey80"
- catnat = apply(
- geau::so_ii_catnat[, year, detail, drop = FALSE],
- 1:2,
- sum
- )
- color = ifelse(
- 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
+ temp = do.call(graphics::legend, theme_legend)
+ if (!is.null(theme_legend[["text.width"]])) {
+ graphics::text(
+ x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]],
+ y = temp[["text"]][["y"]],
+ labels = text_legend,
+ pos = 2
)
}
+ }
- plot(
- geau::so_ii_collectivity[["geometry"]],
- border = border,
- col = color,
- add = TRUE
- )
+ return(invisible(NULL))
+}
+
+map_theme_catchment = function(detail, add_legend) {
+ if (missing(detail)) {
+ detail = "1"
}
+ detail = match.arg(
+ as.character(detail),
+ choices = levels(geau::so_ii_catchment[["degre"]])
+ )
- if ("clc" %in% theme) {
- plot(
- geau::so_ii_clc[["geometry"]],
- border = NA,
- col = geau::so_ii_clc[["color"]],
- add = TRUE
- )
+ selection = geau::so_ii_catchment[["degre"]] == detail
+ geometry = geau::so_ii_catchment[["geometry"]][selection]
+ catchment = as.factor(geau::so_ii_catchment[["catchment_name"]][selection])
+ color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3)
+ color = color_legend[catchment]
+ border = "grey80"
+ lwd = 2
+ theme_legend = list(
+ title = sprintf("Bassin versant"),
+ legend = levels(catchment),
+ x = "topright",
+ cex = .8,
+ bg = "white",
+ inset = 0.01,
+ fill = color_legend,
+ border = border
+ )
+ plot(geometry, border = border, col = color, lwd = lwd, 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 (add_legend == TRUE && detail != "3") {
+ return(theme_legend)
+ } else {
+ return(NULL)
}
+}
- if ("collectivity" %in% theme) {
- if (missing(detail)) {
- detail = "none"
- }
- detail = match.arg(
- detail,
- c("none", "syble", "symbo", "epci", "syndicate")
- )
+map_theme_catnat = function(detail, year, add_legend) {
+ if (missing(detail)) {
+ detail = dimnames(geau::so_ii_catnat)[["hazard"]]
+ }
+ detail = match.arg(
+ detail,
+ dimnames(geau::so_ii_catnat)[["hazard"]],
+ several.ok = TRUE
+ )
+ theme_legend = NULL
+ border = NA
+ color = NA
+ if (!missing(year)) {
border = "grey80"
- color = NA
-
+ 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 = "Caract\u00e9ristiques des communes",
- legend = "Commune",
+ 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 = color,
+ fill = c(color_none, color_with),
border = border
)
- geometry = geau::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"]],
- color_legend,
- NA
- )
- plot(geometry, border = border, col = color, add = TRUE)
- theme_legend[["legend"]] = c(theme_legend[["legend"]], "SYBLE")
- theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
- }
- if (detail %in% c("symbo", "syndicate")) {
- color_legend = scales::alpha("green", .3)
- color = ifelse(
- geau::so_ii_collectivity[["symbo"]],
- color_legend,
- NA
- )
- plot(geometry, border = border, col = color, add = TRUE)
- theme_legend[["legend"]] = c(theme_legend[["legend"]], "SYMBO")
- theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
- }
- if (detail == "epci") {
- epci = as.factor(geau::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)
- theme_legend[["legend"]] = levels(epci)
- theme_legend[["fill"]] = color_legend
- }
}
- if ("hydro" %in% theme) {
- if (missing(detail)) {
- detail = "none"
- }
- detail = match.arg(
- as.character(detail),
- choices = c(
- "none",
- levels(geau::so_ii_hydro[["degre"]]),
- levels(geau::so_ii_hydro[["type"]])
- )
- )
- color = scales::alpha("blue", .3)
- bg = scales::alpha("blue", .3)
- border = NA
- selection = seq(nrow(geau::so_ii_hydro))
- theme_legend = list(
- title = sprintf("R\u00e9seau hydrographique"),
- legend = "\u00e9l\u00e9ment du r\u00e9seau",
- x = "topright",
- cex = .8,
- bg = "white",
- inset = 0.01,
- col = color,
- lwd = 1
- )
- if (detail %in% levels(geau::so_ii_hydro[["type"]])) {
- selection = as.character(geau::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
- }
- geometry = geau::so_ii_hydro[["geometry"]][selection]
- lwd = 4 - as.numeric(geau::so_ii_hydro[["degre"]][selection])
+ plot(
+ geau::so_ii_collectivity[["geometry"]],
+ border = border,
+ col = color,
+ add = TRUE
+ )
- plot(geometry, col = color, lwd = lwd, border = border, add = TRUE)
+ if (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
}
+}
- if ("onrn" %in% theme) {
- if (missing(detail)) {
- detail = "cost"
- }
- detail = match.arg(
- as.character(detail),
- sort(colnames(geau::so_ii_onrn)[1:8])
- )
+map_theme_clc = function(add_legend) {
+ plot(
+ geau::so_ii_clc[["geometry"]],
+ border = NA,
+ col = geau::so_ii_clc[["color"]],
+ add = TRUE
+ )
- onrn_palette = switch(
- EXPR = detail,
- "n_catnat" = scales::colour_ramp(c("white", "red"), alpha = .5),
- "freq_sin" = scales::colour_ramp(c("white", "red"), alpha = .5),
- "cost" = scales::colour_ramp(c("white", "red"), alpha = .5),
- "cost_hab" = scales::colour_ramp(c("white", "red"), alpha = .5),
- "cost_mean" = scales::colour_ramp(c("white", "red"), alpha = .5),
- "ratio" = scales::colour_ramp(c("green", "white", "red"), alpha = .5),
- "balance" = scales::colour_ramp(c("red", "white", "green"), alpha = .5),
- "ppri_year" = scales::colour_ramp(c("grey80", "grey50"), alpha = .5),
- NULL
- )
- onrn_trans = switch(
- EXPR = detail,
- "n_catnat" = scales::identity_trans(),
- "freq_sin" = scales::identity_trans(),
- "cost" = scales::sqrt_trans(),
- "cost_hab" = scales::sqrt_trans(),
- "cost_mean" = scales::sqrt_trans(),
- "ratio" = scales::sqrt_trans(),
- "balance" = scales::modulus_trans(.5),
- "ppri_year" = scales::identity_trans(),
- NULL
+ 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 (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
+ }
+}
+
+map_theme_collectivity = function(detail, add_legend) {
+ if (missing(detail)) {
+ detail = "none"
+ }
+ detail = match.arg(
+ detail,
+ c("none", "syble", "symbo", "epci", "syndicate")
+ )
+
+ border = "grey80"
+ color = NA
+
+ theme_legend = list(
+ title = "Caract\u00e9ristiques des communes",
+ legend = "Commune",
+ x = "topright",
+ cex = .8,
+ bg = "white",
+ inset = 0.01,
+ fill = color,
+ border = border
+ )
+ geometry = geau::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"]],
+ color_legend,
+ NA
)
- onrn_range = switch(
- EXPR = detail,
- "ratio" = c(0, 4),
- "balance" = max(abs(range(geau::so_ii_onrn[["balance"]]))) * c(-1, 1),
- NULL
+ plot(geometry, border = border, col = color, add = TRUE)
+ theme_legend[["legend"]] = c(theme_legend[["legend"]], "SYBLE")
+ theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
+ }
+ if (detail %in% c("symbo", "syndicate")) {
+ color_legend = scales::alpha("green", .3)
+ color = ifelse(
+ geau::so_ii_collectivity[["symbo"]],
+ color_legend,
+ NA
)
+ plot(geometry, border = border, col = color, add = TRUE)
+ theme_legend[["legend"]] = c(theme_legend[["legend"]], "SYMBO")
+ theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
+ }
+ if (detail == "epci") {
+ epci = as.factor(geau::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)
+ theme_legend[["legend"]] = levels(epci)
+ theme_legend[["fill"]] = color_legend
+ }
- color = scales::cscale(
- c(onrn_range, geau::so_ii_onrn[[detail]]),
- onrn_palette,
- trans = onrn_trans)
- if (length(onrn_range) > 0) {
- color = color[-seq(onrn_range)]
- }
- border = "grey80"
- plot(
- geau::so_ii_collectivity[["geometry"]],
- border = border,
- col = color,
- add = TRUE
- )
+ if (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
+ }
+}
- if (sprintf("%s_min", detail) %in% names(geau::so_ii_onrn)) {
- selection = c(detail, sprintf("%s_min", detail), sprintf("%s_max", detail))
- temp = unique(geau::so_ii_onrn[selection])
- temp = temp[order(temp[[detail]]), ]
- text_legend = gsub("0 - 0", "0",
- sprintf(
- "%s - %s",
- temp[[sprintf("%s_min", detail)]],
- temp[[sprintf("%s_max", detail)]]
- )
- )
- value_legend = temp[[detail]]
- }
- 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),
- length.out = 5
- )
- )
- text_legend = value_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)
- )
- )
- text_legend = formatC(
- as.integer(signif(round(value_legend), 2)),
- big.mark = " "
- )
- }
- color_legend = scales::cscale(
- c(onrn_range, value_legend),
- onrn_palette,
- trans = onrn_trans
- )
- if (length(onrn_range) > 0) {
- color_legend = color_legend[-seq(onrn_range)]
- }
- title_onrn = switch(
- EXPR = detail,
- "n_catnat" = "N arr\u00eat\u00e9s Cat-Nat (ONRN)",
- "freq_sin" = "Sinistre / Risque [1995-2018]",
- "cost" = "Co\u00fbt cumul\u00e9 (\u20AC) [1995-2018]",
- "cost_hab" = "Co\u00fbt / hab (\u20ac) [1995-2018]",
- "cost_mean" = "Co\u00fbt / sinistre (\u20ac) [1995-2018]",
- "ratio" = "Co\u00fbt / Prime [1995-2018]",
- "balance" = "Co\u00fbt - Prime (\u20ac) [1995-2018]",
- "ppri_year" = "Ann\u00e9e des PPRI",
- NULL
+map_theme_hydro = function(detail, add_legend) {
+ if (missing(detail)) {
+ detail = "none"
+ }
+ detail = match.arg(
+ as.character(detail),
+ choices = c(
+ "none",
+ levels(geau::so_ii_hydro[["degre"]]),
+ levels(geau::so_ii_hydro[["type"]])
)
+ )
+ color = scales::alpha("blue", .3)
+ bg = scales::alpha("blue", .3)
+ border = NA
+ selection = seq(nrow(geau::so_ii_hydro))
+ theme_legend = list(
+ title = sprintf("R\u00e9seau hydrographique"),
+ legend = "\u00e9l\u00e9ment du r\u00e9seau",
+ x = "topright",
+ cex = .8,
+ bg = "white",
+ inset = 0.01,
+ col = color,
+ lwd = 1
+ )
+ if (detail %in% levels(geau::so_ii_hydro[["type"]])) {
+ selection = as.character(geau::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
+ }
+ geometry = geau::so_ii_hydro[["geometry"]][selection]
+ lwd = 4 - as.numeric(geau::so_ii_hydro[["degre"]][selection])
- theme_legend = list(
- title = title_onrn,
- legend = text_legend,
- x = "topright",
- cex = .8,
- bg = "white",
- inset = 0.01,
- fill = color_legend,
- border = border
- )
- rm(text_legend)
+ plot(geometry, col = color, lwd = lwd, border = border, add = TRUE)
+
+ if (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
+ }
+}
+
+map_theme_onrn = function(detail, add_legend) {
+ if (missing(detail)) {
+ detail = "cost"
}
+ detail = match.arg(
+ as.character(detail),
+ sort(colnames(geau::so_ii_onrn)[1:8])
+ )
- if ("population" %in% theme) {
- 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))
+ onrn_palette = switch(
+ EXPR = detail,
+ "n_catnat" = scales::colour_ramp(c("white", "red"), alpha = .5),
+ "freq_sin" = scales::colour_ramp(c("white", "red"), alpha = .5),
+ "cost" = scales::colour_ramp(c("white", "red"), alpha = .5),
+ "cost_hab" = scales::colour_ramp(c("white", "red"), alpha = .5),
+ "cost_mean" = scales::colour_ramp(c("white", "red"), alpha = .5),
+ "ratio" = scales::colour_ramp(c("green", "white", "red"), alpha = .5),
+ "balance" = scales::colour_ramp(c("red", "white", "green"), alpha = .5),
+ "ppri_year" = scales::colour_ramp(c("grey80", "grey50"), alpha = .5),
+ NULL
+ )
+ onrn_trans = switch(
+ EXPR = detail,
+ "n_catnat" = scales::identity_trans(),
+ "freq_sin" = scales::identity_trans(),
+ "cost" = scales::sqrt_trans(),
+ "cost_hab" = scales::sqrt_trans(),
+ "cost_mean" = scales::sqrt_trans(),
+ "ratio" = scales::sqrt_trans(),
+ "balance" = scales::modulus_trans(.5),
+ "ppri_year" = scales::identity_trans(),
+ NULL
+ )
+ onrn_range = switch(
+ EXPR = detail,
+ "ratio" = c(0, 4),
+ "balance" = max(abs(range(geau::so_ii_onrn[["balance"]]))) * c(-1, 1),
+ NULL
+ )
+
+ color = scales::cscale(
+ c(onrn_range, geau::so_ii_onrn[[detail]]),
+ onrn_palette,
+ trans = onrn_trans)
+ if (length(onrn_range) > 0) {
+ color = color[-seq(onrn_range)]
+ }
+ border = "grey80"
+ plot(
+ geau::so_ii_collectivity[["geometry"]],
+ border = border,
+ col = color,
+ add = TRUE
+ )
+
+ if (sprintf("%s_min", detail) %in% names(geau::so_ii_onrn)) {
+ selection = c(detail, sprintf("%s_min", detail), sprintf("%s_max", detail))
+ temp = unique(geau::so_ii_onrn[selection])
+ temp = temp[order(temp[[detail]]), ]
+ text_legend = gsub("0 - 0", "0",
+ sprintf(
+ "%s - %s",
+ temp[[sprintf("%s_min", detail)]],
+ temp[[sprintf("%s_max", detail)]]
+ )
)
- 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)
+ value_legend = temp[[detail]]
+ }
+ 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),
+ length.out = 5
+ )
)
- border = "grey80"
- plot(
- geau::so_ii_collectivity[["geometry"]],
- border = border,
- col = color[ , year],
- add = TRUE
+ text_legend = value_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)
+ )
)
-
- 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),
+ as.integer(signif(round(value_legend), 2)),
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))
+ }
+ color_legend = scales::cscale(
+ c(onrn_range, value_legend),
+ onrn_palette,
+ trans = onrn_trans
)
+ if (length(onrn_range) > 0) {
+ color_legend = color_legend[-seq(onrn_range)]
}
+ title_onrn = switch(
+ EXPR = detail,
+ "n_catnat" = "N arr\u00eat\u00e9s Cat-Nat (ONRN)",
+ "freq_sin" = "Sinistre / Risque [1995-2018]",
+ "cost" = "Co\u00fbt cumul\u00e9 (\u20AC) [1995-2018]",
+ "cost_hab" = "Co\u00fbt / hab (\u20ac) [1995-2018]",
+ "cost_mean" = "Co\u00fbt / sinistre (\u20ac) [1995-2018]",
+ "ratio" = "Co\u00fbt / Prime [1995-2018]",
+ "balance" = "Co\u00fbt - Prime (\u20ac) [1995-2018]",
+ "ppri_year" = "Ann\u00e9e des PPRI",
+ NULL
+ )
- if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
-
- plot(geau::so_ii_limit, lwd = 2, add = TRUE)
+ theme_legend = list(
+ title = title_onrn,
+ legend = text_legend,
+ x = "topright",
+ cex = .8,
+ bg = "white",
+ inset = 0.01,
+ fill = color_legend,
+ border = border
+ )
- if (bar == TRUE) {
- terra::sbar(
- 10, c(3.55, 43.47),
- type = "bar",
- below = "km",
- label = c(0, 5, 10),
- cex = .8
- )
+ if (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
}
+}
- if (!is.null(dataset_legend)) {
- dataset_legend = c(
- x = "bottomright",
- cex = .8,
- bg = "white",
- inset = 0.01,
- dataset_legend)
- do.call(graphics::legend, dataset_legend)
+map_theme_population = function(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)
+ )
+ 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()
+ )[-(1:2)]
+ text_legend = formatC(
+ as.integer(value_legend),
+ big.mark = " "
+ )
- if (legend_theme == TRUE && exists("theme_legend", inherits = FALSE)) {
- temp = do.call(graphics::legend, theme_legend)
- if (exists("text_legend", inherits = FALSE)) {
- graphics::text(
- x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]],
- y = temp[["text"]][["y"]],
- labels = text_legend,
- pos = 2
- )
- }
- }
+ 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))
+ )
- return(invisible(NULL))
+ if (add_legend == TRUE) {
+ return(theme_legend)
+ } else {
+ return(NULL)
+ }
}
diff --git a/geau/data-raw/so_ii_onrn.R b/geau/data-raw/so_ii_onrn.R
index a6118f04c855831408a5c626149c9d49c877cf57..3fb1f76b88734743a7e6745b37e661caa9053f9c 100644
--- a/geau/data-raw/so_ii_onrn.R
+++ b/geau/data-raw/so_ii_onrn.R
@@ -4,25 +4,11 @@ so_ii_onrn = read.csv2(
geau::current_version("data-common/so-ii/onrn"),
row.names = 1
)
-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
+so_ii_onrn = so_ii_onrn[geau::so_ii_scope, ]
# updating datasets
# actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("geau")
-usethis::use_data(so_ii_population, internal = FALSE, overwrite = TRUE)
+usethis::use_data(so_ii_onrn, internal = FALSE, overwrite = TRUE)
setwd(actual)
diff --git a/geau/data-raw/so_ii_population.R b/geau/data-raw/so_ii_population.R
index a771c06304b70495be2fb2a1afd1e8d74fb31555..48c33714989d3607a51eb4201d7295f742eacee3 100644
--- a/geau/data-raw/so_ii_population.R
+++ b/geau/data-raw/so_ii_population.R
@@ -11,7 +11,7 @@ so_ii_population = readxl::read_xlsx(
class(so_ii_population) = "data.frame"
rownames(so_ii_population) = so_ii_population[["CODGEO"]]
selection = grep(
- "PMUN|PSCDC|PTOT",
+ "PMUN|PSDC|PTOT",
colnames(so_ii_population),
value = TRUE
)
@@ -19,6 +19,7 @@ so_ii_population = as.matrix(
so_ii_population[geau::so_ii_scope, selection]
)
year = gsub("PMUN", "20", selection)
+year = gsub("PSDC", "19", year)
year = gsub("PTOT", "19", year)
year = gsub("1919", "19", year)
year = gsub("1918", "18", year)
diff --git a/geau/data/so_ii_population.rda b/geau/data/so_ii_population.rda
index bc3a1b17f4b91879f41c30609c3c58215fe403f4..40b9f762816882b26cb8a91b2948dbdab5d9a6ed 100644
Binary files a/geau/data/so_ii_population.rda and b/geau/data/so_ii_population.rda differ
diff --git a/geau/man/so_ii_population.Rd b/geau/man/so_ii_population.Rd
index e2fd7371abdf02717f458323fab18ebc9d262bdc..7719fce8ccb0614e5ae5da951da6cea92ef16a4d 100644
--- a/geau/man/so_ii_population.Rd
+++ b/geau/man/so_ii_population.Rd
@@ -5,7 +5,7 @@
\alias{so_ii_population}
\title{Population for so-ii}
\format{
-numeric matrix
+numeric matrix 78 rows, 33 columns
\describe{
\item{row}{commune as in so_ii_scope}
\item{column}{year}