diff --git a/R/basin.R b/R/basin.R index 2b8274d..34d9e8f 100644 --- a/R/basin.R +++ b/R/basin.R @@ -3,6 +3,7 @@ #' @description This function allows the user to delineate watershed basins interactively with a #' shiny app. It uses the {elevatr} package to acquire the Digital Elevation Model (DEM) or user inputted DEM #' and {whitebox} package to delineate the basin (see details). +#' @param map a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided. #' @param ns \code{string} name for the Shiny \code{namespace} to use. The \code{ns} #' is unlikely to require a change. #' @param viewer \code{function} for the viewer. See Shiny \code{\link[shiny]{viewer}}. @@ -45,11 +46,12 @@ #' } #' #' -get_basin_interactively <- function(ns = 'basin-ui', - viewer = shiny::paneViewer(), - title = 'Delineate Basin', - dem = NULL, - ...) { +get_basin_interactively <- function(map = NULL, + ns = 'basin-ui', + viewer = shiny::paneViewer(), + title = 'Delineate Basin', + dem = NULL, + ...) { ## Some code hijacked from mapedit throughout; to get miniUI look, etc @@ -96,6 +98,7 @@ $(document).on('shiny:disconnected', function() { values <- reactiveValues() crud_mod <- reactive(shiny::callModule( + map = map, basinMod, ns, values = values, diff --git a/R/modules.R b/R/modules.R index b2b3d9d..fff665e 100644 --- a/R/modules.R +++ b/R/modules.R @@ -616,10 +616,12 @@ basinModUI <- function(id, ...){ #' @param session Shiny server function session #' @param values A reactive Values list to pass #' @param dem A raster or terra object dem. +#' @param map +#' @param map a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided. #' @return server function for Shiny module #' @importFrom promises finally "%...>%" #' @export -basinMod <- function(input, output, session, values, dem){ +basinMod <- function(input, output, session, values, dem, map){ ns <- session$ns @@ -637,6 +639,38 @@ basinMod <- function(input, output, session, values, dem){ padding: 2.5px;}" leaf_map <- + + if(!is.null(map)){ + + map %>% + leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( + ns('map_res'), 'Select Elevation Zoom',value = 8,min = 1, max = 14, + width = '100%')), + className = "fieldset { border: 0;}") %>% + leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( + ns('threshold'), 'Cell Threshold',value = 1000,min = 1, max = 15000, + width = '100%')), + className = "fieldset { border: 0;}") %>% + leaflet.extras::addDrawToolbar(polylineOptions = F, + circleOptions = F, + circleMarkerOptions = F, + rectangleOptions = T, + markerOptions = T, + polygonOptions = T, + targetGroup = 'draw', + editOptions = leaflet.extras::editToolbarOptions(F, T)) %>% + leaflet::addControl(html = shiny::actionButton(ns("deletebtn"), "remove drawn"), + position = 'bottomright', + className = 'fieldset {border:0;}')%>% + htmlwidgets::onRender(" + function(el, x) { + this.on('baselayerchange', function(e) { + e.layer.bringToBack(); + }) + } + ") + } else { + base_map() %>% leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( ns('map_res'), 'Select Elevation Zoom',value = 8,min = 1, max = 14, @@ -662,7 +696,7 @@ leaf_map <- leaflet::addLayersControl(baseGroups = c("Esri.WorldStreetMap","OpenTopoMap","Esri.WorldImagery", "CartoDB.Positron", "OpenStreetMap", "CartoDB.DarkMatter"), overlayGroups = c("Hydrography")) - +} output$leaf_map <- leaflet::renderLeaflet({ leaf_map }) @@ -921,10 +955,12 @@ streamnetworkModUI <- function(id, ...){ #' @param values A reactive Values list to pass #' @param dem A raster or terra object dem. (optional) #' @param threshold A threshold for stream initiation. 1000 (default). +#' @param map +#' @param map a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided. #' @return server function for Shiny module #' @importFrom promises finally "%...>%" #' @export -streamnetworkMod <- function(input, output, session, values, dem, threshold = 1000){ +streamnetworkMod <- function(input, output, session, values, dem, threshold = 1000, map){ ns <- session$ns @@ -949,7 +985,8 @@ streamnetworkMod <- function(input, output, session, values, dem, threshold = 10 #starting leaflet map output$leaf_map <- leaflet::renderLeaflet({ - base_map() %>% + if(is.null(map)){ + base_map() %>% leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( ns('map_res'), 'Select Elevation Zoom',value = 8,min = 1, max = 14, width = '100%')), @@ -973,6 +1010,36 @@ streamnetworkMod <- function(input, output, session, values, dem, threshold = 10 leaflet::addLayersControl(baseGroups = c("Esri.WorldStreetMap","OpenTopoMap","Esri.WorldImagery", "CartoDB.Positron", "OpenStreetMap", "CartoDB.DarkMatter"), overlayGroups = c("Hydrography")) + } else { + + map %>% + leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( + ns('map_res'), 'Select Elevation Zoom',value = 8,min = 1, max = 14, + width = '100%')), + className = "fieldset { border: 0;}") %>% + leaflet::addControl(html = tags$div(tags$style(css),shiny::numericInput( + ns('threshold'), 'Cell Threshold',value = threshold,min = 1, max = 15000, + width = '100%')), + className = "fieldset { border: 0;}") %>% + leaflet::addControl(html = tags$div(tags$style(css),shiny::actionButton( + ns('submit'), 'Run', + width = '100%'))) %>% + leaflet.extras::addDrawToolbar(polylineOptions = F, circleOptions = F,circleMarkerOptions = F, + rectangleOptions = T, + markerOptions = F, + polygonOptions = T, targetGroup = 'draw') %>% + leaflet::addControl(html = shiny::actionButton(ns("deletebtn"), "remove drawn"), + position = 'bottomright', + className = 'fieldset {border:0;}')%>% + htmlwidgets::onRender(" + function(el, x) { + this.on('baselayerchange', function(e) { + e.layer.bringToBack(); + }) + } + ") + } + }) observe({ @@ -992,10 +1059,15 @@ observe({ values$streams <- .[[5]] values$output_ws <- .[[4]] + values$output_fa <- .[[6]] + values$output_fd <- .[[3]] bb <- sf::st_bbox(dem) - values$out <- list(watersheds = values$output_ws, streams = values$streams) + values$out <- list(watersheds = values$output_ws, + streams = values$streams, + flow_accum = values$output_fa, + flow_dir = values$output_fd) values$basin_data_list <- append(values$basin_data_list, list(values$out)) @@ -1013,9 +1085,8 @@ observe({ "OpenStreetMap", "CartoDB.DarkMatter"), overlayGroups = c("Hydrography", paste0('catchment', vals$count), - paste0('stream', vals$count))) - # %>% - # leaflet::fitBounds(bb[['xmin']], bb[['ymin']], bb[['xmax']], bb[['ymax']]) + paste0('stream', vals$count))) %>% + leaflet::fitBounds(bb[['xmin']], bb[['ymin']], bb[['xmax']], bb[['ymax']]) @@ -1073,8 +1144,13 @@ observe({ values$streams <- .[[5]] values$output_ws <- .[[4]] + values$output_fa <- .[[6]] + values$output_fd <- .[[3]] - values$out <- list(watersheds = values$output_ws, streams = values$streams) + values$out <- list(watersheds = values$output_ws, + streams = values$streams, + flow_accum = values$output_fa, + flow_dir = values$output_fd) values$basin_data_list <- append(values$basin_data_list, list(values$out)) @@ -1104,59 +1180,56 @@ observe({ }) - # # now for the dynamic threshold - # - # observeEvent(input$threshold, ignoreInit = TRUE, { - # - # req(values$output_fa) - # - # promises::future_promise({ - # - # - # - # # extract streams based on threshold - # output_streams <- tempfile(fileext = '.tif') - # - # whitebox::wbt_extract_streams(values$output_fa, - # output_streams, - # threshold = input$threshold) - # - # get_whitebox_streams(values$data_sf, - # input$map_res, - # threshold = input$threshold) - # - # streams_rast <- list(streams = terra::rast(output_streams), - # output_streams = output_streams) - # - # }) %...>% { - # - # values$streams <- .[[5]] - # values$output_ws <- .[[4]] - # - # values$out <- list(watersheds = values$output_ws, streams = values$streams) - # - # values$basin_data_list <- append(values$basin_data_list, list(values$out)) - # - # - # if(vals$count > 0){ - # leaf_prox <- leaflet::leafletProxy('leaf_map', session) %>% - # leaflet::clearGroup(group = c(paste0('raster', vals$count),paste0('poly', vals$count))) - # } else { - # leaf_prox <- leaflet::leafletProxy('leaf_map', session) - # } - # - # vals$count <- sample(1:10000, size = 1) - # - # leaf_prox %>% - # leaflet::addPolygons(data = values$output_ws, fillOpacity = 0, - # color = 'black', weight = 3, group = paste0('poly', vals$count)) %>% - # leaflet::addPolylines(data = values$streams, color = 'blue', group = paste0('raster', vals$count)) - # - # - # - # } - # - # }) + # now for the dynamic threshold +# +# observeEvent(input$threshold, ignoreInit = TRUE, { +# +# req(values$output_fa) +# +# promises::future_promise({ +# +# +# +# # extract streams based on threshold +# output_streams <- tempfile(fileext = '.tif') +# +# whitebox::wbt_extract_streams(values$output_fa, +# output_streams, +# threshold = input$threshold) +# +# ws_poly <- get_whitebox_streams(values$data_sf, +# input$map_res, +# threshold = input$threshold) +# +# }) %...>% { +# +# values$streams <- .[[5]] +# values$output_ws <- .[[4]] +# +# values$out <- list(watersheds = values$output_ws, streams = values$streams) +# +# values$basin_data_list <- append(values$basin_data_list, list(values$out)) +# +# +# if(vals$count > 0){ +# leaf_prox <- leaflet::leafletProxy('leaf_map', session) %>% +# leaflet::clearGroup(group = c(paste0('raster', vals$count),paste0('poly', vals$count))) +# } else { +# leaf_prox <- leaflet::leafletProxy('leaf_map', session) +# } +# +# vals$count <- sample(1:10000, size = 1) +# +# leaf_prox %>% +# leaflet::addPolygons(data = values$output_ws, fillOpacity = 0, +# color = 'black', weight = 3, group = paste0('catchment', vals$count)) %>% +# leaflet::addPolylines(data = values$streams, color = 'blue', group = paste0('stream', vals$count)) +# +# +# +# } +# +# }) # keep track of newly drawn shapes diff --git a/R/streamnetwork.R b/R/streamnetwork.R index fde0993..9f9bdea 100644 --- a/R/streamnetwork.R +++ b/R/streamnetwork.R @@ -3,6 +3,7 @@ #' @description This function allows the user to get stream networks and watersheds interactively with a #' shiny app. It uses the {elevatr} package to acquire the Digital Elevation Model (DEM) or user inputted DEM #' and {whitebox} package to delineate the stream network and watersheds (see details). +#' @param map a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided. #' @param ns \code{string} name for the Shiny \code{namespace} to use. The \code{ns} #' is unlikely to require a change. #' @param viewer \code{function} for the viewer. See Shiny \code{\link[shiny]{viewer}}. @@ -45,7 +46,9 @@ #' #' #' -get_stream_network_interactively <- function(ns = 'streamnetwork-ui', +get_stream_network_interactively <- function( + map = NULL, + ns = 'streamnetwork-ui', viewer = shiny::paneViewer(), title = 'Streamnetwork', dem = NULL, @@ -100,6 +103,7 @@ $(document).on('shiny:disconnected', function() { values <- reactiveValues() crud_mod <- reactive(shiny::callModule( + map = map, streamnetworkMod, ns, values = values, diff --git a/R/utils.R b/R/utils.R index bc2ce7c..6d4b311 100644 --- a/R/utils.R +++ b/R/utils.R @@ -155,7 +155,14 @@ base_map <- function () { group = grp[7], options = opt, layers = "0", attribution = att) opt <- leaflet::layersControlOptions(collapsed = TRUE) map <- leaflet::addLayersControl(map, baseGroups = grp[1:6], - overlayGroups = grp[7], options = opt) + overlayGroups = grp[7], options = opt) %>% + htmlwidgets::onRender(" + function(el, x) { + this.on('baselayerchange', function(e) { + e.layer.bringToBack(); + }) + } + ") } @@ -249,7 +256,9 @@ get_whitebox_streams <- function(aoi, ele <- elevatr::get_elev_raster(aoi, z = z, prj = prj, - clip = 'locations')} + clip = 'locations') + + } # write to temp file output <- tempfile(fileext = '.tif') diff --git a/man/basinMod.Rd b/man/basinMod.Rd index 4f5a944..d5b3b52 100644 --- a/man/basinMod.Rd +++ b/man/basinMod.Rd @@ -4,7 +4,7 @@ \alias{basinMod} \title{Shiny Module Server for basin generation} \usage{ -basinMod(input, output, session, values, dem) +basinMod(input, output, session, values, dem, map) } \arguments{ \item{input}{Shiny server function input} @@ -16,6 +16,8 @@ basinMod(input, output, session, values, dem) \item{values}{A reactive Values list to pass} \item{dem}{A raster or terra object dem.} + +\item{map}{a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided.} } \value{ server function for Shiny module diff --git a/man/get_basin_interactively.Rd b/man/get_basin_interactively.Rd index 141ef7e..d34f055 100644 --- a/man/get_basin_interactively.Rd +++ b/man/get_basin_interactively.Rd @@ -5,6 +5,7 @@ \title{Get Watershed Basin Interactively} \usage{ get_basin_interactively( + map = NULL, ns = "basin-ui", viewer = shiny::paneViewer(), title = "Delineate Basin", @@ -13,6 +14,8 @@ get_basin_interactively( ) } \arguments{ +\item{map}{a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided.} + \item{ns}{\code{string} name for the Shiny \code{namespace} to use. The \code{ns} is unlikely to require a change.} diff --git a/man/get_stream_network_interactively.Rd b/man/get_stream_network_interactively.Rd index 2399d84..f1771be 100644 --- a/man/get_stream_network_interactively.Rd +++ b/man/get_stream_network_interactively.Rd @@ -5,6 +5,7 @@ \title{Get Stream Network Interactively} \usage{ get_stream_network_interactively( + map = NULL, ns = "streamnetwork-ui", viewer = shiny::paneViewer(), title = "Streamnetwork", @@ -14,6 +15,8 @@ get_stream_network_interactively( ) } \arguments{ +\item{map}{a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided.} + \item{ns}{\code{string} name for the Shiny \code{namespace} to use. The \code{ns} is unlikely to require a change.} diff --git a/man/streamnetworkMod.Rd b/man/streamnetworkMod.Rd index d415420..60afe3e 100644 --- a/man/streamnetworkMod.Rd +++ b/man/streamnetworkMod.Rd @@ -4,7 +4,7 @@ \alias{streamnetworkMod} \title{Shiny Module Server for stream networks} \usage{ -streamnetworkMod(input, output, session, values, dem, threshold = 1000) +streamnetworkMod(input, output, session, values, dem, threshold = 1000, map) } \arguments{ \item{input}{Shiny server function input} @@ -18,6 +18,8 @@ streamnetworkMod(input, output, session, values, dem, threshold = 1000) \item{dem}{A raster or terra object dem. (optional)} \item{threshold}{A threshold for stream initiation. 1000 (default).} + +\item{map}{a background leaflet or mapview map to be used for editing. If NULL a blank mapview canvas will be provided.} } \value{ server function for Shiny module