I am creating a Shiny dashboard with a dataframe of start longitude/latitude and end longitude/latitude cooridnated that I have plotted in R using the leaflet package:
`m=leaflet()%>%
addTiles() %>%
addMarkers(lng=(data$Start_long[i:j]), lat=(data$Start_lat[i:j]),popup="Start") %>%
addCircleMarkers(lng=(data$End_long[i:j]), lat=(data$End_lat[i:j]),popup="End",clusterOptions=markerClusterOptions())`
I was wondering if there was a way to join the start and end coordinated by public transport routes (maybe through google maps API or in-library functions or failing that, join the coordinates by a straight line?
You can use my googleway package to both get the directions/routes, and plot it on a Google map
To use Google's API you need a valid key for each API you want to use. In this case you'll want a directions key, and for plotting the map you'll want a maps javascript key
(You can generate one key and enable it for both APIs if you wish)
To call the Directions API and plot it in R, you can do
library(googleway)
api_key <- "your_directions_api_key"
map_key <- "your_maps_api_key"
## set up a data.frame of locations
## can also use 'lat/lon' coordinates as the origin/destination
df_locations <- data.frame(
origin = c("Melbourne, Australia", "Sydney, Australia")
, destination = c("Sydney, Australia", "Brisbane, Australia")
, stringsAsFactors = F
)
## loop over each pair of locations, and extract the polyline from the result
lst_directions <- apply(df_locations, 1, function(x){
res <- google_directions(
key = api_key
, origin = x[['origin']]
, destination = x[['destination']]
)
df_result <- data.frame(
origin = x[['origin']]
, destination = x[['destination']]
, route = res$routes$overview_polyline$points
)
return(df_result)
})
## convert the results to a data.frame
df_directions <- do.call(rbind, lst_directions)
## plot the map
google_map(key = map_key ) %>%
add_polylines(data = df_directions, polyline = "route")
And similarly in a Shiny app
library(shiny)
library(shinydashboard)
library(googleway)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
textInput(inputId = "origin", label = "Origin"),
textInput(inputId = "destination", label = "Destination"),
actionButton(inputId = "getRoute", label = "Get Rotue"),
google_mapOutput("myMap")
)
)
server <- function(input, output){
api_key <- "your_directions_api_key"
map_key <- "your_maps_api_key"
df_route <- eventReactive(input$getRoute,{
print("getting route")
o <- input$origin
d <- input$destination
return(data.frame(origin = o, destination = d, stringsAsFactors = F))
})
output$myMap <- renderGoogle_map({
df <- df_route()
print(df)
if(df$origin == "" | df$destination == "")
return()
res <- google_directions(
key = api_key
, origin = df$origin
, destination = df$destination
)
df_route <- data.frame(route = res$routes$overview_polyline$points)
google_map(key = map_key ) %>%
add_polylines(data = df_route, polyline = "route")
})
}
shinyApp(ui, server)
You can addPolylines() to the map.
It takes two vectors as arguments, one for the lat and one for the lng, where each row is a 'waypoint'.
It's difficult to help you without knowing the structure of your data.
MRE:
library(leaflet)
cities <- read.csv(textConnection("
City,Lat,Long,Pop
Boston,42.3601,-71.0589,645966
Hartford,41.7627,-72.6743,125017
New York City,40.7127,-74.0059,8406000
Philadelphia,39.9500,-75.1667,1553000
Pittsburgh,40.4397,-79.9764,305841
Providence,41.8236,-71.4222,177994
"))
leaflet() %>%
addTiles() %>%
addPolylines(lat = cities$Lat, lng = cities$Long)
I use "for loop" to solve such problem,just draw polylines one by one.
(sorry for my Chinese expression ^_^)
for examply :
for(i in 1:nrow(sz)){
if(i<=nrow(sz) ){
a <- as.numeric(c(sz[i,c(8,10)]));
b <- as.numeric(c(sz[i,c(9,11)]));
A <- A %>% addPolylines(a,b,group=NULL,weight = 1,color = "brown",
stroke = TRUE,fill = NULL,opacity = 0.8)}
or like a more complex one
for(j in 0:23){if(j<=23)
#j--切每小时数据
j1 <- as.character(paste(j,"点",sep=''))
sz <- sz121[sz121$h==j,]
sz_4 <- sz121[sz121$bi_state==4 &sz121$h==j ,]
sz_8 <- sz121[sz121$bi_state==8&sz121$h==j,]
#还原A
A <- leaflet(sz121) %>% amap() %>% addLabelOnlyMarkers(~s_lon,~s_lat) %>%
addLegend(title=j1,colors=NULL,labels =NULL,position="topleft")
A <- A %>%addCircleMarkers(data=sz_8,~s_lon,~s_lat,color="orange",fill=TRUE,fillColor = "red", opacity = 1,fillOpacity=0.8,
weight =1,radius = 10) %>%addCircleMarkers(data=sz_4,~s_lon,~s_lat,color="black",fill=TRUE,fillColor = "red",
opacity = 1,fillOpacity=0.8,weight =5,radius = 10 ) %>%
addCircleMarkers(data=sz_8,~e_lon,~e_lat,color="orange",fill=TRUE,fillColor = "blue", opacity = 1,fillOpacity=0.8,weight=1,radius = 10) %>%
addCircleMarkers(data=sz_4,~e_lon,~e_lat,color="black",fill=TRUE,fillColor = "blue", opacity = 1,fillOpacity=0.8,weight =5,radius = 10 )
for(i in 1:nrow(sz)){
#i--画路径
if(i<=nrow(sz) ){
a <- as.numeric(c(sz[i,c(8,10)]));
b <- as.numeric(c(sz[i,c(9,11)]));
A <- A %>% addPolylines(a,b,group=NULL,weight = 1,color = "brown",stroke = TRUE,fill = NULL,opacity = 0.8)
}
if(i==nrow(sz)){print(A)}
}
Sys.sleep(3)
}
Related
I have the shiny app below in which I create a process map. What I want to do is subset this process map based on the transitions selectInput(). What I acually need is to hide/display the edges between the nodes if deselect/select one transition pair
All the transitions can be seen from the obect edges which I extract from the process_map() object at the beginning.
library(shiny)
library(bupaR)
library(svgPanZoom)
library(DiagrammeRsvg)
library(processmapR)
library(DiagrammeR)
f <- \(data, nofrom, noto) {
u <- attr(data, 'edges')
`attr<-`(data, 'edges', u[u$from != nofrom & u$to != noto,,drop=FALSE])
}
edges<-patients %>%
process_map(performance(mean, "days"))
edges <- attr(edges, "edges")
colnames(edges)[1]<-"predecessor"
colnames(edges)[2]<-"successor"
ui <-shinyUI(fluidPage(
selectInput("tran","transitions",choices = paste(edges$predecessor,"-",edges$successor),
selected = paste(edges$predecessor,"-",edges$successor),multiple = T),
svgPanZoomOutput("pmap",height = 500,width = 1600)
))
server <- function(input, output) {
output$pmap <- renderSvgPanZoom({
req(input$tran)
pre <- strsplit(input$tran, " - ")[[1]][[1]]
suc <- strsplit(input$tran, " - ")[[1]][[2]]
p<-process_map(patients, type_nodes = frequency("absolute",color_scale = "Greys")
,type_edges = frequency("absolute",color_edges = "Greys"),
rankdir = "LR", render = FALSE)
p1<-f(data=p, nofrom=pre, noto=suc)
p1%>% generate_dot() %>%
grViz(width = 1000, height = 2000) %>% export_svg %>%
svgPanZoom(height=800, controlIconsEnabled = TRUE)
})
}
shinyApp(ui=ui,server=server)
I am developing a shiny app which steps through time by each hour and shows the precipitation on a mapdeck map. I read in the weather data for the entire day and using reactivity filtering the data for the hour and plotting them as scatterplot using mapdeck_update to update the data. The color scale changes whenever the map updates based on the range of data in that hour. What I want is a static color scale based on the data range for the day. Is it possible?
I have tried using manual colors but for some reason they are not working
library(mapdeck)
ui <- fluidPage(
fluidRow(sliderInput(inputId = "hr",label = "Hour",min = 1,max = 3,value = 1)),
fluidRow(mapdeckOutput(outputId = "wx"))
)
sr <- function(input, output, session) {
mydata <- read.table(header=TRUE, sep=",",text="
ROW,COL,Center Latitude,Center Longitude,vil_int_36,hr
28,439,23.669885449218786,-97.2498101160108,20,1
41,433,24.37845221074034,-97.59803936272704,21,1
59,441,25.35333762373948,-97.11966878019186,22,1
61,441,25.461905262766468,-97.11878391116397,23,1
62,443,25.515163854569053,-96.99946877404128,24,1
29,439,23.724265738052193,-97.24945283742396,25,2
43,433,24.48713046908765,-97.59764743717052,26,2
59,442,25.35284441116698,-97.06032252207848,27,2
61,442,25.46141127997772,-97.05937801465758,28,2
62,444,25.514605007836384,-96.94003374232112,29,2
29,440,23.723846594719276,-97.19096992696834,30,3
43,434,24.486897474919978,-97.53876699838483,31,3
60,443,25.406603480942334,-97.00047511628769,32,3
62,441,25.516184831702166,-97.11834002241596,33,3
62,449,25.511327212479294,-96.64286546489153,34,3
")
wx_map <- mapdeck(data=NULL,token = Sys.getenv("MAPBOX_API_TOKEN"),style = 'mapbox://styles/mapbox/dark-v9',zoom = 6, location = c(-97,24.5))
observe({
wx_dt <- mydata %>% dplyr::filter(hr == input$hr)
mapdeck_update(map_id = "wx") %>%
add_scatterplot(data=wx_dt,lon = "Center.Longitude",lat = "Center.Latitude",radius = 15000,fill_colour = "vil_int_36",legend = TRUE,layer_id = "wxlyr",update_view = FALSE,focus_layer=FALSE)
})
output$wx <- renderMapdeck(wx_map)
}
shinyApp(ui, sr)
Notice how the range of color scale in the legend changes but the color of the dots stay almost the same. I want the color to represent the min-max of the entire data set (not just the hour) so that I can see change in intensity while stepping through each hour. Thank you.
Good question; you're right you need to create a manual legend so it remains static, otherwise it will update each time the values in the plot update.
The manual legend needs to use the same colours as the map. The map gets coloured by library(colourvalues). So you can use this to make the colours outside of the map, then use the results as the manual legend
l <- colourvalues::colour_values(
x = mydata$vil_int_36
, n_summaries = 5
)
legend <- mapdeck::legend_element(
variables = l$summary_values
, colours = l$summary_colours
, colour_type = "fill"
, variable_type = "category"
)
js_legend <- mapdeck::mapdeck_legend(legend)
Now this js_legend object is in the correct JSON format for the map to render it as a legend
js_legend
# {"fill_colour":{"colour":["#440154FF","#3B528BFF","#21908CFF","#5DC963FF","#FDE725FF"],"variable":["20.00","23.50","27.00","30.50","34.00"],"colourType":["fill_colour"],"type":["category"],"title":[""],"css":[""]}}
Here it is in your shiny
library(mapdeck)
library(shiny)
ui <- fluidPage(
fluidRow(sliderInput(inputId = "hr",label = "Hour",min = 1,max = 3,value = 1)),
fluidRow(mapdeckOutput(outputId = "wx"))
)
sr <- function(input, output, session) {
mydata <- read.table(header=TRUE, sep=",",text="
ROW,COL,Center Latitude,Center Longitude,vil_int_36,hr
28,439,23.669885449218786,-97.2498101160108,20,1
41,433,24.37845221074034,-97.59803936272704,21,1
59,441,25.35333762373948,-97.11966878019186,22,1
61,441,25.461905262766468,-97.11878391116397,23,1
62,443,25.515163854569053,-96.99946877404128,24,1
29,439,23.724265738052193,-97.24945283742396,25,2
43,433,24.48713046908765,-97.59764743717052,26,2
59,442,25.35284441116698,-97.06032252207848,27,2
61,442,25.46141127997772,-97.05937801465758,28,2
62,444,25.514605007836384,-96.94003374232112,29,2
29,440,23.723846594719276,-97.19096992696834,30,3
43,434,24.486897474919978,-97.53876699838483,31,3
60,443,25.406603480942334,-97.00047511628769,32,3
62,441,25.516184831702166,-97.11834002241596,33,3
62,449,25.511327212479294,-96.64286546489153,34,3
")
## create a manual legend
l <- colourvalues::colour_values(
x = mydata$vil_int_36
, n_summaries = 5
)
legend <- mapdeck::legend_element(
variables = l$summary_values
, colours = l$summary_colours
, colour_type = "fill"
, variable_type = "category"
)
js_legend <- mapdeck::mapdeck_legend(legend)
### --------------------------------
wx_map <- mapdeck(
style = 'mapbox://styles/mapbox/dark-v9'
, zoom = 6
, location = c(-97,24.5)
)
observe({
wx_dt <- mydata %>% dplyr::filter(hr == input$hr)
mapdeck_update(map_id = "wx") %>%
add_scatterplot(
data = wx_dt
, lon = "Center.Longitude"
, lat = "Center.Latitude"
, radius = 15000
, fill_colour = "vil_int_36"
, legend = js_legend
, layer_id = "wxlyr"
, update_view = FALSE
, focus_layer = FALSE
)
})
output$wx <- renderMapdeck(wx_map)
}
shinyApp(ui, sr)
I wanna build quadrants on my leaflet as part of my quadrat analysis. currently I have my tessalation object and im trying to draw the tiles on my leaflet. My code is below
library(spatstat)
library(leaflet)
firms_ppp <- ppp(x=cbd_points#coords[,1],y=cbd_points#coords[,2], window =
window)
qc <- quadratcount(firms_ppp)
qc.nu <- as.numeric(qc)
qc.tess <- as.tess(qc)
colorpal4 <- colorNumeric("red",c(min(qc.nu, na.rm = TRUE),max(qc.nu, na.rm = TRUE)))
for (j in 1:length(qc.tess$window$yrange)) {
for (i in 1:length(qc.tess$window$xrange[i])) {
leaflet() %>%
addRectangles(lng1 = qc.tess$window$xrange[i], lng2 = qc.tess$window$xrange[i+1],
lat1 = rev(qc.tess$window$yrange)[j], lat2 = rev(qc.tess$window$yrange)[j+1],
color = colorpal4(qc.nu[j+(i-1)*(length(qc.tess$window$yrange)-1)]),
popup = paste("<h3>",qc.nu[j+(i-1)*(length(qc.tess$window$yrange)-1)],"</h3>")
)
}
}
Any idea how I can build the quadrants? I tried with tiles as well but I cant seem to get it to work too! Pls Help!!
With 2 helping functions found here, which convert a Tesselation object into SpatialPolygons, you can achieve something like this:
library(spatstat)
library(leaflet)
library(sp)
## FUNCTIONS #####################
owin2Polygons <- function(x, id="1") {
stopifnot(is.owin(x))
x <- as.polygonal(x)
closering <- function(df) { df[c(seq(nrow(df)), 1), ] }
pieces <- lapply(x$bdry,
function(p) {
Polygon(coords=closering(cbind(p$x,p$y)),
hole=spatstat.utils::is.hole.xypolygon(p)) })
z <- Polygons(pieces, id)
return(z)
}
tess2SP <- function(x) {
stopifnot(is.tess(x))
y <- tiles(x)
nom <- names(y)
z <- list()
for(i in seq(y))
z[[i]] <- owin2Polygons(y[[i]], nom[i])
return(SpatialPolygons(z))
}
## DATA #####################
cbd_points <- data.frame(
long = runif(100,15,19),
lat = runif(100,40,50)
)
window <- owin(c(0,20), c(30,50))
firms_ppp <- ppp(x=cbd_points$long, y=cbd_points$lat, window = window)
qc <- quadratcount(firms_ppp)
qc.nu <- as.numeric(qc)
qc.tess <- as.tess(qc)
colorpal4 <- colorNumeric("red",c(min(qc.nu, na.rm = TRUE),max(qc.nu, na.rm = TRUE)))
PolyGrid <- tess2SP(qc.tess)
PolyGridDF <- SpatialPolygonsDataFrame(PolyGrid, data = data.frame(ID = 1:length(PolyGrid)), match.ID = F)
## SHINY ########################
library(shiny)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
pal = colorFactor("viridis", as.character(PolyGridDF$ID))
leaflet() %>%
addTiles() %>%
addPolygons(data=PolyGridDF,
label = as.character(PolyGridDF$ID),
color = ~pal(as.character(PolyGridDF$ID)))
})
}
shinyApp(ui, server)
This question already has answers here:
Plotting routes that cross the international dateline using leaflet library in R
(3 answers)
Closed 4 years ago.
I'm creating a map of Australian airports and their international destinations using R-Leaflet.
Here is my sample data:
df<-data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
)
I thought it would be cool to use curved flight paths using gcIntermediate, so I created a SpatialLines object:
library(rgeos)
library(geosphere)
p1<-as.matrix(df[,c(3,4)])
p2<-as.matrix(df[,c(5,6)])
df2 <-gcIntermediate(p1, p2, breakAtDateLine=F,
n=100,
addStartEnd=TRUE,
sp=T)
And then I plotted it using leaflet and Shiny:
server <-function(input, output) {
airportmap<- leaflet() %>% addTiles() %>%
addCircleMarkers(df, lng = df$Australian_lon, lat = df$Australian_lat,
radius = 2, label = paste(df$Australian_Airport, "Airport"))%>%
addPolylines(data = df2, weight = 1)
output$mymap <- renderLeaflet({airportmap}) # render the base map
}
ui<- navbarPage("International flight path statistics - top routes",
tabPanel("Interactive map",
leafletOutput('mymap', width="100%", height=900)
)
)
# Run the application
shinyApp(ui = ui, server = server)
It looks like this:
So the paths are incorrect if they cross the date line. Changing breakAtDateLine to FALSE doesn't fix it (the line disappears but the path is still broken). At this stage, I suspect I may need to use a different mapping system or something but I'd be very grateful if anyone has some advice.
Thanks in advance.
Overview
I set the max bounds and minimum zoom level to only display the world map once. It looks okay in the RStudio viewer but fails when I display it in browser. I'm hoping this helps spark other answers.
Code
# load necessary packages
library( leaflet )
library( geosphere )
# create data
df <-
data.frame("Australian_Airport" = "Brisbane",
"International" = c("Auckland", "Bandar Seri Begawan","Bangkok","Christchurch","Denpasar","Dunedin","Hamilton","Hong Kong","Honiara","Kuala Lumpur"),
"Australian_lon" = c(153.117, 153.117,153.117,153.117,153.117,153.117, 153.117, 153.117, 153.117, 153.117),
"Australian_lat" = c(-27.3842,-27.3842,-27.3842,-27.3842,-27.3842,-27.3842, -27.3842, -27.3842, -27.3842, -27.3842),
"International_lon" = c(174.7633, 114.9398, 100.5018, 172.6362, 115.2126,-82.77177, -84.56134, 114.10950, 159.97290, 101.68685),
"International_lat" = c(-36.848460, 4.903052, 13.756331, -43.532054,-8.670458,28.019740, 39.399501, 22.396428, -9.445638, 3.139003)
, stringsAsFactors = FALSE
)
# create curved lines
curved.lines <-
gcIntermediate(
p1 = as.matrix( x = df[ , 3:4 ] )
, p2 = as.matrix( x = df[ , 5:6 ] )
, breakAtDateLine = TRUE
, n = 1000
, addStartEnd = TRUE
, sp = TRUE
)
# create leaflet
airport <-
leaflet( options = leafletOptions( minZoom = 1) ) %>%
setMaxBounds( lng1 = -180
, lat1 = -89.98155760646617
, lng2 = 180
, lat2 = 89.99346179538875 ) %>%
addTiles() %>%
addCircleMarkers( data = df
, lng = ~Australian_lon
, lat = ~Australian_lat
, radius = 2
, color = "red"
, label = paste( ~Australian_Airport
, "Airport" )
) %>%
addCircleMarkers( data = df
, lng = ~International_lon
, lat = ~International_lat
, radius = 2
, color = "blue"
, label = paste( ~International
, "Airport" )
) %>%
addPolylines( data = curved.lines
, weight = 1
)
# display map
airport
# end of script #
If you are interested in another mapping library, then googleway uses Google Maps, which in my experience is better at handling lines that cross the date line.
Notes
To use Google Maps you need an API key
Currently only sf objects are supported, not sp
This will also work in shiny; I'm just showing you the basic map here
I authored googleway
library(sf)
library(googleway)
## convert the sp object to sf
sf <- sf::st_as_sf(df2)
set_key("your_api_key")
google_map() %>%
add_polylines(data = sf)
I created an application in R-shiny, using the leaflet.extra package, I put a map in which my users can draw polygons, my goal is to be able to download the polygons that my users drew as a GeoJson or Shapefil (.shp) .
My application looks like this:
ui <- fluidPage(
textOutput("text"),leafletOutput("mymap") )
and server:
poly<-reactiveValues(poligonos=list()) #save reactiveValues
output$mymap <- renderLeaflet({
leaflet("mymap") %>%
addProviderTiles(providers$Stamen.TonerLite, #map type or map theme. -default($Stame.TonerLite)
options = providerTileOptions(noWrap = TRUE)
)%>% addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE)) %>%
addStyleEditor()
})
polygons<- eventReactive(input$mymap_draw_all_features, {
features<-input$mymap_draw_all_features
poly$poligonos<-c(poly$poligonos,features)
return(poly$poligonos)
})
The eventReactive function called "polygons" is responsible for recording the polygons (coordinates) that are drawn, but i din't know how to save them or convert into a GeoJson or shapefile format.
What you can do is take the coordinates of the polygons you made with the DrawToolbar and use them to create polygons in a reactiveValues SpatialPolygonsDataFrame. You can export that SPDF as a shapefile (with the example below you have to publish to the server to make the download option work. It will not work from R Studio).
ui <- fluidPage(
textOutput("text"),leafletOutput("mymap"),
downloadButton('downloadData', 'Download Shp'))
--
server<- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet("mymap") %>%
addProviderTiles(providers$Stamen.TonerLite, #map type or map theme. -default($Stame.TonerLite)
options = providerTileOptions(noWrap = TRUE)) %>%
addDrawToolbar(targetGroup = "drawnPoly",
rectangleOptions = F,
polylineOptions = F,
markerOptions = F,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
circleOptions=F,
polygonOptions=drawPolygonOptions(showArea=TRUE, repeatMode=F , shapeOptions=drawShapeOptions( fillColor="red",clickable = TRUE))) %>%
addStyleEditor()
})
latlongs<-reactiveValues() #temporary to hold coords
latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0))
#########
#empty reactive spdf
value<-reactiveValues()
SpatialPolygonsDataFrame(SpatialPolygons(list()), data=data.frame (notes=character(0), stringsAsFactors = F))->value$drawnPoly
#fix the polygon to start another
observeEvent(input$mymap_draw_new_feature, {
coor<-unlist(input$mymap_draw_new_feature$geometry$coordinates)
Longitude<-coor[seq(1,length(coor), 2)]
Latitude<-coor[seq(2,length(coor), 2)]
isolate(latlongs$df2<-rbind(latlongs$df2, cbind(Longitude, Latitude)))
poly<-Polygon(cbind(latlongs$df2$Longitude, latlongs$df2$Latitude))
polys<-Polygons(list(poly), ID=input$mymap_draw_new_feature$properties$`_leaflet_id`)
spPolys<-SpatialPolygons(list(polys))
#
value$drawnPoly<-rbind(value$drawnPoly,SpatialPolygonsDataFrame(spPolys,
data=data.frame(notes=NA, row.names=
row.names(spPolys))))
###plot upon ending draw
observeEvent(input$mymap_draw_stop, {
#replot it - take off the DrawToolbar to clear the features and add it back and use the values from the SPDF to plot the polygons
leafletProxy('mymap') %>% removeDrawToolbar(clearFeatures=TRUE) %>% removeShape('temp') %>% clearGroup('drawnPoly') %>% addPolygons(data=value$drawnPoly, popup="poly", group='drawnPoly', color="blue", layerId=row.names(value$drawnPoly)) %>%
addDrawToolbar(targetGroup = "drawnPoly",
rectangleOptions = F,
polylineOptions = F,
markerOptions = F,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
circleOptions=F,
polygonOptions=drawPolygonOptions(showArea=TRUE, repeatMode=F , shapeOptions=drawShapeOptions( fillColor="red",clickable = TRUE)))
})
latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0)) #clear df
})
########################
### edit polygons / delete polygons
observeEvent(input$mymap_draw_edited_features, {
f <- input$mymap_draw_edited_features
coordy<-lapply(f$features, function(x){unlist(x$geometry$coordinates)})
Longitudes<-lapply(coordy, function(coor) {coor[seq(1,length(coor), 2)] })
Latitudes<-lapply(coordy, function(coor) { coor[seq(2,length(coor), 2)] })
polys<-list()
for (i in 1:length(Longitudes)){polys[[i]]<- Polygons(
list(Polygon(cbind(Longitudes[[i]], Latitudes[[i]]))), ID=f$features[[i]]$properties$layerId
)}
spPolys<-SpatialPolygons(polys)
SPDF<-SpatialPolygonsDataFrame(spPolys,
data=data.frame(notes=value$drawnPoly$notes[row.names(value$drawnPoly) %in% row.names(spPolys)], row.names=row.names(spPolys)))
value$drawnPoly<-value$drawnPoly[!row.names(value$drawnPoly) %in% row.names(SPDF),]
value$drawnPoly<-rbind(value$drawnPoly, SPDF)
})
observeEvent(input$mymap_draw_deleted_features, {
f <- input$mymap_draw_deleted_features
ids<-lapply(f$features, function(x){unlist(x$properties$layerId)})
value$drawnPoly<-value$drawnPoly[!row.names(value$drawnPoly) %in% ids ,]
})
#write the polys to .shp
output$downloadData<-downloadHandler(
filename = 'shpExport.zip',
content = function(file) {
if (length(Sys.glob("shpExport.*"))>0){
file.remove(Sys.glob("shpExport.*"))
}
proj4string(value$drawnPoly)<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
writeOGR(value$drawnPoly, dsn="shpExport.shp", layer="shpExport", driver="ESRI Shapefile")
zip(zipfile='shpExport.zip', files=Sys.glob("shpExport.*"))
file.copy("shpExport.zip", file)
if (length(Sys.glob("shpExport.*"))>0){
file.remove(Sys.glob("shpExport.*"))
}
}
)
}
--
shinyApp(ui=ui,server=server)