Resolve "add_inset"

Closes #10 (closed)

dev/package.development.R

@@ -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

so.ii/R/add.inset.R

-#' @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)
-}

so.ii/R/add_inset.R

+#' @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))
+}
+
+

so.ii/R/data.r

@@ -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.

so.ii/R/map_so_ii.r

@@ -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(