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

geau Version 1.0.8.0 

0 errors :heavy_check_mark: | 0 warnings :heavy_check_mark: | 0 notes :heavy_check_mark:

map_so_ii refactoring
	- découpage des appels aux thèmes en fonctions map_theme_xxx
	- appel via un switch

so_ii_population
	- correction du dataset (il manquait les années de type PSDC
	- correction du script

so_ii_onrn
	- ajout de la bonne version (oubli...)
parent 9621767a
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!10Resolve "refactor map_so_ii theme"
Hide whitespace changes
Inline Side-by-side
Showing
with 428 additions and 370 deletions
+428 -370
geau/DESCRIPTION
+ 1
− 1
View file @ 9674ad22
Package: geau Package: geau
Title: Utilities very useful to share within geau-inondation team Title: Utilities very useful to share within geau-inondation team
Version: 1.0.7.0 Version: 1.0.8.0
Authors@R: Authors@R:
c( c(
person(given = "Frédéric", person(given = "Frédéric",
......
geau/R/data.r
+ 1
− 1
View file @ 9674ad22
...@@ -163,7 +163,7 @@ ...@@ -163,7 +163,7 @@
#' #'
#' A dataset containing the population of commune in so-ii according to INSEE. #' A dataset containing the population of commune in so-ii according to INSEE.
#' #'
#' @format numeric matrix #' @format numeric matrix 78 rows, 33 columns
#' \describe{ #' \describe{
#' \item{row}{commune as in so_ii_scope} #' \item{row}{commune as in so_ii_scope}
#' \item{column}{year} #' \item{column}{year}
......
geau/R/map_so_ii.r
+ 421
− 350
View file @ 9674ad22
...@@ -42,7 +42,7 @@ ...@@ -42,7 +42,7 @@
#' #'
#' @return Nothing useful. #' @return Nothing useful.
#' #'
#' @export #' @export map_so_ii
#' #'
#' @encoding UTF-8 #' @encoding UTF-8
#' @author Frédéric Grelot #' @author Frédéric Grelot
...@@ -81,406 +81,477 @@ map_so_ii = function( ...@@ -81,406 +81,477 @@ map_so_ii = function(
graphics::par(mai = c(.65, .60, .50, .15)) graphics::par(mai = c(.65, .60, .50, .15))
plot(geau::so_ii_limit, axes = TRUE) plot(geau::so_ii_limit, axes = TRUE)
if ("catchment" %in% theme) { ## Plot theme if any
if (missing(detail)) { theme_legend = switch(
detail = "1" EXPR = theme,
} "catchment" = map_theme_catchment(detail, legend_theme),
detail = match.arg( "catnat" = map_theme_catnat(detail, year, legend_theme),
as.character(detail), "clc" = map_theme_clc(legend_theme),
choices = levels(geau::so_ii_catchment[["degre"]]) "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]) if (!is.null(dataset_legend)) {
color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3) dataset_legend = c(
color = color_legend[catchment] x = "bottomright",
border = "grey80"
lwd = 2
theme_legend = list(
title = sprintf("Bassin versant"),
legend = levels(catchment),
x = "topright",
cex = .8, cex = .8,
bg = "white", bg = "white",
inset = 0.01, inset = 0.01,
fill = color_legend, dataset_legend)
border = border do.call(graphics::legend, dataset_legend)
)
if (detail == "3") rm(theme_legend)
plot(geometry, border = border, col = color, lwd = lwd, add = TRUE)
} }
if ("catnat" %in% theme) { if (legend_theme == TRUE && exists("theme_legend", inherits = FALSE)) {
if (missing(detail)) { if (!is.null(theme_legend[["text.width"]])) {
detail = dimnames(geau::so_ii_catnat)[["hazard"]] text_legend = theme_legend[["legend"]]
theme_legend[["legend"]] = rep("", length(text_legend))
} }
detail = match.arg( temp = do.call(graphics::legend, theme_legend)
detail, if (!is.null(theme_legend[["text.width"]])) {
dimnames(geau::so_ii_catnat)[["hazard"]], graphics::text(
several.ok = TRUE x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]],
) y = temp[["text"]][["y"]],
border = NA labels = text_legend,
color = NA pos = 2
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
) )
} }
}
plot( return(invisible(NULL))
geau::so_ii_collectivity[["geometry"]], }
border = border,
col = color, map_theme_catchment = function(detail, add_legend) {
add = TRUE if (missing(detail)) {
) detail = "1"
} }
detail = match.arg(
as.character(detail),
choices = levels(geau::so_ii_catchment[["degre"]])
)
if ("clc" %in% theme) { selection = geau::so_ii_catchment[["degre"]] == detail
plot( geometry = geau::so_ii_catchment[["geometry"]][selection]
geau::so_ii_clc[["geometry"]], catchment = as.factor(geau::so_ii_catchment[["catchment_name"]][selection])
border = NA, color_legend = grDevices::hcl.colors(nlevels(catchment), "Pastel 1", alpha = .3)
col = geau::so_ii_clc[["color"]], color = color_legend[catchment]
add = TRUE 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( if (add_legend == TRUE && detail != "3") {
title = "CLC (2018)", return(theme_legend)
legend = geau::clc_color[["label_fr"]], } else {
x = "topright", return(NULL)
cex = .8,
bg = "white",
inset = 0.01,
fill = geau::clc_color[["color"]]
)
} }
}
if ("collectivity" %in% theme) { map_theme_catnat = function(detail, year, add_legend) {
if (missing(detail)) { if (missing(detail)) {
detail = "none" detail = dimnames(geau::so_ii_catnat)[["hazard"]]
} }
detail = match.arg( detail = match.arg(
detail, detail,
c("none", "syble", "symbo", "epci", "syndicate") dimnames(geau::so_ii_catnat)[["hazard"]],
) several.ok = TRUE
)
theme_legend = NULL
border = NA
color = NA
if (!missing(year)) {
border = "grey80" 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( theme_legend = list(
title = "Caract\u00e9ristiques des communes", title = sprintf("%s %s", legend_title, year),
legend = "Commune", legend = c("Sans d\u00e9claration", "Avec d\u00e9claration"),
x = "topright", x = "topright",
cex = .8, cex = .8,
bg = "white", bg = "white",
inset = 0.01, inset = 0.01,
fill = color, fill = c(color_none, color_with),
border = border 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) { plot(
if (missing(detail)) { geau::so_ii_collectivity[["geometry"]],
detail = "none" border = border,
} col = color,
detail = match.arg( add = TRUE
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)
} }
}
if ("onrn" %in% theme) { map_theme_clc = function(add_legend) {
if (missing(detail)) { plot(
detail = "cost" geau::so_ii_clc[["geometry"]],
} border = NA,
detail = match.arg( col = geau::so_ii_clc[["color"]],
as.character(detail), add = TRUE
sort(colnames(geau::so_ii_onrn)[1:8]) )
)
onrn_palette = switch( theme_legend = list(
EXPR = detail, title = "CLC (2018)",
"n_catnat" = scales::colour_ramp(c("white", "red"), alpha = .5), legend = geau::clc_color[["label_fr"]],
"freq_sin" = scales::colour_ramp(c("white", "red"), alpha = .5), x = "topright",
"cost" = scales::colour_ramp(c("white", "red"), alpha = .5), cex = .8,
"cost_hab" = scales::colour_ramp(c("white", "red"), alpha = .5), bg = "white",
"cost_mean" = scales::colour_ramp(c("white", "red"), alpha = .5), inset = 0.01,
"ratio" = scales::colour_ramp(c("green", "white", "red"), alpha = .5), fill = geau::clc_color[["color"]]
"balance" = scales::colour_ramp(c("red", "white", "green"), alpha = .5), )
"ppri_year" = scales::colour_ramp(c("grey80", "grey50"), alpha = .5),
NULL if (add_legend == TRUE) {
) return(theme_legend)
onrn_trans = switch( } else {
EXPR = detail, return(NULL)
"n_catnat" = scales::identity_trans(), }
"freq_sin" = scales::identity_trans(), }
"cost" = scales::sqrt_trans(),
"cost_hab" = scales::sqrt_trans(), map_theme_collectivity = function(detail, add_legend) {
"cost_mean" = scales::sqrt_trans(), if (missing(detail)) {
"ratio" = scales::sqrt_trans(), detail = "none"
"balance" = scales::modulus_trans(.5), }
"ppri_year" = scales::identity_trans(), detail = match.arg(
NULL 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( plot(geometry, border = border, col = color, add = TRUE)
EXPR = detail, theme_legend[["legend"]] = c(theme_legend[["legend"]], "SYBLE")
"ratio" = c(0, 4), theme_legend[["fill"]] = c(theme_legend[["fill"]], color_legend)
"balance" = max(abs(range(geau::so_ii_onrn[["balance"]]))) * c(-1, 1), }
NULL 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( if (add_legend == TRUE) {
c(onrn_range, geau::so_ii_onrn[[detail]]), return(theme_legend)
onrn_palette, } else {
trans = onrn_trans) return(NULL)
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)) { map_theme_hydro = function(detail, add_legend) {
selection = c(detail, sprintf("%s_min", detail), sprintf("%s_max", detail)) if (missing(detail)) {
temp = unique(geau::so_ii_onrn[selection]) detail = "none"
temp = temp[order(temp[[detail]]), ] }
text_legend = gsub("0 - 0", "0", detail = match.arg(
sprintf( as.character(detail),
"%s - %s", choices = c(
temp[[sprintf("%s_min", detail)]], "none",
temp[[sprintf("%s_max", detail)]] levels(geau::so_ii_hydro[["degre"]]),
) levels(geau::so_ii_hydro[["type"]])
)
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
) )
)
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( plot(geometry, col = color, lwd = lwd, border = border, add = TRUE)
title = title_onrn,
legend = text_legend, if (add_legend == TRUE) {
x = "topright", return(theme_legend)
cex = .8, } else {
bg = "white", return(NULL)
inset = 0.01, }
fill = color_legend, }
border = border
) map_theme_onrn = function(detail, add_legend) {
rm(text_legend) if (missing(detail)) {
detail = "cost"
} }
detail = match.arg(
as.character(detail),
sort(colnames(geau::so_ii_onrn)[1:8])
)
if ("population" %in% theme) { onrn_palette = switch(
if (missing(year)) { EXPR = detail,
year = utils::tail(sort(colnames(geau::so_ii_population)), 1) "n_catnat" = scales::colour_ramp(c("white", "red"), alpha = .5),
} "freq_sin" = scales::colour_ramp(c("white", "red"), alpha = .5),
year = match.arg( "cost" = scales::colour_ramp(c("white", "red"), alpha = .5),
as.character(year), "cost_hab" = scales::colour_ramp(c("white", "red"), alpha = .5),
sort(colnames(geau::so_ii_population)) "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) value_legend = temp[[detail]]
color = matrix( }
scales::cscale( if (detail %in% c("n_catnat", "ppri_year")) {
geau::so_ii_population, value_legend = round(
population_palette, seq(
trans = scales::log_trans()), min(geau::so_ii_onrn[[detail]], na.rm = TRUE),
nrow = nrow(geau::so_ii_population), max(geau::so_ii_onrn[[detail]], na.rm = TRUE),
dimnames = dimnames(geau::so_ii_population) length.out = 5
)
) )
border = "grey80" text_legend = value_legend
plot( }
geau::so_ii_collectivity[["geometry"]], if (detail %in% c("balance")) {
border = border, value_legend = unique(
col = color[ , year], c(
add = TRUE 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( text_legend = formatC(
as.integer(value_legend), as.integer(signif(round(value_legend), 2)),
big.mark = " " big.mark = " "
) )
}
theme_legend = list( color_legend = scales::cscale(
title = sprintf("Population %s", year), c(onrn_range, value_legend),
legend = rep("", length(text_legend)), onrn_palette,
x = "topright", trans = onrn_trans
cex = .8,
bg = "white",
inset = 0.01,
fill = color_legend,
border = border,
text.width = graphics::strwidth(utils::tail(text_legend, 1))
) )
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, ...) theme_legend = list(
title = title_onrn,
plot(geau::so_ii_limit, lwd = 2, add = TRUE) legend = text_legend,
x = "topright",
cex = .8,
bg = "white",
inset = 0.01,
fill = color_legend,
border = border
)
if (bar == TRUE) { if (add_legend == TRUE) {
terra::sbar( return(theme_legend)
10, c(3.55, 43.47), } else {
type = "bar", return(NULL)
below = "km",
label = c(0, 5, 10),
cex = .8
)
} }
}
if (!is.null(dataset_legend)) { map_theme_population = function(year, add_legend) {
dataset_legend = c( if (missing(year)) {
x = "bottomright", year = utils::tail(sort(colnames(geau::so_ii_population)), 1)
cex = .8,
bg = "white",
inset = 0.01,
dataset_legend)
do.call(graphics::legend, dataset_legend)
} }
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)) { theme_legend = list(
temp = do.call(graphics::legend, theme_legend) title = sprintf("Population %s", year),
if (exists("text_legend", inherits = FALSE)) { legend = text_legend,
graphics::text( x = "topright",
x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]], cex = .8,
y = temp[["text"]][["y"]], bg = "white",
labels = text_legend, inset = 0.01,
pos = 2 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)
}
} }
geau/data-raw/so_ii_onrn.R
+ 2
− 16
View file @ 9674ad22
...@@ -4,25 +4,11 @@ so_ii_onrn = read.csv2( ...@@ -4,25 +4,11 @@ so_ii_onrn = read.csv2(
geau::current_version("data-common/so-ii/onrn"), geau::current_version("data-common/so-ii/onrn"),
row.names = 1 row.names = 1
) )
class(so_ii_population) = "data.frame" so_ii_onrn = so_ii_onrn[geau::so_ii_scope, ]
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
# updating datasets # updating datasets
# actual = setwd(file.path(system.file(package = "geau"), "..")) # actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("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) setwd(actual)
geau/data-raw/so_ii_population.R
+ 2
− 1
View file @ 9674ad22
...@@ -11,7 +11,7 @@ so_ii_population = readxl::read_xlsx( ...@@ -11,7 +11,7 @@ so_ii_population = readxl::read_xlsx(
class(so_ii_population) = "data.frame" class(so_ii_population) = "data.frame"
rownames(so_ii_population) = so_ii_population[["CODGEO"]] rownames(so_ii_population) = so_ii_population[["CODGEO"]]
selection = grep( selection = grep(
"PMUN|PSCDC|PTOT", "PMUN|PSDC|PTOT",
colnames(so_ii_population), colnames(so_ii_population),
value = TRUE value = TRUE
) )
...@@ -19,6 +19,7 @@ so_ii_population = as.matrix( ...@@ -19,6 +19,7 @@ so_ii_population = as.matrix(
so_ii_population[geau::so_ii_scope, selection] so_ii_population[geau::so_ii_scope, selection]
) )
year = gsub("PMUN", "20", selection) year = gsub("PMUN", "20", selection)
year = gsub("PSDC", "19", year)
year = gsub("PTOT", "19", year) year = gsub("PTOT", "19", year)
year = gsub("1919", "19", year) year = gsub("1919", "19", year)
year = gsub("1918", "18", year) year = gsub("1918", "18", year)
......
geau/data/so_ii_population.rda
+ 0
− 0
View file @ 9674ad22
No preview for this file type
geau/man/so_ii_population.Rd
+ 1
− 1
View file @ 9674ad22
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
\alias{so_ii_population} \alias{so_ii_population}
\title{Population for so-ii} \title{Population for so-ii}
\format{ \format{
numeric matrix numeric matrix 78 rows, 33 columns
\describe{ \describe{
\item{row}{commune as in so_ii_scope} \item{row}{commune as in so_ii_scope}
\item{column}{year} \item{column}{year}
......
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