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

Merge branch '10-add_inset' into 'master'

Resolve "add_inset"

Closes #10

See merge request !12
parents c70e662c 71893d35
......@@ -8,11 +8,15 @@ devtools::build_vignettes(package)
# devtools::run_examples(package)
### Checks
# system("mv ~/.Rprofile ~/.Rprofile-temp");devtools::check(package);system("mv ~/.Rprofile-temp ~/.Rprofile") # nolint
# system("rm so.ii/data-raw/data-common")
# system("mv ~/.Rprofile ~/.Rprofile-temp")
# devtools::check(package)
# system("mv ~/.Rprofile-temp ~/.Rprofile") # nolint
# system("cp -r data-common so.ii/data-raw")
### Build
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 = 'so.ii', 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
Package: so.ii
Title: Utilities very useful to share within so_ii team
Version: 1.0.17.0
Version: 1.0.18.0
Authors@R:
c(
person(given = "Frédéric",
......@@ -15,7 +15,7 @@ Authors@R:
comment = c(ORCID = "0000-0002-0711-5885"))
)
Description: This package collects some very useful utilities to work in a
collaborative way within geau-inondation.
collaborative way within team so-ii of G-eau.
License: GPL (>= 3)
Encoding: UTF-8
Depends: R (>= 3.4.0)
......
# Generated by roxygen2: do not edit by hand
export(add.inset)
export(add_inset)
export(current_version)
export(estimate_catnat_freq)
export(format_presence)
......
#' @title Add an inset within a map
#'
#' @param x should be something of type polygon readable by terra::vect
#' @param scale numeric, how big should be the inset relative to the whole map
#' @param loc character, vwhere to put the inset
#' @param background character, color to be used for the background
#' @param ... some parameters that will be used by terra::plot
#'
#' @return polyVect transformed to be placed somewhere in the map
#'
#' @export
#'
#' @encoding UTF-8
#' @author This is an adaptation of the function inset of the terra package.
#'
#' @examples
#'
#' \dontrun{
#' # To be added (soon)
#' }
add.inset = function (x, scale = 0.2, loc = "", background = "white", ...)
{
e_usr = terra::ext(graphics::par("usr"))
x = try(terra::vect(x))
e = terra::ext(x)
r = (max(c(diff(e_usr[1:2]) / diff(e[1:2]), diff(e_usr[3:4]) / diff(e[3:4]))) * scale)^2
y = terra::rescale(x, f = r)
e = terra::ext(y)
if (loc != "") {
stopifnot(loc %in% c("bottomright", "bottom", "bottomleft",
"left", "topleft", "top", "topright", "right", "center"))
if (grepl("top", loc)) {
dy = e_usr[4] - e[4]
} else if (grepl("bottom", loc)) {
dy = e_usr[3] - e[3]
} else {
dy = (e_usr[3] + diff(e_usr[3:4])/2) - (e[3] + diff(e[3:4])/2)
}
if (grepl("left", loc)) {
dx = e_usr[1] - e[1]
} else if (grepl("right", loc)) {
dx = e_usr[2] - e[2]
} else {
dx = (e_usr[1] + diff(e_usr[1:2])/2) - (e[1] + diff(e[1:2])/2)
}
} else {
dx = e_usr[1] - e[1]
dy = e_usr[4] - e[4]
}
y = terra::shift(y, dx, dy)
e = terra::ext(y)
y = terra::rescale(y, f = .8)
if (!is.na(background)) {
terra::polys(
terra::rescale(terra::as.polygons(e), .9),
col = background,
lty = 1, lwd = 2, border = "lightgray")
}
terra::plot(y, ..., add = TRUE)
invisible(y)
}
#' @title Add an inset within a map
#'
#' @details
#' If add = TRUE, the location is calculated through the extent of current map.
#' If add = FALSE, the location is calcultaed through the extent of y.
#'
#' The function is based on the facility to rescale and translate sf object.
#'
#' @param x should be a sf object or at least readable by sf::st_geometry.
#' @param y should be a sf object or at least readable by sf::st_bbox.
#' @param ratio numeric, how big should be the inset relative to the whole map
#' or to y. See details.
#' @param add loical, should the inset be added to an existing plot.
#' @param ... some parameters that will be used by sf::plot
#'
#' @return sf geometry transformed to be placed in the good loaction in the map.
#'
#' @export
#'
#' @encoding UTF-8
#' @author Frédéric Grelot
#'
#' @examples
#'
#' library(sf)
#' so.ii::map_so_ii()
#' inset = add_inset(
#' so.ii::so_ii_inset[c("region", "so-ii"), ],
#' so.ii::so_ii_limit,
#' col = c("gray", "red"), border = c(NA, "red"), lwd = 1:2
#' )
add_inset = function(x, y, ratio = 1/5, add = TRUE, ...) {
ext_y = if (add == TRUE) {
sf::st_bbox(stats::setNames(graphics::par("usr"), c("xmin", "xmax", "ymin", "ymax")))
} else {
sf::st_bbox(y)
}
x = sf::st_geometry(x)
ext_x = sf::st_bbox(x)
ratio = ratio * min(c(
diff(ext_y[c("xmin", "xmax")]) / diff(ext_x[c("xmin", "xmax")]),
diff(ext_y[c("ymin", "ymax")]) / diff(ext_x[c("ymin", "ymax")])
))
centroid = sf::st_centroid(x)
x = (x - centroid) * ratio
ext_x = sf::st_bbox(x)
ratio_real = stats::setNames(c(
diff(ext_x[c("xmin", "xmax")]) / diff(ext_y[c("xmin", "xmax")]),
diff(ext_x[c("ymin", "ymax")]) / diff(ext_y[c("ymin", "ymax")])
), c("x", "y"))
pos = c(
ext_y[["xmin"]] + diff(ext_y[c("xmin", "xmax")]) * (ratio_real["x"] / 2 + 0.02),
ext_y[["ymax"]] - diff(ext_y[c("ymin", "ymax")]) * (ratio_real["y"] / 2 + 0.02)
)
pos = sf::st_sfc(sf::st_point(pos))
sf::st_crs(pos) = sf::st_crs(y)
x = x + pos + (centroid - centroid[1]) * ratio
sf::st_crs(x) = sf::st_crs(y)
if (add == TRUE) plot(x, ..., add = TRUE)
return(invisible(x))
}
......@@ -101,6 +101,20 @@
#' @source \url{http://bdtopage.eaufrance.fr/page/objectifs}
"so_ii_hydro"
#' Inset to help localisation of the so-ii perimeter
#'
#' A sf dataset containing 4 simplified geometries of France, Occitanie,
#' Hérault, and so-ii perimeter. rownames are provided with "nation", "region",
#' "department", "so.ii".
#'
#' @format sf data.frame 4 rows, 1 variable
#' \describe{
#' \item{scope}{character, names of the scope}
#' }
#'
#' @source \url{http://bdtopage.eaufrance.fr/page/objectifs}
"so_ii_inset"
#' Spatial perimeter of so-ii
#'
#' A dataset containing the perimeter of so-ii.
......
......@@ -60,24 +60,43 @@
#' years is plotted.}
#' }
#' }
#' \subsection{inset specification}{
#' If inset is not NULL, an inset will be plotted, depending on the value of
#' as.character(inset). Non-case sensitive partial matching is used, with "é"
#' interpreted as "e".
#' \itemize{
#' \item{\strong{department}: so-ii perimeter is located within Hérault
#' departement, if inset may be interpreted as "department", "département",
#' "hérault", "34".}
#' \item{\strong{region}: so-ii perimeter is located within Occitanie region,
#' if inset may be interpreted as "région", "Occitanie", "76" (INSEE code for
#' Occitanie region).}
#' \item{\strong{nation}: so-ii perimeter is located within the metropolitean
#' part of France, if inset may be interpreted as "France", "métropole",
#' "nation".}
#' }
#' If all other cases, nothing is added.
#' }
#' \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{jpg}: grDevices::jpg}
#' \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 sf objectf, data to be plotted
#' @param dataset_legend list of parameters to be passed to legend
#' @param dataset sf object, data to be plotted
#' @param dataset_legend list of parameters to be passed to legend.
#' @param theme character, choice for the theme (if any). See details.
#' @param theme_legend logical, should a legend be plotted for the theme
#' @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. See details.
#' @param bar logical, should a bar be plotted for the dataset
#' @param bar logical, should a bar be plotted for the dataset. See details.
#' @param inset charecter, managing if an inset is plotted.
#' @param path character, the name of the file to save the plot. Graphical
#' device is chosen depending on extension. See details.
#' @param ... some parameters that will be used by plot (from sf)
......@@ -104,6 +123,7 @@ map_so_ii = function(
detail,
year,
bar = TRUE,
inset = NULL,
path = NULL,
...
) {
......@@ -115,8 +135,8 @@ map_so_ii = function(
switch(
EXPR = tolower(tools::file_ext(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"),
"png" = grDevices::png(path, width = width, height = height, units = "cm", res = 144),
"jpg" = grDevices::jpeg(path, width = width, height = height, units = "cm", res = 144),
"svg" = grDevices::svg(path, width = width / 2.54, height = height / 2.54),
stop(sprintf("%s not recognized", tolower(tools::file_ext(path))))
)
......@@ -158,7 +178,29 @@ map_so_ii = function(
)
}
## Plotdataset_legend if any
## Plot inset
if (!is.null(inset)) {
inset = gsub("\u00e9", "e", tolower(as.character(inset)[1]))
admissible = list(
department = c("34", "departement", "department", "herault"),
region = c("76", "occitanie", "region"),
nation = c("france", "metropole", "nation")
)
inset = names(which(sapply(
admissible,
function(x, pattern){length(grep(sprintf("^%s", pattern), x)) > 0},
inset
)))
if (length(inset) == 1 && inset %in% rownames(so.ii::so_ii_inset)) {
add_inset(
so.ii::so_ii_inset[c(inset, "so-ii"), ],
so.ii::so_ii_limit,
col = c("gray85", "red"), border = c("gray", "red"), lwd = 1:2
)
}
}
## Plot dataset_legend if any
if (!is.null(dataset_legend)) {
if (is.null(dataset_legend[["x"]])) dataset_legend[["x"]] = "bottomright"
if (is.null(dataset_legend[["cex"]])) dataset_legend[["cex"]] = 0.8
......@@ -563,7 +605,7 @@ map_theme_onrn = function(detail, add_legend) {
map_theme_osm = function() {
so_ii_osm = terra::rast(
system.file("extdata", "so_ii_osm.tif", package = "geau", mustWork = TRUE)
system.file("extdata", "so_ii_osm.tif", package = "so.ii", mustWork = TRUE)
)
try(terra::plot(so_ii_osm, add = TRUE), silent = TRUE)
graphics::mtext(
......
# code to prepare `so_ii_catchment` dataset goes here
file_dir = geau::current_version(
file_dir = so.ii::current_version(
"data-common/so-ii/topage",
pattern = "^[0-9-]+$"
)
......@@ -11,6 +11,6 @@ so_ii_catchment[["degre"]] = factor(so_ii_catchment[["degre"]])
# updating datasets
actual = setwd("geau")
actual = setwd("so.ii")
usethis::use_data(so_ii_catchment, internal = FALSE, overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_catnat` dataset goes here
so_ii_catnat = read.csv2(
geau::current_version("data-common/so-ii/gaspar", "catnat-")
so.ii::current_version("data-common/so-ii/gaspar", "catnat-")
)
alea_scope = c("inondation", "nappe", "submersion")
......@@ -24,6 +24,6 @@ so_ii_catnat = estimate_catnat_freq(
# updating datasets
actual = setwd("geau")
actual = setwd("so.ii")
usethis::use_data(so_ii_catnat, internal = FALSE, overwrite = TRUE)
setwd(actual)
\ No newline at end of file
......@@ -3,23 +3,23 @@
## epci
so_ii_epci = read.csv2(
geau::current_version("data-common/so-ii/epci")
so.ii::current_version("data-common/so-ii/epci")
)
rownames(so_ii_epci) = so_ii_epci[["epci"]]
epci = names(so_ii_epci)
## collectivity
admin_express = geau::current_version("data-common/data/IGN/ADMIN-EXPRESS/version")
admin_express = so.ii::current_version("data-common/data/IGN/ADMIN-EXPRESS/version")
so_ii_collectivity = sf::st_read(file.path(admin_express, "COMMUNE.shp"))
so_ii_collectivity = so_ii_collectivity["INSEE_COM"]
names(so_ii_collectivity) = c("commune", "geometry")
rownames(so_ii_collectivity) = so_ii_collectivity[["commune"]]
so_ii_collectivity = so_ii_collectivity[geau::so_ii_scope, ]
so_ii_collectivity = so_ii_collectivity[so.ii::so_ii_scope, ]
so_ii_collectivity = merge(
so_ii_collectivity[geau::so_ii_scope, ],
read.csv2(geau::current_version("data-common/so-ii/commune"))
so_ii_collectivity[so.ii::so_ii_scope, ],
read.csv2(so.ii::current_version("data-common/so-ii/commune"))
)
collectivity = names(so_ii_collectivity)[-length(names(so_ii_collectivity))]
......@@ -27,7 +27,7 @@ so_ii_collectivity = merge(so_ii_collectivity, so_ii_epci)
rownames(so_ii_collectivity) = so_ii_collectivity[["commune"]]
so_ii_collectivity = so_ii_collectivity[
geau::so_ii_scope,
so.ii::so_ii_scope,
union(collectivity, epci)
]
Encoding(so_ii_collectivity[["commune_name"]]) = "UTF-8"
......@@ -38,7 +38,7 @@ so_ii_limit = sf::st_union(so_ii_collectivity)
# updating dataset
actual = setwd("geau")
actual = setwd("so.ii")
usethis::use_data(so_ii_collectivity, internal = FALSE, overwrite = TRUE)
usethis::use_data(so_ii_limit, internal = FALSE, overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_hydro` dataset goes here
selection = c("CdOH", "TopoOH")
file_dir = geau::current_version(
file_dir = so.ii::current_version(
"data-common/so-ii/topage",
pattern = "^[0-9-]+$"
)
river = sf::st_read(file.path(file_dir, "cours_eau.shp"))
river = sf::st_transform(
river[selection],
sf::st_crs(geau::so_ii_limit)
sf::st_crs(so.ii::so_ii_limit)
)
names(river) = c("id", "name", "geometry")
classification = read.csv2(
geau::current_version("data-common/so-ii/topage", pattern = "cours_eau"),
so.ii::current_version("data-common/so-ii/topage", pattern = "cours_eau"),
colClasses = "character",
row.names = 1
)
......@@ -23,7 +23,7 @@ waterbody = sf::st_read(file.path(file_dir, "plan_eau.shp"))
waterbody[["name"]] = gsub("C[?]ur", "Cœur", waterbody[["name"]])
classification = read.csv2(
geau::current_version("data-common/so-ii/topage", pattern = "plan_eau"),
so.ii::current_version("data-common/so-ii/topage", pattern = "plan_eau"),
colClasses = "character"
)
waterbody = merge(waterbody, classification)
......@@ -36,6 +36,6 @@ Encoding(waterbody[["name"]]) = "UTF-8"
# updating datasets
actual = setwd("geau")
actual = setwd("so.ii")
usethis::use_data(so_ii_hydro, internal = FALSE, overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_inset` dataset goes here
file_dir = so.ii::current_version("data-common/data/IGN/ADMIN-EXPRESS/version")
france = sf::st_read(file.path(file_dir, "DEPARTEMENT.shp"))
selection = france[["INSEE_DEP"]] < "96" &
france[["INSEE_DEP"]] != "2A" & france[["INSEE_DEP"]] != "2B"
france = france[selection, ]
france = rmapshaper::ms_simplify(france, keep = 0.01)
departement = sf::st_sf(
"scope" = "Hérault",
geometry = sf::st_geometry(france[france[["INSEE_DEP"]] == "34", ])
)
region = sf::st_sf(
"scope" = "Occitanie",
geometry = sf::st_union(france[france[["INSEE_REG"]] == "76", "geometry"])
)
france = sf::st_sf(
"scope" = "France",
geometry = sf::st_union(france)
)
so.ii = sf::st_sf(
"scope" = "so-ii",
geometry = sf::st_geometry(rmapshaper::ms_simplify(so.ii::so_ii_limit, keep = 0.01))
)
so_ii_inset = rbind(france, region, departement, so.ii)
rownames(so_ii_inset) = c("nation", "region", "department", "so-ii")
so_ii_inset = sf::st_transform(so_ii_inset, crs = sf::st_crs(so.ii::so_ii_limit))
# updating datasets
actual = setwd("so.ii")
usethis::use_data(so_ii_inset, internal = FALSE, overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_onrn` dataset goes here
so_ii_montpellier = sf::st_read(
geau::current_version("data-common/so-ii/montpellier", "shp")
so.ii::current_version("data-common/so-ii/montpellier", "shp")
)
so_ii_montpellier = sf::st_transform(
so_ii_montpellier,
crs = sf::st_crs(geau::so_ii_limit)
crs = sf::st_crs(so.ii::so_ii_limit)
)
so_ii_montpellier = so_ii_montpellier[c("SQUARTIER_", "LIBSQUART", "QUARTIER")]
names(so_ii_montpellier) = c("district", "district_name", "district_group", "geometry")
......@@ -15,7 +15,7 @@ so_ii_montpellier[["district_group"]] = as.character(so_ii_montpellier[["distric
# updating datasets
# actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("geau")
# actual = setwd(file.path(system.file(package = "so.ii"), ".."))
actual = setwd("so.ii")
usethis::use_data(so_ii_montpellier, internal = FALSE, overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_onrn` dataset goes here
so_ii_onrn = read.csv2(
geau::current_version("data-common/so-ii/onrn"),
so.ii::current_version("data-common/so-ii/onrn"),
row.names = 1
)
so_ii_onrn = so_ii_onrn[geau::so_ii_scope, ]
so_ii_onrn = so_ii_onrn[so.ii::so_ii_scope, ]
# updating datasets
# actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("geau")
# actual = setwd(file.path(system.file(package = "so.ii"), ".."))
actual = setwd("so.ii")
usethis::use_data(so_ii_onrn, internal = FALSE, overwrite = TRUE)
setwd(actual)
......@@ -2,10 +2,10 @@
library(sf)
library(maptiles)
so_ii_osm = maptiles::get_tiles(geau::so_ii_limit, zoom = 10, crop = TRUE)
so_ii_osm = maptiles::get_tiles(so.ii::so_ii_limit, zoom = 10, crop = TRUE)
# updating datasets
actual = setwd("geau")
actual = setwd("so.ii")
terra::writeRaster(so_ii_osm, "inst/extdata/so_ii_osm.tif", overwrite = TRUE)
setwd(actual)
# code to prepare `so_ii_population` dataset goes here
so_ii_population = readxl::read_xlsx(
geau::current_version(
so.ii::current_version(
"data-common/data/INSEE/Population/Historique",
"base-pop-historique"
),
......@@ -16,7 +16,7 @@ selection = grep(
value = TRUE
)
so_ii_population = as.matrix(
so_ii_population[geau::so_ii_scope, selection]
so_ii_population[so.ii::so_ii_scope, selection]
)
year = gsub("PMUN", "20", selection)
year = gsub("PSDC", "19", year)
......@@ -27,7 +27,7 @@ dimnames(so_ii_population)[[2]] = year
# updating datasets
# actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("geau")
# actual = setwd(file.path(system.file(package = "so.ii"), ".."))
actual = setwd("so.ii")
usethis::use_data(so_ii_population, internal = FALSE, overwrite = TRUE)
setwd(actual)
......@@ -47,8 +47,8 @@ so_ii_clc[["color"]] = as.character(
# updating datasets
# actual = setwd(file.path(system.file(package = "geau"), ".."))
actual = setwd("geau")
# actual = setwd(file.path(system.file(package = "so.ii"), ".."))
actual = setwd("so.ii")
usethis::use_data(so_ii_scope, internal = FALSE, overwrite = TRUE)
usethis::use_data(so_ii_clc, internal = FALSE, overwrite = TRUE)
usethis::use_data(clc_color, internal = FALSE, overwrite = TRUE)
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/add.inset.R
\encoding{UTF-8}
\name{add.inset}
\alias{add.inset}
\title{Add an inset within a map}
\usage{
add.inset(x, scale = 0.2, loc = "", background = "white", ...)
}
\arguments{
\item{x}{should be something of type polygon readable by terra::vect}
\item{scale}{numeric, how big should be the inset relative to the whole map}
\item{loc}{character, vwhere to put the inset}
\item{background}{character, color to be used for the background}
\item{...}{some parameters that will be used by terra::plot}
}
\value{
polyVect transformed to be placed somewhere in the map
}
\description{
Add an inset within a map
}
\examples{
\dontrun{
# To be added (soon)
}
}
\author{
This is an adaptation of the function inset of the terra package.
}