diff --git a/geau/DESCRIPTION b/geau/DESCRIPTION
index adf2a63b3a2494ae7e41e8fa30801a0eef4999ae..f98b01a78c96790b010b571b5d427905dba436c7 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.9.0
+Version: 1.0.10.0
Authors@R:
c(
person(given = "Frédéric",
diff --git a/geau/R/map_so_ii.r b/geau/R/map_so_ii.r
index f2c4f4df0e289c173e9f0a36efedd9321119273f..2976c9acdfc5ea80209156a1b4151ed437f7ca85 100644
--- a/geau/R/map_so_ii.r
+++ b/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)
diff --git a/geau/data/so_ii_onrn.rda b/geau/data/so_ii_onrn.rda
index 5985ecbfe976d7619b844a785b0f048fdb6ff0eb..abc37b177092e92315c09e26ccdc278834f42cf9 100644
Binary files a/geau/data/so_ii_onrn.rda and b/geau/data/so_ii_onrn.rda differ
diff --git a/geau/man/map_so_ii.Rd b/geau/man/map_so_ii.Rd
index a118b15c1603bdfb23da7bb3134b42e3e4a3bec7..ba06effad63d9fd1826c960f6483d1d9dda78902 100644
--- a/geau/man/map_so_ii.Rd
+++ b/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.}
}
}
}
diff --git a/map_so_ii.rmd b/map_so_ii.rmd
index 858fa58c44eeaa051269d7edb1216e3d8963a92d..e45d67920bae60034522d0f55090e366e3b9cdc9 100644
--- a/map_so_ii.rmd
+++ b/map_so_ii.rmd
@@ -9,7 +9,12 @@ map_so_ii(theme = "collectivity", detail = "epci", theme_legend = TRUE)
map_so_ii(theme = "clc")
map_so_ii(theme = "population", theme_legend = TRUE)
map_so_ii(theme = "population", year = "2006", theme_legend = TRUE)
-map_so_ii(theme = "catnat", year = 2019)
+map_so_ii(theme = "population", year = c(2006, 2019), theme_legend = TRUE)
+map_so_ii(theme = "population", year = c(1876, 2019), detail ="relative", theme_legend = TRUE)
+map_so_ii(theme = "catnat")
+map_so_ii(theme = "catnat", detail = "nappe")
+map_so_ii(theme = "catnat", detail = "inondation", year = 2003)
+map_so_ii(theme = "catnat", detail = "inondation", year = 2003:2014)
map_so_ii(theme = "hydro")
map_so_ii(theme = "hydro", detail = 2)
map_so_ii(theme = "hydro", detail = "river")
diff --git a/script/onrn.R b/script/onrn.R
index bb96343a4ae93d88492e95f732f3d1e5382fe2c2..b8c9688c614566108d5b442191749a2a12ad5e40 100644
--- a/script/onrn.R
+++ b/script/onrn.R
@@ -266,10 +266,20 @@ result = merge(result, temp, by = "commune", all.x = TRUE)
### Bilan Sinistre - Prime : estimation
+# result = read.csv2(geau::current_version("data-common/so-ii/onrn"))
+
+#### Some data to compute premium per habitant
pop_france = 66992159 # INSEE (2018)
premium_france = 1670000000 # (CCR2019a pour 2018)
premium_hab = premium_france / pop_france
-result[["balance"]] = (1 - result[["ratio"]]) * geau::so_ii_population[ , "2018"] * premium_hab
+
+#### Need to compute cumulative population
+period = seq(1995, 2018)
+available = as.integer(dimnames(geau::so_ii_population)[[2]])
+selection = as.character(available[sapply(period, function(x){which.min(abs(available - x))})])
+pop_commune = rowSums(geau::so_ii_population[, selection])
+
+result[["balance"]] = (1 - result[["ratio"]]) * pop_commune * premium_hab
result = result[c(
"commune", "n_catnat", "freq_sin", "cost", "cost_mean", "cost_hab", "ratio", "balance",
@@ -279,6 +289,7 @@ result = result[c(
)]
write.csv2(result, sprintf("data-common/so-ii/onrn/onrn-%s.csv", today), row.names = FALSE)
+# write.csv2(result, geau::current_version("data-common/so-ii/onrn"), row.names = FALSE)
unlink(onrn_raw, recursive = TRUE, force = TRUE)