Merge pull request #297 from 4DModeller/devel

Release `0.2.0` of fdmr
4DModeller · Dec 19, 2023 · 357b47a · 357b47a
2 parents ad23491 + b79bf89
commit 357b47a
Show file tree

Hide file tree

Showing 37 changed files with 823 additions and 258 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -5,7 +5,25 @@ All notable changes to `fdmr` will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
-## [Unreleased](https://github.com/openghg/openghg/compare/0.1.1...HEAD)
+## [Unreleased](https://github.com/openghg/openghg/compare/0.2.0...HEAD)
+
+## [0.2.0] - 2023-12-19
+
+### Fixed
+
+- Added a function to ensure correct polygon display across the dateline - [PR #285](https://github.com/4DModeller/fdmr/pull/285)
+
+### Added
+
+- Added a new tutorial on loading data from different sources - [PR #266](https://github.com/4DModeller/fdmr/pull/266/)
+- Added new geophysical processes tutorial thanks to Alexander Minakov (4minakov) - [PR #257](https://github.com/4DModeller/fdmr/pull/257)
+- Added mouse pointer coordinates header and standard measurement tool - [PR #260](https://github.com/4DModeller/fdmr/pull/260)
+- Added new help explainer to the `Help` tab of the `model_viewer` Shiny app - [PR #295](https://github.com/4DModeller/fdmr/pull/295)
+
+### Changed
+
+- Updated `plot_map` to allow use of both `leaflet` and `mapview` packages - [#291](https://github.com/4DModeller/fdmr/pull/291)
+- Moved from using `leaflet` to using (`mapview`)[https://r-spatial.github.io/mapview/index.html] for plotting the mesh and spatial data in the `mesh_builder` Shiny app. This enables use of UTM coordinates - [PR #288](https://github.com/4DModeller/fdmr/pull/288)
 
 ## [0.1.1] - 2023-11-01
 
@@ -25,6 +43,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Allowed reversal of colour palette and added raster plot legend in map plotter - [PR #229](https://github.com/4DModeller/fdmr/pull/229)
 - Added markers option to mesh plotter - [PR #230](https://github.com/4DModeller/fdmr/pull/230)
 - Updated the interfaces of the Shiny apps to the use [bslib](https://rstudio.github.io/bslib/index.html) theming - [PR #236](https://github.com/4DModeller/fdmr/pull/236)
+- Code tab added to `fdmr::model_viewer` so the user can easily reproduce plots - [PR #237](https://github.com/4DModeller/fdmr/pull/237)
 
 ## [0.1.0] - 2023-10-17
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: fdmr
 Title: 4D Modeller project
-Version: 0.1.1
+Version: 0.2.0
 Authors@R: 
     c(person("Gareth", "Jones", , "[email protected]", role = c("aut", "cre"),
             comment = ""),
@@ -55,7 +55,12 @@ Imports:
     fmesher,
     purrr,
     shinyjs,
-    bslib
+    bslib,
+    bsicons,
+    future,
+    leafem,
+    sfheaders,
+    mapview
 Suggests: 
     bookdown,
     knitr,

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+export(antimeridian_wrapping)
 export(clear_caches)
+export(convert_from_lon_360)
 export(create_prediction_field)
 export(get_tutorial_datapath)
 export(latlong_to_utm)

diff --git a/R/plot_mapping.R b/R/plot_mapping.R
@@ -1,4 +1,10 @@
-#' Create a simple Leaflet map from data
+#' Create a simple map from data using either the leaflet or mapview packages
+#'
+#' NOTE that the mapview backend is only intended for quick viewing of data,
+#' most of the customisation arguments are not available.
+#'
+#' The leaflet backend will work for most use cases and is recommended.
+#' For plotting of maps with UTM coordinates, the mapview backend is recommended.
 #'
 #' @param polygon_data Polygon data
 #' @param raster_data Raster datas
@@ -12,8 +18,11 @@
 #' @param polygon_line_colour Polygon surrounding line colour
 #' @param polygon_line_weight Polygon surrounding line weight
 #' @param reverse Reverse the colour palette if TRUE
+#' @param wrapping Split polygons along the antimeridian (-180/180 boundary) if TRUE
+#' @param backend Backend package to use for plotting, either "leaflet" or "mapview"
+#'
+#' @return leaflet::leaflet or mapview::mapview
 #'
-#' @return leaflet::leaflet
 #' @export
 plot_map <- function(polygon_data = NULL,
                      raster_data = NULL,
@@ -26,20 +35,84 @@ plot_map <- function(polygon_data = NULL,
                      polygon_line_colour = "grey",
                      polygon_line_weight = 1,
                      polygon_fill_opacity = 0.6,
-                     reverse = FALSE) {
+                     reverse = FALSE,
+                     wrapping = FALSE,
+                     backend = "leaflet") {
   if (is.null(polygon_data) && is.null(raster_data)) {
     stop("Polygon or raster data must be given.")
   }
-  library(leaflet)
+
+  if (backend == "leaflet") {
+    plot_map_leaflet(
+      polygon_data = polygon_data,
+      raster_data = raster_data,
+      domain = domain,
+      markers = markers,
+      palette = palette,
+      legend_title = legend_title,
+      add_scale_bar = add_scale_bar,
+      polygon_fill_colour = polygon_fill_colour,
+      polygon_line_colour = polygon_line_colour,
+      polygon_line_weight = polygon_line_weight,
+      polygon_fill_opacity = polygon_fill_opacity,
+      reverse = reverse,
+      wrapping = wrapping
+    )
+  } else if (backend == "mapview") {
+    plot_map_mapview(
+      polygon_data = polygon_data,
+      raster_data = raster_data
+    )
+  } else {
+    stop("Invalid backend given, must be either 'leaflet' or 'mapview'.")
+  }
+}
+
+
+#' Create a simple Leaflet map from data
+#'
+#' @param polygon_data Polygon data
+#' @param raster_data Raster data
+#' @param domain Domain data to be passed to leaflet::colorNumeric and leaflet::addLegend
+#' @param markers Markers to display on map. A named list with latitude, longitude and label names must be given.
+#' @param palette Palette to be used for colours, defaults to viridis
+#' @param legend_title Title for legend
+#' @param add_scale_bar Add scale bar if TRUE
+#' @param polygon_fill_opacity Leaflet polygon fill opacity, float from 0 to 1.0, passed to fillOpacity of leaflet::addPolygons
+#' @param polygon_fill_colour Polygon fill colour
+#' @param polygon_line_colour Polygon surrounding line colour
+#' @param polygon_line_weight Polygon surrounding line weight
+#' @param reverse Reverse the colour palette if TRUE
+#' @param wrapping Split polygons along the antimeridian (-180/180 boundary) if TRUE
+#'
+#' @return leaflet::leaflet
+#' @keywords internal
+plot_map_leaflet <- function(polygon_data = NULL,
+                             raster_data = NULL,
+                             domain = NULL,
+                             markers = NULL,
+                             palette = "viridis",
+                             legend_title = NULL,
+                             add_scale_bar = FALSE,
+                             polygon_fill_colour = "#E4572E",
+                             polygon_line_colour = "grey",
+                             polygon_line_weight = 1,
+                             polygon_fill_opacity = 0.6,
+                             reverse = FALSE,
+                             wrapping = FALSE) {
   m <- leaflet::leaflet()
   m <- leaflet::addTiles(m)
-  m <- leaflet::addProviderTiles(m, leaflet::providers$Esri.WorldImagery, group = "Satellite")
+  m <- leaflet::addProviderTiles(m, leaflet::providers$Openstreetmap, group = "Satellite")
+  m <- leafem::addMouseCoordinates(m, native.crs = TRUE)
 
   # Store a vector of layers we add to the map,
   # used later to create the layers control object
   layers <- c()
 
   if (!is.null(polygon_data)) {
+    if (isTRUE(wrapping)) {
+      polygon_data <- fdmr::antimeridian_wrapping(polygon_data, crs = "+proj=longlat +datum=WGS84", unique_inst = TRUE, to_sp = FALSE)
+    }
     if (!is.null(domain)) {
       colours <- leaflet::colorNumeric(palette = palette, domain = domain, reverse = reverse)
       polygon_fill_colour <- ~ colours(domain)
@@ -63,7 +136,7 @@ plot_map <- function(polygon_data = NULL,
   }
 
   if (!is.null(raster_data)) {
-    colours <- leaflet::colorNumeric(palette = palette, domain = raster::values(raster_data), na.color=rgb(0,0,0,0), reverse = reverse)
+    colours <- leaflet::colorNumeric(palette = palette, domain = raster::values(raster_data), na.color = rgb(0, 0, 0, 0), reverse = reverse)
     m <- leaflet::addRasterImage(m,
       x = raster_data,
       opacity = 0.75,
@@ -72,11 +145,11 @@ plot_map <- function(polygon_data = NULL,
       colors = colours,
     )
     m <- leaflet::addLegend(m,
-                            pal = colours,
-                            values = raster::values(raster_data),
-                            opacity = 0.75,
-                            title = legend_title,
-                            na.label = ""
+      pal = colours,
+      values = raster::values(raster_data),
+      opacity = 0.75,
+      title = legend_title,
+      na.label = ""
     )
     layers <- append(layers, "Raster")
   }
@@ -97,5 +170,28 @@ plot_map <- function(polygon_data = NULL,
     m <- leaflet::addScaleBar(m, position = "bottomleft")
   }
 
+  m <- leaflet::addMeasure(m, position = "bottomleft", primaryLengthUnit = "kilometers", primaryAreaUnit = "sqmeters")
+
+  return(m)
+}
+
+
+#' A simple map plotter using mapview. This is only intended for very quick viewing of data.
+#'
+#' @param polygon_data Spatial data to plot
+#' @param raster_data Raster data to plot
+#'
+#' @return mapview::mapview
+#' @keywords internal
+plot_map_mapview <- function(polygon_data = NULL, raster_data = NULL) {
+  map_types <- c("OpenStreetMap", "Esri.WorldImagery", "OpenTopoMap")
+
+  m <- mapview::mapview(map.types = map_types)
+  if (!is.null(polygon_data)) {
+    m <- m + mapview::mapview(polygon_data)
+  }
+  if (!is.null(raster_data)) {
+    m <- m + mapview::mapview(raster_data)
+  }
   return(m)
 }
diff --git a/R/plot_mesh.R b/R/plot_mesh.R
@@ -24,7 +24,9 @@ plot_mesh <- function(mesh, spatial_data = NULL, longitude_column = "LONG", lati
     )
   }
 
-  spatial_mesh <- fdmr::mesh_to_spatial(mesh = mesh, crs = expected_crs)
+  spatial_mesh_original <- fdmr::mesh_to_spatial(mesh = mesh, crs = expected_crs)
+
+  spatial_mesh <- fdmr::antimeridian_wrapping(spatial_mesh_original, crs = expected_crs, unique_inst = FALSE, to_sp = FALSE)
 
   plot_polygons <- FALSE
   plot_points <- FALSE
@@ -60,6 +62,8 @@ plot_mesh <- function(mesh, spatial_data = NULL, longitude_column = "LONG", lati
   m <- leaflet::leaflet()
   m <- leaflet::addTiles(m, group = "OSM")
   m <- leaflet::addPolygons(m, data = spatial_mesh, weight = 0.5, fillOpacity = 0.2, fillColor = "#5252ca", group = "Mesh")
+  m <- leaflet::addMeasure(m, position = "bottomleft", primaryLengthUnit = 'kilometers', primaryAreaUnit = 'sqmeters')
+  m <- leafem::addMouseCoordinates(m, native.crs = TRUE)
 
   if (plot_polygons) {
     m <- leaflet::addPolygons(m, data = spatial_data, fillColor = "#d66363", color = "green", weight = 1, group = "Spatial")

diff --git a/R/plot_priors.R b/R/plot_priors.R
@@ -4,10 +4,9 @@
 #' @param to_plot Type of data to plot, "Range for f" etc
 #'
 #' @return ggplot2::ggplot
-#' @keywords internal
 plot_line_comparison <- function(data, to_plot, title) {
-  ar1_data <- purrr::map(data, function(x) as.data.frame(x$pars[[to_plot]]))
-  single_df <- dplyr::bind_rows(ar1_data, .id = "Run")
+  parsed_data <- purrr::map(data, function(x) as.data.frame(x$pars[[to_plot]]))
+  single_df <- dplyr::bind_rows(parsed_data, .id = "Run")
   if (nrow(single_df) == 0) {
     return("No pars data.")
   }
@@ -18,32 +17,11 @@ plot_line_comparison <- function(data, to_plot, title) {
     ggplot2::theme(text = ggplot2::element_text(size = 16))
 }
 
-
-#' Plot AR(1)
-#'
-#' @param data Parsed model output
-#' @param to_plot Type of data to plot, "Range for f" etc
-#'
-#' @return ggplot2::ggplot
-#' @keywords internal
-plot_ar1 <- function(data) {
-  ar1_data <- purrr::map(data, function(x) as.data.frame(x$pars$`GroupRho for f`))
-  single_df <- dplyr::bind_rows(ar1_data, .id = "Run")
-  if (nrow(single_df) == 0) {
-    return("No pars data.")
-  }
-
-  ggplot2::ggplot(single_df, ggplot2::aes(x = x, y = y, color = Run)) +
-    ggplot2::geom_line() +
-    ggplot2::theme(text = ggplot2::element_text(size = 16))
-}
-
 #' Create boxplots from priors run data
 #'
 #' @param data
 #'
 #' @return graphics::boxplot
-#' @keywords internal
 plot_priors_boxplot <- function(data) {
   # TODO - I'm sure this can be done in a nicer functional way
   fitted_mean_post <- purrr::map(data, function(x) x$fitted_mean_post)
@@ -60,7 +38,6 @@ plot_priors_boxplot <- function(data) {
 #' @param measurement_data Measurement data
 #'
 #' @return ggplot2::ggplot
-#' @keywords internal
 plot_priors_density <- function(data, measurement_data) {
   # Can this be done in a cleaner way? Just create a dataframe from the lists?
   fitted_values <- unlist(purrr::map(data, function(x) x$fitted_mean_post))
@@ -82,7 +59,6 @@ plot_priors_density <- function(data, measurement_data) {
 #' @param data
 #'
 #' @return ggplot2::ggplot
-#' @keywords internal
 plot_dic <- function(data) {
   infocri <- base::cbind.data.frame(
     priors = unlist(purrr::map(seq(1, length(data)), function(x) paste("Run", x))),