I'm building a shinydashboard with a leaflet map display and am having difficulty showing popup text based on a user input. Here is the code so far (the "output$bar" part can be ignored as I haven't started working on that yet):
## app.R ##
library(shinydashboard)
library(shiny)
library(leaflet)
library(ggplot2)
refs <- read.csv('./BSAProjects/HurricaneModel/Data/monthlyrefinerymeanprod.csv', stringsAsFactors = FALSE)
hurs <- read.csv('./BSAProjects/HurricaneModel/Data/hurrdates.csv', stringsAsFactors = FALSE)
huricon <- makeIcon('http://www.youngsvillepolice.com/wp-content/uploads/2015/11/action-icon-HURRICANE.png',
iconWidth = 70,
iconHeight = 70)
ui <- dashboardPage(
dashboardHeader(title = 'Hurricane Model'),
dashboardSidebar(disable = TRUE),
dashboardBody(
fluidRow(
box(leafletOutput('leaflet'),
width = '100%')),
fluidRow(
box(selectInput('menu','Hurricane', choices = hurs$hurricane)),
box(plotOutput('bar', 'Production Levels'))
)
)
)
server <- function(input, output) {
colors <- colorFactor(rainbow(length(refs$SPRRegion)), refs$SPRRegion)
output$leaflet <- renderLeaflet({
map <- leaflet() %>%
addTiles(urlTemplate = 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/{z}/{y}/{x}') %>%
addCircleMarkers(~Longitude,
~Latitude,
popup = paste('<b>EIAID:</b>', refs$EIAID, '<br>',
'<b>SPR Refinery Group:</b>', refs$Refinery.Group, '<br>',
'<b>Refinery:</b>', refs$SprRespondentName, '<br>',
'<b>Capacity:</b>', refs$Capacity, 'MBbl/day'),
clusterOptions = markerClusterOptions(),
color = ~colors(SPRRegion),
data = refs) %>%
addMarkers(~longitude,
~latitude,
icon = huricon,
popup = paste('<b>Hurricane:</b>', hurs$hurricane,'<br>',
'<b>Date:</b>', hurs$date,'<br>',
'<b>HSI:</b>', hurs$hsi),
data = hurs[hurs$hurricane == input$menu,])
})
output$bar <- renderPlot({
bar <- ggplot(hurs, aes())
})
}
shinyApp(ui, server)
What I'm attempting to do is to allow the user to select a hurricane by the drop down menu created with "selectInput" in the UI object. That will then add a marker to the leaflet map with a popup containing the information I have in "addMarkers(popup =...)"
I can successfully get the functionality to place the marker on the leaflet map based on the drop down menu selection, but the popup text is always for the same hurricane that appears in the last row of the "hurs" data file. If I remove the line:
data = hurs[hurs$hurricane == input$menu,]
and have all the hurricanes plotted instead
data = hurs
then I have no problems. I don't have any problems with the labels updating in my "addCircleMarkers" object either so I suspect this has something to do with how the data set is being filtered based on the drop down menu.
Any ideas?
Figured this out after seeing a similar post here (How to subset a dataframe and plot with leaflet depending on inputselect in shiny).
It seems the issue is that the subsetted data needs to be produced outside of the call to "addMarkers." I was trying to subset within and was receiving this issue, but merely pulling it out and placing it immediately following the call to "renderLeaflet" worked:
server <- function(input, output) {
colors <- colorFactor(rainbow(length(refs$SPRRegion)), refs$SPRRegion)
output$leaflet <- renderLeaflet({
hur.subset <- subset(hurs, hurs$hurricane == input$menu) ##PLACED IT HERE
map <- leaflet() %>%
addTiles(urlTemplate = 'http://server.arcgisonline.com/ArcGIS/rest/services/World_Street_Map/MapServer/tile/{z}/{y}/{x}') %>%
addCircleMarkers(~Longitude,
~Latitude,
popup = paste('<b>EIAID:</b>', refs$EIAID, '<br>',
'<b>SPR Refinery Group:</b>', refs$Refinery.Group, '<br>',
'<b>Refinery:</b>', refs$SprRespondentName, '<br>',
'<b>Capacity:</b>', refs$Capacity, 'MBbl/day'),
clusterOptions = markerClusterOptions(),
color = ~colors(SPRRegion),
data = refs) %>%
addMarkers(~longitude,
~latitude,
icon = huricon,
popup = paste('<b>Hurricane:</b>', hur.subset$hurricane,'<br>',
'<b>Date:</b>', hur.subset$date,'<br>',
'<b>HSI:</b>', hur.subset$hsi),
data = hur.subset)
})
}
Related
I am trying to plot the word cloud of sub-categories of that state in popup window when user clicks on that state in map.
ui <- bootstrapPage(
leafletOutput("mymap", height = 300)
)
server <- function(input, output, session){
output$mymap <- renderLeaflet({
leaflet(Sales) %>%
addTiles() %>%
addCircles(lng = ~longitude, lat = ~latitude,
popup= popupGraph(p),
weight = 3,
radius = ~Sales,
color=~cof(newdata$Category), stroke = TRUE, fillOpacity = 0.8)) )
})
shinyApp(ui = ui, server = server)
Here is my leaflet code, I have used it in r shiny. Can anyone please suggest how i render wordcloud on popup when user clicks on a state on map? I don't know how write that function 'p' for word-cloud in popupGraph(p) but i want to pass it as an argument like this, where p is word-cloud
I create a map app using shiny and leaflet.
It projects a map and some shape files.
The shape file has area values.
I want to set whether to display the shape file or not based on the area value.
Specifically, the sliderInput function is used.
Although the display of the shape file is restricted using the sliderInput function,
The setview is reset every time the number is changed by sliderInput.
Instead of running setview every time, I want you to run setview where you are.
What should I do? I want you to tell me.
Below is the sample code
library(shiny)
library(leaflet)
ui <- shinyUI(fluidPage(
titlePanel("sample sample sample sample "),
#sidebarLayout settings
sidebarLayout(
sidebarPanel(
sliderInput("area_slider",label = h3("settings"),min = 0,max = 6000,value = c(0,6000)),
),
#mainpanel settings
mainPanel(
leafletOutput("mymap",height=600)
)
)
))
server <- shinyServer(function(input, output) {
#map settings
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles(group="OSM")%>%
#setView
#setView(lng=139.8,lat=35.7,zoom=12)%>%
#maker settings1
addAwesomeMarkers(lng = df$lng,
lat = df$lat,
clusterOptions = markerClusterOptions(),
group="Oct")%>%
addPolygons(data = shp %>% subset(shp#data$area < input$area_slider),
color = "#2feeb5",
group="carea")%>%
#Layers Control
addLayersControl(
baseGroups = c("OSM"),
overlayGroups = c("Oct","carea"),
options = layersControlOptions(collapsed = FALSE))
})
})
shinyApp(ui, server)
I want to build an interactive map allowing me to look at closely at facilities in particular districts using Shiny/Leaflet in R
The district is a user input (drop-down box), and facilities are shown if they user checks a box. All these work fine.
I want Leaflet/Shiny to draw polygons associated with the facility when I click on the marker representing that facility. But it seems like R isn't even registering my input$map_marker_click in my observe function.
so my ui.r code:
shinyUI(fluidPage(
titlePanel(""),
sidebarLayout(position = "right",
sidebarPanel( selectInput("districtinput", "Select a district:",
list("Alfred Nzo")),
checkboxInput("addClinics", "Show Clinics", FALSE),
verbatimTextOutput("clickid",placeholder = TRUE)),
mainPanel(leafletOutput("mymap"))
)
)
)
and my server.r code:
shinyServer(
function(input,output,session){
DMap<-reactive({
data <- PlotAN
if (input$districtinput=="Alfred Nzo"){data <- subset(PlotAN,"Alfred Nzo" %in% input$districtinput)}
return(data)
})
observe({
if (input$addClinics){
data<-clinics[clinics$district %in% input$districtinput]
leafletProxy("mymap") %>% addMarkers(lat=data$lat, lng=data$lon, popup = data$clinic)
}
if (!input$addClinics){
leafletProxy("mymap") %>% clearMarkers()
}
})
observe({
click<-input$map_marker_click
print(click)
if(!is.null(click$id)){
text<-paste(click$id,": ",click$lat,";",click$lng)
leafletProxy("mymap") %>% clearPopups() %>% showPopup(lat=click$lat,lng=click$lng,popup=text)
output$clickid<-renderText({text})
}
})
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolylines(data=DMap(),color = "black", weight = 1, smoothFactor = 0.5,
opacity = 1.0,
highlightOptions = highlightOptions(color = "white", weight = 2,
bringToFront = TRUE))
})
}
)
For now I haven't even yet linked it to the polygon data I want to show because I wanted to see what input$map_marker_click returns before deciding how I can use it to link back to my polygon data. But input$map_marker_click doesn't even register.
You just need to use input$mymap_marker_click. The first part is the mapId rather than just 'map', as you could have multiple maps in one app.
This pattern is true for accessing events on other widgets too, like datatables created with the DT package.
I'm creating a shiny leaflet map to record where I have been. I have a dataset contains coordinates and time. In my shiny app I've got 2 widgets-- a sliderbard for time line, a dropdown box to show the current countries that I have been. The country choices in the dropdown box is based on the time line sliderbar. Say for example: before 2016 all coordinates on the map are in country A then in the dropdown box there will be only one option in the dropdown box (country A). After 2016-01-01, the number of countries that I have been increased to 2 then in the dropdown box there will be 2 options (country A and country B) and currently this function works well.
Now I want to further develop my shiny app, the function I want is when I have multiple countries in the dropdown box, the app should allow me to choose one of the countries and when the country is chosen, the leaflet map will focus on the country I choose. I think using if else in setview() should solve the problem.
Then I created a (partially) workable shiny script below:
global.R
df <-read.csv("https://dl.dropbox.com/s/5w09dayyeav7hzy/Coordinatestest.csv",
header = T,
stringsAsFactors = F)
df$Time <- as.Date(df$Time, "%m/%d/%Y")
countriesSP <- getMap(resolution='low')
and
ui.R
library(devtools)
library(leaflet)
library(htmlwidgets)
library(shiny)
library(shinydashboard)
library(sp)
library(rworldmap)
library(RCurl)
header <- dashboardHeader(
title = 'Shiny Memery'
)
body <- dashboardBody(
fluidRow(
tabBox(
tabPanel("My Map", leafletOutput("mymap",height = 550)),
width = 700
))
)
dashboardPage(
header,
dashboardSidebar(
sliderInput('Timeline Value','Time line',min = min(df$Time),max = max(df$Time), value = min(df$Time)),
selectInput("select_country", label = "Select Country",
choices = NULL,
selected = NULL)
),
body
)
and
server.R
shinyServer(function(input, output, session) {
output$mymap <- renderLeaflet({
df <- subset(df, df$Time <= input$`Timeline Value`)
observe({
pointsSP <- SpatialPoints(df[,c("lon", "lat")], proj4string=CRS(proj4string(countriesSP)))
indices <- over(pointsSP, countriesSP)
part_choices <- as.list(c("All", na.omit(unique(as.character(indices$ADMIN)))))
updateSelectInput(session, "select_country", choices=part_choices)
})
lng <- ifelse(input$select_country == "All", mean(df$lon), 0)
lat <- ifelse(input$select_country == "All", mean(df$lat), 0)
m <- leaflet(df) %>%
addTiles(
#urlTemplate = "http://otile4.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.png"
) %>% # Add default OpenStreetMap map tiles
#setView(mean(df$lon), mean(df$lat), zoom = 5) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
Please copy and paste the script into Rstudio and run it. You will see as you drag the time line till the end, the country option will increase but default is always All. Ideally when I select one country and as you see based on some simple logic as long as the selection is not All, the coordinates in setview() function should be (0,0) (this can be dynamic later, currently I just want setview() to change the focus of the map). This function is not really working currently, i.e. when I select other country, the focus of the map will change to (0,0) but again change back to the default focus (mean(df$lon), mean(df$lat)) immediately and the selection will change back to All as well.
So any idea on how to alter my code to make this work?
Hope you are clear about my situation in this example.
Much appreciate for the help
I have changed the server.R part how I think this should be done. Let me know if this helps.
server.R
shinyServer(function(input, output, session) {
dfs <- reactive({
tmp <- subset(df, df$Time <= input$`Timeline Value`)
tmp
})
part_choices <- reactive({
tmp <- dfs()
pointsSP <- SpatialPoints(tmp[,c("lon", "lat")], proj4string=CRS(proj4string(countriesSP)))
indices <- over(pointsSP, countriesSP)
as.list(c("All", na.omit(unique(as.character(indices$ADMIN)))))
})
observe({
updateSelectInput(session, "select_country", choices=part_choices())
})
output$mymap <- renderLeaflet({
lng <- ifelse(input$select_country == "All", mean(df$lon), 0)
lat <- ifelse(input$select_country == "All", mean(df$lat), 0)
m <- leaflet(dfs()) %>%
addTiles(
#urlTemplate = "http://otile4.mqcdn.com/tiles/1.0.0/sat/{z}/{x}/{y}.png"
) %>% # Add default OpenStreetMap map tiles
#setView(mean(dfs()$lon), mean(dfs()$lat), zoom = 5) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
I'm wondering how I can change Shiny and Leaflet to plot points according to the change in input without redrawing the whole map.
The code i'm using is:
library(leaflet)
library(shiny)
library(dplyr)
library(readr)
ui <- fluidPage(
titlePanel("Melbourne Urban Tree Visualisation"),
leafletOutput("treedat"),
uiOutput("precinct")
#Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
#td <- read.csv("treedata.csv", header = TRUE)
#pal <- colorNumeric(
#palette = "RdYlGn",
#domain = td$LifeExpectencyValue
#)
output$precinct <- renderUI({
choices <- as.character(unique(td$Precinct))
choices <- c('All', choices)
selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")
})
output$treedat <- renderLeaflet({
#if(is.null(td)) return()
## get the choice from teh drop-down box
PRECINCT = input$precinct
## supbset the data based on the choice
if(PRECINCT != 'All'){
td2 <- td[td$Precinct == PRECINCT, ]
}else{
td2 <- td
}
## plot the subsetted ata
td2 <- leafletProxy(td2) %>% addTiles(
urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
attribution='Map tiles by Stamen Design, CC BY 3.0 — Map data © OpenStreetMap') %>%
addCircleMarkers(radius= 5,
fillOpacity = 0.5,
stroke = FALSE,
color=~pal(LifeExpectencyValue),
popup=paste("<b>", td$CommonName,"</b>", "<br>",
"<b>","Years Left:", "</b>", td$LifeExpectency, "<br>",
"<b>","Genus:","</b>", td$Genus)) %>% addLegend(pal = pal,
values = ~LifeExpectencyValue,
opacity = 1,
title = "Life Expectency")
return(td2)
})
}
shinyApp(ui = ui, server = server)
The dataset used for the code is available at this link - Melbourne Urban Forest Data
There are a lot of points so I wouldn't want to re-draw each time the input is changed. The input is based on the "Precinct" column in the dataset. Any help here is deeply appreciated.
Okay, there you go: leafletProxy is used to add layers to an existing leaflet map. The usage ist just like normal leaflet additions, but you don't need the rendering part, since the map is already rendered in your document.
The first and easiest part is to render the leaflet map on a basic level, that is tiles, legend, static drawings, everything that you want to do just once. This is your starting point. From there on, altering the map is only done by direct commands instead of re-renderings.
This map can now be accessed via its shiny output id. In out case, we had leafletOutput("treedat"), so if we want to address this map, we use leafletProxy("treedat"). We use the same syntax as in regular leaflet modifications. E.g. leafletProxy("treedat") %>% addMarkers(lat = 1, lng = 1) adds a marker to the existing map without re-rendering it.
Thus, every modification to the map can / has to happen from inside some observe statement and not from inside the renderLeaflet. Note that every command is an addition to the original map, which is why I had to use clearMarkers in the example below.
Code:
library(leaflet)
library(shiny)
library(dplyr)
library(readr)
ui <- fluidPage(
titlePanel("Melbourne Urban Tree Visualisation"),
leafletOutput("treedat"),
uiOutput("precinct")
#Giving an input name and listing out types to choose in the Shiny app
)
server <- function(input, output){
td <- data.frame(
LifeExpectencyValue = sample(20:100, 10),
Precinct = c(rep("CBD", 3), rep("ABC", 4), rep("XYZ", 3)),
CommonName = sapply(1:10, function(x){paste(sample(LETTERS, 10, replace = TRUE), collapse = "")}),
Genus = rep(c("m","f"), each = 5),
lat = seq(5, 50, 5),
lng = seq(2, 65, 7)
)
pal <- colorNumeric(palette = "RdYlGn", domain = td$LifeExpectencyValue)
output$precinct <- renderUI({
choices <- as.character(unique(td$Precinct))
choices <- c('All', choices)
selectInput(inputId = "precinct", label = "Precinct", choices = choices, selected = "CBD")
})
output$treedat <- renderLeaflet({
leaflet() %>%
addTiles(
urlTemplate = 'http://{s}.basemaps.cartocdn.com/dark_all/{z}/{x}/{y}.png',
attribution='Map tiles by Stamen Design, CC BY 3.0 — Map data © OpenStreetMap'
) %>%
addLegend(pal = pal, values = td$LifeExpectencyValue, opacity = 1, title = "Life Expectency")
})
observeEvent(input$precinct, {
#if(is.null(td)) return()
## get the choice from teh drop-down box
PRECINCT = input$precinct
## supbset the data based on the choice
if(PRECINCT != 'All'){
td2 <- td[td$Precinct == PRECINCT, ]
}else{
td2 <- td
}
## plot the subsetted ata
leafletProxy("treedat") %>%
clearMarkers() %>%
addCircleMarkers(lat = td2$lat, lng = td2$lng,
radius= 5, fillOpacity = 0.5, stroke = FALSE, color=pal(td2$LifeExpectencyValue),
popup = paste("<b>", td2$CommonName,"</b>", "<br>",
"<b>","Years Left:", "</b>", td2$LifeExpectency, "<br>",
"<b>","Genus:","</b>", td2$Genus))
})
}
shinyApp(ui = ui, server = server)