I have a requirement where I have some cities' longitude and latitude.
Bangalore - 12.9539974,77.6309395
Chennai - 13.0473748,79.9288083
Delhi - 28.6921165,76.8079346
Mumbai - 19.0821978,72.741098
I have created an input box that has some cities listed down
Image
Based on this input I need to zoom into these cities.
How can I do this?
You can do this with leaflet
library(dplyr)
library(shiny)
library(leaflet)
data_cities = data.frame(
city = c('Bangalore', 'Chennai', 'Delhi', 'Mumbai'),
lat = c(12.9539974, 13.0473748, 28.6921165, 19.0821978),
lng = c(77.6309395, 79.9288083, 76.8079346, 72.741098)
)
ui <- fluidPage(
selectInput("select_city", label = "Select city", choices = data_cities$city),
leafletOutput("map")
)
server <- function(input, output) {
# Initiate the map
output$map <- renderLeaflet({
leaflet() %>%
addTiles(options = providerTileOptions(noWrap = TRUE))
})
#Zoom when select city
observeEvent(input$select_city, {
selected_city_data <- data_cities %>%
filter(city == input$select_city)
leafletProxy("map") %>%
setView(lng = selected_city_data$lng, lat = selected_city_data$lat, zoom=8)
})
}
shinyApp(ui = ui, server = server)
Well, you can use a simple API for pinning out the location on selection.
There are several API's available on net.
The one I would suggest is to use a free API's like - IPAPI.
All you need to do is to go through the documentation on their official website, in-order to get a close picture of how the API works.
In that case, you can use a package 'ggmap' and its function named qmap() within it.
or you can also check for package named 'maps'. Install this package and use map.cities() function.
There's one more lib for the same, its called rMaps. This package is available on github.
I think there are a lot of ways to implement this, maybe it should work somehow. In any case, it is necessary to read the documentation.
HTML: <div id="buttons"></div>
JS:
var Balganore = L.map('Bangalore').setView([12.9539974,77.6309395], 8);
Jquery:
$('#buttons').append(
$('<div>').text('City choose:'),
$('<label>').append(
$('<input>').prop({'type':'checkbox', 'checked':true}).click(function(){
$(Bangalore).toggle();
}),
'Bangalore'
),)
Related
I'm a bit new to R Shiny, and I'm trying to make a simple, dynamic web map in which common users can find where to recycle a variety of materials in Eastern Kentucky. In my sidebar panel in the UI, I made a checkboxGroup, so the user can filter through the recycling centers that allows for the recycling of the materials of their choosing (in this case, which centers recycle glass AND/OR aluminum AND/OR plastics). The checkbox shows up when you run the app, but I get a blank dashboard where the map should be. There's something wrong on the Server side of the app, when I try to make a proxy map in the observeEvent() function, but I'm stumped at what I'm doing wrong.
Here's a link to my data, named RE.csv:
https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/csv/RE.csv
Here's the full, original Shiny app code:
https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/app.R
Here's the data, read in R:
RE <- read.csv("C:/Users/username/Desktop/GIS/Shiny Leaflet Map/csv/RE.csv")
RE$y <- as.numeric(RE$y)
RE$x <- as.numeric(RE$x)
RE.SP <- SpatialPointsDataFrame(RE[,c(7,8)], RE[,-c(7,8)])
RE$popup <- paste("<p><h2>", RE$name,"</p></h2>",
"<p>", RE$sector,"</p>",
"<p>", RE$address,"</p>",
"<p>", RE$phone,"</p>")
Here's the UI (dashboardSidebar is where the checkboxGroup input() is located):
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(checkboxGroupInput(inputId = "RE_check",
label = h3("Recycleables"),
choices = list("Glass" = RE$GL, "Aluminum" = RE$AL, "Plastic" = RE$PL),
selected = 0)
),
dashboardBody(
fluidRow(box(width = 12, leafletOutput(outputId = "map"))),
leafletOutput("map")
)
)
And here's the server:
server <- function(session, input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addMarkers(data = RE,
lng = ~x, lat = ~y,
label = l apply(RE$popup, HTML),
group = "recycle") %>%
})
And this is the section I'm having trouble with in the server.r side. I'm unsure what I'm doing wrong, but I know it's something wrong with my observeEvent(). What I'm trying to accomplish is an observe event in which if the user checks glass in the checkbox group, then every recycling center that has the value "yes" for recycling glass will pop up. Just having a brain fart for how to go about getting this result.
observeEvent({
RE_click <- input$map_marker_click
if (is.null(RE_click))
return()
if(input$RE_check == "Glass"){
leafletProxy("map") %>%
clearMarkers() %>%
addMarkers(data = RE_click,
lat = RE$y,
lng = RE$x,
popup = RE$popup)
}
})
}
shinyApp(ui = ui, server = server)
I'm sure the answer to my dilemma is a lot simpler than I'm making it out to be, but I'd appreciate any/all help.
Stay safe out there! Thanks
I would like to add local tiles for leaflet to render them offline in a shiny application.
Although there are solutions to this on SO for example here and here , I am still ending up with grey map with no tiles. It would really help me to see some reproducible example.
Thanks.
My example code:
library(shiny)
library(dplyr)
library(RgoogleMaps)
#downloads tiles for a given regions, saves it to C:/Users/.../mapTiles/OSM
for (zoom in 0:16)
GetMapTiles(center = c(lat = 52.431635, lon = 13.194773),
zoom = zoom,
nTiles = round(c(20,20)/(17-zoom)))
#shiny ui
ui = fluidPage(leafletOutput("map"))
#create basic map, load tiles from directory and set view to centre of downloaded tiles
server = function(input, output, server){
addResourcePath(prefix = "OSM", "C:/Users/.../mapTiles")
output$map = renderLeaflet({
leaflet() %>%
addTiles( urlTemplate = "/OSM/{z}_{x}_{y}.png") %>%
setView(52.431635, 13.194773 , zoom = 10) %>% #set to the location with tiles
addMarkers(52.431635, 13.194773 )
}
)
}
shinyApp(ui, server)
In my case, I create my own tiles via gdal2tiles, which takes your data and automatically creates a {z}/{x}/{y}.png folder structure. Please see this link for a nice tutorial and what i mean about the file structure;
+---14
| +---8185
| +---5460.png
| +---5461.png
| +---etc.png
| \---8186
# I use the following server (see how my addTiles has a folder structure)
server <- function(input, output,session) {
addResourcePath("mytiles", "C:/.../tiles")
output$tilemap <- renderLeaflet({
leaflet() %>%
setView(lng = -4.4, lat = 52, zoom = 12) %>%
addTiles(urlTemplate = "mytiles/{z}/{x}/{y}.png")
})
}
Now, as you are downloading tiles from Google Maps to your hard drive, you'll want a slightly different approach as the files are downloaded in a {z}_{x}_{y}.png format, and not produced into a file structure like gdal creates;
+---11_1098_671.png
etc.
so you need to adjust your addTiles code to reflect this, using underscores, like the Google filenames;
server <- function(input, output,session) {
addResourcePath("mytiles", "C:/.../OSM")
output$tilemap <- renderLeaflet({
leaflet() %>%
setView(lng = 13.194773, lat = 52.431635, zoom = 11) %>%
addTiles(urlTemplate = "mytiles/{z}_{x}_{y}.png")
})
}
Lastly, my setView arguments are in a different order to yours but i'm not sure whether that makes a difference or not.
i tried this solution but it could not work,the topic is old but it really helped me to achieve what i wanted to do, i found another solution for those of you in the same case by creating two ports :
just define two differents ports for your shiny server( 3838) and for the server hosting the tiles (8000)
servr::httd(dir="C:/TestApp/data_hydrepat/tiles_hydrepat/mapTiles/mytiles",daemon=TRUE,port=8000)
options(shiny.port = 3838)
to close the server hosting the tiles, just put a reactive on an input or something.. and close
(servr::daemon_stop(which = daemon_list())
hope it'll help !
I'm using the leaftlet.extras R package to add Gps control inside a map.
I'm using the extension addControlGPS inside my code :
... %>%
addControlGPS(options = gpsOptions(position = "topleft", activate = TRUE,
autoCenter = TRUE, maxZoom = 60,
setView = TRUE)) %>%
...
The controller works ok.
I need to extract the Gps coordinates to re-use in my code as arguments for other functions. Is there any way to do that ?
Every time the gps location updates, the coordinates are written to map.id+'_gps_located'. You can find all leaflet.extras bindings in the htmlwidgets/bindings folder in their git.
Working example
library(leaflet)
library(leaflet.extras)
library(shiny)
ui <- fluidPage(
leafletOutput('map')
)
server <- function(input, output, session) {
output$map <- renderLeaflet({ leaflet()%>%addTiles() %>%
addControlGPS(options = gpsOptions(position = "topleft", activate = TRUE,
autoCenter = TRUE, maxZoom = 60,
setView = TRUE))})
observe(
print(input$map_gps_located)
)
}
shinyApp(ui, server)
I've recently had a similar problem with an app I was working on.
You can extract the gps coordinates from a leaflet map by using the _marker_click feature, where is the map label you specify as an output for the leaflet rendering statement.
In my case here's the chunk of code I used to retrieve the coords. In my case the output name of the map object was parksMap therefore the full input to consider in the event observation was parksMap_marker_click. This statement can be saved in a variable (in my case pin), that stores the coordinates data. Finally you need to wrap it all in a reactive expression to be able to save every coordinate when clicking on a point in the leaflet map.
# code to load the park card once the click event on a marker is intercepted
observeEvent(input$parksMap_marker_click, {
pin <- input$parksMap_marker_click
#print(Sys.time()) #uncomment to log coords
#print(pin) #uncomment to log coords
selectedPoint <- reactive(parks[parks$Latitude == pin$lat & parks$Longitude == pin$lng,])
leafletProxy("parksMap", data = selectedPoint()) %>% clearPopups() %>%
addPopups(~Longitude,
~Latitude,
popup = ~park_card(selectedPoint()$ParkName, selectedPoint()$ParkCode, selectedPoint()$State, selectedPoint()$Acres, selectedPoint()$Latitude, selectedPoint()$Longitude)
)
})
The full github repo of the app is available here.
I have a simple shiny-app with just a dropdown listing districts of Afghanistan and a leaflet map of the same.
The shape file can be accessed at this link - using AFG_adm2.shp from http://www.gadm.org/download
here's the app code:
library(shiny)
library(leaflet)
library(rgdal)
library(sp)
afg <- readOGR(dsn = "data", layer ="AFG_adm2", verbose = FALSE, stringsAsFactors = FALSE)
ui <- fluidPage(
titlePanel("Test App"),
selectInput("yours", choices = c("",afg$NAME_2), label = "Select Country:"),
leafletOutput("mymap")
)
server <- function(input, output){
output$mymap <- renderLeaflet({
leaflet(afg) %>% addTiles() %>%
addPolylines(stroke=TRUE, color = "#00000", weight = 1)
})
proxy <- leafletProxy("mymap")
observe({
if(input$yours!=""){
#get the selected polygon and extract the label point
selected_polygon <- subset(afg,afg$NAME_2==input$yours)
polygon_labelPt <- selected_polygon#polygons[[1]]#labpt
#remove any previously highlighted polygon
proxy %>% removeShape("highlighted_polygon")
#center the view on the polygon
proxy %>% setView(lng=polygon_labelPt[1],lat=polygon_labelPt[2],zoom=7)
#add a slightly thicker red polygon on top of the selected one
proxy %>% addPolylines(stroke=TRUE, weight = 2,color="red",data=selected_polygon,layerId="highlighted_polygon")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
I want a infoBox or valueBox like widget from shinyDashboard to display some data(like district population) below the map based on user selection. How can I do this?
You can mimic the shinydashboard::infoBox with your own function:
create function
myInfoBox <- function(title, value)
{
div(
div(class='myinfobox-title', title),
div(class='myinfobox-value', value)
)
}
use uiOutput() whenever you want to place it e.g. uiOutput('idOfInfoBox')
in server part use e.g. output$idOfInfoBox <- renderUI(myInfoBox(title, value)
add .css file in www/ directory and add some properties for classes myinfobox-title and myinfobox-value
I hope this helps.
You need to change the structure of the program and need to add dashboard page in UI.
Here are some reference just have a look. you will get to know!!!
https://rstudio.github.io/shinydashboard/structure.html
https://rdrr.io/cran/shinydashboard/man/valueBox.html
I have a Shiny App that inserts a circle on a map based on the lat lng associated with the zip code input. The map renders when I load it; however, when I attempt to change the value of the zip code via a selectInput object, the map renders a blank window - i.e. the selectedZip variable.
Any help addressing this issue will be appreciated:
library(shiny)
library(leaflet)
# Data
data <- read.csv('VENDOR_PERFORMANCE_EX.csv')
ui <- fluidPage(
titlePanel("VPD"),
sidebarLayout(
sidebarPanel("Inputs"),
mainPanel("Results")),
selectInput("zipInput", "Select Zip Code", data$Zip),
selectInput("vendorInput", "Select Vendor", as.character(data$Vendor)),
leafletOutput("CLEmap", width = "75%", height = 600)
)
server <- function(input, output, session) {
selectedZip <- reactive({
data[data$Zip == input$zipInput, ]
})
output$CLEmap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-81.730844, 41.430102, zoom = 11) %>%
addCircles(data = selectedZip(), lng = ~ Y, lat = ~ X, radius = 1069)
})
}
shinyApp(ui=ui, server = server)
This works, although there is something very strange going on. And although I can't be sure it fixes the same problem you have because I don't have your data, it seems likely.
Once I added data and got something that sounded like your error I hunted around a bit. The only change I made in the end is adding a unique statement to your zipInput instance of selectInput, I was clued by the fact that that selectInput was not initializing correctly, although it was actually working other than the initial value being blank.
I think that the selectInput control was not correctly able to deal with duplicate entries in the choices vector, and was causing the shiny control to behave strange in some way, and thereby corrupting ... something. Not really sure what.
Weird. And not sure of what was really going on. Anyway this works. And if you take out the unique it does not work and gets an error like you describe.
The code:
library(shiny)
library(leaflet)
# Data
#data <- read.csv('VENDOR_PERFORMANCE_EX.csv')
data <- data.frame(Zip=c("44102","44102","44109"),
Vendor=c("Vendor1","Vendor2","vendor3"),
X=c(41.475,41.477,41.467),Y=c(-81.742,-81.748,-81.697))
ui <- fluidPage(
titlePanel("VPD"),
sidebarLayout(
sidebarPanel("Inputs"),
mainPanel("Results")),
selectInput("vendorInput", "Select Vendor", as.character(data$Vendor)),
selectInput("zipInput", "Select Zip Code", unique(as.character(data$Zip)) ),
leafletOutput("CLEmap", width = "75%", height = 600)
)
server <- function(input, output, session) {
selectedZips <- reactive({
data[data$Zip == input$zipInput, ]
})
output$CLEmap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-81.730844, 41.430102, zoom = 11) %>%
addCircles(data=selectedZips(),lng = ~Y, lat = ~X,radius = 300 )
})
}
shinyApp(ui=ui, server = server)
The output: