Commit 1baf0262 authored by Grelot Frederic's avatar Grelot Frederic 🏊🏿
Browse files

so.ii Version 1.0.16.0

- renommage de la library en so.ii
- ajout de la fonction plot_legend pour générer des légendes indépendamment des cartes
parent 20cde0d8
package = "geau" ; devtools::document(package) ; devtools::load_all(package)
package = "so.ii" ; devtools::document(package) ; devtools::load_all(package)
### Vignettes
# setwd(package):usethis::use_vignette(package);setwd("..")
......@@ -15,4 +15,4 @@ devtools::build(package, path = "library", vignettes = TRUE)
### install -> sudo
# devtools::install_local(package)
sudo su - -c "R -e \"devtools::install_gitlab('geau-inondation/geau-utility', subdir = 'geau', host = 'gitlab.irstea.fr', upgrade = 'never', auth_token = 'rCEfcrjoms9UNykCuM5c')\"" # nolint
\ No newline at end of file
sudo su - -c "R -e \"devtools::install_gitlab('geau-inondation/geau-utility', subdir = 'so.ii', host = 'gitlab.irstea.fr', upgrade = 'never', auth_token = 'rCEfcrjoms9UNykCuM5c')\"" # nolint
\ No newline at end of file
```{r library}
library(sf)
library(geau)
library(so.ii)
```
```{r update-theme}
......@@ -12,22 +12,46 @@ map_so_ii(theme = "collectivity", path = sprintf(path, "collectivity"))
map_so_ii(theme = "collectivity", theme_legend = TRUE, detail = "syndicate", path = sprintf(path, "syndicate"))
map_so_ii(theme = "collectivity", theme_legend = TRUE, detail = "epci", path = sprintf(path, "epci"))
map_so_ii(theme = "clc", theme_legend = TRUE, path = sprintf(path, "clc"))
map_so_ii(theme = "population", theme_legend = TRUE, path = sprintf(path, "population"))
map_so_ii(theme = "population", main = "population [2019]", theme_legend = TRUE, path = sprintf(path, "population"))
map_so_ii(theme = "population", year = 1931, theme_legend = TRUE, path = sprintf(path, "population-1931"))
map_so_ii(theme = "population", year = 2018:2019, theme_legend = TRUE, path = sprintf(path, "population-last"))
map_so_ii(theme = "population", year = 2014:2019, theme_legend = TRUE, path = sprintf(path, "population-last-5"))
map_so_ii(theme = "catnat", theme_legend = TRUE, path = sprintf(path, "catnat"))
map_so_ii(theme = "catnat", year = 2000:2019, theme_legend = TRUE, path = sprintf(path, "catnat-2000-2019"))
map_so_ii(theme = "catnat", year = 2021, theme_legend = TRUE, path = sprintf(path, "catnat-2021"))
map_so_ii(so_ii_hydro[as.character(so_ii_hydro$degre) <= 1, ], col = scales::colour_ramp(c("white", "blue"))(.5), border = NA, theme = "catchment", theme_legend = TRUE, path = sprintf(path, "catchment"))
map_so_ii(so_ii_hydro[as.character(so_ii_hydro$degre) <= 2, ], col = scales::colour_ramp(c("white", "blue"))(.5), border = NA, theme = "catchment", detail = 2, theme_legend = TRUE, path = sprintf(path, "catchment_sub"))
map_so_ii(theme = "onrn", detail = "freq_sin", theme_legend = TRUE, path = sprintf(path, "freq_sin"))
map_so_ii(theme = "onrn", detail = "cost", theme_legend = TRUE, path = sprintf(path, "cost"))
map_so_ii(theme = "onrn", detail = "cost_hab", theme_legend = TRUE, path = sprintf(path, "cost_hab"))
map_so_ii(theme = "onrn", detail = "cost_mean", theme_legend = TRUE, path = sprintf(path, "cost_mean"))
map_so_ii(theme = "onrn", detail = "ratio", theme_legend = TRUE, path = sprintf(path, "ratio"))
map_so_ii(theme = "onrn", detail = "balance", theme_legend = TRUE, path = sprintf(path, "balance"))
map_so_ii(theme = "onrn", detail = "ppri_year", theme_legend = TRUE, path = sprintf(path, "ppri_year"))
# Cat-Nat
period = range(dimnames(so_ii_catnat)[["period"]])
map_so_ii(
theme = "catnat",
main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
theme_legend = TRUE,
path = sprintf(path, "catnat"))
period = range(2000:2019)
map_so_ii(
theme = "catnat",
year = period,
main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
theme_legend = TRUE,
path = sprintf(path, "catnat-2000-2019"))
period = 2021
map_so_ii(
theme = "catnat",
year = period
main = sprintf("Cat-Nat [%s]", paste(period, collapse = "-")),
theme_legend = TRUE,
path = sprintf(path, "catnat-2021"))
# ONRN
map_so_ii(theme = "onrn", main = "sinistre / risque", detail = "freq_sin", theme_legend = TRUE, path = sprintf(path, "freq_sin"))
map_so_ii(theme = "onrn", main = "€ somme", detail = "cost", theme_legend = TRUE, path = sprintf(path, "cost"))
map_so_ii(theme = "onrn", main = "€ / habitant", detail = "cost_hab", theme_legend = TRUE, path = sprintf(path, "cost_hab"))
map_so_ii(theme = "onrn", main = "€ / sinistre", detail = "cost_mean", theme_legend = TRUE, path = sprintf(path, "cost_mean"))
map_so_ii(theme = "onrn", main = "sinistre / prime", detail = "ratio", theme_legend = TRUE, path = sprintf(path, "ratio"))
map_so_ii(theme = "onrn", main = "sinistre - prime", detail = "balance", theme_legend = TRUE, path = sprintf(path, "balance"))
map_so_ii(theme = "onrn", main = "PPRI", detail = "ppri_year", theme_legend = TRUE, path = sprintf(path, "ppri_year"))
```
```{r update-rex-example}
......
Package: geau
Title: Utilities very useful to share within geau-inondation team
Version: 1.0.15.0
Package: so.ii
Title: Utilities very useful to share within so_ii team
Version: 1.0.16.0
Authors@R:
c(
person(given = "Frédéric",
......
......@@ -6,3 +6,4 @@ export(estimate_catnat_freq)
export(format_presence)
export(kable_units)
export(map_so_ii)
export(plot_legend)
......@@ -110,11 +110,14 @@ map_so_ii = function(
theme = match.arg(theme)
if (!is.null(path)) {
width = 18
height = 18
switch(
EXPR = tolower(tools::file_ext(path)),
"pdf" = grDevices::cairo_pdf(path),
"png" = grDevices::png(path),
"svg" = grDevices::svg(path),
"pdf" = grDevices::cairo_pdf(path, width = width / 2.54, height = height / 2.54),
"png" = grDevices::png(path, width = width, height = height, units = "cm"),
"jpg" = grDevices::jpeg(path, width = width, height = height, units = "cm"),
"svg" = grDevices::svg(path, width = width / 2.54, height = height / 2.54),
stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
)
on.exit(grDevices::dev.off())
......@@ -122,7 +125,7 @@ map_so_ii = function(
## Init map
graphics::par(mai = c(.65, .60, .50, .15))
plot(geau::so_ii_limit, axes = TRUE, main = list(...)[["main"]], cex.main = 3)
plot(so.ii::so_ii_limit, axes = TRUE, main = list(...)[["main"]], cex.main = 2.5)
## Plot theme if any, return theme_legend
theme_legend = switch(
......@@ -142,7 +145,7 @@ map_so_ii = function(
if (!missing(dataset)) plot(dataset[["geometry"]], add = TRUE, ...)
## Make so_ii_limit visible
plot(geau::so_ii_limit, lwd = 2, add = TRUE)
plot(so.ii::so_ii_limit, lwd = 2, add = TRUE)
## Plot bar
if (bar == TRUE) {
......@@ -192,12 +195,12 @@ map_theme_catchment = function(detail, add_legend) {
}
detail = match.arg(
as.character(detail),
choices = levels(geau::so_ii_catchment[["degre"]])
choices = levels(so.ii::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])
selection = so.ii::so_ii_catchment[["degre"]] == detail
geometry = so.ii::so_ii_catchment[["geometry"]][selection]
catchment = as.factor(so.ii::so_ii_catchment[["catchment_name"]][selection])
color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3)
color = color_legend[catchment]
border = "grey80"
......@@ -223,25 +226,25 @@ map_theme_catchment = function(detail, add_legend) {
map_theme_catnat = function(detail, year, add_legend) {
if (missing(detail)) {
detail = dimnames(geau::so_ii_catnat)[["hazard"]]
detail = dimnames(so.ii::so_ii_catnat)[["hazard"]]
}
detail = match.arg(
detail,
dimnames(geau::so_ii_catnat)[["hazard"]],
dimnames(so.ii::so_ii_catnat)[["hazard"]],
several.ok = TRUE
)
if (missing(year)) {
year = range(dimnames(geau::so_ii_catnat)[["period"]])
year = range(dimnames(so.ii::so_ii_catnat)[["period"]])
}
year = match.arg(
as.character(year),
dimnames(geau::so_ii_catnat)[["period"]],
dimnames(so.ii::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],
so.ii::so_ii_catnat[, year, detail, drop = FALSE],
1,
sum
)
......@@ -253,7 +256,7 @@ map_theme_catnat = function(detail, year, add_legend) {
catnat_palette
)[-1]
plot(
geau::so_ii_collectivity[["geometry"]],
so.ii::so_ii_collectivity[["geometry"]],
border = border,
col = color,
add = TRUE
......@@ -296,20 +299,20 @@ map_theme_catnat = function(detail, year, add_legend) {
map_theme_clc = function(add_legend) {
plot(
geau::so_ii_clc[["geometry"]],
so.ii::so_ii_clc[["geometry"]],
border = NA,
col = geau::so_ii_clc[["color"]],
col = so.ii::so_ii_clc[["color"]],
add = TRUE
)
theme_legend = list(
title = "CLC (2018)",
legend = geau::clc_color[["label_fr"]],
legend = so.ii::clc_color[["label_fr"]],
x = "topright",
cex = .8,
bg = "white",
inset = 0.01,
fill = geau::clc_color[["color"]]
fill = so.ii::clc_color[["color"]]
)
if (add_legend == TRUE) {
......@@ -341,13 +344,13 @@ map_theme_collectivity = function(detail, add_legend) {
fill = color,
border = border
)
geometry = geau::so_ii_collectivity[["geometry"]]
geometry = so.ii::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"]],
so.ii::so_ii_collectivity[["syble"]],
color_legend,
NA
)
......@@ -358,7 +361,7 @@ map_theme_collectivity = function(detail, add_legend) {
if (detail %in% c("symbo", "syndicate")) {
color_legend = scales::alpha("green", .3)
color = ifelse(
geau::so_ii_collectivity[["symbo"]],
so.ii::so_ii_collectivity[["symbo"]],
color_legend,
NA
)
......@@ -367,7 +370,7 @@ map_theme_collectivity = function(detail, add_legend) {
theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
}
if (detail == "epci") {
epci = as.factor(geau::so_ii_collectivity[["epci_name"]])
epci = as.factor(so.ii::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)
......@@ -390,14 +393,14 @@ map_theme_hydro = function(detail, add_legend) {
as.character(detail),
choices = c(
"none",
levels(geau::so_ii_hydro[["degre"]]),
levels(geau::so_ii_hydro[["type"]])
levels(so.ii::so_ii_hydro[["degre"]]),
levels(so.ii::so_ii_hydro[["type"]])
)
)
color = scales::alpha("blue", .3)
bg = scales::alpha("blue", .3)
border = NA
selection = seq(nrow(geau::so_ii_hydro))
selection = seq(nrow(so.ii::so_ii_hydro))
theme_legend = list(
title = sprintf("R\u00e9seau hydrographique"),
legend = "\u00e9l\u00e9ment du r\u00e9seau",
......@@ -408,15 +411,15 @@ map_theme_hydro = function(detail, add_legend) {
col = color,
lwd = 1
)
if (detail %in% levels(geau::so_ii_hydro[["type"]])) {
selection = as.character(geau::so_ii_hydro[["type"]]) == detail
if (detail %in% levels(so.ii::so_ii_hydro[["type"]])) {
selection = as.character(so.ii::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
if (detail %in% levels(so.ii::so_ii_hydro[["degre"]])) {
selection = as.character(so.ii::so_ii_hydro[["degre"]]) <= detail
}
geometry = geau::so_ii_hydro[["geometry"]][selection]
lwd = 4 - as.numeric(geau::so_ii_hydro[["degre"]][selection])
geometry = so.ii::so_ii_hydro[["geometry"]][selection]
lwd = 4 - as.numeric(so.ii::so_ii_hydro[["degre"]][selection])
plot(geometry, col = color, lwd = lwd, border = border, add = TRUE)
......@@ -433,7 +436,7 @@ map_theme_onrn = function(detail, add_legend) {
}
detail = match.arg(
as.character(detail),
sort(colnames(geau::so_ii_onrn)[1:8])
sort(colnames(so.ii::so_ii_onrn)[1:8])
)
onrn_palette = switch(
......@@ -463,12 +466,12 @@ map_theme_onrn = function(detail, add_legend) {
onrn_range = switch(
EXPR = detail,
"ratio" = c(0, 4),
"balance" = max(abs(range(geau::so_ii_onrn[["balance"]]))) * c(-1, 1),
"balance" = max(abs(range(so.ii::so_ii_onrn[["balance"]]))) * c(-1, 1),
NULL
)
color = scales::cscale(
c(onrn_range, geau::so_ii_onrn[[detail]]),
c(onrn_range, so.ii::so_ii_onrn[[detail]]),
onrn_palette,
trans = onrn_trans)
if (length(onrn_range) > 0) {
......@@ -476,15 +479,15 @@ map_theme_onrn = function(detail, add_legend) {
}
border = "grey80"
plot(
geau::so_ii_collectivity[["geometry"]],
so.ii::so_ii_collectivity[["geometry"]],
border = border,
col = color,
add = TRUE
)
if (sprintf("%s_min", detail) %in% names(geau::so_ii_onrn)) {
if (sprintf("%s_min", detail) %in% names(so.ii::so_ii_onrn)) {
selection = c(detail, sprintf("%s_min", detail), sprintf("%s_max", detail))
temp = unique(geau::so_ii_onrn[selection])
temp = unique(so.ii::so_ii_onrn[selection])
temp = temp[order(temp[[detail]]), ]
text_legend = gsub("0 - 0", "0",
sprintf(
......@@ -498,8 +501,8 @@ map_theme_onrn = function(detail, add_legend) {
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),
min(so.ii::so_ii_onrn[[detail]], na.rm = TRUE),
max(so.ii::so_ii_onrn[[detail]], na.rm = TRUE),
length.out = 5
)
)
......@@ -508,8 +511,8 @@ map_theme_onrn = function(detail, add_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)
seq(min(so.ii::so_ii_onrn[[detail]]), 0, length.out = 4),
seq(0, max(so.ii::so_ii_onrn[[detail]]), length.out = 4)
)
)
text_legend = formatC(
......@@ -574,11 +577,11 @@ map_theme_osm = function() {
map_theme_population = function(detail, year, add_legend) {
if (missing(year)) {
year = utils::tail(sort(colnames(geau::so_ii_population)), 1)
year = utils::tail(sort(colnames(so.ii::so_ii_population)), 1)
}
year = match.arg(
as.character(year),
sort(colnames(geau::so_ii_population)),
sort(colnames(so.ii::so_ii_population)),
several.ok = TRUE
)
......@@ -588,21 +591,21 @@ map_theme_population = function(detail, year, add_legend) {
pop_palette = scales::colour_ramp(c("white", "red"), alpha = .5)
color = matrix(
scales::cscale(
geau::so_ii_population,
so.ii::so_ii_population,
pop_palette,
trans = scales::log_trans()),
nrow = nrow(geau::so_ii_population),
dimnames = dimnames(geau::so_ii_population)
nrow = nrow(so.ii::so_ii_population),
dimnames = dimnames(so.ii::so_ii_population)
)
plot(
geau::so_ii_collectivity[["geometry"]],
so.ii::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])
max_pop = max(so.ii::so_ii_population[ , year])
min_pop = min(so.ii::so_ii_population[ , year])
base = 10
value_legend = unique(c(
......@@ -611,7 +614,7 @@ map_theme_population = function(detail, year, add_legend) {
max_pop
))
color_legend = scales::cscale(
c(range(geau::so_ii_population), value_legend),
c(range(so.ii::so_ii_population), value_legend),
pop_palette,
trans = scales::log_trans()
)[-(1:2)]
......@@ -646,11 +649,11 @@ map_theme_population = function(detail, year, add_legend) {
)
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]]
"absolute" = so.ii::so_ii_population[ , year[2]] -
so.ii::so_ii_population[ , year[1]],
"relative" = (so.ii::so_ii_population[ , year[2]] -
so.ii::so_ii_population[ , year[1]]) /
so.ii::so_ii_population[ , year[1]]
)
range_data = max(abs(range(pop_data))) * c(-1, 1)
pop_trans = switch(
......@@ -665,7 +668,7 @@ map_theme_population = function(detail, year, add_legend) {
trans = pop_trans
)[-(1:2)]
plot(
geau::so_ii_collectivity[["geometry"]],
so.ii::so_ii_collectivity[["geometry"]],
border = border,
col = color,
add = TRUE
......
#' @title Plot a legend independently of a map
#'
#' @details
#' \subsection{path specification}{
#' Depending on the extension a device is chosen.
#' \itemize{
#' \item{\strong{pdf}: grDevices::cairo_pdf}
#' \item{\strong{png}: grDevices::png}
#' \item{\strong{svg}: grDevices::svg}
#' }
#' If path is NULL, standard plotting is used. If an extension is not managed,
#' an error is raised.
#' }
#'
#' @param dataset_legend list of parameters to be passed to legend
#' @param path character, the name of the file to save the plot. Graphical
#' device is chosen depending on extension. See details.
#' @param horiz logical, should the legend be horizontal
#' @param add logical, should the legend be added to the current plot
#'
#' @return Nothing useful.
#'
#' @export plot_legend
#'
#' @encoding UTF-8
#' @author Frédéric Grelot
#'
#' @examples
#'
#' dataset_legend = list(
#' title = "Beatutiful legend",
#' legend = c("red circle", "black square", "blue diamond"),
#' pch = 21:23,
#' pt.bg = c("red", "black", "blue")
#' )
#' plot_legend(dataset_legend)
#' plot_legend(dataset_legend, horiz = FALSE)
plot_legend = function(dataset_legend, path = NULL, horiz = TRUE, add = FALSE) {
dataset_legend[["horiz"]] = horiz
if (add == FALSE) {
if (!is.null(path)) {
switch(
EXPR = tolower(tools::file_ext(path)),
"pdf" = grDevices::cairo_pdf(path),
"png" = grDevices::png(path),
"jpg" = grDevices::jpeg(path),
"svg" = grDevices::svg(path),
stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
)
on.exit(grDevices::dev.off())
dataset_legend[["x"]] = "center"
graphics::par(mai = c(0, 0, 0, 0))
plot(NULL, axes = FALSE, ann = FALSE, xlim = 0:1, ylim = 0:1)
dimension = do.call(graphics::legend, dataset_legend)
grDevices::dev.off()
width = dimension[["rect"]][["w"]]
height = dimension[["rect"]][["h"]]
switch(
EXPR = tolower(tools::file_ext(path)),
"pdf" = grDevices::cairo_pdf(path, width = width * 7.5, height = height * 7.5),
"png" = grDevices::png(path, width = round(width * 500), height = round(height * 500)),
"jpg" = grDevices::jpeg(path, width = round(width * 500), height = round(height * 500)),
"svg" = grDevices::svg(path, width = width * 7.5, height = height * 7.5)
)
}
old_par = graphics::par(mai = c(0, 0, 0, 0))
dataset_legend[["x"]] = "center"
plot(NULL, axes = FALSE, ann = FALSE, xlim = 0:1, ylim = 0:1)
}
do.call(graphics::legend, dataset_legend)
}
\ No newline at end of file
Markdown is supported
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