i have somehow a quite tricky question. Im creating an interactive leaflet map in my shinydashboard. Everything works fine (the error just appears because its waiting for some text input to be processed and then mapped).
But.. I don't get the map to work, when only the first textinput is given some Input. One must insert something in the second, which is not handy and can lead to some weird results. If nothing is insert, the script doesn't get any further and is stuck.
Wrap up. How its possible to make the second textinput obligatory?
Is there a workaround or a possibility to deactivate the second textinput until one inserts a string? Otherwise the script just waits and waits (throws this error because no string is given which can be processed obviously)...
Structure
textinput from shiny dashboard -> parsed into google_places request -> tidy -> returns points (Lon, Lat) -> gets displayed on the leaflet map.
The Dashboard
Even though it must not have to do with the leaflet-map I provide a shrinked code. Its the second addCircleMarkers argument.
The map
map$dat <-leaflet () %>%
addProviderTiles(providers$CartoDB.Positron, group = "Positron Design") %>%
addMarkers(lat= Ort_geocode()$lat, lng= Ort_geocode()$lng, group = "Standort") %>%
addCircleMarkers(data = cowork(), popup = paste(as.character(cowork()$name), "</br>", cowork()$rating),fill =TRUE, fillColor ="#20205F", stroke =FALSE, fillOpacity = 0.8, group = "Erste Nutzung",
labelOptions = labelOptions(noHide = T, textOnly = TRUE, direction = "bottom", style = list("color" = "black", "font-size" = "11px", "font-family" = "AkkuratStd", "font-style" = "Thin"))) %>%
addCircleMarkers(data = Zweite_Nutzung(), popup = paste(as.character(Zweite_Nutzung()$name), "</br>", Zweite_Nutzung()$rating), fill =TRUE, fillColor ="#607758", stroke =FALSE, fillOpacity = 0.8, group = "Zweite Nutzung" ,
labelOptions = labelOptions(noHide = T, textOnly = TRUE, direction = "bottom", style = list("color" = "black", "font-size" = "11px", "font-family" = "AkkuratStd", "font-style" = "Thin"))) %>%
addHeatmap(data = cowork(), lng= cowork()$lng,lat= cowork()$lat, intensity = 20 ,max=40,radius=20,blur=15, gradient = "inferno" , group = "Cluster") %>%
addHeatmap(data = Zweite_Nutzung(), lng= Zweite_Nutzung()$lng,lat= Zweite_Nutzung()$lat, intensity = 20 ,max=40,radius=20,blur=15, gradient = "magma", group = "Cluster 2") %>%
addLayersControl(
baseGroups = c("Kartengrundlage", "Positron Design"),
overlayGroups = c("Standort", "Cluster", "Cluster 2", "Erste Nutzung", "Zweite Nutzung", "Modalität 1", "Modalität 2", "Modalität 1 Nacht", "Modalität 2 Nacht"),
options = layersControlOptions(collapsed = FALSE)) %>%
hideGroup("Cluster") %>%
hideGroup("Cluster 2") %>%
addFullscreenControl(pseudoFullscreen = TRUE)
})
Im more than thankful if somebody could help me.
Great weekend guys!
Sebastian
Related
I am building a Shiny app and am trying to get a resized leaflet legend using leaflegend. My dataset has several different measures in it, some that are raw counts and some percentages. I am trying to code the legend numberFormat so that it displays the appropriate format for each. I currently have the values in dat2$value and the properly formatted label in dat2$lbl. I have tried defining a function to execute this translation for numberFormat but am getting strange results.
#define getLabel
getLabel = function(x){
dat2$lbl[dat2$value == x]
}
#draw map on screen
leafletProxy("map") %>%
clearShapes() %>%
clearControls() %>%
addMapPane("polygons", zIndex = 410) %>%
addMapPane("borders", zIndex = 420) %>%
addPolygons(
data = dat2,
stroke = T,
color = "#343434",
weight = 0.5,
opacity = 1,
fillColor = ~ pal(dat2$value),
fillOpacity = 0.8,
smoothFactor = 0.2,
popup = content,
options = pathOptions(pane = "polygons")
) %>%
addLegendBin(
pal = pal,
values = dat2$value,
numberFormat = function(x) lapply(x, getLabel),
title = input$group,
position = "topleft",
orientation = "vertical"
)
Resulting output:
Any thoughts on what is going wrong here? I feel so close, but can't quite get it to where I need it to be.
I would like users to be able to change the choropleth map overlay by selecting different attributes from a dropdown. The map and different attributes render fine based on user selection, but the popup option of the addPolygons function does not interpret the input values the same as the rest of the app.
For below, assume we are using an object of class 'sf' named densitydata with columns for the polygon geography and the different densities to be mapped (dens1, dens2 and dens3). I want the popup to return the values of the selected density for the clicked feature. E.g. "Selected density: 1.23" but instead get the name of the column: "Selected density: dens1".
If I put the input in a mathematical function like round(), I get an error that I'm providing a non-numeric value to a mathematical function:
popup = ~paste0("<b>Selected density:</b> ", round(input$densities, 2))
Dropdown menu:
dashboardSidebar(
selectInput(inputId = "densities", label = "Select attribute",
choices = c("Density 1" = "dens1",
"Density 2" = "dens2",
"Density 3" = "dens3"), selected = NULL, multiple = F, selectize = TRUE, width = '500px', size = NULL),
Rendering the map in the server function:
output$DensMap <- renderLeaflet({
# Define palette for new selection
DensPal <- colorQuantile(palette = "YlOrRd",
domain = {densitydata %>%
pull(input$densities)},
n = 5)
# Render map
leaflet(data = densitydata) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(fillColor = ~DensPal({densitydata %>% pull(input$densities)}),
fillOpacity = 0.5,
weight = 2,
popup = ~paste0("<b>Selected density:</b> ", input$densities) %>%
addLegend(pal = DensPal,
values = {densitydata %>% pull(input$densities)},
opacity=0.7,
title = "Legend title here",
position = "bottomleft" )
} )
You can not use input$densities directly, you can use it thru densitydata[[input$densities]]:
output$DensMap <- renderLeaflet({
# Define palette for new selection
DensPal <- colorQuantile(palette = "YlOrRd",
domain = densitydata[[input$densities]],
n = 5)
# Render map
leaflet(data = densitydata) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(fillColor = ~DensPal(densitydata[[input$densities]]),
fillOpacity = 0.5,
weight = 2,
popup = ~paste0("<b>Selected density:</b> ",
densitydata[[input$densities]]) %>%
addLegend(pal = DensPal,
values = densitydata[[input$densities]],
opacity=0.7,
title = "Legend title here",
position = "bottomleft" )
} )
I am trying to host a leaflet map on Rpubs.com, but am facing problems trying to size the map size in the knitted Rmd file before publishing. Ideally, I would like for the map to resize based on the browser window dimensions. There are a couple of examples on Rpubs.com that achieve this, such as this one, but I couldn't find any useful solutions to scale my map.
This is the map as it currently stands. Note the white space at the sides and hard-coded length.
The code chunk I used to generate the Leaflet object is as follows
```{r echo = FALSE, fig.height= 10, fig.width = 12, fig.align="left"}
mata_cams <- leaflet() %>%
setView(lat = 1.352754, lng = 103.866692, zoom = 12) %>%
addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga",
attribution =
'Google Maps
(Terms of Service)',
group = "Google Maps") %>%
addProviderTiles(provider = "OneMapSG.Original", group = "OneMapSG") %>%
addProviderTiles(provider = "OneMapSG.Grey", group = "OneMapSG (Grey)") %>%
setMaxBounds(lat1 = 1.157170,
lat2 = 1.476471,
lng1 = 103.588712,
lng2 = 104.1) %>%
addCircleMarkers(~location_longitude,
~location_latitude,
color = "#f07b0e",
radius = 5,
group = "Speed Cameras",
popup = popup_speed,
fillOpacity = 0.5,
stroke = FALSE,
data = all_speed_cams) %>%
addCircleMarkers(data = red_light_cams#data,
lat = ~LATITUDE,
lng = ~LONGITUDE,
color = "red",
group = "Red Light Cameras",
popup = popup_rl,
radius = 5,
fillOpacity = 0.5,
stroke = FALSE) %>%
addKML(kml_road,
markerType = "circleMarker",
fillColor = "blue",
fillOpacity = 0.5,
stroke = FALSE,
markerOptions = leaflet::markerOptions(radius = 5),
group = "Road Cameras") %>%
addLegend(colors = c("#f07b0e", "red", "blue"),
labels = c("Speed Cameras", "Red Light Cameras", "Road Cameras"),
values = NULL,
position = "topright",
title = "Camera Type") %>%
addLayersControl(baseGroups = c("Google Maps", "OneMapSG", "OneMapSG (Grey)"),
overlayGroups = c("Speed Cameras", "Red Light Cameras", "Road Cameras"),
options = layersControlOptions(collapsed = FALSE))
mata_cams
```
All other code chunks in the Rmd use include = FALSE, and the YAML header only includes the line output: html_document.
I have tried
Using out.width = '100%' and out.height = '100%' in the chunk header. This was suggested in several other SO threads, but has no discernible effect on the knitted map's dimensions.
Using the widgetframe package. When running the code in RStudio, this creates the output perfectly as publishable output within RStudio (shows in the viewer window, not after the code chunk). But when published it fails to load on Rpubs.com. It also fails to display when knitted - the error (I think the same in both cases, but at least true for the knitted document) is "/rmd_output/0/mata_cams_output_files/figure-html//widgets/widget_unnamed-chunk-6.html?initialWidth=910&childId=htmlwidget-07c11ed0372ca4ab106d&parentTitle=mata_cams_output.utf8.md&parentUrl=http%3A%2F%2F127.0.0.1%3A25451%2Frmd_output%2F0%2F not found"
The solution I finally settled on was to use fig.height and fig.width to manually set the figure dimensions, but this does not allow for the auto-sizing as desired.
Hope to get help with this.
In order to scale the map to the full size of the browser window (as shown in the example you gave here), you need to publish the map directly from the preview window, and not from an Rmarkdown document.
I am trying to create a high-quality map of a small part of the UK, without any distortions caused by the use of projections, and with the addition of markers consisting of text and symbols. Ultimately the goal is to write out a png or pdf file. An earlier, related question can be found here.
Having not used R in anger for several years, I have been wading through a morass of packages trying to find something suitable. Leaflet for R is promising, but although I can create a decent-looking map, add markers, and vary the colour of markers and so on using columns from a data frame, I have not been able to vary the size, colour, and text offsets used in the labelOptions argument.
The following reproducible example shows what I can achieve, and also where I am not succeeding. I would like the size of text label to vary according to the df.data$textsizes column. Given that the style argument takes a list of value pairs, that would seem difficult, and nothing has worked so far.
If am hoping that somebody can either suggest either a way to bend the wily labelOptions to my will, or a completely different approach to try.
require(leaflet)
require(magrittr)
df.entrynames <- c("Entry 1: Some text","Entry 2: More text")
df.lat <- c(51.509898,51.510736)
df.lon <- c(-0.1345093,-0.135190)
df.colors <-c("Blue","Red")
df.sizes <-c(36,12)
df.data <- data.frame(entrynames=df.entrynames,lat=df.lat,lon=df.lon,colors=df.colors,textsizes=df.sizes)
df.data$entrynames <- as.character(df.data$entrynames)
df.data$colors <- as.character(df.data$colors)
df.data$textsizes <- paste(df.data$textsizes,"px",sep="")
leaflet() %>% setView(lng = -0.134509, lat = 51.509898, zoom = 17) %>% addTiles() %>%
addCircleMarkers(data = df.data,
lat = ~lat, lng = ~lon,
label = df.data$entrynames,
color = df.data$colors,
labelOptions = labelOptions(noHide = TRUE,
style = list(
"color" = "gray30",
"font-family" = "serif",
"font-style" = "italic",
"box-shadow" = "3px 3px rgba(0,0,0,0.25)",
"font-size" = "14px",
"border-color" = "rgba(0,0,0,0.5)"
),
textOnly = FALSE,
offset=c(0,0)))
df.entrynames <- c("Entry 1: Some text","Entry 2: More text")
df.lat <- c(51.509898,51.510736)
df.lon <- c(-0.1345093,-0.135190)
df.colors <-c("Blue","Red")
df.sizes <-c(36,2)
df.data <- data.frame(entrynames=df.entrynames,lat=df.lat,lon=df.lon,colors=df.colors,textsizes=df.sizes)
df.data$entrynames <- as.character(df.data$entrynames)
df.data$colors <- as.character(df.data$colors)
df.data$textsizes <- paste(df.data$textsizes,"px",sep="")
#Add a vector to split the data by
df.data$place<-seq(1:nrow(df.data))
library(purrr)
#split the data
ob_place <- df.data %>%
split(., .$place)
#make a map
m <- leaflet() %>%
addTiles()
#Add layers
names(ob_place) %>%
purrr::walk(function(df.data) {
m<<-m %>% #seems like there's supposed to be two carrots here, i had problems without one
addCircleMarkers(data=ob_place[[df.data]],fillColor=~colors,
fillOpacity = 0.6,
weight=1,
radius=13,
color="white",
opacity = .6,
lng=~lon, lat=~lat,
group = "Show All",
label = ~entrynames,
labelOptions = labelOptions(noHide = T,
#direction = ~MyDirection, #https://rstudio.github.io/leaflet/popups.html
textsize = ~textsizes,
#opacity=~opacity,
style = list(
"color"="black",
"font-family" ="sans-serif",
"box-shadow" = "3px 3px rgba(0,0,0,0.25)",
#"font-size" = "12px",
"border-color" = "rgba(0,0,0,0.5)"
)))
})
m
Similar to setting the direction of labels
I am looking to add a title to the layer control box along the lines of "Available layers".
My search has lead me to only one relevant result:
Exact same question using JS. Unclear how to translate
My code:
map %>% leaflet() %>%
addProviderTiles(provider = "CartoDB") %>%
# Group 1 Polygons
addPolygons(data = map[!is.na(map$var),] ,weight =1,
color = ~g1_pal(g1), fillOpacity = .6,
group = "Group 1",
# add labels
label = ~labels,
# highlight polygons on hover
highlight = highlightOptions(weight = 5, color = "white",
bringToFront = TRUE)) %>%
# Group 2
addPolygons(data = map[!is.na(map$var2),], weight =1,
color = ~g2_pal(g2), fillOpacity = .6,
group = "Group 2",
# add labels that display mean income
label = ~labels2,
# highlight polygons on hover
highlight = highlightOptions(weight = 5, color = "white",
bringToFront = TRUE)) %>%
addLayersControl(baseGroups = c("Group 1", "Group 2"),
options = layersControlOptions(collapsed=F,
# Series of attempts
label = "Layers",
title = "Layers"))
Neither of these attempts worked. It does appear from the link above that there is an attribute that can be accessed but I am unsure of how to reference it.
The best way to do this (that I'm aware of) is to use htmlwidgets::onRender to add your Javascript to the map upon rendering. This is described in the last section at the bottom of the last page in the docs, so it's easy to miss!
Here's an example that implements the Javascript that Saurabh Yadav described in his answer to the question you linked. You simply add the Javascript function to the end of the leaflet() piped call:
library(leaflet)
leaflet() %>%
addTiles() %>%
addLayersControl(
overlayGroups = "MyImaginaryLine",
options = layersControlOptions(collapsed = FALSE)) %>%
htmlwidgets::onRender("
function() {
$('.leaflet-control-layers-overlays').prepend('<label style=\"text-align:center\">My Epic Title</label>');
}
")