Removing density (polygon )outside country map boundary in R - r

I have a location point data (lat and long) like this to map and I want to remove density lines outside the US map boundary.
df1<-structure(list(Latitude = c(44.085655, 45.75582402, 44.465059,
46.85455171, 44.79125494, 44.085655, 44.43086558, 45.75582402,
44.77051274, 45.19945455, 47.27561322, 44.21957345, 44.3090238,
44.94220871, 44.961121, 44.710093, 44.34052462, 45.11789419,
45.95867596, 46.56683647, 46.50792317, 44.45755466, 45.07106473,
44.28764499, 45.77015307, 44.71947041, 45.00157585, 44.68872029,
44.533648, 46.88808589, 44.56185674, 44.08025478, 45.36716924,
44.82353463, 45.06309272, 46.14316994, 44.47153, 44.29015112,
44.3461, 44.3429524167217, 44.3622947358144, 46.861376854859,
46.193502, 44.28649439, 44.677071, 44.656418), Longitude = c(-70.164692,
-87.08797801, -73.1317265, -68.03996219, -68.80975286, -70.164692,
-71.18455899, -87.08797801, -85.64676572, -67.27073026, -68.58126288,
-73.50262934, -71.75870552, -72.17091902, -74.82915083, -73.447775,
-74.12240542, -87.60659852, -86.22085006, -87.408152, -84.3395823,
-83.33775439, -83.42056958, -85.39666393, -84.72208165, -84.69989941,
-84.66704973, -85.64621272, -87.933788, -67.99941449, -70.54746671,
-70.18023411, -68.53049377, -68.73114004, -69.87230606, -67.83254698,
-73.20752, -69.69422198, -69.7603999999998, -69.7510695984823,
-69.8046068622161, -68.0330276970697, -67.801417, -69.6878877839999,
-67.57706, -67.646081)), row.names = c(NA, -46L), class = "data.frame")
I am mapping this data with this code:
world <- ne_countries(scale = "medium", returnclass = "sf")
usa = filter(world,admin =="United States of America")
usa <- st_as_sf(maps::map("state", fill=TRUE, plot =FALSE))
# Plot
ggplot() +
geom_sf(data = usa, fill = "blue",color = "black",alpha=.9) +
coord_sf(
xlim = c(-119, -74),
ylim = c(22, 51),
default_crs = sf::st_crs(4326),
crs = st_crs("ESRI:102003"),
expand = TRUE,
lims_method = "box",
label_axes = list(
bottom = "E", top = "E",
left = "N", right = "N"
))+stat_density2d_filled(data = df1, aes(x = Longitude, y = Latitude, fill=(..level..),
alpha = (..level..)), geom = "polygon")
The plot is like that
I am looking to remove the polygons are outside the US map (Blue texture). I have used this code to do that but In step 2 I have problem :
#Step 1
spdf <- SpatialPointsDataFrame(coords = vetrace1[, c("Longitude", "Latitude")], data = vetrace1,
proj4string = CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))
step 2
whatever <- spdf[!is.na(over(spdf, as(usa, "SpatialPolygons"))), ]
# step 3
whatever <- as.data.frame(whatever)
The error I got is :
"Error in h(simpleError(msg, call)) :
error in evaluating the argument 'y' in selecting a method for function 'over': no method or default for coercing “sf” to “SpatialPolygons”"
Could you help me how to trim this map.

Related

R tmap how to show only 1 legend

I have this script that draw a wkt file, how to show only 1 legend not two
library(sf)
library(tmap)
dataset= read.csv('https://raw.githubusercontent.com/djouallah/loadRobjectPBI/master/wkt/wkt.csv')
dataset <- dataset[c("geometry","color","status","labels")]
dataset$color <- as.character(dataset$color)
map <- st_as_sf(dataset, wkt="geometry",crs = 4326)
chartlegend <- unique(dataset[c("status","color")])
chartlegend <- chartlegend[order(chartlegend$status),]
rm(dataset)
tm_shape(map)+tm_lines(col="color",lwd = 3.5)+tm_symbols(col = "color", size = 0.06,shape=15)+tm_text(text="labels",col="white")+
rm(map)+
tm_add_legend(type='fill',labels=chartlegend$status, col=chartlegend$color)+
tm_layout(frame = FALSE,bg.color = "transparent",legend.width=2)+
tm_legend(position=c("right", "top"),text.size = 1.3)+
rm(chartlegend)

R: import satellite image for specific region

Based on simulation data I have created raster file that indicates hazard, aka hazard map:
library(raster)
rockfall_intensity <- raster (xmn = 696583.6, xmx = 696799.6, ymn = 167579.6, ymx = 167789.6, res = 2,
crs = "+proj=somerc +lat_0=46.95240555555556 +lon_0=7.439583333333333 +k_0=1 +x_0=2600000 +y_0=1200000 +ellps=bessel +towgs84=674.374,15.056,405.346,0,0,0,0 +units=m +no_defs")
# average kinetic energy per raster cell
rockfall_intensity <- rasterize(trjct[, c('x', 'y')], rockfall_intensity, trjct$Etot, fun = mean)
plot(rockfall_intensity, col=brewer.pal(9,"YlOrRd"))
I want to download satelite image for this region (and pin the raster on top). I have looked into the get_map function
??get_map
mapImageData3 <- get_map(location = c(lon = -7.439583333333333, lat = 46.95240555555556),
color = "color",
source = "google",
maptype = "roadmap",
zoom = 16)
ggmap(mapImageData3,
extent = "device",
ylab = "Latitude",
xlab = "Longitude")
Theme element panel.border missing
Error in if (theme$panel.ontop) { : argument is of length zero
In addition: Warning message:
`panel.margin` is deprecated. Please use `panel.spacing` property instead
How can I fix the error ?
Is this there a better way to do this?
I am hoping to get an hazad map, something like:
You have a few problems here:
Your location is in the middle of the ocean. You're selecting roadmap, at a very high zoom. So you will see nothing but blue.
Use maptype = "satellite" if you want the kind of map you're showing in the photo above, and a smaller zoom.
If you want to actually see the labels (and not get the warning), select a different value for extent.
For example:
mapImageData3 <- get_map(location = c(lon = -7.43958, lat = 46.95241),
color = "color", source = "google",
maptype = "satellite", zoom = 7)
ggmap(mapImageData3, extent = "normal", ylab = "Lattitude",
xlab = "Longitude")

R googleway map cannot be loaded

I am trying to use R googleway to analyze crime records from NY Open Data. I want to add precinct polygon and crime circle to NY city map. However, even when I reduce the total crime points to 19k, I still cannot load the created map. Please see the code below.
map_key = "api_key
ggmap = google_map(location = c(mean(40.730610), mean(-73.935242)), zoom =
11, key = map_key)
ggmap %>% add_polygons(data = nypp_df_gg, lat = "lat", lon = "lon", id =
"ID", pathId = "pathID") %>% add_circles(lat = "Latitude", lon =
"Longitude", data = data.frame(NYPD_complaint_bf2006))
It does work if I limit the rows to 500. May I know if there is a way to visualize large observations>1MM? I tried to use add_heatmap but without any luck too.
The code that works is
ggmap %>% add_polygons(data = nypp_df_gg, lat = "lat", lon = "lon", id =
"ID", pathId = "pathID") %>% add_circles(lat = "Latitude", lon =
"Longitude", data = data.frame(NYPD_complaint_bf2006[1:500,]))
I can plot 22k circles using add_circles() if you play around with the load interval.
add_circles(lat = "Y", lon = "X", info_window = "SPECIES", update_map_view = FALSE,
focus_layer = FALSE, load_interval = 25, radius = 5, ...)
I sorted my data so it would start filling in the center of the map using a distance calculation to where I defined the center lat, lon.

How to make a SpatialLines object from undefined - but known - spatial sequence of points in R?

I have a SpatialPoints object that can define a SpatialLines object. The problem is I don't have any information attribute about the sequence of the points to create the Lines. So, making Lines from points following the order of the rows I get lines that don't follow my desired criteria. I think I have to define some rules based on maybe:
Nearest points
Direction
Or both
How can I achieve that?
# Load packages
library('sp')
# Load data
x <- c(788722.0, 788764.6, 788784.1, 788774.2, 788796.7, 788755.5, 788805.7, 788745.6, 788731.0, 788815.1, 788711.8, 788708.6, 788824.9, 788699.7, 788833.6, 788690.3, 788677.9, 788842.4, 788671.9, 788665.9)
y <- c(6193202, 6193217, 6193212, 6193212, 6193197, 6193217, 6193207, 6193216, 6193202, 6193211, 6193207, 6193230, 6193217, 6193235, 6193224, 6193235, 6193236, 6193230, 6193244, 6193252)
# Define projection
epsg.32721 <- "+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs"
# Create SpatialPoints object
spatialPointsObject <- SpatialPoints(coords = cbind(x,y), proj4string = CRS(epsg.32721))
# Plot SpatialPoints
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "SpatialPoints")
box()
SpatialPoints plot with order of points I want to achieve
# Create SpatialLines objects from SpatialPoints
line <- Line(coords = spatialPointsObject#coords)
lines <- Lines(slinelist = line, ID = "X")
spatialLinesObject <- SpatialLines(LinesList = list(lines), proj4string = CRS(epsg.32721))
# Plot SpatialLines + SpatialPoints
plot(spatialLinesObject, xlab = "Longitude", ylab = "Latitude", main = "SpatialLines + SpatialPoints")
points(spatialPointsObject, pch = 19)
box()
SpatialLines plot without the desired order of points I want to achieve
2nd example
Moving point 6 rightmost to exclude sort points by x coordinate attribute as a solution to the problem
# Load packages
library('sp')
# Load data
x <- c(788722, 788764, 788784, 788774, 788796, 788755, 788805, 788745, 788731, 788815, 788711, 788720, 788824, 788699, 788833, 788690, 788677, 788842, 788671, 788665)
y <- c(6193202, 6193217, 6193212, 6193212, 6193197, 6193217, 6193207, 6193216, 6193202, 6193211, 6193207, 6193230, 6193217, 6193235, 6193224, 6193235, 6193236, 6193230, 6193244, 6193252)
# Define projection
epsg.32721 <- "+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs"
# Create SpatialPoints object
spatialPointsObject <- SpatialPoints(coords = cbind(x,y), proj4string = CRS(epsg.32721))
# Plot SpatialPoints
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "SpatialPoints")
box()
SpatialPoints plot with order of points I want to achieve
Hope this helps:
# Load packages
library('sp')
# Load data
x <- c(788722.0, 788764.6, 788784.1, 788774.2, 788796.7, 788755.5, 788805.7, 788745.6, 788731.0, 788815.1, 788711.8, 788708.6, 788824.9, 788699.7, 788833.6, 788690.3, 788677.9, 788842.4, 788671.9, 788665.9)
y <- c(6193202, 6193217, 6193212, 6193212, 6193197, 6193217, 6193207, 6193216, 6193202, 6193211, 6193207, 6193230, 6193217, 6193235, 6193224, 6193235, 6193236, 6193230, 6193244, 6193252)
# Define projection
epsg.32721 <- "+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs"
# Create SpatialPoints object
spatialPointsObject <- SpatialPoints(coords = cbind(x,y), proj4string = CRS(epsg.32721))
# Plot SpatialPoints
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "SpatialPoints")
box()
# Create SpatialLines objects from SpatialPoints
tmp <- spatialPointsObject#coords
tmp <- as.data.frame(tmp)
tmp <- tmp[order(tmp$x),]
spatialPointsObject#coords <- as.matrix(tmp)
line <- Line(coords = spatialPointsObject#coords)
lines <- Lines(slinelist = line, ID = "X")
spatialLinesObject <- SpatialLines(LinesList = list(lines), proj4string = CRS(epsg.32721))
# Plot SpatialLines + SpatialPoints
plot(spatialLinesObject, xlab = "Longitude", ylab = "Latitude", main = "SpatialLines + SpatialPoints")
points(spatialPointsObject, pch = 19)
box()
I could solve my own question:
Option 1
With a function (MakeSpatialLineFromUnsortedSpatialPoints) defining the starting point as Point 1 of the desired line and then finding the nearest point as Point 2. After I got Point 2, finding the nearest point from Point 2 but excluding Point 1 to get Point 3 and so on. To find Point n I have to find the nearest point from Point n-1 excluding all the previous points from Point n-1.
I also included some checks in the function to validate 1) if the input spatialPointsObject is a SpatialPoints class object and 2) warn if there are duplicated points.
Option 2
Using the Traveling Salesperson Problem package TSP.
Input:
# Load packages
library('sp')
library('rgeos')
# Define projection
epsg.32721 <- "+proj=utm +zone=21 +south +datum=WGS84 +units=m +no_defs"
# Load data
x <- c(788722, 788764, 788784, 788774, 788796, 788755, 788805, 788745, 788731, 788815, 788711, 788720, 788824, 788699, 788833, 788690, 788677, 788842, 788671, 788665)
y <- c(6193202, 6193217, 6193212, 6193212, 6193197, 6193217, 6193207, 6193216, 6193202, 6193211, 6193207, 6193230, 6193217, 6193235, 6193224, 6193235, 6193236, 6193230, 6193244, 6193252)
# Create SpatialPoints object
spatialPointsObject <- SpatialPoints(coords = cbind(x,y), proj4string = CRS(epsg.32721))
# Plot SpatialPoints
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "SpatialPoints")
box()
Option 1:
# Function
MakeSpatialLineFromUnsortedSpatialPoints <- function(spatialPointsObject, startPointCell, projection) {
# Check if spatialPointsObject is a SpatialPoints object
isSP = class(spatialPointsObject) == "SpatialPoints"
if(!isSP) {
return(print("Warning: the spatialPointsObject argument is not a SpatialPoints object"))
}
# Remove duplicate points
n = length(spatialPointsObject)
spatialPointsObject = remove.duplicates(obj = spatialPointsObject, remove.second = TRUE)
# Warn if there are duplicate points in data
if(n > length(spatialPointsObject)) {
print("Warning: you have duplicate points in your SpatialPoints object. The duplicated points were removed.")
}
seqCell = integer()
seqCell[1] = startPointCell
# Now calculate pairwise distances between points excluding previous points
for(i in 2:length(spatialPointsObject)) {
distancesFromPoint = gDistance(spgeom1 = spatialPointsObject[seqCell[i-1]], spgeom2 = spatialPointsObject, byid=TRUE)
minDist = min(distancesFromPoint[-seqCell,])
minDistCell = as.numeric(names(which(distancesFromPoint[,][-seqCell] == minDist)))
seqCell[i] = minDistCell
}
SL = SpatialLines(LinesList = list(Lines(slinelist = Line(spatialPointsObject[seqCell]#coords), ID = "1")), proj4string = CRS(projection))
return(SL)
}
spatialLinesObject <- MakeSpatialLineFromUnsortedSpatialPoints(spatialPointsObject = spatialPointsObject, startPointCell = 20, projection = epsg.32721)
# Plots
# Plot SpatialPoints object
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "")
# Plot starting point
plot(spatialPointsObject[20], pch = 19, col = 'blue', add = TRUE)
# Plot SpatialLines
plot(spatialLinesObject, col = 'green', add = TRUE)
box()
Plot: SpatialPoints and desired SpatialLine
Update
Option 2:
# Load packages
library('sp')
library('TSP')
# TSP
tsp <- TSP(dist(spatialPointsObject#coords))
tsp <- insert_dummy(tsp, label = "cut")
tour <- solve_TSP(tsp, method="nn", two_opt=TRUE, rep=10, start=20)
path.tsp <- unname(cut_tour(tour, "cut"))
spatialLinesObject <- SpatialLines(LinesList = list(Lines(slinelist = Line(spatialPointsObject[path.tsp,]#coords), ID = "1")), proj4string = CRS(epsg.32721))
# Plots
# Plot SpatialPoints object
plot(spatialPointsObject, pch = 19, xlab = "Longitude", ylab = "Latitude", main = "")
# Plot starting point
plot(spatialPointsObject[20], pch = 19, col = 'blue', add = TRUE)
# Plot SpatialLines
plot(spatialLinesObject, col = 'green', add = TRUE)
box()

R maps - Filter coordinates out when plotting points in map

I have a large data frame of events locations (longitude, latitude). See a sample below:
events <- structure(list(lat = c(45.464944, 40.559207, 45.956775, 44.782831, 45.810287, 35.913357, 43.423855, 45.2359, 45.526025, 41.91371, 46.340833, 40.696482, 42.367164, 41.913701, 41.89167, 46.046206, 41.108316, 45.514132, 45.688118, 37.090387, 43.446555, 41.913712, 46.614833, 45.368825, 41.892168), lon = c(9.163453, 8.321587, 12.983347, 10.886471, 9.077844, 10.560439, 6.768272, 9.23176, 9.375761, 12.466994, 6.889444, 17.316925, 13.352248, 12.466992, 12.516713, 14.497758, 16.871019, 12.056176, 9.176543, 15.293506, 6.77119, 12.466993, 15.194904, 11.110711, 12.516085)), .Names = c("lat", "lon"), row.names = c(NA, 25L), class = "data.frame")
and I would like to plot only the events that happened in a given country (for instance, Italy).
The following plots all events:
library(rworldmap)
library(maps)
par(mar=c(0,0,0,0))
plot(getMap(resolution="low"), xlim = c(14,14), ylim = c(36.8,47))
points(x=events$lon, y=events$lat, pch = 19, col ='red' , cex = 0.6)
How can I filter out the events that fall outside the boundaries of the country ? Thank you in advance for help and support.
assign polygon map to an object:
m = getMap(resolution="low")
convert events into an sp object -- first longitude, then latitude:
pts = SpatialPoints(events[c(2,1)])
assign CRS:
proj4string(pts) = proj4string(m)
plot points inside any of the polygons:
points(pts[m,], pch = 3)
select points inside Italy:
it = m[m$ISO_A2 == "IT",]
points(pts[it,], col = 'blue')
(this uses sp::over, but behind the scenes)

Resources