Related
This is my code. I am trying to create an interactive webapp where the user can add new data by drawing polygons and then the
I don't understand the error it returns when trying to click 'Run App' in RSTudio or deploy the app to shinyapps (as it works locally when I just run the code). Does someone have an idea why it doesn't work when running or deploying?
## install required packages (if not installed yet)
require(class)
require(dplyr)
require(leafem)
require(leaflet)
require(leaflet.extras)
require(raster)
require(rgdal)
require(rsconnect)
require(sf)
require(sp)
require(shiny)
#### 0. Import Data ####
## import landfills clusters spatial data (point data)
landfills_clusters <- readOGR("plasticleakagewebapp/data/landfill_clusters.gpkg")
landfills_clusters_sf <- st_read('plasticleakagewebapp/data/landfill_clusters.gpkg')
### import landfill polygons
landfills_polygons <- readOGR("plasticleakagewebapp/data/landfills/OpenLandfills_Vietnam.shp", use_iconv = T, encoding = "UTF-8")
## import shapefile of vietnam
vietnam <- readOGR("plasticleakagewebapp/data/vietnam/vietnam.shp")
#### 1. Interactive Map (Leaflet) ####
## plot map with landfills colored by cluster
# e.g. plot water distance < 500m in red
# create color palette
cof <- colorFactor(c("green","blue","red"), domain = c("1","2","3"))
map <- leaflet(landfills_clusters_sf) %>%
addProviderTiles(providers$Esri.WorldImagery) %>%
setView(lng = 105.48, lat = 15.54, zoom = 6) %>%
addMiniMap %>%
addPolygons(data = vietnam, fill = F, weight = 2, color = "#FFFFCC", group = "Outline") %>%
addPolygons(data = landfills_polygons, fill = F, weight = 2, color = "#FFFFCC") %>%
addCircleMarkers(data = landfills_clusters_sf, color = ~cof(km_cluster_unstand), radius = sqrt(landfills_clusters_sf$area_ha)*2,
fillOpacity = 0.5, label = ~name, group = "Risk") %>%
addLegend("bottomleft", colors= c("red","blue","green"), labels=c("high", "medium", "low"), title = "Leakage Risk")
map
#### Interactive Map ####
ui_inter <- fluidPage("Classification the Plastic Leakage Risk of Landfills in Vietnam", id = "nav",
tabPanel("Interactive Map",
div(class = "outer",
# If not using custom CSS, set height of leafletOutput to a number instead of percent
leafletOutput("map", width = "1700px", height = "800px"),
absolutePanel(id = "controls", class = "panel panel-default", fixed = T,
draggable = T, top = 60, left = "auto", right = 20, bottom = "auto",
width = 350, height = "auto",
h2("Plastic Leakage Risk"),
plotOutput("histRain", height = 200),
plotOutput("histWind", height = 200),
),
)
),
tabPanel("Data Explorer",
hr(),
# display the data in an interactive table
DT::dataTableOutput("landfills"),
textInput('Long', 'Enter new landfill longitude'),
textInput('Lat', 'Enter new landfill latitude'),
actionButton("update", "Update Table")
)
)
df <- landfills_clusters_sf[-c(2,9:10,12,16:17)] # select relevant columns
## add long & lat coordinates
df$long <- st_coordinates(landfills_clusters_sf)[,1]
df$lat <- st_coordinates(landfills_clusters_sf)[,2]
server_inter <- function(input, output, session) {
## create interactive map with leaflet
output$map <- renderLeaflet({
map %>%
# add toolbox to draw polygons
addDrawToolbar(
targetGroup = "drawnPoly",
rectangleOptions = F,
polylineOptions = F,
markerOptions = F,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
circleOptions = F,
circleMarkerOptions = F,
polygonOptions = drawPolygonOptions(showArea = T, repeatMode = F, shapeOptions =
drawShapeOptions(fillColor = "orange", clickable = T))) %>%
addStyleEditor()
})
latlongs <- reactiveValues() # temporary to hold coords
latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0))
## create empty reactive spdf to store drawn polygons
value <- reactiveValues()
value$drawnPoly <- SpatialPolygonsDataFrame(SpatialPolygons(list()), data = data.frame(notes=character(0), stringsAsFactors = F))
# fix the polygon to start another
observeEvent(input$map_draw_new_feature, {
coor <- unlist(input$map_draw_new_feature$geometry$coordinates)
Longitude <- coor[seq(1,length(coor), 2)]
Latitude <- coor[seq(2,length(coor), 2)]
isolate(latlongs$df2 <- rbind(latlongs$df2, cbind(Longitude, Latitude)))
poly <- Polygon(cbind(latlongs$df2$Longitude, latlongs$df2$Latitude))
polys <- Polygons(list(poly), ID = input$map_draw_new_feature$properties$`_leaflet_id`)
spPolys <- SpatialPolygons(list(polys))
print(spPolys)
value$drawnPoly <- rbind(value$drawnPoly, SpatialPolygonsDataFrame(spPolys, data = data.frame(notes = NA, row.names = row.names(spPolys))))
## add polygons to landfills polygons df
test <- SpatialPolygonsDataFrame(spPolys, data = data.frame(name = 1:length(spPolys), row.names = row.names(spPolys)))
test#data$area <- NA
test#data$Notes <- NA
test#data$location <- NA
test#proj4string <- CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
new_polygons <- rbind(landfills_polygons, test)
## export new & old landfills to shapefile
shapefile(x = new_polygons, filename = "plasticleakagewebapp/data/landfill/OpenLandfills_Vietnam_total.shp", overwrite = T)
shapefile(x = test, filename = "plasticleakagewebapp/data/landfills/OpenLandfills_Vietnam_new.shp", overwrite = T)
## run DataPreparation script to calculate data of new landfill
source("plasticleakagewebapp/plasticleakage_datapreparation.R")
## import outcome of script
variables <- readOGR("plasticleakagewebapp/data/landfill_variables.gpkg")
# basic landfills as training data
train <- landfills_clusters#data[,c(7:8,11,13:15)]
# newly created landfills (from webapp) as testing data
test <- variables#data[,c(7:8,11,13:14)]
# predict risk class/cluster of new landfill (without re-running clustering algorithm)
knnClust <- class::knn(train = train[,-6], test = test, k = 1, cl = train$km_cluster_unstand)
knnClust
## add cluster as row
variables$km_cluster_unstand <- knnClust
# drop not needed columns
landfills_clusters$risk <- NULL
landfills_clusters$risk_label <- NULL
# combine all landfills into one spdf
new_variables <- rbind(landfills_clusters, variables)
## save results as shapefile
st_write(st_as_sf(new_variables), "plasticleakagewebapp/landfill_clusters_total.gpkg", overwrite = T, append = F)
## update plot upon ending draw
observeEvent(input$map_draw_stop, {
#replot it - take off the DrawToolbar to clear the features and add it back and use the values from the SPDF to plot the polygons
leafletProxy('map') %>%
removeDrawToolbar(clearFeatures = T) %>% removeShape('temp') %>% clearGroup('drawnPoly') %>%
addPolygons(data = value$drawnPoly, group = 'drawnPoly', color = "blue", layerId = row.names(value$drawnPoly)) %>%
addDrawToolbar(
targetGroup = "drawnPoly",
rectangleOptions = F,
polylineOptions = F,
markerOptions = F,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()),
circleOptions = F,
polygonOptions=drawPolygonOptions(showArea = T, repeatMode = F, shapeOptions
= drawShapeOptions(fillColor = "orange", clickable = T)))
})
latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0)) # clear df
## plot newly added landfills & risk cluster
leafletProxy("map", session) %>%
#addPolygons(data = landfills_polygons, fill = F, weight = 2, color = "#FFFFCC") %>%
addCircleMarkers(data = variables, color = ~cof(km_cluster_unstand), radius = sqrt(variables$area_ha)*2,
fillOpacity = 0.5, label = ~name, group = "Risk")
})
# create object for clicked marker (=landfill)
observeEvent(input$map_marker_click,{
## click returns clickid, long & lat
click <- input$map_marker_click
# if(is.null(click))
# return()
leafletProxy("map", session) %>% setView(lng = click$lng, lat = click$lat, zoom = 16)
})
# A reactive expression that returns the set of landfills that are in map bounds (to plot reactive graphs)
landfillsInBounds <- reactive({
if (is.null(input$map_bounds))
return(landfills_clusters_sf[FALSE,])
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
subset(landfills_clusters_sf,
st_coordinates(landfills_clusters_sf)[,2] >= latRng[1] & st_coordinates(landfills_clusters_sf)[,2] <= latRng[2] &
st_coordinates(landfills_clusters_sf)[,1] >= lngRng[1] & st_coordinates(landfills_clusters_sf)[,1] <= lngRng[2])
})
output$histRain <- renderPlot({
# If no zipcodes are in view, don't plot
if (nrow(landfillsInBounds()) == 0)
return(NULL)
hist(landfillsInBounds()$rain,
main = "Weather Data",
xlab = "Average Precipitation (mm)",
xlim = range(landfills_clusters_sf$rain),
col = '#00ffff',
border = 'white')
})
output$histWind <- renderPlot({
# If no landfills are in view, don't plot
if (nrow(landfillsInBounds()) == 0)
return(NULL)
hist(landfillsInBounds()$windspeed,
main = "",
xlab = "Average Wind Speed (km/h)",
xlim = range(landfills_clusters_sf$windspeed),
col = '#00DD00',
border = 'white')
})
output$landfills <- DT::renderDT({
df
})
}
# Run the app
shinyApp(ui_inter, server_inter)
Error which is returend when clicking "Run App" in RStudio:
Fehler in ogrListLayers(dsn = dsn) : Cannot open data source
I would like to ask how to calculate number of point that are in some region when we have longtitue and latitude variables of point and polygon of country and its regions.
I provided example below:
I would like to calculate how many point are in what regions (including zero when there is no point) and than add this variables to data2#data object so one can use count measures to fill each regions polygons.
library(leaflet)
library(tidyverse)
set.seed(101)
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds"
data2 <- readRDS(url(URL2))
URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_ESP_2_sp.rds"
data3 <- readRDS(url(URL3))
URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_PRT_2_sp.rds"
data4 <- readRDS(url(URL4))
URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_GBR_2_sp.rds"
data5 <- readRDS(url(URL5))
random_long_lat <-
data.frame(
long = sample(runif(300, min = -2.5, max = 15.99), replace = F),
lat = sample(runif(300, min = 42.69, max = 59.75), replace = F)
)
all <- rbind(data2, data3, data4, data5)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=all, stroke = TRUE, color = "black", weight="", smoothFactor = 0.95,
fill = F) %>%
addCircles(lng = random_long_lat$long, lat = random_long_lat$lat)
# Here add new variable called count, that would count how many point are in the region
all#data
I would like the result so one can calculate something like this:
all#data <-
all#data %>%
mutate(counts = rnorm(nrow(all), 100, sd = 20))
cuts <- c(0, 5, 20, 40, 80, 150, max(all#data$counts))
cuts <- colorBin("Greens", domain = all$counts, bins = cuts)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=all, stroke = TRUE, color = "white", weight="", smoothFactor = 0.95,
fillOpacity = 0.65, fillColor = ~cuts(all$counts)) %>%
addLegend(pal = cuts,
values = all$counts,
labFormat = labelFormat(suffix = " "),
opacity = 0.85, title = "How many point were counted in each region", position = "topright")
however I dont know is it posible to calculate number of point in each regions having just coordinances?
If you transform the points and France polygons to sf objects, you can use st_intersects() to count the number of points in each polygon.
Note that I updated your sample points so that each quintile break in cuts is unique. With your original data, the first three quintiles were just 0 so the coloring in the leaflet map didn't work.
new sample data
library(leaflet)
library(tidyverse)
set.seed(101)
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds"
data2 <- readRDS(url(URL2))
random_long_lat <-
data.frame(
long = sample(runif(1000, min = -2.5, max = 5.99), replace = F),
lat = sample(runif(1000, min = 42.69, max = 49.75), replace = F)
)
make sf objects and count points in polygons
library(sf)
data_sf <- data2 %>% st_as_sf()
random_long_lat_sf <- random_long_lat %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
data_sf_summary <- data_sf %>%
mutate(counts = lengths(st_intersects(., random_long_lat_sf)))
define breaks for legend and draw map
cuts <- quantile(data_sf_summary$counts, probs = seq(0, 1, 0.2))
cuts <- colorBin("Greens", domain = data_sf_summary$counts, bins = cuts)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data_sf_summary, stroke = TRUE, color = "white", weight="", smoothFactor = 0.95,
fillOpacity = 0.65, fillColor = ~cuts(data_sf_summary$counts)) %>%
addLegend(pal = cuts,
values = data_sf_summary$hdp,
labFormat = labelFormat(suffix = " "),
opacity = 0.85, title = "How many point were counted in each region", position = "topright")
Also note that tmap package, which lets you switch between static and interactive maps using the same syntax (which resembles ggplot syntax).
same map with tmap:
library(tmap)
tmap_mode("view") # make map interactive
tm_shape(data_sf_summary) +
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
title = "How many point were counted in each region")
static map with tmap:
library(tmap)
tmap_mode("plot") # make map static
tm_shape(data_sf_summary) +
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top"))
For multiple countries
First create new sample points that cover Europe:
random_long_lat <-
data.frame(
long = sample(runif(1000, min = -7.5, max = 19.99), replace = F),
lat = sample(runif(1000, min = 38.69, max = 60.75), replace = F)
)
all <- rbind(data2, data3, data4, data5)
Then make the sf objects and find the counts of points in every polygon:
all_sf <- all %>% st_as_sf()
random_long_lat_sf <- random_long_lat %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
all_sf_summary <- all_sf %>%
mutate(counts = lengths(st_intersects(., random_long_lat_sf)))
qtm(random_long_lat_sf)
Option 1: Choose maps from a list object by name using the NAME_0 column.
tmap_mode("view") # make maps interactive
list_of_maps <- map(unique(all_sf_summary$NAME_0),
~ tm_shape(all_sf_summary %>%
filter(NAME_0 == .x)) + # filter the data for your country of interest
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
alpha = 0.85,
border.col = NA,
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top"))) %>%
set_names(unique(all_sf_summary$NAME_0))
list_of_maps[['France']]
list_of_maps[['Portugal']]
Option 2: Show all the maps at once
### all maps at once
tm_shape(all_sf_summary) + # filter the data for your country of interest
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
alpha = 0.85,
border.col = NA,
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top")) +
tm_facets(by = c("NAME_0"), ncol = 2, showNA = FALSE)
With the code below I get my dataframe with US county data
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
My object is to crate an interactive leaflet choropleth map of Avg_yield so first I fortify my USA polygon data
library(rgeos)
library(maptools)
library(ggplot2)
states.shp.f <- fortify(USA, region = "NAME_2")
Then I subset my dataset and merge it with the fortified:
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"id"
## merge shape file with data
merge.shp.coef <- merge(states.shp.f, mydata2, by = "id")
but now I have a dataset with every county name many times and also some counties have different values of Avg_yield. Whats the proper way to process those data in order to use the leaflet code like:
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)
The propoer way to do this is to transform your polygon object into a sf object
with st_as_sf()
Here you have a working example :
(I did used some other data for the polygon, I thought yours too precise and require a lot of resources, plus I made it work with shiny)
library(leaflet)
library(tidyverse)
library(ggplot2)
library(sf)
library(shiny)
USA <- st_read(dsn = '[your path]/cb_2018_us_county_500k.shp')
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
states_sf <- st_as_sf(USA)
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"NAME"
## merge shape file with data
states_sf_coef <- left_join(states_sf, mydata2, by = "NAME")
ui <- fluidPage(
leafletOutput("map", height = "100vh")
)
server <- function(input, output, session) {
bins <- c(0, 5, 10, 15, 20, 25, 30, 35, 40)
mypal <- colorBin("YlOrRd", domain = states_sf_coef$Avg_yield, bins = bins)
#Sortie map
output$map <- renderLeaflet({
leaflet()%>%
addProviderTiles("OpenStreetMap.Mapnik")%>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(
data = states_sf_coef,
fillColor = ~mypal(states_sf_coef$Avg_yield),
stroke = FALSE,
smoothFactor = 0.2,
fillOpacity = 0.3,
popup = paste("Region: ", states_sf_coef$NAME_2, "<br>",
"Avg_yield: ", states_sf_coef$Avg_yield, "<br>"))%>%
addLegend(position = "bottomleft",
pal = mypal,
values = states_sf_coef$Avg_yield,
title = "Avg_yield",
opacity = 1)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
I have created a map that has different layers for different variables, but would like to also have a selector box that allows you to select which year you view, essentially filtering the data for that particular year.
The code below makes the map based on all years data. I'd like almost the same map, but with the ability to change what year you are viewing data for (i.e. 1990, 1991, 1992, or 1993)
# get shapefiles (download shapefiles: http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip)
usgeo <- st_read("~/cb_2014_us_county_5m/cb_2014_us_county_5m.shp") %>%
mutate(fips = as.numeric(paste0(STATEFP, COUNTYFP)))
### alternatively, tweak this code so you can download data directly ####
temp <- tempfile()
download.file("http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip",temp)
data <- st_read(unz(temp, "cb_2014_us_county_5m.shp"))
unlink(temp)
########################################################
# create fake data
sample <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
# join fake data with shapefiles
sample <- st_as_sf(sample %>% left_join(usgeo))
# drop layers (not sure why, but won't work without this)
sample$geometry <- st_zm(sample$geometry, drop = T, what = "ZM")
# change projection
sample <- sf::st_transform(sample, "+proj=longlat +datum=WGS84")
# create popups
incomepopup <- paste0("County: ", sample$NAME, ", avg income = $", sample$income)
poppopup <- paste0("County: ", sample$NAME, ", avg pop = ", sample$pop)
lifepopup <- paste0("County: ", sample$NAME, ", avg life expectancy = ", sample$life)
# create color palettes
lifePalette <- colorNumeric(palette = "Purples", domain=sample$life)
incomePalette <- colorNumeric(palette = "Reds", domain=sample$income)
popPalette <- colorNumeric(palette = "Oranges", domain=sample$pop)
# create map
leaflet(sample) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = poppopup,
color = ~popPalette(sample$pop),
group = "pop") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = lifepopup,
color = ~lifePalette(sample$life),
group = "life") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = incomepopup,
color = ~incomePalette(sample$income),
group = "income") %>%
addLayersControl(
baseGroups=c("income", "life", "pop"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
The first map here (and screenshotted below) shows the output of what I already have (except the data is filtered for only year == 1993). I'd like that, but without the "year" variable, and instead, an additional selector box that would allow you to select which year you want data for.
Using these instructions: win.graph()
map("usa")
map("usa",col='white',fill=T, xlim=c(-73.7 ,-71.52), ylim=c(38.6,40.92))
points.geodata(x=dat_zero,coords=dat_zero$coords,dat_zero$data,pt.divide="quintiles",
col=1:5,xlim=c(-73.7 ,-71.52), ylim=c(38.6,40.92),add.to.plot = T)
not from mistakes but does not do it.
welcome to SO. Generally it's a good idea to include what packages you may have loaded and more description of the problem itself.
Here's an approach using plotly. I'm using ggplot2::map_data() to generate some sample data (larger dataset) and show how it works:
library(ggplot2)
library(plotly)
dat <- map_data(map = 'county')
# map_data() is a large dataset, I'm limiting the map to 50 observations
# the coords$value field is the variable that determines the color of the mapped point
coords <- dat[sample(sample(x = 1:nrow(dat), size = 50, replace = T)), ]
coords$value <- rnorm(n = nrow(coords), mean = 10, sd = 3)
# some code to let plotly know we're plotting a map (projection etc.)
g <- list(
scope = 'usa',
projection = list(type = 'Mercator'),
showland = TRUE,
landcolor = toRGB("gray85"),
subunitwidth = 1,
countrywidth = 1,
subunitcolor = toRGB("white"),
countrycolor = toRGB("white")
)
plt <- plot_geo(locationmode = 'USA-states', sizes = c(1, 250), data = coords) %>%
add_markers(x = ~long, y = ~lat, color = ~value) %>%
layout(title = 'County Map',
geo = g)
OUTPUT