-
Grelot Frederic authored0 errors
#' @title Plot a thematic map of so-ii#' #' @details#' \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{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.}#' \item{\strong{hydro}: detail must be chosen in "none", "1", "2", "3" for#' levels of detail or "canal", "river", "waterbody" for types of#' 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 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. If 2 or more years are#' provided an analysis of the evolution between the range of given#' years is plotted.}#' }#' }#' #' @param dataset sf objectf, data to be plotted#' @param dataset_legend list of parameters to be passed to legend#' @param theme character, choice for the theme (if any)#' @param theme_legend logical, should a legend be plotted for the theme#' @param detail character, detail for theme, depends on theme. See details.#' @param year character, the year chosen for some themes (catnat, population)#' @param bar logical, should a bar be plotted for the dataset#' @param path character, the name of the file to save the plot#' @param ... some parameters that will be used by plot (from sf)#'#' @return Nothing useful.#' #' @export map_so_ii#'#' @encoding UTF-8#' @author Frédéric Grelot#' @author David Nortes Martinez#' #' @examples#' #' \dontrun{#' # To be added (soon)#' }map_so_ii = function( dataset, dataset_legend = NULL, theme = c("none", "collectivity", "catchment", "catnat", "clc", "hydro", "onrn", "population"), theme_legend = FALSE, detail, year,7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
bar = TRUE,
path = NULL,
...
) {
theme = match.arg(theme)
if (!is.null(path)) {
switch(
EXPR = tolower(tools::file_ext(path)),
"pdf" = grDevices::pdf(path),
"png" = grDevices::png(path),
stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
)
on.exit(grDevices::dev.off())
}
## Init map
graphics::par(mai = c(.65, .60, .50, .15))
plot(geau::so_ii_limit, axes = TRUE)
## Plot theme if any, return theme_legend
theme_legend = switch(
EXPR = theme,
"catchment" = map_theme_catchment(detail, theme_legend),
"catnat" = map_theme_catnat(detail, year, theme_legend),
"clc" = map_theme_clc(theme_legend),
"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(detail, year, theme_legend),
NULL
)
## Plot dataset if any
if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
## Make so_ii_limit visible
plot(geau::so_ii_limit, lwd = 2, add = TRUE)
## Plot bar
if (bar == TRUE) {
terra::sbar(
10, c(3.55, 43.47),
type = "bar",
below = "km",
label = c(0, 5, 10),
cex = .8
)
}
## Plotdataset_legend if any
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)
}
## Plot theme_legend if any
if (!is.null(theme_legend)) {
if (!is.null(theme_legend[["text.width"]])) {
text_legend = theme_legend[["legend"]]
theme_legend[["legend"]] = rep("", length(text_legend))
}
temp = do.call(graphics::legend, theme_legend)
if (!is.null(theme_legend[["text.width"]])) {
graphics::text(
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]],
y = temp[["text"]][["y"]],
labels = text_legend,
pos = 2
)
}
}
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"]])
)
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)
if (add_legend == TRUE && detail != "3") {
return(theme_legend)
} else {
return(NULL)
}
}
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
)
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
)
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
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,
col = color,
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 {
return(NULL)
}
}
map_theme_clc = function(add_legend) {
plot(
geau::so_ii_clc[["geometry"]],
border = NA,
col = geau::so_ii_clc[["color"]],
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) {
return(theme_legend)
} else {
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
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
)
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 (add_legend == TRUE) {
return(theme_legend)
} else {
return(NULL)
}
}
map_theme_hydro = function(detail, add_legend) {
if (missing(detail)) {
detail = "none"
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
}
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(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])
)
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(),
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
"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)]]
)
)
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 = " "
)
text.width = max(graphics::strwidth(text_legend))
}
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)]
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
}
title_onrn = switch(
EXPR = detail,
"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]",
"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
)
theme_legend = list(
title = title_onrn,
legend = text_legend,
x = "topright",
cex = .8,
bg = "white",
inset = 0.01,
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 {
return(NULL)
}
}
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)),
several.ok = TRUE
)
border = "grey80"
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,
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
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)]
plot(
geau::so_ii_collectivity[["geometry"]],
border = border,
col = color,
add = TRUE
)
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))
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
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,
701702703704705706707708709710711712713714715716717718
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)
} else {
return(NULL)
}
}