Skip to content
GitLab
Select Git revision
  • master default
  • 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
Find file BlameHistoryPermalink
  • Grelot Frederic's avatar
    catnat, population, clc · 9dbbbaeb
    Grelot Frederic authored 
    - catnat dataset remplace gaspar dataset
	- passage en array pour garder les types d'aléa
- estimate_catnat_freq incluse dans la librairie
- population dataset pour la population
- clc_color dataset pour les couleurs et label de clc
- map_so_ii inclus population, gère les légendes pour les thèmes
- dossier script hors librairie por garder la trace des mises à jour des données (doit aller dand floodam.data)

0 errors :heavy_check_mark: | 0 warnings :heavy_check_mark: | 1 note :heavy_multiplication_x:
Mais la note concerne le temps...
    9dbbbaeb
map_so_ii.r 5.60 KiB
1 
#' @title Plot a thematic map of so-ii
2 
#'
3 
#' @details
4 
#' hazard must be chosen in c("inondation", "submersion", "nappe").
5 
#'
6 
#' @param dataset sf objectf, data to be plotted
7 
#' @param dataset_legend list of parameters to be passed to legend
8 
#' @param theme character, choice for the theme (if any)
9 
#' @param bar logical, should a bar be plotted for the dataset
10 
#' @param path character, the name of the file to save the plot
11 
#' @param legend_theme logical, should a legend be plotted for the theme
12 
#' @param year character, the year chosen for some themes (catnat, population)
13 
#' @param hazard character, type of hazard chosen (if any). See details.
14 
#' @param ...  some parameters that will be used by plot (from sf)
15 
#'
16 
#' @return Nothing useful.
17 
#'
18 
#' @export
19 
#'
20 
#' @encoding UTF-8
21 
#' @author Frédéric Grelot
22 
#'
23 
#' @examples
24 
#'
25 
#' \dontrun{
26 
#' # To be added (soon)
27 
#' }
28
29 
map_so_ii = function(
30 
    dataset,
31 
    dataset_legend = NULL,
32 
    theme = "clc",
33 
    bar = TRUE,
34 
    path = NULL,
35 
    legend_theme = FALSE,
36 
    year,
37 
    hazard,
38 
    ...
39 
) {
40
41 
    if (!is.null(path)) {
42 
        switch(
43 
            EXPR = tolower(tools::file_ext(path)),
44 
            "pdf" = grDevices::pdf(path),
45 
            "png" = grDevices::png(path),
46 
            stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
47 
        )
48 
        on.exit(grDevices::dev.off())
49 
    }
50
51 
    ## Init map
52 
    graphics::par(mai = c(.65, .60, .50, .15))
53 
    plot(geau::so_ii_limit, axes = TRUE)
54
55 
    if ("clc" %in% theme) {
56 
        plot(
57 
            geau::so_ii_clc[["geometry"]],
58 
            border = NA,
59 
            col = geau::so_ii_clc[["color"]],
60 
            add = TRUE
61 
        )
62
63 
        theme_legend = list(
64 
            title = "CLC (2018)",
65 
            legend = geau::clc_color[["label_fr"]],
66 
            x = "topright",
67 
            cex = .8,
68 
            bg = "white",
69 
            inset = 0.01,
70 
            fill = geau::clc_color[["color"]]
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
) } if ("population" %in% theme) { if (missing(year)) { year = utils::tail(sort(colnames(geau::so_ii_population)), 1) } 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_commune[["geometry"]], border = border, col = color[ , year], add = TRUE ) 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( as.integer(value_legend), big.mark = " " ) theme_legend = list( title = sprintf("Population %s", year), legend = rep("", length(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)) ) } if ("catnat" %in% theme) { border = NA color = NA if (!missing(year)) { border = "grey80" if (missing(hazard)) { hazard = dimnames(geau::so_ii_catnat)[["hazard"]] } else { hazard = intersect( hazard, dimnames(geau::so_ii_catnat)[["hazard"]] ) if (length(hazard) == 0) { hazard = dimnames(geau::so_ii_catnat)[["hazard"]] } } catnat = apply( geau::so_ii_catnat[, as.character(year), hazard, drop = FALSE], 1:2, sum )
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205
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( geau::so_ii_commune[["geometry"]], border = border, col = color, add = TRUE ) } 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 ) } 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) } if (legend_theme == TRUE && exists("theme_legend")) { temp = do.call(graphics::legend, theme_legend) if (exists("text_legend")) { graphics::text( x = temp[["rect"]][["left"]] + temp[["rect"]][["w"]], y = temp[["text"]][["y"]], labels = text_legend, pos = 2 ) } } return(invisible(NULL)) }