I am trying to display markers on a map, which appearance would depend on a selectInput. The global idea is that the user can click on different locations on a map, searching for an ideal spot. Eventually, when the choice is ok, he validates the location by clicking on a actionbutton, displaying a marker. Without adding the icon shape, everything is working, but when I add icon properties to the addMarkers line, I get a Error in : objet de type 'closure'..., I tried several things depending on Observe, eventReactive, etc... but I'm out of ideas, any help would be much appreciated ! Thank you !
library(shiny)
library(shinythemes)
library(leaflet)
icon.shapes <- c("cylindrical","spherical","cubic")
ui <- navbarPage(
fluidPage(theme = shinytheme("cerulean"),
wellPanel(tags$style(type="text/css", '#leftPanel { width:300px; float:left;}'),
id = "leftPanel",
selectInput("icon_shape", "Icon shape :",
icon.shapes),
),
mainPanel(
tabsetPanel(
tabPanel("Location", leafletOutput("map")),
)
)
)
)
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)
})
observeEvent(input$map_click, {
click <- input$map_click
text<-paste("Lattitude ", click$lat, "Longtitude ", click$lng)
updateNumericInput(session, 'lat', value=input$map_click$lat)
updateNumericInput(session, 'lng', value=input$map_click$lng)
proxy <- leafletProxy("map")
proxy %>% clearPopups() %>%
addPopups(click$lng, click$lat, text)
proxy <- leafletProxy("map")
proxy %>% clearShapes() %>%
addCircles(click$lng, click$lat)
})
cageIcons <- reactive({
icons(
iconUrl = ifelse(input$icon_shape == "Cylindrical",
"http://www.pngmart.com/files/7/Cylinder-PNG-File.png",
ifelse(input$icon_shape == "Sphérical",
"https://img.pngio.com/sphere-d-png-sphere-3d-png-transparent-png-6604207-free-3d-sphere-png-840_614.png",
"https://www.pinclipart.com/picdir/middle/7-75687_shapes-clipart-cube-pink-cube-png-transparent-png.png")
),
iconWidth = 38, iconHeight = 95,
iconAnchorX = 22, iconAnchorY = 94,
)
return(icons)
})
observeEvent(input$submit_config, {
proxy <- leafletProxy("map")
proxy %>%
addMarkers(input$map_click$lng, input$map_click$lat, icon=icons)
})
}
shinyApp(ui = ui, server = server)
Related
I am in the process of making a shiny app. I am trying to make my map interactive where the map shows only the selected Sites. Although, right now my map is showing the location of every single site in the data. This is what I have tried doing so far.( this is a simplified code)
Site_Name <-sample(c('a','b','c'),replace=T,5)
Latitude <-runif(5,min=-26, max=-22)
Longitude<-runif(5,min=-54, max=-48)
Sites <-data.frame(Site_Name,Latitude,Longitude)
fluidPage(
theme = shinytheme("cerulean"),
sidebarLayout(
sidebarPanel(
selectizeInput("sites",
"Site Name",choices= Sites$Site_Name,
options= list(maxItems = 2)),
mainPanel(
tabsetPanel(
tabPanel("Plots",leafletOutput("Station")
)
)
shinyServer(function(input, output, session) {
df1 <- eventReactive(input$sites, {
Sites %>% dplyr::filter(Site_Name %in% input$sites)
})
output$Station = renderLeaflet({
leaflet(data = df1()) %>%
addProviderTiles(providers$Esri.WorldStreetMap) %>%
addMarkers(Sites$Longitude, Sites$Latitude, popup= input$sites,
icon = list(
iconUrl = 'https://raw.githubusercontent.com/pointhi/leaflet-color-markers/master/img/marker-icon-2x-red.png',
iconSize = c(13, 20)))
})
}
It's showing all because you told to show all. You should replace Sites$Longitude, Sites$Latitude, popup= input$sites in addMarkers with lng = ~Longitude, lat = ~Latitude, popup= ~Site_Name.
What I would like to do is that if a user clicks on a line, it displays the line name in the box to the right of the map, and if a user clicks somewhere else on the map, it 'deselects' that line:
The problem is that when a user clicks the polyline, leaflet fires both a map_shape_click (the polyline) and map_click (the map) event. Even more annoyingly, it fires the map_shape_click event before the map_click event.
How can I distinguish whether the user has clicked a line, or just the base map, so that my select/deselect works? Reproducible example:
library(shiny)
library(tidyverse)
library(leaflet)
ui <- fluidPage(
fluidRow(
column(
width = 8,
leafletOutput("map")
),
column(
width = 4,
uiOutput("info")
)
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = -71.03165, lat = 42.37595, zoom = 13) %>%
addPolylines(lng = c(-71.05884, -71.02), lat = c(42.360081, 42.359),
layerId = "line1") %>%
addPolylines(lng = c(-71.05884, -71.05), lat = c(42.360081, 42.4),
layerId = "line2")
})
observeEvent(input$map_shape_click, {
x <- input$map_shape_click
output$info <- renderUI({
div(
"Line: ", x$id
)
})
})
observeEvent(input$map_click, {
output$info <- renderUI({
div(
"Nothing selected"
)
})
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(tidyverse)
library(leaflet)
ui <- fluidPage(
fluidRow(
column(
width = 8,
leafletOutput("map")
),
column(
width = 4,
uiOutput("info")
)
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(lng = -71.03165, lat = 42.37595, zoom = 13) %>%
addPolylines(lng = c(-71.05884, -71.02), lat = c(42.360081, 42.359),
layerId = "line1") %>%
addPolylines(lng = c(-71.05884, -71.05), lat = c(42.360081, 42.4),
layerId = "line2")
})
clicked <- reactiveVal()
observeEvent(input$map_shape_click, {
freezeReactiveValue(input, 'map_click')
clicked(input$map_shape_click)
})
observeEvent(input$map_click, {
clicked(input$map_click)
})
output$info <- renderUI({
req(clicked())
if(is.null(clicked()[['id']])) return(div("Nothing selected"))
div("Line: ", clicked()$id)
})
}
shinyApp(ui = ui, server = server)
Things are a little tricky here. we use freezeReactiveValue to freeze the map click, meaning if there is any shape click event, we do not update the value of map_click. This is a little advanced shiny. I recommend you read the help file and read this chapter: https://mastering-shiny.org/action-dynamic.html#freezing-reactive-inputs
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'm working on a shiny app, which shows some markers on a leaflet map. When one of the markers is clicked, the corresponding row of the data.frame should be shown in a rhandsontable on the right of the map. In detail the map width should be decreased (e.g. from 100% to 50%) and in the free space the rhandsontable should be inserted.
There a some problems with my code, which I couldn't solve so far:
Markers are not plotted on map when they are inside a leafletProxy (which is necessary in a more complex app).
Only the first marker click is observed, then the table does not change anymore (probably something wrong with observeEvent)
the rhandsontable is added below the map, not in the space to the right, which gets free, when the map width is reduced.
The data should be stored in a reactive value (to make changes possible).
Here is a minimal reproducible example:
library(shiny)
library(leaflet)
library(rhandsontable)
ui <- fluidPage(
fluidRow(
uiOutput("map2"),
uiOutput("table2")
)
)
server <- function(input, output, session){
values <- reactiveValues(
data = data.frame(X = c(1, 2), lat = c(48, 49), lng = c(11, 11.5)),
which_marker = NULL,
leaflet_map_width = "100%"
)
output$map2 <- renderUI({
leafletOutput("map", width = values$leaflet_map_width, height = "500px")
})
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% setView(11, 48.5, 8) # %>% addMarkers(data = values$data, layerId = values$data$X)
})
observe({
leafletProxy("map") %>% addMarkers(data = values$data, layerId = values$data$X)
})
observeEvent(input$map_marker_click, {
print("observed map_marker_click")
values$which_marker <- input$map_marker_click$id
values$leaflet_map_width = "50%"
output$table2 <- renderUI({
rHandsontableOutput("table")
})
})
output$table <- renderRHandsontable({
data <- values$data[values$which_marker, ]
rhandsontable(t(data), rowHeaderWidth = 120)
})
}
shinyApp(ui, server)
Note: This answers only 1/3 of the questions.
But as one can see in the comments it does not make sense to give hints there:
To answer your third questions see a solution below. (set the width of the columns according to your needs)
library(shiny)
library(leaflet)
library(rhandsontable)
ui <- fluidPage(
uiOutput("map2")
)
server <- function(input, output, session){
values <- reactiveValues(
data = data.frame(X = c(1, 2), lat = c(48, 49), lng = c(11, 11.5)),
which_marker = NULL,
leaflet_map_width = "100%"
)
observe({
values$which_marker <- input$map_marker_click$id
})
output$map2 <- renderUI({
if(!is.null(input$map_marker_click)){
fluidRow(
column(width = 10, offset = 0, style='padding:0px;',
leafletOutput("map", width = "100%", height = "500px")),
column(width = 2, offset = 0, style='padding:0px;',
rHandsontableOutput("table")
)
)
}else{
leafletOutput("map", width = values$leaflet_map_width, height = "500px")
}
})
output$map <- renderLeaflet({
leaflet() %>% addTiles() %>% addMarkers(data = values$data, layerId = values$data$X)
})
output$table <- renderRHandsontable({
data <- values$data[values$which_marker, ]
rhandsontable(t(data), rowHeaderWidth = 120)
})
}
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).