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)
Related
I'm using leaflet to plot a map and to get coordinates from user click.
Next, I want to save these coordinates in a global reactive list, so I can use these coordinates in another module. The problem is that I can't access the reactive list when it's placed on the server function (in app.R escope), neither outside the server function. The only way i found is to put the list of reactives inside the server function on the module server, so obviously is not global anymore.
How should I proceed? I want something like this (code below), so I can use the value saved in 'r' in all modules within the same session (not shared between sessions).
Map Module
mapModuleUI <- function(id){
ns <- NS(id)
leafletOutput(ns('map'), height="600px")
}
mapModuleServer <- function(input, output, session, r){
# MAP plot #####
output$map = renderLeaflet({
leaflet(width = '50 px', height = '50 px') %>% addTiles() %>% setView(-41.65, -22.0285, zoom = 10)
})
# # MAP LOGIC
observe({
click <- input$map_click
leafletProxy('map') %>% removeMarker('pointClicked')
if (is.null(click)){return()}
leafletProxy('map') %>% addMarkers(lng = click$lng, lat = click$lat, layerId = 'pointClicked')
r$lat <- click$lat %>% formatC(digits = 2, format = 'f')
r$lon <- click$lng %>% formatC(digits = 2, format = 'f')
})
} # end server function
app.R
ui <- dashboardPage(skin = 'green',
....
tabItem(tabName = "newGr",
box(mapModuleUI('mapa'))
)
...
)
server <- function(input, output, session) {
r <- reactiveValues()
callModule(mapModuleServer, 'mapa')
}
shinyApp(ui, server)
Leaflet provides an option, when setting up your map, to hide the zoom controls
leaflet(options = leafletOptions(zoomControl = FALSE)
However, I would like to call this option after having already created a map so that a user can download the map without the zoom controls and without me having to re-create a different version of the map from scratch.
Here's a simple version of my app at the moment:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom) %>%
### HERE ###
mapshot(file = file)
}
)
}
shinyApp(ui, server)
I'd like to be able to add a line of code where I've commented ### HERE ### that would turn off zoom controls. In my actual code the displayed map is really complex with lots of options and I wouldn't want to have all that code twice just for the sake of removing zoom controls in the initial call to leaflet().
Thanks
You can do it like so:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
m = map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom)
m$x$options = append(m$x$options, list("zoomControl" = FALSE))
mapshot(m, file = file)
}
)
}
shinyApp(ui, server)
which is updating the leaflet options after map creation. I will incorporate this in the mapshot function to optionally remove the zoomControl.
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
Is it possible to load offline/local leaflet map tiles within a Shiny app? I am able to load the tiles in an interactive R session as shown here, but I now want to try and load them for use in a Shiny app. Here's an example of what I have so far. I'm thinking it has something to do with Shiny running through an IP and port and needing to load the tiles through an IP and port as well. I've tried a few things to change IPs and ports (making them the same) as explained here but haven't figured out anything that works. I can also get it to work using online tiles, but I need it to work with local map tiles.
library(shiny)
library(leaflet)
library(RColorBrewer)
library(RgoogleMaps)
options(shiny.port = 8000)
(bwi <- getGeoCode("BWI;MD"))
df <- as.data.frame(rbind(bwi))
df$col <- c("orange")
df$name <- c("BWI")
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = df$col
)
#################################################################################
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style = "padding: 8px; background: #FFFFEE; opacity:.9",
checkboxInput("markers", "Show Markers?", TRUE)
)
)
#################################################################################
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "http:/localhost:8000/C:/Users/OTAD USER/Documents/mapTiles/ESRIWorldTopoMap/{z}_{x}_{y}.png") %>%
setView(lat = bwi[1], lng = bwi[2], zoom = 8)
})
observe({
proxy <- leafletProxy("map", data = df)
# Remove/show any markers
proxy %>% clearMarkers()
if (input$markers) {
proxy %>% addAwesomeMarkers(lat = df$lat, lng = df$lon,
icon = icons, label = df$name)
}
})
}
#Put the ui and server together and run
runApp(shinyApp(ui = ui,
server = server), launch.browser=TRUE
)
1- You have to authorize shiny to serve tiles in that folder by providing an "alias" on the ressource with addResourcePath
2- then use that alias as the base URL in addTiles
server <- function(input, output, session) {
addResourcePath("mytiles", "C:/Users/OTAD USER/Documents/mapTiles/ESRIWorldTopoMap")
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "/mytiles/{z}_{x}_{y}.png") %>%
setView(lat = bwi[1], lng = bwi[2], zoom = 8)
})
...
I am having trouble adding different layers in my shiny app. I want to add a group of polygons along with a group of circle markers along with a group of arbitrary (.png) icons. I have the group of geojson files that are added in a for loop that is wrapped in an observe({}) statement with the function
map$addGeoJSON(x) where x is a feature with coordinates. The 'map' object is created by the command
map <- createLeafletMap(session, 'map')
This is all fine and dandy, and the polygons get added fine. I also want to commit to this way of adding the polygons. That should not have to change.
The error happens when I try to add markers onto that map object in the same way (e.g. with map$addMarkers(....) ) Below is the error and the code for the app that tries to add markers in the desired way and fails.
The shiny app below with the quakes data recreates my error
"Listening on ...
Warning: Error in observerFunc: attempt to apply non-function
Stack trace (innermost first):
56: observerFunc [C:/Users/jbz/Desktop/leaflet-map-question.R#35]
1: runApp
ERROR: [on_request_read] connection reset by peer"
library(shiny)
library(leaflet)
library(RColorBrewer)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletMap("map", width = "100%", height = "100%",
options=list(center = c(40.736, -73.99), zoom = 14)),
absolutePanel(top = 10, right = 10,
sliderInput("range", "Magnitudes", min(quakes$mag), max(quakes$mag),
value = range(quakes$mag), step = 0.1
),
selectInput("colors", "Color Scheme",
rownames(subset(brewer.pal.info, category %in% c("seq", "div")))
),
checkboxInput("legend", "Show legend", TRUE)
)
)
server <- function(input, output, session) {
filteredData <- reactive({
quakes[quakes$mag >= input$range[1] & quakes$mag <= input$range[2],]
})
colorpal <- reactive({
colorNumeric(input$colors, quakes$mag)
})
map <- createLeafletMap(session, 'map')
observe({
df <- filteredData()
map$addMarkers(
lng=df$Lon, lat=df$Lat, popup = paste(as.character(df$mag)))
})
}
shinyApp(ui, server)
(How) can I add markers correctly while insisting on using the function createLeafletMap()?
map <- createLeafletMap(session, 'map')
try:
library(dplyr)
df <- filteredData()
leafletProxy("map") %>%
addMarkers(df, lng = ~Lon, lat = ~Lat, popup = paste(as.character(df$mag) )
under observe