Skip to content
GitLab
Commit 708f40c6 authored by Grelot Frederic's avatar Grelot Frederic :swimmer_tone5:
Browse files

Merge branch '9-enhance-theme-population' into 'master' 

Resolve "enhance theme population"

Closes #9

See merge request !11
parents 02a95449 cf3f7f61
master map_production v1.0.29.1 v1.0.29.0 v1.0.28.0 v1.0.27.0 v1.0.26.0 v1.0.25.0 v1.0.24.0 v1.0.23.0 v1.0.22.0 v1.0.21.0 v1.0.20.0
1 merge request!11Resolve "enhance theme population"
Hide whitespace changes
Inline Side-by-side
Showing
with 273 additions and 95 deletions
+273 -95
geau/DESCRIPTION
+ 1
− 1
View file @ 708f40c6
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
+ 242
− 87
View file @ 708f40c6
......@@ -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/data/so_ii_onrn.rda
+ 0
− 0
View file @ 708f40c6
No preview for this file type
geau/man/map_so_ii.Rd
+ 12
− 5
View file @ 708f40c6
......@@ -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.}
}
}
}
......
map_so_ii.rmd
+ 6
− 1
View file @ 708f40c6
......@@ -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")
......
script/onrn.R
+ 12
− 1
View file @ 708f40c6
......@@ -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)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment