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
Related
I'm using addFlows() to add some flow data to a leaflet map in Shiny.
What I need it to do is emit the layerId when the appropriate line is clicked, so that I can display some information to the user in a sidebar. How can I trigger a click event?
I know that with polylines or polygons I can use observeEvent(input$map_shape_click, {}), but I'm not sure of the addFlows variant of this. I can't use addPolylines() instead because I need the arrow heads as representative of direction.
Reproducible code (with non-working click event):
library(shiny)
library(leaflet)
library(leaflet.minicharts)
library(tidyverse)
dat <- data.frame(
Line_no = c("line1", "line2"),
Origin_lat = c(40.15212, 40.65027),
Origin_lng = c(-74.79037, -74.91990),
Dest_lat = c(40.78749, 40.78749),
Dest_lng = c(-73.96188, -73.96188),
flow = c(237, 84)
)
ui <- fluidPage(
leafletOutput("map", height=800)
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$Esri.WorldImagery) %>%
setView(lat = 40.39650, lng = -74.39541, zoom = 9)
})
observe({
leafletProxy("map") %>%
addFlows(
layerId = dat$Line_no,
lng0 = dat$Origin_lng,
lat0 = dat$Origin_lat,
lng1 = dat$Dest_lng,
lat1 = dat$Dest_lat,
flow = dat$flow
)
})
observeEvent(input$map_shape_click, {
glimpse("Clicked!")
})
}
shinyApp(ui, server)
Is it possible to split the code of a map so that a part of the map only updates if it's own input is changed?
In the reproducible example below, when selecting the "toner" tile and selecting a new station, the whole leaflet map is executed again because addLegend needs to be updated. Which makes the tile jump back to "OSM (default)" tile. I would like to stay at the tile I selected when I select other stations.
library(leaflet)
library(shiny)
library(dplyr)
pal <- colorFactor(
palette = "YlGnBu",
domain = quakes$stations
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("stations",
"Choose a station",
choices=sort(unique(quakes$stations)),
selected = c(10, 11))
),
mainPanel(
leafletOutput("map")
)
)
)
server <- function(input, output) {
points <- reactive({
quakes %>%
filter(stations %in% input$stations)
})
output$map <- renderLeaflet({
leaflet(quakes) %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
addLayersControl(
baseGroups = c("OSM (default)", "Toner"),
options = layersControlOptions(collapsed = FALSE)) %>%
addLegend("Legend", position = "topleft", pal = pal, values = input$stations)
})
observe({
if(nrow(points()) == 0) {
leafletProxy("map", data = points()) %>%
clearMarkers()
} else {
leafletProxy("map", data = points()) %>%
clearMarkers() %>%
addCircleMarkers(radius = 2)
}
})
}
shinyApp(ui, server)
I tried several things, including adding addLegend to the else statement, but that does not go well. I'm new to leaflet/shiny, moving addLegend seemed most logic to me. I really appreciate any suggestions!
As far as I get it you were on the right track by trying to move addLegend to the observer. Doing so worked fine for me.
Move addLegend to observe
Before adding the legend use clearControls to remove any existing legend (otherwise you get multiple legends)
I removed the duplicated code in the observe
As far as I get it the condition nrow(points()) > 0 is only needed to decide whether a legend should be drawn or not. For the markers it doesn't matter.
library(leaflet)
library(shiny)
library(dplyr)
pal <- colorFactor(
palette = "YlGnBu",
domain = quakes$stations
)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
checkboxGroupInput("stations",
"Choose a station",
choices=sort(unique(quakes$stations)),
selected = c(10, 11))
),
mainPanel(
leafletOutput("map")
)
)
)
server <- function(input, output) {
points <- reactive({
quakes %>%
filter(stations %in% input$stations)
})
output$map <- renderLeaflet({
leaflet(quakes) %>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$Stamen.Toner, group = "Toner") %>%
addLayersControl(
baseGroups = c("OSM (default)", "Toner"),
options = layersControlOptions(collapsed = FALSE))
})
observe({
proxy <- leafletProxy("map", data = points()) %>%
clearMarkers() %>%
clearControls() %>%
addCircleMarkers(radius = 2)
if (nrow(points()) > 0)
proxy <- proxy %>% addLegend("Legend", position = "topleft", pal = pal, values = input$stations)
proxy
})
}
shinyApp(ui, server)
I want to display my marker labels based on zoom level.
Based on (https://rstudio.github.io/leaflet/shiny.html) I tried to use "input$MAPID_zoom". In my example, labels stored in location_name should be displayed when zoom level (mapscale) is lower to 6.
What I tried :
library(shiny)
library(leaflet)
# my data
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE)
# UI
ui <- shinyUI(fluidPage(
leafletOutput('map')
))
# server
server <- shinyServer(function(input, output, session) {
mapscale <- observe({
input$map_zoom # get zoom level
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(data=df, lng = ~lng, lat = ~lat,
label =~if(mapscale<6, location_name))
})
})
shinyApp(ui = ui, server = server)
A few remarks on your code if you like.
If you wrap the zoom in a reactive function, reference it like mapscale(). Use the normal if statement in R and the ~ in front of the variable. Then you should be fine.
Reproducible example:
library(shiny)
library(leaflet)
df <- data.frame(
location_name = c('S1', 'S2'),
lng = c(-1.554136, -2.10401),
lat = c(47.218637, 47.218637),
stringsAsFactors = FALSE
)
ui <- shinyUI(
fluidPage(
leafletOutput(outputId = 'map')
)
)
server <- shinyServer(function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles()
})
observeEvent(
eventExpr = input$map_zoom, {
print(input$map_zoom) # Display zoom level in the console
leafletProxy(
mapId = "map",
session = session
) %>%
clearMarkers() %>%
addMarkers(
data = df,
lng = ~lng,
lat = ~lat,
label = if(input$map_zoom < 6) ~location_name
)
}
)
})
shinyApp(
ui = ui,
server = server
)
i am trying to use shiny dashboard with leaflet package. I tried using "SelectInput" function in the dashboard to create reactive map based on the input selected(geoArea).However, i am not able to make the leaflet and the SelectInput connect with each other.
I also wanted to distinguish two groups in my dataset and plot it in leaflet/shiny (column name "up.and.down" has positive and negative values).In Base R i could do it using filter option from the tidyverse package and give distinct colour to each but however i am not sure how this works in Shinydashboard. Any help in regards will be much appreciated.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<- read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv")
`ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))`
`server <- function(input, output) {
data_input<-reactive({
datafile %>%
leaflet() %>%
addTiles() %>%
addMarkers(lng = datafile$lng,lat = datafile$lat)
})
data_input_ordered<-reactive({
data_input()[order(match(data_input)$geoArea)]
})`
`labels<- reactive({
paste("<p>", datafile$goals,"</p>"),
paste("<p>", datafile$achieved,"</p>")
})`
`output$mymap<- renderLeaflet(
datafile %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = datafile$lng,lat = datafile$lat)
)
}
shinyApp(ui = ui, server = server)`
Try this one:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<-read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv") %>%
mutate(color=ifelse(up.and.down<0,"red","blue"))
ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))
server <- function(input, output) {
output$mymap<- renderLeaflet({
validate(need(datafile,"Add file"))
validate(need(input$Area,"Select Area"))
datafile %>%
filter(geoArea %in% input$Area) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = ~lng,lat = ~lat,color=~color,
popup = ~paste(paste0("Goals - ",goals),paste0("Achieved - ",achieved), sep="<br>"))
})
}
shinyApp(ui = ui, server = 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)