I'm having trouble setting up this shiny with a leaflet map. My original post had two questions and it was suggested I should start a new post to address my second issue: how do I get the map to show my updated data after I have filtered by speed; my table gets updated whether I change "speed" or the map bounds, but the leaflet map does not update points based on the speed filter input.
REPRODUCIBLE CODE
library(shiny)
library(magrittr)
library(leaflet)
library(DT)
ships <-
read.csv(
"https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
)
ui <- shinyUI(fluidPage(
titlePanel("Filter"),
sidebarLayout(
sidebarPanel(width = 3,
numericInput(
"speed_f", label = h5("Ship's Speed"), value = 100
)),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel(
"Leaflet",
leafletOutput("leafletmap", width = "350px"),
dataTableOutput("tbl")
)
))
)
))
server <- function(input, output) {
in_bounding_box <- function(data, lat, long, bounds, speed) {
data %>%
dplyr::filter(
lat > bounds$south &
lat < bounds$north &
long < bounds$east & long > bounds$west &
speed > input$speed_f
)
}
output$leafletmap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
addCircleMarkers(
data = ships,
~ long ,
~ lat,
popup = ~ speed,
radius = 5 ,
stroke = FALSE,
fillOpacity = 0.8,
popupOptions = popupOptions(closeButton = FALSE)
)
})
data_map <- reactive({
if (is.null(input$leafletmap_bounds)) {
ships
} else {
bounds <- input$leafletmap_bounds
in_bounding_box(ships, lat, long, bounds, speed)
}
})
output$tbl <- DT::renderDataTable({
DT::datatable(
data_map(),
extensions = "Scroller",
style = "bootstrap",
class = "compact",
width = "100%",
options = list(
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
dom = 'tp'
)
)
})
}
shinyApp(ui = ui, server = server)
UPDATE
Making the following change data = data_map() seems to work, with an exception:
output$leafletmap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
addCircleMarkers(
data = data_map(), #### THIS LINE HAS CHANGED
~ long ,
~ lat,
popup = ~ speed,
radius = 5 ,
stroke = FALSE,
fillOpacity = 0.8,
popupOptions = popupOptions(closeButton = FALSE)
)
})
However, the leaflet map does not let me zoom out of the area defined by the filtered points. Is there a way around this?
If you define a reactive just for the map data and use that within renderLeaflet it should allow you to then move out of the are defined. You don't need to change any of your other functions or reactives, just add the new reactive and make a couple of changes to renderLeaflet as below
map_data_react <- reactive({
ships %>% dplyr::filter(speed > input$speed_f)
})
output$leafletmap <- renderLeaflet({
ships_data <- map_data_react() # Add this
ships_data %>% leaflet() %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
addCircleMarkers(
~ long , # Removed `data = data_map()`
~ lat,
popup = ~ speed,
radius = 5 ,
stroke = FALSE,
fillOpacity = 0.8,
popupOptions = popupOptions(closeButton = FALSE)
)
})
Related
So I want to change the CircleMarker colour in Leaflet map when I select a row in the table. I didn't get any errors but nothing happens. I don't know how to create and apply the reactive function properly in my Shiny app.
I tried to create a reactive function when a row is selected in the table and apply it to a separate leaflet proxy and leaflet map.
library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Quakes Test"),
# Sidebar with numericInput for quakes depth range
sidebarLayout(
sidebarPanel(
numericInput(inputId = "min_depth", label = "Mininum depth", value = min(quakes$depth), min = min(quakes$depth), max = max(quakes$depth)),
numericInput(inputId = "max_depth", label = "Maximum depth", value = max(quakes$depth), min = min(quakes$depth), max = max(quakes$depth))
),
# Show a map
mainPanel(
fluidRow(
leafletOutput("mymap_occ", width = "98%", height = 500))
)
),
fluidRow(DT::dataTableOutput(outputId = "prop_table"))
)
server <- function(input, output) {
#filter terrains
depth_final <- reactive({
obj <- quakes
if (input$min_depth != "All") {
obj <- quakes %>%
filter(depth >= as.numeric(input$min_depth)) %>%
filter(depth <= as.numeric(input$max_depth))
}
})
#row selected in table
table2_bat <- reactive({
data <- depth_final()
data <- data[input$prop_table, ]
})
output$prop_table <- renderDT({
datatable(depth_final(), extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'single')
})
#row selected map
observe({
leafletProxy("mymap_occ", data = table2_bat()) %>%
clearGroup(group = "FOO") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "yellow", opacity = 1, fillOpacity = 1,
radius = 5, weight = 20, group = "FOO")
})
#map
observe({
leafletProxy("mymap_occ", data = depth_final()) %>%
clearGroup(group = "FOO_2") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "red", opacity = 1, fillOpacity = 0.75,
radius = 5, weight = 2, group = "FOO_2")
})
output$mymap_occ <- renderLeaflet({
leaflet(table2_bat()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
output$mymap_occ <- renderLeaflet({
leaflet(depth_final()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
}
shinyApp(ui = ui, server = server)
First. You have to use eventReactive instead of reactive to trigger an action based on an event, i.e. when the user selects a row. Second. To get the index of the selected row you have to use input$prop_table_rows_selected (see here) instead of input$prop_table. input$prop_table does not exist, i.e. it returns NULL. Hence, to make your app work try this:
#row selected in table
table2_bat <- eventReactive(input$prop_table_rows_selected, {
data <- depth_final()
data <- data[input$prop_table_rows_selected, ]
})
I need to create an interactive map with leaflet package, where I can use a selectInput to control what data points to show on the map. I also want to use the layer control button to select one or both layers (data points) to appear on the map. My code is shown below.
I want the map to respond to selectInput only when go button is clicked.
My code works when I select one item in the selectInput (map refreshes when I click go).
I found when I select the second item, initially I see error: subscript out of bounds. When go clicked, both markers appear.
When I remove one of the two item selected, the map responds before the action button clicked.
It appears that the selectInput is not responding to action button properly. Does anyone know why that happens? What did I do wrong? I spend hours trying to figure it out but no luck...... Thanks a lot in advance.
library(shiny)
library(leaflet)
hotels <- read.table(text = "Hotel Year latitude longitude
A 2000 41.886337 -87.628472
B 2005 41.88819 -87.635199
C 2010 41.891113 -87.63301",
header = TRUE)
ui <- fluidPage(
selectizeInput(inputId = 'year', label='Choose Year:',
choices = c(2000,2005,2010),
multiple=TRUE,
options = list(
maxItems = 2,
placeholder = '',
onInitialize = I("function() { this.setValue(''); }"))),
actionButton("go", "go"),
leafletOutput("mymap")
)
server <- function(input, output, session) {
df_list = reactive ({
input$go
isolate(
if (length(input$year)>1) {
list(hotels[hotels$Year == input$year[1],],
hotels[hotels$Year == input$year[2],])
} else {
list(hotels[hotels$Year == input$year[1],])
}
)
})
output$mymap <- renderLeaflet({
map = leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addCircleMarkers( data = df_list()[[1]] ,
group = 'Data Markers 1',
lng = ~longitude,
lat = ~latitude,
radius = 10,
stroke = F,
fillOpacity = 0.9,
color = 'red')
if ( length(input$year)>1){
map = map %>%
addCircleMarkers( data = df_list()[[2]] ,
group = 'Data Markers 2',
lng = ~longitude,
lat = ~latitude,
radius = 10,
stroke = F,
fillOpacity = 0.9,
color = 'blue')
}
if ( length(input$year)>1) {
map = map %>%
addLayersControl(
overlayGroups = c('Data Markers 1', 'Data Markers 2'),
options = layersControlOptions(collapsed = FALSE) )
} else {
map = map %>%
addLayersControl(
overlayGroups = c('Data Markers 1'),
options = layersControlOptions(collapsed = FALSE) )
}
})
}
shinyApp(ui, server)
The main point is that you should use observeEvent() when working with action buttons. You mixed up the reactive path, so values changed not in the order you assumed they would.
library(shiny)
library(leaflet)
hotels <- read.table(text = "Hotel Year latitude longitude
A 2000 41.886337 -87.628472
B 2005 41.88819 -87.635199
C 2010 41.891113 -87.63301",
header = TRUE)
ui <- fluidPage(
selectizeInput(inputId = 'year', label='Choose Year:',
choices = c(2000,2005,2010),
multiple=TRUE,
options = list(
maxItems = 2,
placeholder = '',
onInitialize = I("function() { this.setValue(''); }"))),
actionButton("go", "go"),
leafletOutput("mymap")
)
server <- function(input, output, session) {
# use the button for observeEvent
# ignore values ensure an empty map is loading in the beginning
observeEvent(input$go, ignoreInit = FALSE, ignoreNULL = FALSE, {
# no need for a reactive list here
if (length(input$year)>1) {
df_list <- list(hotels[hotels$Year == input$year[1],],
hotels[hotels$Year == input$year[2],])
} else {
df_list <- list(hotels[hotels$Year == input$year[1],])
}
output$mymap <- renderLeaflet({
map <- leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addCircleMarkers( data = df_list[[1]] ,
group = 'Data Markers 1',
lng = ~longitude,
lat = ~latitude,
radius = 10,
stroke = F,
fillOpacity = 0.9,
color = 'red')
# not using input does not invoke reactiveness
if ( length(df_list) > 1){
map <- map %>%
addCircleMarkers( data = df_list[[2]] ,
group = 'Data Markers 2',
lng = ~longitude,
lat = ~latitude,
radius = 10,
stroke = F,
fillOpacity = 0.9,
color = 'blue')
}
if ( length(input$year)>1) {
map <- map %>%
addLayersControl(
overlayGroups = c('Data Markers 1', 'Data Markers 2'),
options = layersControlOptions(collapsed = FALSE) )
} else {
map <- map %>%
addLayersControl(
overlayGroups = c('Data Markers 1'),
options = layersControlOptions(collapsed = FALSE) )
}
map
})
})
}
shinyApp(ui, server)
Note: Rather use assignment arrows for assignment ;)
I'm trying to create a shinyapp using mapdeck that maps a variable based on some attributes. Basically, I select a city and then select an activity and a time threshold to produce the desirable map. Reproducible code below (make sure to use a mapbox API):
library(shiny)
library(dplyr)
library(mapdeck)
library(sf)
ui <- shinyUI(fluidPage(
selectInput(inputId = "city",
label = h1("Pick city:"),
choices = c("Belo Horizonte" = "bho",
"Fortaleza" = "for"),
selected = "bho"),
selectInput(inputId = "activity",
label = h1("Pick activity:"),
choices = c("TT", "ST"),
selected = "TT"),
sliderInput(inputId = "time",
label = h1("Pick time threshold:"),
min = 30, max = 120,
step = 30, value = 30,
animate = TRUE),
mapdeckOutput("map")
)
)
# SERVER --------------------------------------------------------------------------------------
# Define a server for the Shiny app
server <- shinyServer(function(input, output) {
data <- readRDS(url("https://github.com/kauebraga/misc/raw/master/data.rds"), "rb")
centroids <- data.frame(sigla_muni = c("for", "bho"),
lon = c(-38.52770, -43.95988),
lat = c( -3.785656, -19.902739))
# register mapbox api key
mapdeck::set_token("YOUR_API")
# reactive for the city
city_filtered <- reactive({
data %>% filter(sigla_muni == input$city)
})
# reactive for the activity
activity_filtered <- reactive({
city_filtered() %>% dplyr::filter(activity == input$activity)
})
# Reactive for time threshold
time_filtered <- reactive({
activity_filtered() %>% dplyr::filter(time_threshold == input$time)
})
# initialize baseMap
output$map <- renderMapdeck({
mapdeck(location = c(-43.95988, -19.902739), zoom = 0)
})
#
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
}
)
shinyApp(ui = ui, server = server)
I want to use the cool map transitions provided by mapdeck, so I create a basemap with zero zoom and then use the mapdeck_view function inside my shiny::observer so I can have the nice transition whenever I open the map or select a different city. I set the views based on cities centroids.
The problem is that the view (and the transition) also updates whenever I change the zoom inside the same city and then select different attributes (different activities or a different time threshold). I wish there was a way to keep the map in the same zoom while I change attributes within the same city, having transition only when I change cities.
I tried to play with shiny::isolate inside my observer but didn't succeed (nothing happened in this case):
observe({
isolate({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
a <- mapdeck_update(map_id = "map") %>%
add_polygon(
data = time_filtered(),
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess_cum",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
Appreciate any help. Thanks!
I think you need the city input and the time & activity inputs in different observers. This appears to achieve your desired behaviour.
observe({
centroids_city <- filter(centroids, sigla_muni == input$city)
mapdeck_update(map_id = "map") %>%
mapdeck_view(location = c(centroids_city$lon, centroids_city$lat), zoom = 10,
duration = 3000,
transition = "fly")
})
observeEvent({c(input$time, input$activity, input$city)},{
print(" -- changing -- ")
sf <- time_filtered()
print( unique( sf$sigla_muni ) )
print( unique( sf$time_threshold ) )
print( unique( sf$activity ) )
mapdeck_update(map_id = "map") %>%
add_polygon(
data = sf,
fill_colour = "value",
fill_opacity = 200,
layer_id = "acess",
palette = "inferno",
update_view = FALSE,
focus_layer = FALSE,
)
})
I am writing a Leaflet map in R and integrating it with shiny. I have three questions to ask and the code will be at the bottom with the problems highlighted:
On this map, I have random markers, each representing an aquatic environment. I also have a drop-down list allowing you to select the specific environment you want, which will only select those markers corresponding to the environment. I have created the absolutePanel which allows you to do this but cannot get the script to select for the markers using the reactive function.
Not an important factor, but will be useful. I have highlighted the countries that contain the markers, but when you move the slider to select for the years and corresponding markers you want to view, "empty" countries still remain. As the markers are removed based on the year, I want the countries no longer containing markers to be highlighted. Also it seems very slow.
Only for interest sake, but is there a map like "OpenStreetMap.Mapink" that is completely in English?
Below is the data file linked, as well as the script for the map:
https://drive.google.com/drive/folders/10anPY-I-B13zTQ7cjUsjQoJDcMK4NCXb?usp=sharing
library(shiny)
library(leaflet)
library(maps)
library(htmltools)
library(htmlwidgets)
library(dplyr)
###############################
map_data <- read.csv("example1.csv", header = TRUE)
countries <- map_data %>%
distinct(DOI, Country.s., .keep_all = TRUE)
area_data <- map_data %>%
filter(Area.Site == "Area")
site_data <- map_data %>%
filter(Area.Site == "Site")
sampling_count <- count(site_data, "Country.s.")
country_count <- count(countries, "Country.s.")
bounds <- map("world", area_data$Country.s., fill = TRUE, plot = FALSE)
bounds$studies <- country_count$freq[match(gsub("\\:.*", "", bounds$names), country_count$Country.s.)]
bounds$sampling_points <- sampling_count$freq[match(gsub("\\:.*", "", bounds$names), sampling_count$Country.s.)]
bounds$year <- site_data$Publication_Year[match(gsub("\\:.*", "", bounds$names), site_data$Country.s.)]
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map",
width = "100%",
height = "100%"),
################################
#Question 1
################################
absolutePanel(top = 5, right = 320,
selectInput("environment", "Sampling Source: ",
c("All" = "P&C",
"Surface Water" = "SW",
"Wastewater" = "WW",
"Sea Water" = "Sea"))),
################################
#Question 1
################################
absolutePanel(bottom = 5, right = 320,
sliderInput("year", "Publication Year(s)", min(site_data$Publication_Year), max(site_data$Publication_Year),
value = range(site_data$Publication_Year), step = 1, sep = "", width = 500))
)
server <- function(input, output, session) {
marker_data <- reactive({
site_data[site_data$Publication_Year >= input$year[1] & site_data$Publication_Year <= input$year[2],]
})
area_s_data <- reactive({
area_data[area_data$Publication_Year >= input$year[1] & area_data$Publication_Year <= input$year[2],]
})
border_data <- reactive({
bounds[bounds$year >= input$year[1] & bounds$year <= input$year[2],]
})
output$map <- renderLeaflet({
leaflet(map_data, options = leafletOptions(worldCopyJump = TRUE)) %>%
################################
#Question 3
################################
addProviderTiles("OpenStreetMap.Mapnik")
################################
#Question 3
################################
})
observe({
leafletProxy("map", data = marker_data()) %>%
clearMarkers() %>%
addAwesomeMarkers(lat = ~Latitude,
lng = ~Longitude,
label = ~paste(Aquatic_Environment_Type))
})
################################
#Question 2
################################
observe({
leafletProxy("map", data = area_s_data()) %>%
clearShapes() %>%
addCircles(lat = ~Latitude,
lng = ~Longitude,
radius = ~as.numeric(Area_Radius_Meter),
color = "blue",
weight = 1,
highlightOptions = highlightOptions(color = "red",
weight = 2,
bringToFront = TRUE)) %>%
addPolygons(data = bounds,
color = "red",
weight = 2,
fillOpacity = 0.1,
highlightOptions = highlightOptions(color = "black",
weight = 2,
bringToFront = TRUE))
################################
#Question 2
################################
})
}
shinyApp(ui, server)
The code below is meant to reproduce that which is found in this example with the exception of adding an additional parameter for "speed". However, my map-datatable link has broken - Can anyone help me spot the bug? The original code updates the table based on the bounds of the map, while in my code changing the map zoom has no effect on my table. I'm also not able to get the "speed" filter to work on the table and map, which is a functionality I am looking for. Any pointers would be appreciated.
library(shiny)
library(magrittr)
library(leaflet)
library(DT)
ships <-
read.csv(
"https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
)
ui <- shinyUI(fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(width = 3,
numericInput(
"speed", label = h5("Ship's Speed"), value = 100
)),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel(
"Leaflet",
leafletOutput("leafletmap", width = "350px"),
dataTableOutput("tbl")
)
))
)
))
server <- shinyServer(function(input, output) {
in_bounding_box <- function(data, lat, long, bounds, speed) {
data %>%
dplyr::filter(
lat > bounds$south &
lat < bounds$north &
long < bounds$east & long > bounds$west & ship_speed < input$speed
)
}
output$leafletmap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
addCircleMarkers(
data = ships,
~ long ,
~ lat,
popup = ~ speed,
radius = 5 ,
stroke = FALSE,
fillOpacity = 0.8,
popupOptions = popupOptions(closeButton = FALSE)
)
})
data_map <- reactive({
if (is.null(input$map_bounds)) {
ships
} else {
bounds <- input$map_bounds
in_bounding_box(ships, lat, long, bounds, speed)
}
})
output$tbl <- DT::renderDataTable({
DT::datatable(
data_map(),
extensions = "Scroller",
style = "bootstrap",
class = "compact",
width = "100%",
options = list(
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
dom = 'tp'
)
)
})
})
shinyApp(ui = ui, server = server)
Two small changes:
In the example you linked, input$map_bounds works, because the leaflet output object is called map. However, you renamed it to leafletmap, so we should refer to input$leafletmap_bounds.
in the dplyr statement, we should refer to speed, not ship_speed.
Working code is given below, hope this helps!
library(shiny)
library(magrittr)
library(leaflet)
library(DT)
ships <-
read.csv(
"https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
)
ui <- shinyUI(fluidPage(
titlePanel(""),
sidebarLayout(
sidebarPanel(width = 3,
numericInput(
"speed", label = h5("Ship's Speed"), value = 100
)),
mainPanel(tabsetPanel(
type = "tabs",
tabPanel(
"Leaflet",
leafletOutput("leafletmap", width = "350px"),
dataTableOutput("tbl")
)
))
)
))
server <- shinyServer(function(input, output) {
in_bounding_box <- function(data, lat, long, bounds, speed) {
data %>%
dplyr::filter(
lat > bounds$south &
lat < bounds$north &
long < bounds$east & long > bounds$west & speed < input$speed
)
}
output$leafletmap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
addCircleMarkers(
data = ships,
~ long ,
~ lat,
popup = ~ speed,
radius = 5 ,
stroke = FALSE,
fillOpacity = 0.8,
popupOptions = popupOptions(closeButton = FALSE)
)
})
data_map <- reactive({
if (is.null(input$leafletmap_bounds)) {
ships
} else {
bounds <- input$leafletmap_bounds
in_bounding_box(ships, lat, long, bounds, speed)
}
})
output$tbl <- DT::renderDataTable({
DT::datatable(
data_map(),
extensions = "Scroller",
style = "bootstrap",
class = "compact",
width = "100%",
options = list(
deferRender = TRUE,
scrollY = 300,
scroller = TRUE,
dom = 'tp'
)
)
})
})
shinyApp(ui = ui, server = server)
The leaflet map you are rendering is called leafletmap. So rather than referring to map_bounds try changing it to leafletmap_bounds:
data_map <- reactive({
if (is.null(input$leafletmap_bounds)) {
ships
} else {
bounds <- input$leafletmap_bounds
in_bounding_box(ships, lat, long, bounds, speed)
}
})
Also in the filter, change ship_speed to speed. Should hopefully work.