diff --git a/CHANGELOG.md b/CHANGELOG.md index 06d01367..3121feec 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated `plot_map` to allow use of both `leaflet` and `mapview` packages - [#291](https://github.com/4DModeller/fdmr/pull/291) +### Changed + +- 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 ### Added diff --git a/R/shiny_meshbuilder.R b/R/shiny_meshbuilder.R index d818fa25..8a22be0d 100644 --- a/R/shiny_meshbuilder.R +++ b/R/shiny_meshbuilder.R @@ -1,13 +1,13 @@ #' Mesh building shiny app #' -#' @param spatial_data a data.frame or tibble containing spatial data -#' @param data Observations data, for use with the check_mesh functionality +#' @param spatial_data Spatial data +#' @param obs_data Measurement data #' @param crs CRS as a proj4string #' @param offset Specifies the size of the inner and outer extensions around data locations, passed to fmesher::fm_mesh_2d_inla #' @param max_edge The largest allowed triangle edge length. One or two values, passed to fmesher::fm_mesh_2d_inla #' @param cutoff The minimum allowed distance between points, passed to fmesher::fm_mesh_2d_inla -#' @param latitude_column Name of the latitude column in the spatial data -#' @param longitude_column Name of the longitude column in the spatial data +#' @param y_coord Name of the latitude column in the spatial data +#' @param x_coord Name of the longitude column in the spatial data #' #' @importFrom magrittr %>% #' @@ -17,12 +17,12 @@ meshbuilder_shiny <- function( spatial_data, obs_data = NULL, crs = NULL, - max_edge = NULL, offset = NULL, + max_edge = NULL, cutoff = NULL, plot_poly = FALSE, - latitude_column = "LAT", - longitude_column = "LONG") { + y_coord = "LAT", + x_coord = "LONG") { if (!is.data.frame(spatial_data) && !is(spatial_data, "SpatialPolygonsDataFrame") && !is(spatial_data, "SpatialPointsDataFrame")) { stop("spatial_data must be a data.frame or tibble containing columns with latitude and longitude data.") } @@ -47,81 +47,95 @@ meshbuilder_shiny <- function( ) } - got_lat_long <- all(c(longitude_column, latitude_column) %in% names(spatial_data)) + # If the user passes in any of these then we enable the sliders + enable_inputs <- (!is.null(max_edge) || !is.null(offset) || !is.null(cutoff)) + + got_lat_long <- all(c(x_coord, y_coord) %in% names(spatial_data)) if (!got_lat_long) { stop("Cannot read latitude and longitude data from spatial data. Please ensure given names are correct.") } - # The number of nodes we count as being a big mesh - n_nodes_big_mesh <- 10000 - - default_max_edge <- c(0.1, 0.3) - default_offset <- c(0.2, 0.7) - default_cutoff <- 0.2 + default_max_edge_min <- 0.01 + default_max_edge_max <- 0.3 + default_offset_min <- 0.02 + default_offset_max <- 0.2 + default_cutoff <- 0.02 # TODO - these defaults need changing? - if (is.null(max_edge)) max_edge <- default_max_edge - if (is.null(offset)) offset <- default_offset - if (is.null(cutoff)) cutoff <- default_cutoff + if (!is.null(max_edge)) { + default_max_edge_min <- max_edge[1] + default_max_edge_max <- max_edge[2] + } + + if (!is.null(offset)) { + default_offset_min <- offset[1] + default_offset_max <- offset[2] + } + + if (!is.null(cutoff)) default_cutoff <- cutoff # Make sure we have our own internal correctly formatted version of the data - coords_only <- spatial_data[, c(longitude_column, latitude_column)] + coords_only <- spatial_data[, c(x_coord, y_coord)] names(coords_only) <- c("LONG", "LAT") - plot_polygons <- FALSE - plot_points <- FALSE - # We may not use this - spatial_points <- NULL - # Do some checks to see what kind of data we have - # If we have a SpatialPolygonsDataFrame, we can plot the polygons - # otherwise if we just have SpatialPoints we can plot the points - # otherwise we don't plot anything - if (class(spatial_data) == "SpatialPolygonsDataFrame") { - plot_polygons <- TRUE - } else { - plot_points <- TRUE - - spatial_points <- sp::SpatialPointsDataFrame( - coords = coords_only, - data = spatial_data, - proj4string = sp::CRS(crs) - ) - } busy_spinner <- get_busy_spinner() - ui <- bslib::page_fluid( - theme = bslib::bs_theme(bootswatch = "cosmo"), + ui <- shiny::fluidPage( busy_spinner, - shinybusy::add_loading_state( - "#map", - timeout = 600, - text = "Calculating mesh...", - svgColor = "steelblue" - ), + shinyjs::useShinyjs(), shiny::headerPanel(title = "Creating a mesh"), shiny::sidebarLayout( shiny::sidebarPanel( - shiny::sliderInput( - inputId = "max_edge", - label = "Max edge:", - min = 0.02, value = c(0.1, 0.3), max = 10 + shiny::checkboxInput(inputId = "enable_inputs", label = "Enable customisation", value = enable_inputs), + shiny::h4("Max edge"), + shiny::fluidRow( + shiny::column( + 6, + shiny::numericInput( + inputId = "max_edge_min", + label = "Min:", + value = default_max_edge_min + ) + ), + shiny::column( + 6, + shiny::numericInput( + inputId = "max_edge_max", + label = "Max:", + value = default_max_edge_max + ) + ) ), shiny::p("Max permitted edge length for a triangle"), - shiny::sliderInput( - inputId = "offset", - label = "Offset:", - min = 0.02, value = c(0.2, 0.7), max = 10 + shiny::h4("Offset"), + shiny::fluidRow( + shiny::column( + 6, + shiny::numericInput( + inputId = "offset_min", + label = "Min:", + value = default_offset_min + ), + ), + shiny::column( + 6, + shiny::numericInput( + inputId = "offset_max", + label = "Max:", + value = default_offset_max + ) + ) ), shiny::p("Specifies the size of the inner and outer extensions around data locations."), - shiny::sliderInput( + shiny::h4("Cutoff"), + shiny::numericInput( inputId = "cutoff", - label = "Cutoff:", - min = 0.005, value = 0.2, max = 0.9 + label = NULL, + value = default_cutoff ), shiny::p("Minimum allowed distance between data points."), shiny::actionButton("plot_mesh", label = "Plot mesh"), shiny::actionButton("reset_mesh", label = "Reset"), - # shiny::actionButton("check_button", "Check mesh"), ), shiny::mainPanel( shiny::tabsetPanel( @@ -129,7 +143,9 @@ meshbuilder_shiny <- function( shiny::tabPanel( "Plot", class = "p-3 border", - shiny::div(id = "map_div", leaflet::leafletOutput("map", height = "80vh")) + shiny::div(leaflet::leafletOutput("map", height = "80vh")), + shiny::br(), + shiny::textOutput(outputId = "mesh_crs") ), shiny::tabPanel("Code", class = "p-3 border", shiny::verbatimTextOutput("mesh_code")), shiny::tabPanel( @@ -151,26 +167,54 @@ meshbuilder_shiny <- function( # Define server logic required to draw a histogram server <- function(input, output, session) { + shiny::observeEvent(input$enable_inputs, { + if (input$enable_inputs) { + shinyjs::enable("max_edge_min") + shinyjs::enable("max_edge_max") + shinyjs::enable("offset_min") + shinyjs::enable("offset_max") + shinyjs::enable("cutoff") + } else { + shinyjs::disable("max_edge_min") + shinyjs::disable("max_edge_max") + shinyjs::disable("offset_min") + shinyjs::disable("offset_max") + shinyjs::disable("cutoff") + } + }) + shiny::observeEvent(input$reset_mesh, { - shiny::updateSliderInput(session, inputId = "max_edge", value = default_max_edge) - shiny::updateSliderInput(session, inputId = "offset", value = default_offset) - shiny::updateSliderInput(session, inputId = "cutoff", value = default_cutoff) + shiny::updateNumericInput(session, inputId = "max_edge_min", value = default_max_edge_min) + shiny::updateNumericInput(session, inputId = "max_edge_max", value = default_max_edge_max) + shiny::updateNumericInput(session, inputId = "offset_min", value = default_offset_min) + shiny::updateNumericInput(session, inputId = "offset_max", value = default_offset_max) + shiny::updateNumericInput(session, inputId = "cutoff", value = default_cutoff) + }) + + output$mesh_crs <- shiny::renderText({ + paste("Mesh CRS: ", crs) }) mesh <- shiny::eventReactive(input$plot_mesh, ignoreNULL = FALSE, { + if (input$enable_inputs) { + max_edge <- c(input$max_edge_min, input$max_edge_max) + offset <- c(input$offset_min, input$offset_max) + cutoff <- input$cutoff + } else { + max_edge <- NULL + offset <- NULL + cutoff <- NULL + } + fmesher::fm_mesh_2d_inla( loc = coords_only, - max.edge = input$max_edge, - cutoff = input$cutoff, - offset = input$offset, + max.edge = max_edge, + cutoff = cutoff, + offset = offset, crs = crs, ) }) - # large_mesh <- shiny::reactive({ - # mesh()$n > n_nodes_big_mesh - # }) - mesh_spatial <- shiny::reactive( suppressMessages( suppressWarnings( @@ -179,66 +223,43 @@ meshbuilder_shiny <- function( ) ) - output$map <- leaflet::renderLeaflet({ - m <- leaflet::leaflet() - m <- leaflet::addTiles(m, group = "OSM") - m <- leaflet::addPolygons(m, data = mesh_spatial(), 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") - } else if (plot_points) { - m <- leaflet::addCircles(m, data = spatial_points, group = "Spatial", fillColor = "#b9220b", color = "#b9220b") + spatial <- shiny::reactive({ + if (is.data.frame(spatial_data)) { + sf::st_as_sf( + spatial_data, + coords = c(x_coord, y_coord), + crs = crs + ) + } else { + spatial_data } - - m <- leaflet::addLayersControl(m, - position = "topright", - baseGroups = c("OSM"), - overlayGroups = c("Mesh", "Spatial"), - options = leaflet::layersControlOptions(collapsed = FALSE) - ) }) - output$mesh_code <- shiny::reactive( - paste0( - "location_data <- spatial_data[, c('", longitude_column, "', '", latitude_column, "')]\n\n", - "names(location_data) <- c('LONG', 'LAT')\n\n", - "mesh <- fmesher::fm_mesh_2d_inla(loc = location_data, - max.edge = c(", paste0(input$max_edge, collapse = ", "), "), - cutoff = ", input$cutoff, ", - offset=c(", paste0(input$offset, collapse = ", "), "))\n" - ) - ) - - # shiny::observe({ - # if (large_mesh() && !modal_shown()) { - # shiny::showModal(shiny::modalDialog( - # "Mesh is large, plotting may be slow.", - # title = "Mesh warning", - # easyClose = TRUE, - # footer = NULL - # )) - # } - # modal_shown(TRUE) - # }) - + output$map <- leaflet::renderLeaflet({ + map_tiles <- c("OpenStreetMap", "Esri.WorldImagery", "OpenTopoMap") + m <- mapview::mapview(mesh_spatial(), layer.name = "Mesh", col.regions = "#548C2F", map.types = map_tiles) + mapview::mapview(spatial(), layer.name = "Spatial") + m@map + }) - shiny::observeEvent(input$check_button, { - if (is.null(obs_data) || is.null(mesh())) { - errors <- "No observation data. Cannot check mesh." + output$mesh_code <- shiny::reactive({ + if (input$enable_inputs) { + max_edge_str <- paste0("max.edge = c(", input$max_edge_min, ",", input$max_edge_max, "),") + cutoff_str <- paste0("cutoff = ", input$cutoff, ",") + offset_str <- paste0("offset = c(", input$offset_min, ",", input$max_edge_max, ")") } else { - errors <- fdmr::mesh_checker(mesh = mesh(), observations = obs_data) - if (!length(errors)) { - errors <- "No errors found." - } + max_edge_str <- "max.edge = NULL," + cutoff_str <- "cutoff = NULL," + offset_str <- "offset = NULL" } - shiny::showModal(shiny::modalDialog( - stringr::str_flatten(errors, collapse = "\n"), - title = "Mesh check", - easyClose = TRUE, - footer = NULL - )) + paste0( + "location_data <- spatial_data[, c('", x_coord, "', '", y_coord, "')],\n", + "names(location_data) <- c('LONG', 'LAT')\n", + "mesh <- fmesher::fm_mesh_2d_inla(loc = location_data,\n\t", + max_edge_str, "\n\t", + cutoff_str, "\n\t", + offset_str, ")\n" + ) }) } @@ -255,12 +276,12 @@ meshbuilder_shiny <- function( #' @param offset Specifies the size of the inner and outer extensions around data locations, passed to fmesher::fm_mesh_2d_inla #' @param max_edge The largest allowed triangle edge length. One or two values, passed to fmesher::fm_mesh_2d_inla #' @param cutoff The minimum allowed distance between points, passed to fmesher::fm_mesh_2d_inla -#' @param latitude_column Name of the latitude column in the spatial data -#' @param longitude_column Name of the longitude column in the spatial data +#' @param y_coord Name of the latitude column in the spatial data +#' @param x_coord Name of the longitude column in the spatial data #' #' @return shiny::app #' @export -mesh_builder <- function(spatial_data, obs_data = NULL, crs = NULL, max_edge = NULL, offset = NULL, cutoff = NULL, latitude_column = "LAT", longitude_column = "LONG") { +mesh_builder <- function(spatial_data, obs_data = NULL, crs = NULL, max_edge = NULL, offset = NULL, cutoff = NULL, y_coord = "LAT", x_coord = "LONG") { shiny::runApp(meshbuilder_shiny( spatial_data = spatial_data, obs_data = obs_data, @@ -268,7 +289,7 @@ mesh_builder <- function(spatial_data, obs_data = NULL, crs = NULL, max_edge = N max_edge = max_edge, offset = offset, cutoff = cutoff, - latitude_column = latitude_column, - longitude_column = longitude_column + y_coord = y_coord, + x_coord = x_coord )) } diff --git a/man/mesh_builder.Rd b/man/mesh_builder.Rd index 30ca5dde..b8b00eee 100644 --- a/man/mesh_builder.Rd +++ b/man/mesh_builder.Rd @@ -11,8 +11,8 @@ mesh_builder( max_edge = NULL, offset = NULL, cutoff = NULL, - latitude_column = "LAT", - longitude_column = "LONG" + y_coord = "LAT", + x_coord = "LONG" ) } \arguments{ @@ -28,9 +28,9 @@ mesh_builder( \item{cutoff}{The minimum allowed distance between points, passed to fmesher::fm_mesh_2d_inla} -\item{latitude_column}{Name of the latitude column in the spatial data} +\item{y_coord}{Name of the latitude column in the spatial data} -\item{longitude_column}{Name of the longitude column in the spatial data} +\item{x_coord}{Name of the longitude column in the spatial data} } \value{ shiny::app diff --git a/man/meshbuilder_shiny.Rd b/man/meshbuilder_shiny.Rd index 673598a1..27656e22 100644 --- a/man/meshbuilder_shiny.Rd +++ b/man/meshbuilder_shiny.Rd @@ -8,30 +8,30 @@ meshbuilder_shiny( spatial_data, obs_data = NULL, crs = NULL, - max_edge = NULL, offset = NULL, + max_edge = NULL, cutoff = NULL, plot_poly = FALSE, - latitude_column = "LAT", - longitude_column = "LONG" + y_coord = "LAT", + x_coord = "LONG" ) } \arguments{ -\item{spatial_data}{a data.frame or tibble containing spatial data} +\item{spatial_data}{Spatial data} -\item{crs}{CRS as a proj4string} +\item{obs_data}{Measurement data} -\item{max_edge}{The largest allowed triangle edge length. One or two values, passed to fmesher::fm_mesh_2d_inla} +\item{crs}{CRS as a proj4string} \item{offset}{Specifies the size of the inner and outer extensions around data locations, passed to fmesher::fm_mesh_2d_inla} -\item{cutoff}{The minimum allowed distance between points, passed to fmesher::fm_mesh_2d_inla} +\item{max_edge}{The largest allowed triangle edge length. One or two values, passed to fmesher::fm_mesh_2d_inla} -\item{latitude_column}{Name of the latitude column in the spatial data} +\item{cutoff}{The minimum allowed distance between points, passed to fmesher::fm_mesh_2d_inla} -\item{longitude_column}{Name of the longitude column in the spatial data} +\item{y_coord}{Name of the latitude column in the spatial data} -\item{data}{Observations data, for use with the check_mesh functionality} +\item{x_coord}{Name of the longitude column in the spatial data} } \value{ shiny::app diff --git a/vignettes/meshbuilder.Rmd b/vignettes/meshbuilder.Rmd index 70bf7b92..7a029780 100644 --- a/vignettes/meshbuilder.Rmd +++ b/vignettes/meshbuilder.Rmd @@ -41,7 +41,7 @@ Let's call the `mesh_builder` function and pass in the data and tell it to use ` > **_NOTE:_** The mesh builder may take a short time (~ 20s) to build this mesh due to its size. ```{r eval=FALSE} -fdmr::mesh_builder(spatial_data = lakes_data, longitude_column = "centroid_lon", latitude_column = "centroid_lat") +fdmr::mesh_builder(spatial_data = lakes_data, x_coord = "centroid_lon", y_coord = "centroid_lat") ``` ## Loading data - `rds` file @@ -81,29 +81,14 @@ offset <- c(initial_range / 4, initial_range) cutoff <- max_edge / 7 ``` +> **_NOTE:_** By default we let `fmesher` select the defaults for these values itself. If you encounter long mesh build times try using the `meshbuilder` defaults of NULL values for `max_edge` etc. + Now we're ready to start the app. ```{r eval=FALSE} fdmr::mesh_builder(spatial_data = sp_data, max_edge = max_edge_fin, offset = offset, cutoff = cutoff) ``` -## Run checks on mesh - -We provide a simple function to check meshes created using the mesh builder tool. From with the user interface click "Check mesh" to run a number of tests on the mesh. -Currently these are: - -1. Check that the number of mesh nodes isn't greater than the number of measurments -2. Check that the number of triangles isn't greater than the number of measurements -3. Check that there are no isolated triangles - -To use the mesh checking functionality you must pass your measuremnet data to the `fdmr::mesh_builder` function. Here we use the COVID-19 data. Create a mesh of your design and when you're finished click the "Check mesh" button. This passes the created mesh -to the `fdmr::mesh_checker` function and returns a list containing any errors found with the mesh. - -```{r eval=FALSE} -covid19_data <- fdmr::load_tutorial_data(dataset = "covid", filename = "covid19_data.rds") -fdmr::mesh_builder(spatial_data = sp_data, obs_data = covid19_data) -``` - ## Exporting your mesh To export your mesh click on the Code tab and copy and paste the code used to created the mesh. diff --git a/vignettes/simulation_poisson_data.Rmd b/vignettes/simulation_poisson_data.Rmd index b1656e63..c4f22e6b 100644 --- a/vignettes/simulation_poisson_data.Rmd +++ b/vignettes/simulation_poisson_data.Rmd @@ -227,11 +227,7 @@ fdmr::plot_mesh(mesh = mesh, spatial_data = simdf@coords) ```{r meshbuilder,eval=FALSE} fdmr::mesh_builder(spatial_data = sp_data) ``` -The interactive map allows you to customise the initial parameters such as `max_edge`, `offset` and `cutoff` to change the shape and size of the mesh. We also provide a simple function to check if there are any errors with the meshes created using the mesh builder tool. To use the mesh checking functionality you must pass your measuremnet data to the `fdmr::mesh_builder` function. Specifically, create a mesh of your design using the meshbuilder tool. When you’re finished, click the “Check mesh” button on the user interface. This passes the created mesh to the `fdmr::mesh_checker` function and returns a list containing any errors found with the mesh. - -```{r meshchecking,eval=FALSE} -fdmr::mesh_builder(spatial_data = sp_data, obs_data = simdf) -``` +The interactive map allows you to customise the initial parameters such as `max_edge`, `offset` and `cutoff` to change the shape and size of the mesh. ## Model builder Shiny app `fdmr` provides a Priors Shiny app which allows you to interactively set and see the model fitting results of different priors. You can launch this app by passing the spatial and observation data to the `fdmr::model_builder` function.