Based on the comments below I've explicitly broken out lat/long in the spatial data frame.
Added
addCircleMarkers( ~ longitude, ~ latitude)
Added
observeEvent(input$map_marker_click, {
p <- input$map_marker_click
print(p)
})
Yet, nothing shows up in the console when I click the markers so I'm still confused.
Revised Code
# Click on circle and get info
library(shiny)
library(leaflet)
ui <- fluidPage(
leafletOutput("mymap"),
fluidRow(verbatimTextOutput("click_text"))
)
server <- function(input, output, session) {
# Create tree geometries
tree_1g <- st_point(c(-79.2918671415814, 43.6760766531298))
tree_2g <- st_point(c(-79.4883669334101, 43.6653747165064))
tree_3g <- st_point(c(-79.2964680812039, 43.7134458013647))
# Create sfc object with multiple sfg objects
points_sfc <- st_sfc(tree_1g, tree_2g, tree_3g, crs = 4326)
# Create tree attributes
data <- data.frame (
layerId = c("001", "002", "003"),
address = c(10, 20, 30),
street = c("first", "second", "third"),
tname = c("oak", "elm", "birch"),
latitude = c(43.6760766531298, 43.6653747165064, 43.7134458013647),
longitude = c(-79.2918671415814, -79.4883669334101, -79.2964680812039)
)
tree_data <- st_sf(data, geometry = points_sfc)
output$mymap <- renderLeaflet({
leaflet(data = tree_data) %>%
addProviderTiles(providers$Stamen.Watercolor) %>%
# Centre the map in the middle of Toronto
setView(lng = -79.384293,
lat = 43.685,
zoom = 11) %>%
addCircleMarkers( ~ longitude, ~ latitude)
})
observeEvent(input$map_marker_click, {
p <- input$map_marker_click
print(p)
})
}
shinyApp(ui, server)
When a user clicks on each marker I would like some relevant info displayed below the map. Based on this earlier post I tried this. However, nothing happens when I click on the marker. It may have something to do with my not understanding how to associate markers with layerIds?
# Click on circle and get info
library(shiny)
library(leaflet)
ui <- fluidPage(
leafletOutput("mymap"),
fluidRow(verbatimTextOutput("click_text"))
)
server <- function(input, output, session) {
# Create tree geometries
tree_1g <- st_point(c(-79.2918671415814, 43.6760766531298))
tree_2g <- st_point(c(-79.4883669334101, 43.6653747165064))
tree_3g <- st_point(c(-79.2964680812039, 43.7134458013647))
# Create sfc object with multiple sfg objects
points_sfc <- st_sfc(tree_1g, tree_2g, tree_3g, crs = 4326)
# Create tree attributes
data <- data.frame (
layerId = c("001", "002", "003"),
address = c(10, 20, 30),
street = c("first", "second", "third"),
tname = c("oak", "elm", "birch")
)
tree_data <- st_sf(data, geometry = points_sfc)
output$mymap <- renderLeaflet({
leaflet(data = tree_data) %>%
addProviderTiles(providers$Stamen.Watercolor) %>%
# Centre the map in the middle of Toronto
setView(lng = -79.384293,
lat = 43.685,
zoom = 11) %>%
addCircleMarkers()
})
observe({
click <- input$map_marker_click
if(is.null(click))
return()
address <- paste("Address: ", click$street)
output$click_text <- renderText({
address
})
})
}
shinyApp(ui, server)
When you 'observe' something on the map, you need to reference the map you're observing. You do this using this structure
output$<map_id>_event_to_observe
So, in your example your map_id is mymap, hence you'll need to use
observeEvent(input$mymap_marker_click, {
p <- input$mymap_marker_click
print(p)
})
Related
I would like to make an interactive map in shiny, and filter as follows: first, select the name_region column, and then only the selected region will appear on the map. I would also like to have a way to optionally mark the state or municipality polygon. If nothing is checked, I would like all polygons to appear on the map.
Could someone help me with these first steps please?
library(shiny)
library(leaflet)
library(shinyWidgets)
library(sf)
library(geobr)
#Read states
SP <- read_state("SP",2019)
RJ <- read_state("RJ",2019)
PI <- read_state("PI",2019)
BA <- read_state("BA",2019)
#Read municipalities
SP_M <- read_municipality("SP",2019)
RJ_M <- read_municipality("RJ",2019)
PI_M <- read_municipality("PI",2019)
BA_M <- read_municipality("BA",2019)
#Rbind
States_all <- rbind(SP,RJ,PI,BA)
Mun_all <- rbind(SP_M,RJ_M,PI_M,BA_M)
#Transform coordinates
States_all <- st_transform(States_all, crs = 4326)
Mun_all <- st_transform(Mun_all, crs = 4326)
#UI
ui <- fluidPage(
leafletOutput("mymap"),
fluidPage(
selectInput("name_region", "Region", choices = unique(States_all$name_region))
))
#SERVER
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addScaleBar() %>%
addTiles() %>%
addPolygons(data=Mun_all,color = "blue", fillColor = "transparent",weight = 1,
smoothFactor = 0.5,opacity = 1.0,popup = ~as.character(name_muni)) %>%
addPolygons(data=States_all,color = "black",
fillColor = "transparent",weight = 1,smoothFactor = 0.5, opacity = 1.0,
popup = ~as.character(name_state))
})
observe({
leafletProxy("mymap") %>%
clearShapes()
})
}
#SHINYAPP
shinyApp(ui, server)
I have an input dataframe whose column values may contain a comma separated list. Is there a way to create a filter for shiny that can iterate through list within a dataframe?
Ideally a user should be able to view all three points, and filter through those points who have a PointUse of either farm, house, or even both.
Going back and creating a 'both' option in the source data is not an option.
Must stick with the just the two filter options, farm or house.
#############################################
# Needed Libraries & Input Files
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house")) # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)
choiseList <- c("farm", "house")
#############################################
# UI
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)
#############################################
# SERVER
server <- function(input, output, session) {
## The Filter
filter_df <- reactive({
Map_DF %>% filter(for(p in PointUse){p} %in% input$PointUseInput) # <- the filter
})
## Base Map Creation
output$mapA <- renderLeaflet({
leaflet() %>%
addProviderTiles(
providers$Esri.DeLorme,
options = providerTileOptions(
updateWhenZooming = FALSE,
updateWhenIdle = TRUE)
) %>%
setView(lng = -107.50, lat = 39.00, zoom = 7)
})
## Update Map with Filter Selection
observe({
leafletProxy("mapA", session) %>%
clearMarkers() %>%
addCircleMarkers(
data = filter_df(),
radius = 10,
color = "red",
lat = ~Latitude,
lng = ~Longitude,
popupOptions(autoPan = FALSE),
popup = ~paste("PointUse: ", filter_df()$PointUse))
})
}
############################################
shinyApp(ui = ui, server = server)
What about using a logical vector as an index instead of filter? See the code below where sapply is used to create a logical vector of the rows that match the input$PointUseInput value.
library(shiny)
library(shinydashboard)
library(leaflet)
##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house")) # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)
choiseList <- c("farm", "house")
#############################################
# UI
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)
#############################################
# SERVER
server <- function(input, output, session) {
## The Filter
filter_df <- reactive({
Map_DF[sapply(Map_DF$PointUse, function(p) {any(input$PointUseInput %in% p)}), ]
})
## Base Map Creation
output$mapA <- renderLeaflet({
leaflet() %>%
addProviderTiles(
providers$Esri.DeLorme,
options = providerTileOptions(
updateWhenZooming = FALSE,
updateWhenIdle = TRUE)
) %>%
setView(lng = -107.50, lat = 39.00, zoom = 7)
})
## Update Map with Filter Selection
observe({
leafletProxy("mapA", session) %>%
clearMarkers() %>%
addCircleMarkers(
data = filter_df(),
radius = 10,
color = "red",
lat = ~Latitude,
lng = ~Longitude,
popupOptions(autoPan = FALSE),
popup = ~paste("PointUse: ", filter_df()$PointUse))
})
}
############################################
shinyApp(ui = ui, server = server)
filter function expects a logical vector as an input. We can use map_lgl to map through the list column and any to show if at least one value in each row is equal to the input value.
Map_DF %>% filter(map_lgl(PointUse, ~any(. %in% input$PointUseInput)))
I am just starting with R/Shiny. In this exercise, I am trying to calculate distance from the clicked point on a leaflet map to other points in a data frame. The final output I need to get is distance from the clicked point to each of the lat-long pairs in the sample_points data frame. I am able to get reactive lat-long values of the clicked point, but not the distance measurement. Please see the below app.R code. Any suggestions are appreciated.
library(shiny)
library(shinydashboard)
library(dplyr)
library(leaflet)
library(geodist)
# Sample points
sample_lat <- c(40.1, 40.2, 40.3, 40.4, 40.5)
sample_long <- c(-89.1, -89.2, -89.3, -88.9, -88.8)
sample_points <-
data.frame(Latitude = sample_lat, Longitude = sample_long)
ui <- dashboardPage(dashboardHeader(),
dashboardSidebar(),
dashboardBody(fluidRow(
box(width = NULL,
leafletOutput("map", height = 500)),
box(width = NULL,
tableOutput("location")),
box(width = NULL,
renderDataTable("distance"))
)))
server <- function(input, output) {
# Map output
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-89.0, 40.5, zoom = 9)
})
click_values <- reactiveValues(clat = NULL,
clng = NULL)
# Click event
observeEvent(input$map_click, {
click <- input$map_click
click_values$clat <- click$lat
click_values$clng <- click$lng
leafletProxy('map') %>%
clearMarkers() %>%
addMarkers(lng = click_values$clng,
lat = click_values$clat)
})
clicked_point <-
reactive({
df = data.frame(Long = click_values$clng,
Lat = click_values$clat)
})
output$location <- renderTable({
clicked_point()
})
# Calculated distance from the clicked point
output$distance <- renderDataTable({
sample_points %>%
mutate(
dist = geodist::geodist_vec(
x1 = sample_points$Longitude,
y1 = sample_points$Latitude,
x2 = clicked_point$Long,
y2 = clicked_point$Lat,
paired = TRUE,
measure = "haversine"
)
) %>%
mutate(dist_mi = dist / 1609) %>%
select(-dist)
})
}
shinyApp(ui, server)
In ui, you should use dataTableOutput("distance"), not renderDataTable(). That is why output$distance <- renderDataTable({...}) is not being executed.
Then in output$distance you forgot to call clicked_point as a reactive. It should be clicked_point()$Long for example. And to avoid having an error display on first load, you need to check if clicked_point already has valid values.
output$distance <- renderDataTable({
if(nrow(clicked_point()) == 0)
return()
sample_points %>%
...
})
I earlier suggested using req() to check if clicked_point() contained a valid value, but req(), and isTruthy() returns TRUE for empty data.frames.
I would like to automatically detect which polygon is at the center of the map. And it should update dynamically when the user is moving through the map.
For the moment I could not find a way to reverse find on which polygon are some coordinates.
I think I could simulate a input$map_shape_click with shinyjs or javascript and so get input$map_shape_click$id, but before I go to this solution, I would like to make sure there is no other way.
Here is a minimal example
library(leaflet)
library(shiny)
# data source : https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds
cities <- readRDS(file = "../gadm36_FRA_2_sf.rds")
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities,layerId = ~NAME_2,label = ~NAME_2)
})
observeEvent(input$map_bounds,{
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east, input$map_bounds$west))
# how can I detect on which polygon the center is ?
})
}
shinyApp(ui = ui, server = server)
library(leaflet)
library(shiny)
library(sf)
cities <- readRDS(file = "gadm36_FRA_2_sp.rds") %>%
st_as_sf()
ui <- fluidPage(leafletOutput("map"))
server <- function(input, output, session) {
rv <- reactiveValues()
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles(provider = providers$CartoDB.Positron) %>%
setView(lng = 1, lat = 45, zoom = 8) %>%
addPolygons(data = cities, layerId = ~NAME_2, label = ~NAME_2)
})
observeEvent(input$map_bounds, {
rv$center <- c(mean(input$map_bounds$north, input$map_bounds$south), mean(input$map_bounds$east,
input$map_bounds$west))
pnt <- st_point(c(rv$center[2], rv$center[1]))
rslt <- cities[which(st_intersects(pnt, cities, sparse = FALSE)),]$NAME_1
print(rslt)
})
}
shinyApp(ui = ui, server = server)
So I found a way to do it with the function sf::st_intersects
observeEvent(input$map_bounds,{
rv$center <- data.frame(x = mean(c(input$map_bounds$north, input$map_bounds$south)),
y = mean(c(input$map_bounds$east, input$map_bounds$west)))
res <- sf::st_as_sf(rv$center, coords=c("y","x"), crs=st_crs(cities$geometry))
intersection <- as.integer(st_intersects(res, cities$geometry))
print(if_else(is.na(intersection), '', cities$NAME_2[intersection]))
})
below is my code. I have a working map that zooms into each county when clicked on but I want the map to be shaded darker or lighter based on how many zip codes are in a certain place and the count of data in each state.
Any help would be much appreciated!
require(leaflet)
require(maps)
require(maptools)
require(sp)
require(rgeos)
zipdata=data2$LossZipCode
statedata=data2$LossStateAbbreviation
mapStates=map("state",fill=TRUE,plot=FALSE)
mapCounty=map("county",fill=TRUE,plot=FALSE)
shinyApp(
ui = fluidPage(leafletOutput('myMap'),
br(),
leafletOutput('myMap2')),
server <- function(input, output, session) {
#leafletOutput("myMap"),br(),leafletOutput("myMap2")
output$myMap=renderLeaflet({
leaflet()%>%
addProviderTiles("Stamen.TonerLite",options=providerTileOptions(noWrap=TRUE))%>%
addPolygons(lng=mapStates$x, lat=mapStates$y,fillColor=topo.colors(10,alpha=NULL),stroke=FALSE)
})
observeEvent(input$myMap_shape_click, {
click <- input$myMap_shape_click
if(is.null(click))
return()
lat <- click$lat
lon <- click$lng
coords <- as.data.frame(cbind(lon, lat))
point <- SpatialPoints(coords)
mapStates_sp <- map2SpatialPolygons(mapStates, IDs = mapStates$names)
i <- point [mapStates_sp, ]
selected <- mapStates_sp [i]
mapCounty_sp <- map2SpatialPolygons(mapCounty, IDs = mapCounty$names)
z <- over(mapCounty_sp, selected)
r <- mapCounty_sp[(!is.na(z))]
output$myMap2 <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addPolygons(data=r,
fillColor = topo.colors(10, alpha = NULL),
stroke = FALSE)
})
})
})