R Shiny clusterOptions not displayed on a tabPanel - conflict with rCharts? - r

I am sort of struggling to display clusters of positions on a tabPanel map, when on another tabPanel, a heatmap is active.
The weird thing is that when I remove the second tabPanel (heatmap) in the ui.R, then the clusters are shown ok on the first tabPanel.
If I keep the heatmap tabPanel in the ui.R and remove "clusterOptions = markerClusterOptions()" in the server.R then the positions are displayed on the first tabPanel and heat map is OK.
Here is my code so you can easily reproduce the problem :
global.R
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
library(rCharts)
Lat <- c(48.89612,48.87366,48.88739,48.88558,48.87561)
Long <- c(2.383857,2.383921,2.387161,2.386701,2.387337)
data_test <- data.frame(Lat,Long)
data_test <- ddply(data_test, .(Lat, Long), summarise, count = length(Lat))
server.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
shinyServer(function (input, output){
output$map1 <- renderLeaflet({
leaflet() %>% setView(lng = 2.3488000, lat = 48.8534100, zoom = 12) %>%
addProviderTiles('CartoDB.Positron') %>%
addTiles() %>%
addCircleMarkers(lng = data_test$Long, lat = data_test$Lat,color=
'red',
clusterOptions = markerClusterOptions())
})
output$baseMap <- renderMap({
map2 = Leaflet$new()
map2$setView(c(48.85341,2.34880,13))
map2$addParams(height = 590, width = 880, zoom = 12)
map2$set(dcom = "baseMap")
return(map2)
})
output$heatMap <- renderUI({
j <- paste0("[",data_test[,"Lat"], ",", data_test[,"Long"],
",",data_test[,"count"], "]", collapse=",")
j <- paste0("[",j,"]")
tags$body(tags$script(HTML(sprintf("
var addressPoints = %s
if (typeof heat === typeof undefined) {
heat = L.heatLayer(addressPoints, {radius:
50,blur: 20,maxZoom: 5,max: 6.0,
gradient: {0.0: 'green',0.5: 'yellow',1.0:
'red' }}),
heat.addTo(map)}
else {heat.setLatLngs(addressPoints)}", j
))))
})
})
ui.R
library(rCharts)
library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)
library(plyr)
header <- dashboardHeader(
title = "Test Paris", titleWidth = 450
)
body <- dashboardBody(
fluidRow(
column(width = 12,
tabBox(width = 12,
id = "CartePrincipale",
tabPanel("Map of Accidents",leafletOutput("map1", height="590px")),
tabPanel("HeatMap of Accidents",
showOutput("baseMap", "Leaflet"),
tags$style(' .leaflet {height: "590px";}'),
tags$head(tags$script(src="http://leaflet.github.io/Leaflet.heat/dist/leaflet-heat.js")),
uiOutput("heatMap"))
)))
)
dashboardPage(
header,
dashboardSidebar(disable = TRUE),
body)
Is there a conflict somewhere with rCharts?
Many thanks for your assistance !

Well, I finally came across the answer, thanks to a few posts and replies from Ramnath to other people issues in the website.
In the ui.r, for the second tabPanel, the trick was just to replace
showOutput("baseMap", "Leaflet")
by :
htmlOutput("baseMap")
Clusters are now displayed Ok on the first tabPanel !

Related

Publishing a shiny/leaflet map made in R to a website

I'm helping a friend doing some research on the number of breweries in CT. With help from this community I was able to make a map of breweries in leaflet and was able to add a slider using shiny. Now I want to be able to give my friend the map so he can add it to the website where he is publishing his research. I'm new to some of this and was wondering if anybody had some ideas for me. Here is the code (thanks to Ben) I used to make the map:
library(shiny)
library(leaflet)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(bottom = 30, right = 10,
textOutput("Counter"),
sliderInput("Year", "Year", 1990, 2000, value = 1995, step = 1, sep = "")
)
)
server <- function(input, output, session) {
sliderData <- reactive({
breweries_subset %>%
filter(YearOpened <= input$Year)
})
output$Counter <- renderText(
paste("Number Breweries: ", nrow(sliderData()))
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(min(breweries_subset$Longitude), min(breweries_subset$Latitude),
max(breweries_subset$Longitude), max(breweries_subset$Latitude))
})
observe({
leafletProxy("map", data = sliderData()) %>%
clearMarkers() %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = 'Breweries',
popup = ~ Name)
})
}
shinyApp(ui = ui, server = server)
UPDATE
I took your suggestions and tried publishing to shinyapps.io. Here's the code I used:
For ui.R:
library(shiny)
library(leaflet)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(bottom = 30, right = 10,
textOutput("Counter"),
sliderInput("Year", "Year", 1990, 2019, value = 1995, step = 1, sep = "")
)
)
And for server.R:
library(shiny)
library(leaflet)
library(leaflet.extras)
library(fontawesome)
library(rsconnect)
function(input, output, session) {
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
sliderData <- reactive({
ct_breweries %>%
filter(YearOpened <= input$Year)
})
output$Counter <- renderText(
paste('Number of Breweries: ', nrow(sliderData()))
)
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
fitBounds(min(ct_breweries$Longitude), min(ct_breweries$Latitude),
max(ct_breweries$Longitude), max(ct_breweries$Latitude))
})
observe({
leafletProxy('map', data = sliderData()) %>%
clearMarkers() %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = 'Breweries',
popup = ~ Name)
})
}
It works fine locally. When I try to publish it, I get a Disconnected from Server error. In the logs it says something about 'YearOpened' not found. There's definitely a column for that in the .csv. I'm wondering if it has something to do with the call to the fall. Any ideas? Thanks
Try adding all the package loading and dataset reading to a global.R file (in the same app folder) as below:
library(shiny)
library(leaflet)
library(leaflet.extras)
library(fontawesome)
library(rsconnect)
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
You can then remove these from ui.R and server.R.
The problem seems to be that the dataset is not visible to the server - this should fix that. Also, make sure that the csv file is in the same folder.
Update
Based on my comment above, if this is sufficient, you can just save an html file of the map that you can send to your friend to open in a browser. I have attempted to write the code without your data so this may not work.
library(leaflet)
library(fontawesome)
library(htmlwidgets)
ct_breweries <- read.csv('ct_breweries.csv', header=TRUE, sep=',')
leaflet_map <- leaflet(data = ct_breweries) %>%
addProviderTiles(provider = 'Esri.WorldStreetMap') %>%
addAwesomeMarkers(icon = beer_icon,
group = ~ YearOpened,
popup = ~ Name) %>%
addLayersControl(
overlayGroups = 1990:2000,
options = layersControlOptions(collapsed = FALSE)
) %>% hideGroup(~ YearOpened)
saveWidget(leaflet_map, file="leaflet_map.html")
It does lose the slider option - replaced with checkboxes. You can remove the hideGroup() and collapsed = FALSE to see other options. This might be easier assuming the slider is not a requirement.
This file is saved offline but you will need an internet connection to fetch the leaflet map tiles.

Shiny dashboard and leaflet using selectInput

i am trying to use shiny dashboard with leaflet package. I tried using "SelectInput" function in the dashboard to create reactive map based on the input selected(geoArea).However, i am not able to make the leaflet and the SelectInput connect with each other.
I also wanted to distinguish two groups in my dataset and plot it in leaflet/shiny (column name "up.and.down" has positive and negative values).In Base R i could do it using filter option from the tidyverse package and give distinct colour to each but however i am not sure how this works in Shinydashboard. Any help in regards will be much appreciated.
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<- read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv")
`ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))`
`server <- function(input, output) {
data_input<-reactive({
datafile %>%
leaflet() %>%
addTiles() %>%
addMarkers(lng = datafile$lng,lat = datafile$lat)
})
data_input_ordered<-reactive({
data_input()[order(match(data_input)$geoArea)]
})`
`labels<- reactive({
paste("<p>", datafile$goals,"</p>"),
paste("<p>", datafile$achieved,"</p>")
})`
`output$mymap<- renderLeaflet(
datafile %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = datafile$lng,lat = datafile$lat)
)
}
shinyApp(ui = ui, server = server)`
Try this one:
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(leaflet)
library(tidyverse)
datafile<-read.csv("/Users/prabeshkc/Desktop/stackoverflow data.csv") %>%
mutate(color=ifelse(up.and.down<0,"red","blue"))
ui<- dashboardPage(
skin = "blue",
dashboardHeader(title = "Cluster Map"),
dashboardSidebar(
selectInput("Area",label = "Geo Area",
choices = datafile$geoArea)
),
dashboardBody(
fluidRow(box(width = 12,leafletOutput(outputId = "mymap")))
))
server <- function(input, output) {
output$mymap<- renderLeaflet({
validate(need(datafile,"Add file"))
validate(need(input$Area,"Select Area"))
datafile %>%
filter(geoArea %in% input$Area) %>%
leaflet() %>%
addTiles() %>%
addCircleMarkers(lng = ~lng,lat = ~lat,color=~color,
popup = ~paste(paste0("Goals - ",goals),paste0("Achieved - ",achieved), sep="<br>"))
})
}
shinyApp(ui = ui, server = server)

R Leaflet GeoJSON Coloring

I am still working on this R Leaflet self project to learn and I'm trying to color in some Polygons in the Wake County area of Raleigh, NC. Below is the image of what I am trying to color.
https://imgur.com/a/xdvNLvM
Basically I am trying to get each of those polygons colored differently. I've tried addPolygons but I guess I didn't have correct Polygon data. I've looked at color binning but I seem to be out of ideas. Below is my code. I even tried to unnest the GeoJSON data and create a factor palette but that hasn't seemed to work.
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
data <- geojson_read(dataurl, method = 'web', parse = FALSE, what = 'list')
wake <- readOGR(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
#bikedata <- 'D:/bicycle-crash-data-chapel-hill-region.geojson'
#bike <- geojson_read(bikedata)
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- geojson_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
data
})
#bikegeojson <- reactive({
# bike
#})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4)
})
observe({
leafletProxy("map") %>%
addWMSTiles("http://mesonet.agron.iastate.edu/cgi-bin/wms/nexrad/n0r.cgi",
layers = "nexrad-n0r-900913",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "") %>%
addGeoJSON(wakegeojson(), weight = 3, fill = factpal) %>%
#addGeoJSON(bikegeojson()) %>%
addGeoJSON(vtgeojson(), fill = FALSE, color = "black")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
I think I need to explore the addPolygons feature more but I'm not exactly sure how to do that or how to parse/unnest my GeoJSON data in order to accomplish filling in the Wake County Zipcodes with different colors. Any help is always appreciated. Thank you.
I would switch to sf. You can directly load the geojson and produce a Multipolygon and a Multilinestring object which will also read much faster than readOGR.
Then you can just put those objects in addPolygons and addPolylines.
The following example should work:
library(shiny)
library(leaflet.extras)
library(geojsonio)
library(rgdal)
library(sf)
dataurl <- 'https://opendata.arcgis.com/datasets/f5c3b84a6fcc499d8f9ece78602258eb_0.geojson'
wake <- st_read(dataurl)
wake$zips <- factor(sample.int(39L, nrow(wake), TRUE))
vtdata <- 'http://geodata.vermont.gov/datasets/4c206846699947429df59c8cb552ab5c_11.geojson'
vt <- st_read(vtdata)
factpal <- colorFactor(topo.colors(39), wake$zips)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
wakegeojson <- reactive({
wake
})
vtgeojson <- reactive({
vt
})
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addPolygons(data=wakegeojson(), color=factpal(wake$zips)) %>%
addPolylines(data=vtgeojson(), color="red")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)

Change setView dynamically according to select box in R shiny app

I'm developing a leaflet map in R shiny. In this app I want the focus of the map to be changed whenever the lng and lat value in setView() is changed. The lng and lat values are based on what country I select from a drop down box. Previously I use static value for lng and lat in an ifelse() function and the app works. But now the problem is when I want to make things more generic: the lng and lat will be the mean of the longitude and latitude from a subset of the data with the chosen country, the app doesn't show map anymore (from my point of view the calculation seems right)
Below is the simplified and workable R script:
global.R:
library(devtools)
library(leaflet)
library(htmlwidgets)
library(shiny)
library(shinydashboard)
library(sp)
library(rworldmap)
library(RCurl)
library(ggmap)
df <- read.csv(url("https://docs.google.com/spreadsheets/d/1rrEJiuxr4nafTqUQBlPpUdGwvGeGtBJExlPJdday2uw/pub?output=csv"),
header = T,
stringsAsFactors = F)
df$Time <- as.Date(df$Time, "%d/%m/%Y")
ui.R
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 = c(min(df$Time), min(df$Time)+10)),
selectInput("select_country", label = "Select Country",
choices = NULL,
selected = NULL)
),
body
)
server.R
shinyServer(function(input, output, session) {
dfs <- reactive({
tmp <- subset(df, df$Time <= input$`Timeline Value`[2] & df$Time >= input$`Timeline Value`[1])
tmp
})
part_choices <- reactive({
as.list(c("All", unique(as.character(dfs()$Country))))
})
observe({
updateSelectInput(session, "select_country", choices=part_choices())
})
output$mymap <- renderLeaflet({
lng <- ifelse(input$select_country == "All", mean(dfs()$lon),
mean(subset(dfs(), Country %in% input$select_country)$lon)
)
lat <- ifelse(input$select_country == "All", mean(dfs()$lat),
mean(subset(dfs(), Country %in% input$select_country)$lat)
)
m <- leaflet(dfs()) %>%
addTiles(
) %>%
setView(lng, lat, zoom = 5) %>%
addMarkers(~lon, ~lat,
clusterOptions = markerClusterOptions())
})
})
You will see in the server.R part I use ifelse() to change the lng and lat value that later can be used in setView() function. After I changed the else argument into a calculation the app doesn't work anymore.
Really appreciate if someone can tell me where I was wrong.
Thanks in advance.
In your ui.R, try changing your country input to
selectInput("select_country", label = "Select Country",
choices = "All",
selected = "All")
My guess is that the ifelses do not return a number, given that input$select_country is initialized at NULL, which (for reasons that are unclear to me) causes both renderLeaflet and updateSelectInput not to run, preventing the country selector from being updated.

R Shiny: how to filter a dataframe before outputting a merged SpatialPolygonsDataFrame based on UI selectInput()?

At the moment I'm working on a dashboard-project to display store data on a leaflet map. I managed to do this without any (reactive) filtering input. A functionality I would like to add is to filter the stores. With this filter the user is able to see data for their own store instead of all stores on the leaflet map.
In order to create a new leaflet map, the load_data.R needs to be reloaded based on the filter-input. Note that in load_data.R there is a where-statement:
WHERE STORE_NAME = #INPUT OF THE FILTER IN ui.R.
My question to you is: how to fill the '#' in the where statement in load_data.R based on the ui.R selectInput() to remerge and replot the SpatialPolygonsDataFrame(SalesMap) when the user applies a filter?
load_data.R
library(RSQLite)
library(rgdal)
library(dplyr)
# Use the SQLite database
my_sqdb = src_sqlite("Data/dataset.sqlite")
# Extract the main dataset out of the SQLite database
df = data.frame(tbl(my_sqdb, sql("SELECT * FROM df
WHERE STORE_NAME = #INPUT OF THE FILTER IN ui.R")))
# Extract the stores with their locations out of the SQLite database
Winkels = data.frame(tbl(my_sqdb, sql("SELECT * FROM Winkels")))
# Read the shape-data(polygons) into R
shape <-readOGR("Data/Polygonen NL Postcodes 4PP.kml", "Polygonen NL Postcodes 4PP")
# Combine the main dataset with the shape data to plot data into zipcode areas
SalesMap <- merge(shape, df, by.x='Description', by.y='POSTCODE')
ui.R
library(shiny)
library(shinydashboard)
library(leaflet)
source("R/load_metadata.R", chdir=TRUE)
# Header of the dashboard
header <- dashboardHeader(
title = "Demographic Dashboard",
titleWidth = 350,
dropdownMenuOutput("task_menu")
)
# Side bar of the dashboard
sidebar <- dashboardSidebar(
sidebarMenu(
id = "menu_tabs",
menuItem("Household Penetration", tabName = "menutab1", icon = icon("percent")),
selectInput("STORE_NAME", label = "Store",
choices = STOREFILTER$STORE_NAME,
selected = STOREFILTER$STORE_NAME[1])
)
)
# Body of the dashboard
body <- dashboardBody(
tabItems(
tabItem(
tabName = "menutab1",
tags$style(type = "text/css", "#mymap {height: calc(100vh - 80px) !important;}"),
leafletOutput("mymap")
)
)
)
# Shiny UI
ui <- dashboardPage(
header,
sidebar,
body
)
server.R
#shiny
library(shiny)
library(shinydashboard)
#define color
library(RColorBrewer)
library(colorspace)
# leaflet map
library(leaflet)
library(htmlwidgets)
library(htmltools)
# Processing the data for output
source("R/load_data.R", chdir=TRUE)
## Creating leaflet map
pal <- colorNumeric("Reds", SalesMap#data$SALES)
polygon_popup <- paste0("<strong>ZIP: </strong>", SalesMap$Description, "<br>",
"<strong>Store: </strong>", SalesMap$STORE_NAME, "<br>",
"<strong>Value: </strong>", SalesMap$SALES, "%")
pop = as.character(Winkels$WINKEL)
Icon <- makeIcon(
iconUrl = "Images/icon.png",
iconWidth = 100, iconHeight = 78
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
addTiles(
urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox'
) %>%
addPolygons(data = SalesMap,
fillColor = ~pal(SalesMap#data$SALES),
fillOpacity = 0.6, ## how transparent do you want the polygon to be?
popup = polygon_popup,
color = "black", ## color of borders between districts
weight = 2.0) %>%
addMarkers(Winkels$Lon, Winkels$Lat, popup=pop, icon=Icon)
})
}
Thanks in advance.
Joris
Solution:
"If you want to use input variables, then the sql command needs to be inside your server bracket and inside a reactive environment. You'll need to reorganize your code instead of source it at the beginning."
Thanks to:
warmoverflow
Code:
server.R
## LOADING PACKAGES
#shiny
library(shiny)
library(shinydashboard)
#define color
library(RColorBrewer)
library(colorspace)
# leaflet map
library(leaflet)
# Data processing
library(RSQLite)
library(rgdal)
## LOADING DATA
# Use the SQLite database
my_sqdb = src_sqlite("R/Data/dataset.sqlite")
# Extract the main dataset out of the SQLite database
df = data.frame(tbl(my_sqdb, sql("SELECT * FROM df")))
# Extract the stores with their locations out of the SQLite database
Winkels = data.frame(tbl(my_sqdb, sql("SELECT * FROM Winkels")))
# Read the shape-data(polygons) into R
shape <-readOGR("R/Data/Polygonen NL Postcodes 4PP.kml", "Polygonen NL Postcodes 4PP")
## LOADING SHINY SERVER
server <- function(input, output, session) {
# Reactive dataset
newData <- reactive({
input$Button
isolate({
dfdf <- subset(df,
STORE_NAME == input$storeInput)
})
return(dfdf)
})
## Creating Leaflet Map
output$mymap <- renderLeaflet({
dfdf = newData()
SalesMap <- merge(shape, dfdf, by.x='Description', by.y='POSTCODE')
## Preparing colors, popups and icons for the leaflet map
# Colorscale
pal <- colorNumeric("Reds", SalesMap#data$SALES)
# Popup for showing data in ZIP-area
polygon_popup <- paste0("<strong>Postcode: </strong>", SalesMap$Description, "<br>",
"<strong>Store: </strong>", SalesMap$STORE_NAME, "<br>",
"<strong>Waarde: </strong>", SalesMap$SALES, "%")
# Popup (with icon) for showing markers with store name
pop = as.character(Winkels$WINKEL)
# Creating Icon
Icon <- makeIcon(
iconUrl = "Images/icon.png",
iconWidth = 100, iconHeight = 78
)
# Adding tiles, polygons and markers
leaflet() %>%
addTiles(
urlTemplate = "//{s}.tiles.mapbox.com/v3/jcheng.map-5ebohr46/{z}/{x}/{y}.png",
attribution = 'Maps by Mapbox'
) %>%
addPolygons(data = SalesMap,
fillColor = ~pal(SalesMap#data$SALES),
fillOpacity = 0.6, ## how transparent do you want the polygon to be?
popup = polygon_popup,
color = "black", ## color of borders between districts
weight = 2.0) %>%
addMarkers(Winkels$Lon, Winkels$Lat, popup=pop, icon=Icon)
})
}

Resources