Shiny slider crashing R code using leaflet - r

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!

Related

How to filter the data in shiny using select input?

I wanted to filter the district names in two of the data sets based on the drop-down selection and map them using plots. I get the following error message.
Error : Problem with filter() input ..1. i Input ..1 is
district == input$district. x Can't access reactive value 'district'
outside of reactive consumer. i Do you need to wrap inside reactive()
or observe()?
library(shiny)
library(sf)
library(sp)
library(tidyverse)
library(osrm)
library(leaflet)
library(dplyr)
library(geosphere)
library(readxl)
dst = c('A',
'B',
'C')
raw1 <- read_xlsx("raw_map.xlsx")
clean1 <- read_xlsx("clean_map.xlsx")
ui <- fluidPage(
titlePanel("District data viz"),
sidebarLayout(
sidebarPanel(
selectInput("district",
"Name of the dst:",
choices = dst),
),
mainPanel(
fluidRow(12,leafletOutput("raw")),
fluidRow(12,leafletOutput("clean")),
)
)
)
server <- function(input, output) {
raw <- dplyr::filter(raw1, district == input$district)
clean <- dplyr::filter(clean1, district == input$district)
output$raw <- renderLeaflet({
leaflet(data = raw) %>%
addTiles() %>%
addMarkers(lng = raw$lon, lat = raw$lat,
label = raw$CHE_Village,
popup = raw$CHE_Name,
labelOptions = labelOptions(noHide = T))
})
output$clean <- renderLeaflet({
leaflet(data = clean) %>%
addTiles() %>%
addMarkers(lng = clean$lon, lat = clean$lat,
label = clean$CHE_Village,
popup = clean$CHE_Name,
labelOptions = labelOptions(noHide = T))
})
}
shinyApp(ui = ui, server = server)

Creating Shiny App of a Map using Reactive Date Input in Leaflet

I have created a shiny app where the user can select from a date range to show crimes that occurred in Chicago by Longitude and Latitude.
The problem I am having is to make the dateRangeInput reactive within the leafletOutput. I have looked up a LOT of different option and found that these work the best but the problems I am having are:
Map generates with markers but is not reactive (when commenting out the clearMarkers())
Map generates without markers so I cant even tell if its reactive or not (when using clearMarkers())
I have tried both approaches of using observe() and observeEvent().
Please help... what am I missing.
Data can be found at https://data.cityofchicago.org/Public-Safety/Crimes-2001-to-Present/ijzp-q8t2
**** Interested in date range 01/01/20 to 09/30/20.... the file referenced in a data
crimes.df <- read.csv("Crimes_2020.csv", stringsAsFactors = TRUE)
#Seprating Date and Time into multiple columns
dup_crimes.df$datetime <- as.POSIXct(dup_crimes.df$Date, format = "%m/%d/%Y %H:%M")
dup2_crimes.df <- transform(dup_crimes.df, time = format(dup_crimes.df$datetime, "%T"),
date = format(dup_crimes.df$datetime, "%m/%d/%Y"))
class(dup2_crimes.df$date)
dup2_crimes.df$Month <- as.numeric(format(as.Date(dup2_crimes.df$date), format = "%y"))
dup2_crimes.df$Month.Name <- month.abb[dup2_crimes.df$Month]
#Filter out locations NOT related to Chicago
dup3_crimes.df <- filter(dup2_crimes.df, dup2_crimes.df$Latitude >= 41)
unique(dup3_crimes.df$Primary.Type)
ui <- fluidPage(
titlePanel("2020 Crimes in Chicago"),
tabsetPanel(type = "tabs",
tabPanel("Map of Location of crimes by date",
dateRangeInput(inputId = "date",
label = "Date",
start = '2020-02-25',
end = '2020-07-04',
min = '2020-01-01',
max = '2020-09-30'
),
leafletOutput("Map"))
)
)
server <- function(input,output){
datefileter1 <- reactive({
dup3_crimes.df[
dup3_crimes.df$date >= input$date[1] &
dup3_crimes.df$date <= input$date[2],]
})
#https://www.youtube.com/watch?v=G5BDubIyQZY
#Static Map
output$Map <- renderLeaflet({
leaflet(data = dup3_crimes.df) %>%
addTiles() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
})
#Put Dynamic Content
# observe(leafletProxy("Map", data = datefileter1()) %>%
# clearMarkers() %>%
# addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
# )
observeEvent(input$date,
leafletProxy("Map", data = datefileter1()) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
)
# observe({
#
# leafletProxy("Map", data = datefilter()) %>%
# clearShapes() %>%
# addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
# fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)
# )
# })
#
}
#Run Shiny App
shinyApp(ui = ui , server =server)
---->> With clearMarkers()
---->> Without clearMarkers() - shows all the locations and NOT reactive (intentionally selected 7/4/20)
Try this, it should work. You can include the reactive df in a simple leaflet call:
ui <- fluidPage(
titlePanel("2020 Crimes in Chicago"),
tabsetPanel(type = "tabs",
tabPanel("Map of Location of crimes by date",
dateRangeInput(inputId = "date",
label = "Date",
start = '2020-02-25',
end = '2020-07-04',
min = '2020-01-01',
max = '2020-09-30'
),
leafletOutput("Map"),
tableOutput("tab"))
)
)
server <- function(input,output){
datefileter1 <- reactive({
dup3_crimes.df[
dup3_crimes.df$date >= input$date[1] &
dup3_crimes.df$date <= input$date[2],]
})
output$tab <- renderTable(datefileter1())
output$Map <- renderLeaflet({
leaflet(data = datefileter1()) %>%
addTiles() %>%
addCircleMarkers(lng = ~Longitude, lat = ~Latitude)
})
}
#Run Shiny App
shinyApp(ui = ui , server =server)

I cannot get slider inputs to modify a map in shiny

I cannot get the map to react with the sliders. THe data was from https://www.kaggle.com/nasa/meteorite-landings/data#
when i move the sliders the map "refreshes" like it resets itself as if something were going to change but all of the data points show up on the graph. any help would be appreciated.
library(shiny)
library(dplyr)
library(leaflet)
library(ggplot2)
Meteor <- read.csv()
#to take all NA values out
ReMeteor <- na.omit(Meteor) #from now on using ReMeteor instead of Meteor
ui <- shinyUI(fluidPage(
titlePanel("Meteorite Landings"),
# Sidebar with a sliders and checkbox
sidebarLayout( position = "right",
sidebarPanel(
#1st slider year range
sliderInput("years","The year the meteorite fell, or the year it was found ",
min = min(ReMeteor$year),
max = max(ReMeteor$year),
step = 1,value = c(1399,2013),
animate = TRUE),
#2nd slider mass range
sliderInput("masss","The mass of the meteorite, in grams",
min = min(ReMeteor$mass),
max = max(ReMeteor$mass),
step = 100,value = c(.010,60000000),
animate = TRUE),
#checkbox
selectInput("fall",
"Was meteorite seen falling or found?",
choices = sort(unique(ReMeteor$fall))),
),
mainPanel( leafletOutput("my_leaf",height = 650, width = 605),textOutput("text1"),textOutput("text2")
))))
server <- shinyServer(function(input, output, session) {
#i think this block of four was letting it refresh, although no changes
filtered <- reactive({
ReMeteor[ReMeteor$year >= input$years[1] & ReMeteor$year <= input$years[2],]
ReMeteor[ReMeteor$mass >= input$masss[1] & ReMeteor$mass <= input$masss[2],]
})
#need last checkbox
# filter(ReMeteor >= input$year[1] &
# ReMeteor <= input$year[2]) %>%
# filter(ReMeteor >= input$mass[1] &
# ReMeteor <= input$mass[2])%>%
# filter(ReMeteor = sort(unique(ReMeteor$fall)))
# fitBounds()#here it is !!! https://rstudio.github.io/leaflet/shiny.html search : fitbounds --- this too https://rstudio.github.io/leaflet/markers.html
output$my_leaf <- renderLeaflet({
leaflet(data = filtered()) %>%
addMiniMap(zoomLevelOffset = -4) %>%
addProviderTiles("Esri.NatGeoWorldMap")
})
#fitBounds(ReMeteor, ReMeteor$reclong,ReMeteor$reclat,ReMeteor$reclong,ReMeteor$reclat)
observe({
# year_ <-input$year
# mass_ <-input$mass
# fall_ <-input$fall
#
leafletProxy("my_leaf", data = filtered()) %>%
clearShapes() %>%
clearMarkers() %>%
clearPopups() %>%
addMarkers(lat = ReMeteor$reclat,
lng = ReMeteor$reclong,
clusterOptions = markerClusterOptions(),
popup = as.character(ReMeteor$name,ReMeteor$recclass))
})
output$text1 <- renderText({
paste("You have chosen a range from the year", input$years[1], "to", input$years[2])
})
output$text2 <- renderText({
paste("You have chosen a range of mass from", input$masss[1], "to", input$masss[2], "grams")
})
})
shinyApp(ui, server)
The issue here is that although you correctly used the reactive value filtered() in your leafletProxy call, you use the non-reactive version of ReMeteor in your addMarkers call.
observe({
leafletProxy("my_leaf", data = filtered()) %>%
clearShapes() %>%
clearMarkers() %>%
clearPopups() %>%
addMarkers(lat = filtered()$reclat,
lng = filtered()$reclong,
clusterOptions = markerClusterOptions(),
popup = as.character(filtered()$name,filtered()$recclass))
})

R shiny checkboxGroup to plot data on map

I am very new to shiny, and I have a question.
I have a simple dataset with observations (Number_Total) of species (Species), in a certain location (X,Y).
I would like to generate a map, that enables you to select the species in a dropdown menu. Shiny then shows you were the species occurs on the map.
I got pretty far (for my experience), but selecting species in the menu does not do anything...
ui <- (fluidPage(titlePanel("Species Checker"),
sidebarLayout(
sidebarPanel(
selectizeInput('species', 'Choose species',
choices = df$Species, multiple = TRUE)
),
mainPanel(
leafletOutput("CountryMap",
width = 1000, height = 500))
)
))
The server side
server <- function(input, output, session){
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5) %>%
addCircles(lng = df$Y, lat = df$X, weight = 10,
radius =sqrt(df$Number_Total)*15000, popup = df$Species)
})
observeEvent(input$species, {
if(input$species != "")
{
leafletProxy("CountryMap") %>% clearShapes()
index = which(df$Species == input$species)
leafletProxy("CountryMap")%>% addCircles(lng = df$X[index],
lat = df$Y[index],
weight = 1,
radius =sqrt(df$Number_Total[index])*30, popup = df$Species[index])
}
})
}
And finally plot it
shinyApp(ui = ui, server = server)
I know my code is probably messy, but again, I blaim my experience =)
I did not manage to get an example dataset in here right away, so here it comes as picture
This is the result of the above code (with slightly different data)
enter image description here
Here's what you need. I think you are skilled enough to understand this but comment if you have any questions.
server <- function(input, output, session) {
# map_data <- reactive({
# req(input$species)
# df[df$Species %in% input$species, ]
# })
output$CountryMap <- renderLeaflet({
leaflet() %>% addTiles() %>%
setView(lng = 10, lat = 40, zoom = 5)
})
map_proxy <- leafletProxy("CountryMap")
observe({
md <- df[df$Species %in% input$species, ]
map_proxy %>%
addCircles(lng = md$Y, lat = md$X, weight = 10,
radius = sqrt(md$Number_Total)*15000, popup = md$Species)
})
}

R Error in get: object '.xts_chob' not found

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.

Resources