I am trying to execute the following code -
library(dplyr) ; library(rgdal) ; library(leaflet);
crimes <- read.csv("crime_data.csv", header = T) %>%
filter(borough == "Manchester",
date == "2015-11-01") %>%
group_by(category, lsoa, borough) %>%
summarise(n = n()) %>%
rename(LSOA11CD = lsoa) %>%
as.data.frame()
lsoa <- readOGR("manchester_lsoa.geojson", "OGRGeoJSON")
ui <- shinyUI(fluidPage(
fluidRow(
column(7, offset = 1,
br(),
div(h4(textOutput("title"), align = "center"), style = "color:black"),
div(h5(textOutput("period"), align = "center"), style = "color:black"),
br())),
fluidRow(
column(7, offset = 1,
leafletOutput("map", height="530"),
br(),
actionButton("reset_button", "Reset view")),
column(3,
uiOutput("category", align = "left")))
))
server <- (function(input, output, session) {
output$category <- renderUI({
radioButtons("category", "Select a crime category:",
choices = levels(crimes$category),
selected = "Burglary")
})
selected <- reactive({
subset(crimes,
category==input$category)
})
output$title <- renderText({
req(input$category)
paste0(input$category, " offences by LSOA in Manchester")
})
output$period <- renderText({
req(input$category)
paste("during November 2015")
})
lat <- 53.442788; lng <- -2.244708; zoom <- 11
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
setView(lat = lat, lng = lng, zoom = zoom)
})
observe({
lsoa#data <- left_join(lsoa#data, selected())
lsoa$rate <- round((lsoa$n / lsoa$pop_All.Ag) * 1000, 1)
qpal <- colorQuantile("YlGn", lsoa$rate, n = 5, na.color = "#bdbdbd")
popup <- paste0("<strong>LSOA: </strong>",
lsoa$LSOA11CD,
"<br><strong>Category: </strong>",
lsoa$category,
"<br><strong>Rate: </strong>",
lsoa$rate)
leafletProxy("map", data = lsoa) %>%
addProviderTiles("CartoDB.Positron") %>%
clearShapes() %>%
clearControls() %>%
addPolygons(data = lsoa, fillColor = ~qpal(rate), fillOpacity = 0.7,
color = "white", weight = 2, popup = popup) %>%
addLegend(pal = qpal, values = ~rate, opacity = 0.7,
position = 'bottomright',
title = paste0(input$category, "<br>", " per 1,000 population"))
})
observe({
input$reset_button
leafletProxy("map") %>% setView(lat = lat, lng = lng, zoom = zoom)
})
})
shinyApp(ui, server)
and I get this error
Warning in is.na(e2) :
is.na() applied to non-(list or vector) of type 'NULL'
Joining, by = "LSOA11CD"
Warning: Column `LSOA11CD` joining factors with different levels, coercing to character vector
Warning: Error in get: object '.xts_chob' not found
ERROR: [on_request_read] connection reset by peer
The links to the required files are this and this
Can someone please tell me what the error is? Is the error due to leaflet package? Or is it because of other packages? And also can someone give me the solution to the error as well?
It could be a namespace issue. Is the xts library loaded? I've had a similar issue and fixed it by calling addLegend from leaflet explicitly:
leaflet::addLegend(pal = qpal, values = ~rate, opacity = 0.7,
position = 'bottomright',
title = paste0(input$category, "<br>", " per 1,000 population"))
Probe using an old version of 'xts', for example install the version 0.9:
require(devtools)
install_version("xts", version = "0.9-7", repos = "http://cran.us.r-project.org")
It is a stuff up with the its package and shiny. The trick is to install one of these and use the :: notation to call functions from the other. So I mainly need shiny so the package is loaded then I use the notation for its functions:
temp.data <- xts::as.xts(df2, order.by = df2$day)
I got the same problem. So, I install a new version of xts and restart the R session.
Related
I have successfully created an interactive choropleth map using Leaflet in R that projects a single variable across a set of polygons.
library(RSocrata)
library(rgdal)
library(leaflet)
library(sp)
library(dplyr)
#library(mapview)
area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")
data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")
pal <- colorNumeric("viridis", NULL)
leaflet(health_area) %>%
addTiles() %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 1,
fillColor = ~pal(as.numeric(firearm_related)),
label = ~paste0(community, ": ", formatC(firearm_related, big.mark = ",")))
The health data set has multiple variables and I would like to create a shiny app that allows users to choose a different variable to produce a choropleth map. Using the code provided by Kyle Walker as a model for my server, I came up with the code below that allows users to choose from a list of two variables. Unfortunately I am having problems running it, getting a Warning: Error in min: invalid 'type' (list) of argument error. Any help in resolving this would be appreciated. I have also looked at the RStudio, Using Leaflet With Shiny tutorial, but the examples provided are not choropleth maps.
Here is my non-working code:
## app.R ##
library(shiny) # for shiny apps
library(leaflet) # renderLeaflet function
library(RSocrata)
library(rgdal)
library(sp)
library(dplyr)
area_bound <- rgdal::readOGR("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
area_bound$area_num_1 <- as.numeric(area_bound$area_numbe)
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")
data_num <- as.data.frame(apply(health[3:29], 2, as.numeric))
data_num <- bind_cols(health[1:2], data_num)
health_area <- sp::merge(area_bound, data_num, by.x = "area_numbe", by.y = "community_area")
groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "group",
label = "Select a group to map",
choices = groups
)
),
mainPanel(
leafletOutput("map", height = "600")
)
)
)
server = function(input, output) {
group_to_map <- reactive({
input$group
})
output$map <- renderLeaflet({
leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
setView(lng = -87.623177,
lat = 41.881832,
zoom = 8.5)
})
observeEvent(input$group, {
pal <- colorNumeric("viridis", group_to_map)
leafletProxy("map") %>%
clearShapes() %>%
clearControls() %>%
addPolygons(data = group_to_map,
color = ~pal(),
weight = 0.5,
fillOpacity = 0.5,
smoothFactor = 0.2) %>%
addLegend(
position = "bottomright",
pal = pal,
values = group_to_map,
title = "% of population"
)
})
}
shinyApp(ui, server)
There are several issues with your shiny code. First, to refer to values from a reactive you have to call it like a function, i.e. you have to do group_to_map(). Next, group_to_map() is just a character. To use the data column whose name is stored in group_to_map() you have to do health_area[[group_to_map()]]. I also fixed the issue with your palette functions. Finally, note that I switched to sf for reading the geo data as I'm more familiar with sf objects:
## app.R ##
library(shiny) # for shiny apps
library(leaflet) # renderLeaflet function
library(RSocrata)
library(dplyr)
area_bound <- sf::st_read("https://data.cityofchicago.org/resource/igwz-8jzy.geojson")
health <- read.socrata("https://data.cityofchicago.org/resource/iqnk-2tcu.json")
health[3:29] <- lapply(health[3:29], as.numeric)
#> Warning in lapply(health[3:29], as.numeric): NAs introduced by coercion
health_area <- left_join(area_bound, health, by = c("area_num_1" = "community_area"))
groups <- c("Breast Cancer" = "breast_cancer_in_females", "Firearm" = "firearm_related")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(
inputId = "group",
label = "Select a group to map",
choices = groups
)
),
mainPanel(
leafletOutput("map", height = "600")
)
)
)
server = function(input, output) {
group_to_map <- reactive({
input$group
})
output$map <- renderLeaflet({
leaflet(options = leafletOptions(zoomControl = FALSE)) %>%
addProviderTiles(providers$Stamen.TonerLite) %>%
setView(lng = -87.623177,
lat = 41.881832,
zoom = 8.5)
})
observeEvent(input$group, {
pal <- colorNumeric("viridis", range(health_area[[group_to_map()]]))
leafletProxy("map") %>%
clearShapes() %>%
clearControls() %>%
addPolygons(data = health_area,
color = ~pal(health_area[[group_to_map()]]),
weight = 0.5,
fillOpacity = 0.5,
smoothFactor = 0.2) %>%
addLegend(
position = "bottomright",
pal = pal,
values = health_area[[group_to_map()]],
title = "% of population"
)
})
}
shinyApp(ui, server)
#>
#> Listening on http://127.0.0.1:5938
So I want to change the CircleMarker colour in Leaflet map when I select a row in the table. I didn't get any errors but nothing happens. I don't know how to create and apply the reactive function properly in my Shiny app.
I tried to create a reactive function when a row is selected in the table and apply it to a separate leaflet proxy and leaflet map.
library(shiny)
library(DT)
library(dplyr)
library(leaflet)
library(leaflet.extras)
# Define UI
ui <- fluidPage(
# Application title
titlePanel("Quakes Test"),
# Sidebar with numericInput for quakes depth range
sidebarLayout(
sidebarPanel(
numericInput(inputId = "min_depth", label = "Mininum depth", value = min(quakes$depth), min = min(quakes$depth), max = max(quakes$depth)),
numericInput(inputId = "max_depth", label = "Maximum depth", value = max(quakes$depth), min = min(quakes$depth), max = max(quakes$depth))
),
# Show a map
mainPanel(
fluidRow(
leafletOutput("mymap_occ", width = "98%", height = 500))
)
),
fluidRow(DT::dataTableOutput(outputId = "prop_table"))
)
server <- function(input, output) {
#filter terrains
depth_final <- reactive({
obj <- quakes
if (input$min_depth != "All") {
obj <- quakes %>%
filter(depth >= as.numeric(input$min_depth)) %>%
filter(depth <= as.numeric(input$max_depth))
}
})
#row selected in table
table2_bat <- reactive({
data <- depth_final()
data <- data[input$prop_table, ]
})
output$prop_table <- renderDT({
datatable(depth_final(), extensions = 'Buttons', rownames = FALSE, escape = FALSE, selection = 'single')
})
#row selected map
observe({
leafletProxy("mymap_occ", data = table2_bat()) %>%
clearGroup(group = "FOO") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "yellow", opacity = 1, fillOpacity = 1,
radius = 5, weight = 20, group = "FOO")
})
#map
observe({
leafletProxy("mymap_occ", data = depth_final()) %>%
clearGroup(group = "FOO_2") %>%
addCircleMarkers(lng = ~long, lat = ~lat,
color = "white", fillColor = "red", opacity = 1, fillOpacity = 0.75,
radius = 5, weight = 2, group = "FOO_2")
})
output$mymap_occ <- renderLeaflet({
leaflet(table2_bat()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
output$mymap_occ <- renderLeaflet({
leaflet(depth_final()) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat)) %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Vue satellite") %>%
addProviderTiles(providers$Stamen.TonerLabels, group = "Vue satellite")
})
}
shinyApp(ui = ui, server = server)
First. You have to use eventReactive instead of reactive to trigger an action based on an event, i.e. when the user selects a row. Second. To get the index of the selected row you have to use input$prop_table_rows_selected (see here) instead of input$prop_table. input$prop_table does not exist, i.e. it returns NULL. Hence, to make your app work try this:
#row selected in table
table2_bat <- eventReactive(input$prop_table_rows_selected, {
data <- depth_final()
data <- data[input$prop_table_rows_selected, ]
})
I have a leaflet map and I want the option of switching from the values of A being mapped to the values of B. Every example I can find says to use shiny and leaflet and all of these examples include something along the lines of:
ui <- fluidPage(
selectInput(inputId = "Data",
label = "Data",
choices = c("A","B"),
leafletProxy(outputId = "map") #or leafletOutput
))
but I keep getting the error that
leafletProxy (or leafletOutput)does not exist
. How do I solve this? My leaflet is created with :
mypal <- colorNumeric(palette = "viridis", domain = d$A)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data =
USA, stroke = TRUE, color='black', opacity=1, weight=.5, smoothFactor = 0.2, fillOpacity = 1,
fillColor = ~mypal(d$A),
popup = paste('<b>',d$state, "</b><br>A:", d$A) %>%
addLegend(position = "bottomleft", pal = mypal, values = d$A,
title = "A",
opacity = 1)
It seems from your example that your shiny has no server function, so it is not going to work.
Please, find attached a mock shiny you can start building on:
library(shiny)
library(leaflet)
ui <- fluidPage(
selectInput(inputId = "Data",
label = "Data",
choices = c("A", "B")),
leafletOutput("map")
)
server <- server <- function(input, output, session) {
output$map <- renderLeaflet({
if((input$Data) == "A"){
point = c(42.6525, -73.757222)
}
if((input$Data) == "B"){
point = c(39.283333, -76.616667)
}
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addMarkers(lat = point[1], lng = point[2])
})
It will show "Albany" when you select "A" and Baltimore when you select "B"
Basically:
ui is kind of the "interface", what it is going to be shown:
selectInput: you can choose A or B here
leafletOutput: will show the leaflet map
server will do the "hard job" of creating the map and computing actions when you use selecInput:
output$map means that we want to render the leafletOuput (that is why it is called map, as in leafletOutput("map")
Then, according to the input selected (A or B)
if((input$Data) == "A"){
point = c(42.6525, -73.757222)
}
if((input$Data) == "B"){
point = c(39.283333, -76.616667)
}
We assign coordinates of Albany or Baltimore to point.
Finally, we build the map:
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
addMarkers(lat = point[1], lng = point[2])
PLEASE, take into account that this is a mock shiny, it is far from perfect, it is only illustrative.
Best!
I am writing a Shiny app using leaflet to plot different points based on slider values. My relevant Shiny/leaflet code is shown below:
server <- function(input, output, session) {
subsetData1 <- reactive({
District25_NoPaperBallot %>%
filter(District25_NoPaperBallot$Difference >= as.numeric(input$slider1[1]) &
District25_NoPaperBallot$Difference <= as.numeric(input$slider1[2]))
})
output$map <- renderLeaflet({
leaflet(data = District25_NoPaperBallot) %>%
setView(lng =-87.3633, lat=36.1490 , zoom = 8) %>%
addTiles() %>%
addCircleMarkers(~ District25_NoPaperBallot$Longitude, ~District25_NoPaperBallot$Latitude,
popup = as.character(District25_NoPaperBallot$PRECINCT),
label = ~as.character(District25_NoPaperBallot$PRECINCT),
radius = 5)
})
observe({
leafletProxy("map", data = subsetData1()) %>%
clearMarkers() %>%
clearShapes() %>%
addCircleMarkers(lng = ~ Longitude, lat = ~ Latitude,
popup = as.character(District25_NoPaperBallot$PRECINCT),
label = ~as.character(District25_NoPaperBallot$PRECINCT),
radius = 5)
}
)
}
ui <- fluidPage(
sidebarPanel( sliderInput(inputId = "slider1", label = "Difference",
min = min(District25_NoPaperBallot$Difference),
max = max(District25_NoPaperBallot$Difference),
value = c(min(District25_NoPaperBallot$Difference),
max(District25_NoPaperBallot$Difference)))
),
mainPanel(leafletOutput("map"))
)
shinyApp(ui = ui, server = server)
When I run the app from RStudio, the page won't load and crashes immediately. The following errors are output:
Warning in data.matrix(data) : NAs introduced by coercion
Warning in data.matrix(data) : NAs introduced by coercion
Warning: Error in UseMethod: no applicable method for 'metaData' applied to an object of class "c('mts', 'ts')"
Where am I going wrong? Any tips on what to change? I appreciate any and all help!
I am new to writing shiny apps and new to using the leaflet package. I am trying to create a shiny app which will get user inputs and plot a choropleth map based on the aggregated values of the selected user variable.
My sample dataset has the following variables: statename latitude longitude countyname medianage asianpopulation otherpopulation
My app would ask the user to select from either username or countyname. Based on this selection, internally I group my dataset using statename or countyname.
Then the user selects either one or many from the variables: medianage asianpopulation otherpopulation.
Based on this, I want to plot the choropleth map on the sum of the values of these variables and show a table below with these values.
I am not able to use the addPolygons method to plot the map. Do I need to use a shape file for this? Where am I going wrong in this code?
library(dplyr)
library(shiny)
library(readr)
library(leaflet)
library(lazyeval)
library(rgdal)
setwd("E:/Data")
ui <- fluidPage(
titlePanel("Filters"),
sidebarLayout(
sidebarPanel(
radioButtons("level", "Select the Level", choices = c("State", "County"),selected = "State" ,inline = TRUE),
selectInput("variable", "Variable Name", choices = NULL, multiple = FALSE, selectize = TRUE, selected = "medianage")
),
mainPanel(
leafletOutput("map"),
dataTableOutput("heatmapdata")
)
)
)
server <- function(input, output, session) {
read_csv(file="Sample.csv") %>%
select(statename, latitude, longitude, countyname, medianage, asianpopulation, otherpopulation) -> heatmapData -> hd
variable = c()
group = c()
heatmapData <- data.frame(heatmapData)
hd <- heatmapData
heatmapdata_1 <- select(heatmapData, -c(latitude, longitude))
heatmapdata_2 <- select(heatmapdata_1, -c(statename, countyname))
updateSelectInput(session, "variable", choices = sort(unique(colnames(heatmapData))), selected = "medianage")
heatmapdata_2 <- heatmapdata_1
datasetLevel.group <- function(df, grp.var) {
df %>% group_by_(grp.var) %>%
summarise_each(funs(sum)) -> df
df
}
datasetLevel <- reactive({
heatmapdata_2 <- heatmapdata_1
inputvariable <- c("medianage")
if (input$level == "State") {
inputlevel = c("statename")
heatmapdata_2 <- select(heatmapdata_2, -c(countyname))
}
if (input$level == "County") {
inputlevel = c("countyname")
heatmapdata_2 <- select(heatmapdata_2, -c(statename))
}
sm <- datasetLevel.group(heatmapdata_2, inputlevel)
group <- inputlevel
variable <- inputvariable
l_hd <- list(sm, inputlevel, input$variable)
l_hd
})
output$map <- renderLeaflet(
{
leaflet() %>% addTiles(options=tileOptions(minZoom = 3, maxZoom = 10)) %>%
setView(lng = -98.35, lat = 39.5, zoom = 4) %>%
setMaxBounds( -180, 5, -52, 73)
}
)
output$heatmapdata <- renderDataTable(
select_(datasetLevel()[[1]], datasetLevel()[[2]], datasetLevel()[[3]]),
options = list(pageLength=5,
scrollX=TRUE,
lengthMenu = c(5, 10, 25, 100),
searching=FALSE)
)
observe({
pal <- colorQuantile("YlOrRd", NULL, n = 20)
leafletProxy("map", data = datasetLevel()[[1]]) %>%
clearMarkers() %>%
clearMarkerClusters() #%>%
# addPolygons(data = datasetLevel()[[1]],
# fillColor = ~pal(variable),
# fillOpacity = 0.8,
# color = "#BDBDC3",
# weight = 1)
})
}
shinyApp(ui = ui, server = server)
I have commented out the addPolygons code as I get an error with that. I have been breaking my head to get the maps color coded based on the aggregated values of the selected variable.
The data file can be found at: https://drive.google.com/file/d/0B4PQcgewfQ3-MF9lNjU4clpUcUk/view?usp=sharing
Any help on this will be really helpful. Thanks.