Following is my shiny code. I want this app to allow user to click on the map and in response (i.e., Observe event) to the click, I want the map to show the marker.
library(shiny)
library(maps)
library(stringi)
library(ggmap)
library(leaflet)
ui <- shinyUI(bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
))
server <- shinyServer(function(input, output, session) {
## Make your initial map
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = -4, lat= 52.54, zoom = 7) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE))
})
## Observe mouse clicks and add marker
observeEvent(input$map_click, {
click <- input$map_click
clat <- click$lat
clng <- click$lng
text<- paste("Lattitude", click$lat, "Longtitude", click$lng)
proxy <- leafletProxy("map")
proxy %>% clearPopups() %>%
addPopups(click$lng, click$lat, text) %>%
addMarkers(lng=clng, lat=clat, popup = as.character(text), label = as.character(text))
})
})
runApp(shinyApp(ui, server), launch.browser = TRUE)
I get the following error.
Warning: Error in leafletProxy: could not find function "startsWith"
Stack trace (innermost first):
66: leafletProxy
65: observeEventHandler [#22]
1: runApp
Related
I can't find any documentation on how to add a tooltip with addPulseMarkers above the Layer Control (using leaflet.extras). See below for an example of what I'd aiming to do.
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addPulseMarkers(lng = ~long, lat = ~lat,
icon = makePulseIcon(color = "blue", heartbeat = 2),
group = "I want a tooltip on hover above this that says, 'Nice'") %>%
addLayersControl(
overlayGroups = c("I want a tooltip on hover above this that says, 'Nice'"),
options = layersControlOptions(collapsed = FALSE)
)
})
}
shinyApp(ui, server)
Do you mean like this?
library(shiny)
library(leaflet)
library(leaflet.extras)
ui <- fluidPage(
leafletOutput("map")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addPulseMarkers(lng = ~long, lat = ~lat,
icon = makePulseIcon(color = "blue", heartbeat = 2),
group = "I want a tooltip on hover above this that says, 'Nice'") %>%
addLayersControl(
overlayGroups = c("I want a tooltip on hover above this that says, 'Nice'"),
options = layersControlOptions(collapsed = FALSE)
) %>%
htmlwidgets::onRender("
function() {
$('.leaflet-control-layers-overlays').prepend('<label style=\"text-align:center\">Nice</label>');
}
")
})
}
shinyApp(ui, server)
It borrows from: Add title to layers control box in Leaflet using R
I am trying to improve the usability of my app.R code in R Shiny which is getting very long.
Essentially, I'd like to create a module (infras.R) to contain a large number of observeEvent functions that are linked to checkboxInputs.
I understand I need to source the module in app.R, wrap the observeEvent in a function, include namespaces (ns) for input IDs in the observeEvent function and insert a callModule for the function. I've also wrapped the callModule in an ObserveEvent so that its functionality persists and does not trigger only once after starting the webapp.
The following error is output on running app.R but I'm not sure how to resolve:
Warning: Error in proxy: could not find function "proxy"
81: eval
80: eval
79: %>%
78: module [infras.R#153]
73: callModule
72: observeEventHandler
1: runApp
Thanks for your assistance with this as I've found it challenging to find literature on how to do this.
Key snippets from my R scripts.
infras.R (updated):
icons_pow <- awesomeIcons(
iconColor = 'white',
markerColor = 'green',
text = "m"
)
mod <- function(input, output, session, pow_id, prox){
observeEvent(pow_id(),{
if(pow_id() != 0){
pow_id <- readOGR("../geospatial_files/ind", layer = "plants")
pow_iddf <- as.data.frame(pow_id)
prox %>%
addAwesomeMarkers(lng=pow_iddf$coords.x1, lat=pow_iddf$coords.x2, group = "pow_idg", icon=icons_pow,
label = paste(pow_iddf$Name,pow_iddf$Power_type,sep = ", "))
}
else {prox %>% clearGroup("pow_idg") %>% removeControl(layerId="pow_idc")
}
}
)
}
app.R (updated):
...
source("infras.R")
...
server <- function(input, output, session) {
...
proxy <- leafletProxy("map")
callModule(mod, "mod", reactive(input$pow_id), proxy)
})
...
}
You need to wrap your input object into a reactive and use that as an input argument to your module. The other input argument is your leaflet proxy. Inside the module, you can use observe to change your proxy, which is then instantly updated:
library(shiny)
library(leaflet)
library(RColorBrewer)
# The module containing the observer. Input is the reactive handle of legend input and the proxy
mod <- function(input, output, session, legend, prox){
observe({
prox %>% clearControls()
if (legend()) {
prox %>% addLegend(position = "bottomright",
pal = colorNumeric("Blues", quakes$mag), values = ~mag
)
}
})
}
ui <- bootstrapPage(
checkboxInput("legend", "Show legend", TRUE),
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
pal <- colorNumeric("Blues", quakes$mag)
leaflet(quakes) %>% addTiles() %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
})
# This is the handle for map
proxy <- leafletProxy("map", data = quakes)
callModule(mod, "mod", reactive(input$legend), proxy)
}
shinyApp(ui, server)
I am building a shiny app where I would like to get the coordinates of a polygon from a leaflet map. Specifically, the shape is drawn using the Drawtoolbar from the leaflet.extras package. A simple example app is below.
My question is, how can I get the coordinates from the shape drawn on the map by the user? Thank you in advance.
library(shiny)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
leafletOutput("mymap",height=800)
)
# Define server logic
server <- function(input, output) {
output$mymap <- renderLeaflet(
leaflet() %>%
addProviderTiles("Esri.OceanBasemap",group = "Ocean Basemap") %>%
setView(lng = -166, lat = 58.0, zoom = 5) %>%
addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
)
observeEvent(input$mymap_shape_click,{
print(input$mymap_shape_click)
})
observeEvent(input$mymap_click,{
print(input$mymap_click)
})
}
# Run the application
shinyApp(ui = ui, server = server)
You need to observe the _draw_new_feature function
library(leaflet.extras)
# Define UI
ui <- fluidPage(
leafletOutput("mymap",height=800)
)
# Define server logic
server <- function(input, output) {
output$mymap <- renderLeaflet(
leaflet() %>%
addProviderTiles("Esri.OceanBasemap",group = "Ocean Basemap") %>%
setView(lng = -166, lat = 58.0, zoom = 5) %>%
addDrawToolbar(
targetGroup='draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
)
observeEvent(input$mymap_draw_new_feature,{
feature <- input$mymap_draw_new_feature
print(feature)
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am working on a shiny application where a user clicks on a map (leaflet map) and based on that click, certain actions are being performed, like draw a circle of radius one km around the clicked point. This functionality works fine. However I want to add the mouse coordinates by using the addMouseCoordinates() function from the mapview package. I have used this in the past with no problems. However with the following code, I am unable to see the coordinates.
leafletProxy('incidentmap') %>%
addCircles(lng=clng, lat=clat, group='circles',
weight=1, radius=input$radius, color='black', fillColor='green',
fillOpacity=0.2, opacity=1)%>%
addCircles(lng=filtered$Long,lat=filtered$Lat)%>%
addMouseCoordinates(style = "basic")
Now if I click on the map, the application crashes with the following error:
> Warning: Error in : inherits(map, "leaflet") is not TRUE Stack trace
> (innermost first):
> 75: stopifnot
> 74: addMouseCoordinates
> 73: function_list[[k]]
> 72: withVisible
> 71: freduce
> 70: _fseq
> 69: eval
> 68: eval
> 67: withVisible
> 66: %>%
> 65: observeEventHandler [/Users/dhirajkhanna/Desktop/CallAnalysis/CDR/server.R#39]
> 1: runApp ERROR: [on_request_read] connection reset by peer
Has it got something to do with leafletProxy() ?
Help would be appreciated.
Here's a reproducible example:
library(shiny)
library(mapview)
library(leaflet)
ui <- fluidPage(
leafletOutput("incidentmap")
)
server <- function(input,output,session){
output$incidentmap <- renderLeaflet({
leaflet() %>%
setView(lng = 77.9568288, lat = 27.1696145, zoom=11) %>%
addTiles(options = providerTileOptions(noWrap = TRUE))
})
## Observe mouse clicks and add circles
observeEvent(input$incidentmap_click, {
click <- input$incidentmap_click
clat <- click$lat
clng <- click$lng
leafletProxy('incidentmap') %>%
addCircles(lng=clng, lat=clat, group='circles',
weight=1, radius=1000, color='black', fillColor='green',
fillOpacity=0.2, opacity=1)%>%
addMouseCoordinates(style = "basic")
})
}
shinyApp(ui,server)
It works when you move the addMouseCoordinates call to where the map is set up (where you define output$incidentmap)
library(shiny)
library(mapview)
library(leaflet)
ui <- fluidPage(
leafletOutput("incidentmap")
)
server <- function(input,output,session){
output$incidentmap <- renderLeaflet({
leaflet() %>%
setView(lng = 77.9568288, lat = 27.1696145, zoom=11) %>%
addTiles(options = providerTileOptions(noWrap = TRUE)) %>%
addMouseCoordinates(style = "basic")
})
## Observe mouse clicks and add circles
observeEvent(input$incidentmap_click, {
click <- input$incidentmap_click
clat <- click$lat
clng <- click$lng
leafletProxy('incidentmap') %>%
addCircles(lng=clng, lat=clat, group='circles',
weight=1, radius=1000, color='black', fillColor='green',
fillOpacity=0.2, opacity=1)
})
}
shinyApp(ui,server)
Here is an attempt to fill your need. You can easily improve uppon it ..
library(leaflet)
library(mapview)
library(shiny)
ui <- fluidPage(
leafletOutput("map1")
)
server <- function(input, output, session) {
output$map1 <- renderLeaflet({
leaflet() %>% addTiles()
})
observeEvent(input$map1_click, {
click <- input$map1_click
clat <- click$lat
clng <- click$lng
content <- paste(sep = "<br/>",
"<b>",clat, "</b>",
"<b>", clng, "</b>" )
leafletProxy('map1') %>%
addCircles(lng=clng, lat=clat, group='circles',
weight=1, radius=100, color='black', fillColor='orange',
fillOpacity=0.5, opacity=1) %>%
addPopups(lng = clng, lat = clat, content)
})
}
shinyApp(ui, server)
Is it possible to get the lat long from a click event in leaflet/shiny (in R) from the tile map? (i.e. NOT from any loaded markers, polygons etc). Just to show positional (lat/long) info i guess.
I thought maybe from this qu it was possible but no luck.
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output,session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron")%>%
setView(lng = -4, lat= 52.54, zoom = 7)
})
#Show popup on click
observeEvent(input$map_marker_click, {
click <- input$map_marker_click
text<-paste("Lattitude ", click$lat, "Longtitude ", click$lng)
proxy <- leafletProxy("map")
proxy %>% clearPopups() %>%
addPopups(click$lng, click$lat, text)
})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
Ultimately i want to create a click marker for raster data (using the returned lat/long) in Leaflet & Shiny but this would be a good start (This qu seems to have done something but i cannot recreate it at all).