From 1457c93f81ec2cc174f06503e0d32cb66b1e01df Mon Sep 17 00:00:00 2001 From: Bill DeVoe <39626006+bdevoe@users.noreply.github.com> Date: Thu, 7 Nov 2019 12:52:42 -0500 Subject: [PATCH 1/2] Update doc --- R/findLocations.R | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/R/findLocations.R b/R/findLocations.R index 0b4dcbe..ab69cf6 100644 --- a/R/findLocations.R +++ b/R/findLocations.R @@ -1,19 +1,10 @@ -# You can learn more about package authoring with RStudio at: -# -# http://r-pkgs.had.co.nz/ -# -# Some useful keyboard shortcuts for package authoring: -# -# Build and Reload Package: 'Cmd + Shift + B' -# Check Package: 'Cmd + Shift + E' -# Test Package: 'Cmd + Shift + T' - #' Find locations inside a polygon, square, or circle drawn with leaflet.extras drawing tools on a Shiny Leaflet map. #' #' @param shape Shiny input (input$MAPID_draw_new_feature), representing shape drawn on the map by the user. #' @param location_coordinates A SpatialPointsDataFrame containing coordinates and ids for all map locations. #' @param location_id_colname Column name from location_coordinates containing desired names or ids for set of locations returned. #' @return A vector of location ids. +#' @import sp #' @examples #' mock_input.map_feature <- list(type = "Feature" #' , properties = list(`_leaflet_id`= 13477, feature_type = "rectangle") @@ -28,8 +19,6 @@ #' findLocations(shape = mock_input.map_feature #' , location_coordinates = coords #' , location_id_colname = "locationID") - - findLocations <- function(shape, location_coordinates, location_id_colname) { # derive polygon coordinates and feature_type from shape input From da3550d060921dc4e71114de88596dd2a67391c6 Mon Sep 17 00:00:00 2001 From: DeVoe Date: Mon, 13 Apr 2020 08:48:33 -0400 Subject: [PATCH 2/2] Added support for Simple Features geometries --- DESCRIPTION | 2 +- NAMESPACE | 8 +- R/findLocations.R | 235 +++++++++++++++++++++++++++++++-------- geoshaper.Rproj | 1 + man/findLocations.Rd | 30 ++--- man/findLocations_sf.Rd | 51 +++++++++ man/findLocations_sp.Rd | 51 +++++++++ tests/testthat/test.R | 147 +++++++++++++----------- tests/testthat/test_sf.R | 148 ++++++++++++++++++++++++ 9 files changed, 542 insertions(+), 131 deletions(-) create mode 100644 man/findLocations_sf.Rd create mode 100644 man/findLocations_sp.Rd create mode 100644 tests/testthat/test_sf.R diff --git a/DESCRIPTION b/DESCRIPTION index ea0fec0..1c43677 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,4 +17,4 @@ Imports: leaflet.extras Suggests: testthat, tibble -RoxygenNote: 6.0.1 +RoxygenNote: 6.1.1 diff --git a/NAMESPACE b/NAMESPACE index d75f824..2a4779f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1 +1,7 @@ -exportPattern("^[[:alpha:]]+") +# Generated by roxygen2: do not edit by hand + +export(findLocations) +export(findLocations_sf) +export(findLocations_sp) +import(sf) +import(sp) diff --git a/R/findLocations.R b/R/findLocations.R index ab69cf6..2c93e5e 100644 --- a/R/findLocations.R +++ b/R/findLocations.R @@ -1,60 +1,207 @@ -#' Find locations inside a polygon, square, or circle drawn with leaflet.extras drawing tools on a Shiny Leaflet map. +#' findLocations #' -#' @param shape Shiny input (input$MAPID_draw_new_feature), representing shape drawn on the map by the user. -#' @param location_coordinates A SpatialPointsDataFrame containing coordinates and ids for all map locations. -#' @param location_id_colname Column name from location_coordinates containing desired names or ids for set of locations returned. +#' Find locations inside a polygon, square, or circle drawn with leaflet.extras +#' drawing tools on a Shiny Leaflet map. Works with input locations as a +#' Spatial Points Dataframe or a Simple Features Dataframe +#' +#' @rdname findLocations +#' @param shape Shiny input (input$MAPID_draw_new_feature), representing shape +#' drawn on the map by the user. +#' @param location_coordinates A SF point object or SpatialPointsDataframe +#' containing coordinates and ids for all map locations. +#' @param location_id_colname Column name from location_coordinates containing +#' desired names or ids for set of locations returned. #' @return A vector of location ids. -#' @import sp -#' @examples -#' mock_input.map_feature <- list(type = "Feature" -#' , properties = list(`_leaflet_id`= 13477, feature_type = "rectangle") -#' , geometry = list(type = "Polygon" -#' , coordinates = list(list(list(-76.15723, 39.51252) -#' , list(-76.15723, 40.30467), list(-74.73999, 40.30467) -#' , list(-74.73999, 39.51252), list(-76.15723, 39.51252))))) -#' airports <- data.frame('locationID' = c('PHL', 'DTW') -#' , 'Longitude' = c(-75.2408, -83.3533) -#' , 'Latitude' = c(39.8722, 42.2125)) -#' coords = sp::SpatialPointsDataFrame(airports[,c('Longitude', 'Latitude')], airports) -#' findLocations(shape = mock_input.map_feature -#' , location_coordinates = coords -#' , location_id_colname = "locationID") +#' @export findLocations <- function(shape, location_coordinates, location_id_colname) { + # Check that location_id_colname is present in data + if (!(location_id_colname %in% colnames(location_coordinates))) { + stop(sprintf("Column %s is not present in input data.", location_id_colname)) + } + # Call function based on class of location coordinates + if ("sf" %in% class(location_coordinates)) { + return(findLocations_sf(shape, location_coordinates, location_id_colname)) + } else if ("sp" %in% class(location_coordinates)) { + return(findLocations_sp(shape, location_coordinates, location_id_colname)) + } else { + stop("Input data for argument location_coordinates must be SF or SP object.") + } +} - # derive polygon coordinates and feature_type from shape input - polygon_coordinates <- shape$geometry$coordinates +#' findLocations_sf +#' +#' Find locations inside a polygon, square, or circle drawn with leaflet.extras +#' drawing tools on a Shiny Leaflet map, when locations are a Simple Features +#' Point Dataframe +#' +#' @rdname findLocations_sf +#' @param shape Shiny input (input$MAPID_draw_new_feature), representing shape +#' drawn on the map by the user. +#' @param location_coordinates A SpatialPointsDataFrame containing coordinates +#' and ids for all map locations. +#' @param location_id_colname Column name from location_coordinates containing +#' desired names or ids for set of locations returned. +#' @return A vector of location ids. +#' @export +#' @import sf +#' @examples +#' mock_input.map_feature <- list( +#' type = "Feature", +#' properties = list(`_leaflet_id` = 13477, feature_type = "rectangle"), +#' geometry = list( +#' type = "Polygon", +#' coordinates = list(list( +#' list(-76.15723, 39.51252), +#' list(-76.15723, 40.30467), list(-74.73999, 40.30467), +#' list(-74.73999, 39.51252), list(-76.15723, 39.51252) +#' )) +#' ) +#' ) +#' airports <- data.frame( +#' "locationID" = c("PHL", "DTW"), +#' "Longitude" = c(-75.2408, -83.3533), +#' "Latitude" = c(39.8722, 42.2125) +#' ) +#' coords = sf::st_as_sf(airports, coords = c("Longitude", "Latitude")) +#' findLocations_sf( +#' shape = mock_input.map_feature, +#' location_coordinates = coords, +#' location_id_colname = "locationID" +#' ) +findLocations_sf <- function(shape, location_coordinates, location_id_colname) { + # If the CRS is missing, assume it is lat lon + if (sf::st_crs(location_coordinates) == sf::NA_crs_) { + sf::st_crs(location_coordinates) <- 4326 + } + # Derive polygon coordinates and feature_type from shape input + polygon_coordinates <- matrix(unlist(shape$geometry$coordinates), + ncol = 2, + byrow = T) feature_type <- shape$properties$feature_type + # For rectangles and polygons + if (feature_type %in% c('rectangle', 'polygon')) { + # Transform into a SF polygon + drawn_polygon <- sf::st_polygon(list(polygon_coordinates)) + # Remove CRS from location coordinates + sf::st_crs(location_coordinates) <- NA + # Set relation to geometry to surpress warnings + sf::st_agr(location_coordinates) <- 'constant' + # Identify selected locations + selected_locs <- sf::st_intersection(location_coordinates, drawn_polygon) + # Get location ids + selected_loc_id <- selected_locs[[location_id_colname]] + return(selected_loc_id) + } + if (feature_type == 'circle') { + # Radius in meters + r <- units::set_units(shape$properties$radius, m) + # Center to SF + center <- sf::st_as_sf(as.data.frame(polygon_coordinates), + coords = c(1,2), + crs = 4326) + # Find UTM zone of center point as EPSG code + utm <- (floor((as.data.frame(polygon_coordinates)[1,1] + 180) / 6) %% 60) + 1 + if (as.data.frame(polygon_coordinates)[1,2] > 0) { + utm <- utm + 32600 + } else { + utm <- utm + 32700 + } + # Project to UTM for buffering, using EPSG code of UTM zone + center <- sf::st_transform(center, crs = utm) + drawn_circle <- sf::st_buffer(center, dist = r) + # Project location coordinates to UTM zone + location_coordinates <- sf::st_transform(location_coordinates, crs = utm) + # Set relation to geometry to surpress warnings + sf::st_agr(location_coordinates) <- 'constant' + sf::st_agr(drawn_circle) <- 'constant' + # Identify selected locations + selected_locs <- sf::st_intersection(location_coordinates, drawn_circle) + # Get location ids + selected_loc_id <- selected_locs[[location_id_colname]] + return(selected_loc_id) + } +} - if(feature_type %in% c("rectangle","polygon")) { - - # transform into a spatial polygon - drawn_polygon <- sp::Polygon(do.call(rbind,lapply(polygon_coordinates[[1]],function(x){c(x[[1]][1],x[[2]][1])}))) - - # identify selected locations - selected_locs <- sp::over(location_coordinates, sp::SpatialPolygons(list(sp::Polygons(list(drawn_polygon),"drawn_polygon")))) - - # get location ids - x = (location_coordinates[which(!is.na(selected_locs)), location_id_colname]) +#' findLocations_sp +#' +#' Find locations inside a polygon, square, or circle drawn with leaflet.extras +#' drawing tools on a Shiny Leaflet map, when locations are a Spatial Points +#' Dataframe +#' +#' @rdname findLocations_sp +#' @param shape Shiny input (input$MAPID_draw_new_feature), representing shape +#' drawn on the map by the user. +#' @param location_coordinates A SpatialPointsDataFrame containing coordinates +#' and ids for all map locations. +#' @param location_id_colname Column name from location_coordinates containing +#' desired names or ids for set of locations returned. +#' @return A vector of location ids. +#' @export +#' @import sp +#' @examples +#' mock_input.map_feature <- list( +#' type = "Feature", +#' properties = list(`_leaflet_id` = 13477, feature_type = "rectangle"), +#' geometry = list( +#' type = "Polygon", +#' coordinates = list(list( +#' list(-76.15723, 39.51252), +#' list(-76.15723, 40.30467), list(-74.73999, 40.30467), +#' list(-74.73999, 39.51252), list(-76.15723, 39.51252) +#' )) +#' ) +#' ) +#' airports <- data.frame( +#' "locationID" = c("PHL", "DTW"), +#' "Longitude" = c(-75.2408, -83.3533), +#' "Latitude" = c(39.8722, 42.2125) +#' ) +#' coords <- sp::SpatialPointsDataFrame(airports[, c("Longitude", "Latitude")], airports) +#' findLocations_sp( +#' shape = mock_input.map_feature, +#' location_coordinates = coords, +#' location_id_colname = "locationID" +#' ) +findLocations_sp <- function(shape, location_coordinates, location_id_colname) { + # Derive polygon coordinates and feature_type from shape input + polygon_coordinates <- shape$geometry$coordinates + feature_type <- shape$properties$feature_type + # For rectangles and polygons + if (feature_type %in% c("rectangle", "polygon")) { + # Transform into a spatial polygon + drawn_polygon <- sp::Polygon(do.call(rbind, lapply(polygon_coordinates[[1]], function(x) { + c(x[[1]][1], x[[2]][1]) + }))) + # Identify selected locations + selected_locs <- sp::over(location_coordinates, sp::SpatialPolygons(list(sp::Polygons(list(drawn_polygon), "drawn_polygon")))) + # Get location ids + x <- (location_coordinates[which(!is.na(selected_locs)), location_id_colname]) - selected_loc_id = as.character(x[[location_id_colname]]) + selected_loc_id <- as.character(x[[location_id_colname]]) return(selected_loc_id) - } else if (feature_type == "circle") { + center_coords <- matrix(c( + polygon_coordinates[[1]], + polygon_coordinates[[2]] + ), + ncol = 2 + ) - center_coords <- matrix(c(polygon_coordinates[[1]], polygon_coordinates[[2]]) - , ncol = 2) - - # get distances to center of drawn circle for all locations in location_coordinates - # distance is in kilometers - dist_to_center <- sp::spDistsN1(location_coordinates, center_coords, longlat = TRUE) - - # get location ids - # radius is in meters - x <- location_coordinates[dist_to_center < shape$properties$radius/1000, location_id_colname] + # Get distances to center of drawn circle for all locations in + # location_coordinates distance is in kilometers + dist_to_center <- sp::spDistsN1(location_coordinates, + center_coords, + longlat = T + ) - selected_loc_id = as.character(x[[location_id_colname]]) + # Get location ids - radius is in meters + x <- location_coordinates[ + dist_to_center < shape$properties$radius / 1000, + location_id_colname + ] + selected_loc_id <- as.character(x[[location_id_colname]]) return(selected_loc_id) } } diff --git a/geoshaper.Rproj b/geoshaper.Rproj index 497f8bf..270314b 100644 --- a/geoshaper.Rproj +++ b/geoshaper.Rproj @@ -18,3 +18,4 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source +PackageRoxygenize: rd,collate,namespace diff --git a/man/findLocations.Rd b/man/findLocations.Rd index 9097392..aba5bc4 100644 --- a/man/findLocations.Rd +++ b/man/findLocations.Rd @@ -2,35 +2,25 @@ % Please edit documentation in R/findLocations.R \name{findLocations} \alias{findLocations} -\title{Find locations inside a polygon, square, or circle drawn with leaflet.extras drawing tools on a Shiny Leaflet map.} +\title{findLocations} \usage{ findLocations(shape, location_coordinates, location_id_colname) } \arguments{ -\item{shape}{Shiny input (input$MAPID_draw_new_feature), representing shape drawn on the map by the user.} +\item{shape}{Shiny input (input$MAPID_draw_new_feature), representing shape +drawn on the map by the user.} -\item{location_coordinates}{A SpatialPointsDataFrame containing coordinates and ids for all map locations.} +\item{location_coordinates}{A SF point object or SpatialPointsDataframe +containing coordinates and ids for all map locations.} -\item{location_id_colname}{Column name from location_coordinates containing desired names or ids for set of locations returned.} +\item{location_id_colname}{Column name from location_coordinates containing +desired names or ids for set of locations returned.} } \value{ A vector of location ids. } \description{ -Find locations inside a polygon, square, or circle drawn with leaflet.extras drawing tools on a Shiny Leaflet map. -} -\examples{ -mock_input.map_feature <- list(type = "Feature" - , properties = list(`_leaflet_id`= 13477, feature_type = "rectangle") - , geometry = list(type = "Polygon" - , coordinates = list(list(list(-76.15723, 39.51252) - , list(-76.15723, 40.30467), list(-74.73999, 40.30467) - , list(-74.73999, 39.51252), list(-76.15723, 39.51252))))) -airports <- data.frame('locationID' = c('PHL', 'DTW') - , 'Longitude' = c(-75.2408, -83.3533) - , 'Latitude' = c(39.8722, 42.2125)) -coords = sp::SpatialPointsDataFrame(airports[,c('Longitude', 'Latitude')], airports) -findLocations(shape = mock_input.map_feature - , location_coordinates = coords - , location_id_colname = "locationID") +Find locations inside a polygon, square, or circle drawn with leaflet.extras +drawing tools on a Shiny Leaflet map. Works with input locations as a +Spatial Points Dataframe or a Simple Features Dataframe } diff --git a/man/findLocations_sf.Rd b/man/findLocations_sf.Rd new file mode 100644 index 0000000..148aa93 --- /dev/null +++ b/man/findLocations_sf.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/findLocations.R +\name{findLocations_sf} +\alias{findLocations_sf} +\title{findLocations_sf} +\usage{ +findLocations_sf(shape, location_coordinates, location_id_colname) +} +\arguments{ +\item{shape}{Shiny input (input$MAPID_draw_new_feature), representing shape +drawn on the map by the user.} + +\item{location_coordinates}{A SpatialPointsDataFrame containing coordinates +and ids for all map locations.} + +\item{location_id_colname}{Column name from location_coordinates containing +desired names or ids for set of locations returned.} +} +\value{ +A vector of location ids. +} +\description{ +Find locations inside a polygon, square, or circle drawn with leaflet.extras +drawing tools on a Shiny Leaflet map, when locations are a Simple Features +Point Dataframe +} +\examples{ +mock_input.map_feature <- list( + type = "Feature", + properties = list(`_leaflet_id` = 13477, feature_type = "rectangle"), + geometry = list( + type = "Polygon", + coordinates = list(list( + list(-76.15723, 39.51252), + list(-76.15723, 40.30467), list(-74.73999, 40.30467), + list(-74.73999, 39.51252), list(-76.15723, 39.51252) + )) + ) +) +airports <- data.frame( + "locationID" = c("PHL", "DTW"), + "Longitude" = c(-75.2408, -83.3533), + "Latitude" = c(39.8722, 42.2125) +) +coords = sf::st_as_sf(airports, coords = c("Longitude", "Latitude")) +findLocations_sf( + shape = mock_input.map_feature, + location_coordinates = coords, + location_id_colname = "locationID" +) +} diff --git a/man/findLocations_sp.Rd b/man/findLocations_sp.Rd new file mode 100644 index 0000000..f11823c --- /dev/null +++ b/man/findLocations_sp.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/findLocations.R +\name{findLocations_sp} +\alias{findLocations_sp} +\title{findLocations_sp} +\usage{ +findLocations_sp(shape, location_coordinates, location_id_colname) +} +\arguments{ +\item{shape}{Shiny input (input$MAPID_draw_new_feature), representing shape +drawn on the map by the user.} + +\item{location_coordinates}{A SpatialPointsDataFrame containing coordinates +and ids for all map locations.} + +\item{location_id_colname}{Column name from location_coordinates containing +desired names or ids for set of locations returned.} +} +\value{ +A vector of location ids. +} +\description{ +Find locations inside a polygon, square, or circle drawn with leaflet.extras +drawing tools on a Shiny Leaflet map, when locations are a Spatial Points +Dataframe +} +\examples{ +mock_input.map_feature <- list( + type = "Feature", + properties = list(`_leaflet_id` = 13477, feature_type = "rectangle"), + geometry = list( + type = "Polygon", + coordinates = list(list( + list(-76.15723, 39.51252), + list(-76.15723, 40.30467), list(-74.73999, 40.30467), + list(-74.73999, 39.51252), list(-76.15723, 39.51252) + )) + ) +) +airports <- data.frame( + "locationID" = c("PHL", "DTW"), + "Longitude" = c(-75.2408, -83.3533), + "Latitude" = c(39.8722, 42.2125) +) +coords <- sp::SpatialPointsDataFrame(airports[, c("Longitude", "Latitude")], airports) +findLocations_sp( + shape = mock_input.map_feature, + location_coordinates = coords, + location_id_colname = "locationID" +) +} diff --git a/tests/testthat/test.R b/tests/testthat/test.R index 741599e..51e9904 100644 --- a/tests/testthat/test.R +++ b/tests/testthat/test.R @@ -3,18 +3,17 @@ library(leaflet) library(leaflet.extras) library(sp) -airports <- read.csv('Airport_Codes_mapped_to_Latitude_Longitude_in_the_United_States.csv') +airports <- read.csv("Airport_Codes_mapped_to_Latitude_Longitude_in_the_United_States.csv") # Define UI for application ui <- fluidPage( # Application title - titlePanel("US Airports") - - ,fluidRow(column(8 - ,leafletOutput("mymap") - ) - ) + titlePanel("US Airports"), + fluidRow(column( + 8, + leafletOutput("mymap") + )) ) # Define server logic @@ -25,62 +24,75 @@ server <- function(input, output) { airports$Longitude <- airports$Longitude - 2 * airports$Longitude # generate second set of unique location IDs for second layer of selected locations - airports$secondLocationID <- paste(as.character(airports$locationID), "_selectedLayer", sep="") + airports$secondLocationID <- paste(as.character(airports$locationID), "_selectedLayer", sep = "") # list to store the selections for tracking data_of_click <- reactiveValues(clickedMarker = list()) coordinates <- reactive({ - SpatialPointsDataFrame(airports[,c('Longitude', 'Latitude')] , airports) + SpatialPointsDataFrame(airports[, c("Longitude", "Latitude")], airports) }) # base map output$mymap <- renderLeaflet({ leaflet() %>% addTiles() %>% - addCircles(data = airports, - radius = 1000, - lat = airports$Latitude, - lng = airports$Longitude, - fillColor = "white", - fillOpacity = 1, - color = "hotpink", - weight = 2, - stroke = T, - layerId = as.character(airports$locationID), - highlightOptions = highlightOptions(color = "mediumseagreen", - opacity = 1.0, - weight = 2, - bringToFront = TRUE)) %>% + addCircles( + data = airports, + radius = 1000, + lat = airports$Latitude, + lng = airports$Longitude, + fillColor = "white", + fillOpacity = 1, + color = "hotpink", + weight = 2, + stroke = T, + layerId = as.character(airports$locationID), + highlightOptions = highlightOptions( + color = "mediumseagreen", + opacity = 1.0, + weight = 2, + bringToFront = TRUE + ) + ) %>% addDrawToolbar( - targetGroup='Selected', - polylineOptions=FALSE, + targetGroup = "Selected", + polylineOptions = FALSE, markerOptions = FALSE, - polygonOptions = drawPolygonOptions(shapeOptions=drawShapeOptions(fillOpacity = 0 - ,color = 'white' - ,weight = 3)), - rectangleOptions = drawRectangleOptions(shapeOptions=drawShapeOptions(fillOpacity = 0 - ,color = 'white' - ,weight = 3)), - circleOptions = drawCircleOptions(shapeOptions = drawShapeOptions(fillOpacity = 0 - ,color = 'white' - ,weight = 3)), - editOptions = editToolbarOptions(edit = FALSE, selectedPathOptions = selectedPathOptions())) + polygonOptions = drawPolygonOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + rectangleOptions = drawRectangleOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + circleOptions = drawCircleOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + editOptions = editToolbarOptions(edit = FALSE, selectedPathOptions = selectedPathOptions()) + ) }) - observeEvent(input$mymap_draw_new_feature,{ - #Only add new layers for bounded locations - found_in_bounds <- findLocations(shape = input$mymap_draw_new_feature - , location_coordinates = coordinates() - , location_id_colname = "locationID") + observeEvent(input$mymap_draw_new_feature, { + # Only add new layers for bounded locations + found_in_bounds <- findLocations( + shape = input$mymap_draw_new_feature, + location_coordinates = coordinates(), + location_id_colname = "locationID" + ) # prevent re-adding selected ids from prior interactions - for(id in found_in_bounds){ - if(id %in% data_of_click$clickedMarker){ + for (id in found_in_bounds) { + if (id %in% data_of_click$clickedMarker) { # don't add id - }else{ + } else { # add id - data_of_click$clickedMarker<-append(data_of_click$clickedMarker, id, 0) + data_of_click$clickedMarker <- append(data_of_click$clickedMarker, id, 0) } } @@ -88,31 +100,36 @@ server <- function(input, output) { selected <- subset(airports, locationID %in% data_of_click$clickedMarker) proxy <- leafletProxy("mymap") - proxy %>% addCircles(data = selected, - radius = 1000, - lat = selected$Latitude, - lng = selected$Longitude, - fillColor = "wheat", - fillOpacity = 1, - color = "mediumseagreen", - weight = 3, - stroke = T, - layerId = as.character(selected$secondLocationID), - highlightOptions = highlightOptions(color = "hotpink", - opacity = 1.0, - weight = 2, - bringToFront = TRUE)) - + proxy %>% addCircles( + data = selected, + radius = 1000, + lat = selected$Latitude, + lng = selected$Longitude, + fillColor = "wheat", + fillOpacity = 1, + color = "mediumseagreen", + weight = 3, + stroke = T, + layerId = as.character(selected$secondLocationID), + highlightOptions = highlightOptions( + color = "hotpink", + opacity = 1.0, + weight = 2, + bringToFront = TRUE + ) + ) }) - observeEvent(input$mymap_draw_deleted_features,{ + observeEvent(input$mymap_draw_deleted_features, { # loop through list of one or more deleted features/ polygons - for(feature in input$mymap_draw_deleted_features$features){ + for (feature in input$mymap_draw_deleted_features$features) { # get ids for locations within the bounding shape - bounded_layer_ids <- findLocations(shape = feature - , location_coordinates = coordinates() - , location_id_colname = "secondLocationID") + bounded_layer_ids <- findLocations( + shape = feature, + location_coordinates = coordinates(), + location_id_colname = "secondLocationID" + ) # remove second layer representing selected locations @@ -122,7 +139,7 @@ server <- function(input, output) { first_layer_ids <- subset(airports, secondLocationID %in% bounded_layer_ids)$locationID data_of_click$clickedMarker <- data_of_click$clickedMarker[!data_of_click$clickedMarker - %in% first_layer_ids] + %in% first_layer_ids] } }) } diff --git a/tests/testthat/test_sf.R b/tests/testthat/test_sf.R new file mode 100644 index 0000000..45ccb73 --- /dev/null +++ b/tests/testthat/test_sf.R @@ -0,0 +1,148 @@ +library(shiny) +library(leaflet) +library(leaflet.extras) +library(sp) + +airports <- read.csv("Airport_Codes_mapped_to_Latitude_Longitude_in_the_United_States.csv") + +# Define UI for application +ui <- fluidPage( + + # Application title + titlePanel("US Airports"), + fluidRow(column( + 8, + leafletOutput("mymap") + )) +) + +# Define server logic +server <- function(input, output) { + + # longitudinal coordinates in dataset are off, reverse all to negative values + # to place them in the western hemisphere + airports$Longitude <- airports$Longitude - 2 * airports$Longitude + + # generate second set of unique location IDs for second layer of selected locations + airports$secondLocationID <- paste(as.character(airports$locationID), "_selectedLayer", sep = "") + + # list to store the selections for tracking + data_of_click <- reactiveValues(clickedMarker = list()) + + coordinates <- reactive({ + sf::st_as_sf(airports, coords = c("Longitude", "Latitude")) + }) + + # base map + output$mymap <- renderLeaflet({ + leaflet() %>% + addTiles() %>% + addCircles( + data = airports, + radius = 1000, + lat = airports$Latitude, + lng = airports$Longitude, + fillColor = "white", + fillOpacity = 1, + color = "hotpink", + weight = 2, + stroke = T, + layerId = as.character(airports$locationID), + highlightOptions = highlightOptions( + color = "mediumseagreen", + opacity = 1.0, + weight = 2, + bringToFront = TRUE + ) + ) %>% + addDrawToolbar( + targetGroup = "Selected", + polylineOptions = FALSE, + markerOptions = FALSE, + polygonOptions = drawPolygonOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + rectangleOptions = drawRectangleOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + circleOptions = drawCircleOptions(shapeOptions = drawShapeOptions( + fillOpacity = 0, + color = "white", + weight = 3 + )), + editOptions = editToolbarOptions(edit = FALSE, selectedPathOptions = selectedPathOptions()) + ) + }) + + observeEvent(input$mymap_draw_new_feature, { + # Only add new layers for bounded locations + found_in_bounds <- findLocations( + shape = input$mymap_draw_new_feature, + location_coordinates = coordinates(), + location_id_colname = "locationID" + ) + + # prevent re-adding selected ids from prior interactions + for (id in found_in_bounds) { + if (id %in% data_of_click$clickedMarker) { + # don't add id + } else { + # add id + data_of_click$clickedMarker <- append(data_of_click$clickedMarker, id, 0) + } + } + + # look up airports by ids found + selected <- subset(airports, locationID %in% data_of_click$clickedMarker) + + proxy <- leafletProxy("mymap") + proxy %>% addCircles( + data = selected, + radius = 1000, + lat = selected$Latitude, + lng = selected$Longitude, + fillColor = "wheat", + fillOpacity = 1, + color = "mediumseagreen", + weight = 3, + stroke = T, + layerId = as.character(selected$secondLocationID), + highlightOptions = highlightOptions( + color = "hotpink", + opacity = 1.0, + weight = 2, + bringToFront = TRUE + ) + ) + }) + + observeEvent(input$mymap_draw_deleted_features, { + # loop through list of one or more deleted features/ polygons + for (feature in input$mymap_draw_deleted_features$features) { + + # get ids for locations within the bounding shape + bounded_layer_ids <- findLocations( + shape = feature, + location_coordinates = coordinates(), + location_id_colname = "secondLocationID" + ) + + + # remove second layer representing selected locations + proxy <- leafletProxy("mymap") + proxy %>% removeShape(layerId = as.character(bounded_layer_ids)) + + first_layer_ids <- subset(airports, secondLocationID %in% bounded_layer_ids)$locationID + + data_of_click$clickedMarker <- data_of_click$clickedMarker[!data_of_click$clickedMarker + %in% first_layer_ids] + } + }) +} + +# Run the application +shinyApp(ui = ui, server = server)