I am traying to create a map (specifically a Porto city map) I have somes points that are represents by latitude and longitud degree. But the points are very accurate and I want to create a grid to put the similars and close points together.
In this way I could take more relevant information for zones that concentrates more points.
########### Exploratory Visualization of the station locations ###########
# Create a data frame showing the **Latitude/Longitude**
# They are more than 5000 points (these they are only an example)
station <- data.frame(lat = c(41.141412, 41.140359, 41.151951, 41.18049),
long = c(-8.618643, -8.612964, -8.574678, -8.645994),
station = 1:4)
# Convert to SpatialPointsDataFrame
coordinates(station) <- ~long + lat
# Set the projection. They were latitude and longitude, so use WGS84 long-lat projection
proj4string(station) <- CRS("+init=epsg:4326")
# View the station location using the mapview function
mapview(station)
########### Determine the origin NOT RUN ###########
# Set the origin
ori <- SpatialPoints(cbind(41.141412, -8.618643), proj4string = CRS("+init=epsg:4326"))
# Convert the projection of ori
# Use EPSG: 3857 (Spherical Mercator)
ori_t <- spTransform(ori, CRSobj = CRS("+init=epsg:3857"))
coordinates(ori)
coordinates(ori_t)
########### Determine the extent of the grid ###########
# Transformed with https://epsg.io/
y_ori <- 5029715.97
x_ori <- -966577.67
# Define how many cells for x and y axis
x_cell <- 16
y_cell <- 12
# Define the resolution to be 1000 meters
cell_size <- 1000
# Create the extent
ext <- extent(x_ori, x_ori + (x_cell * cell_size), y_ori, y_ori + (y_cell * cell_size))
ext
# Initialize a raster layer
ras <- raster(ext)
# Set the resolution to be
res(ras) <- c(cell_size, cell_size)
ras[] <- 0
# Project the raster
projection(ras) <- CRS("+init=epsg:3857")
# Create interactive map
mapview(station) + mapview(ras)
########### Determine the extent of the grid ###########
# Save the raster layer
writeRaster(ras, filename = "ras.tif", format="GTiff")
# Convert to spatial pixel
st_grid <- rasterToPoints(ras, spatial = TRUE)
gridded(st_grid) <- TRUE
st_grid <- as(st_grid, "SpatialPixels")
The result of this code are 4 points over the map of Porto and a grid over there. I want to the nearby points belong to the same grid.
Thank!
Related
I want to assess if the observations in my data are spatially randomly distributed over the sampling area (Sweden). I wanted to reproduce the example given in this answer: Spatial Autocorrelation Analysis (Global Moran's I) in R
Here is a small subset of my data, and the spatial polygon I used. Note that the coordinates are in SWEREF99 (ESPG: 3006)
## spatial polygon of Sweden
library(rworldmap)
library(sp)
worldmap <- getMap(resolution = "high")
sweden <- worldmap[which(worldmap$SOVEREIGNT == "Sweden"),]
plot(sweden)
sweden
## conversion to EPSG: 3006 (SWEREF99 TM) (https://spatialreference.org/ref/epsg/3006/)
crs.laea <- CRS("+proj=utm +zone=33 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs")
sweden_proj <- spTransform(sweden, crs.laea)
## Data subset
x <- c(669894, 669894, 669894, 671088, 671117, 671117, 671117, 670513, 670513, 670513, 669921, 669310, 669310, 669310, 669303, 629720, 630318, 630925, 630925, 630925)
y <- c(7116684, 7116684, 7116684, 7116706, 7114900, 7114900, 7114900, 7114896, 7114896, 7114896, 7114888, 7115473, 7115473, 7115473, 7116075, 7131172, 7131180, 7131190, 7131190, 7131190)
library(spatstat)
coords.ppp_1 <- ppp( x , y , xrange = c(280227, 911417) , yrange = c(6142436, 7605020) )
coords.ppp <- unique(coords.ppp_1)
### plot data and Sweden map for check
plot(coords.ppp_1)
plot(sweden_proj, add=T)
So far it seems ok. Then I convert the spatial polygon to an owin object, simulate random data for comparison, and do the analysis.
library(maptools)
sw <- as.owin.SpatialPolygons(sweden_proj)
# Generate completely spatially random point patterns to compare against the observed
n <- coords.ppp_1$n
ex <- expression(runifpoint( n , sw))
# Compute a simulation envelope using Gest, which estimates the nearest neighbour distance distribution function G(r)
set.seed(1)
res <- envelope( coords.ppp , Gest , nsim = 99, simulate = ex ,verbose = FALSE, savefuns = TRUE )
plot(res)
With the envelope() I get the following error message:
"In envelopeEngine(X = X, fun = fun, simul = simrecipe, nsim = nsim, :
Window containing simulated patterns is not a subset of data window"
I suspect that there is a problem with the conversion between sp and owin, but I couldn't figure out what the issue really is.
Any advice?
I am trying to interpolate a irregular raster grid to a regular grid using akima library in R. However, after I define the regular grid and interpolate the values to the new regular grid, I end up in a strange raster position. I'm doing something wrong but I don't see where. If anyone has a solution (or know a different approach), please let me know. Thank you very much.
library(raster)
library(akima)
library(rgdal)
library(sp)
# download the file
url <- 'https://downloads.psl.noaa.gov/Datasets/NARR/Derived/monolevel/air.2m.mon.ltm.nc'
file <- paste0(getwd(), "/airtemp.nc")
download.file(url, file, quiet = TRUE, mode = "wb") # less than 4 mb
# define the grid edges according to https://psl.noaa.gov/data/gridded/data.narr.monolevel.html
y <- c(12.2, 14.3, 57.3, 54.5)
x <- c(-133.5, -65.1, -152.9, -49.4)
xym <- cbind(x, y)
p = Polygon(xym)
ps = Polygons(list(p),1)
sps = SpatialPolygons(list(ps))
# create a spatial grid to 0.3 cell size
xy <- makegrid(sps, cellsize = 0.3)
xy$first <-1
names(xy) <- c('x','y',"first")
coordinates(xy)<-~x+y
gridded(xy)<-T
# read the netcdf file and extract the values
cape <- brick(file)[[1]] #get the first layer only
rp <- rasterToPoints(cape)
rp <- na.exclude(rp)
# interpolate to the crs for Northern America Conformal Conic
r2 <- project(rp[,1:2], paste('+proj=lcc +lat_1=20 +lat_2=60 +lat_0=40 +lon_0=-96 +x_0=0 +y_0=0 +datum=NAD83 +units=m +no_defs'), inv=TRUE, use_ob_tran=TRUE)
# add the transformed coordinates
rp[,1:2] <-r2
rp <- as.data.frame(rp)
# create a spatial points object and plot it
coordinates(rp)<-~x+y
spplot(rp, scales=list(draw = T))
# interpolate the points to the coordinates (takes a while)
akima.sp <- interpp(x = coordinates(rp)[,1], y = coordinates(rp)[,2],
z = rp#data[,names(rp)[1]],
xo = coordinates(xy)[,1],
yo = coordinates(xy)[,2],
linear = F, extrap = F)
# create a raster file
r.a <- rasterFromXYZ(as.matrix(data.frame(akima.sp)))
plot(r.a)
I defined a polygon:
library(rgee)
ee_Initialize()
polygon <- ee$Geometry$Polygon(
list(
c(91.17, -13.42),
c(154.10, -13.42),
c(154.10, 21.27),
c(91.17, 21.27),
c(91.17, -13.42)
))
Map$addLayer(polygon)
The polygon covers countries around south-east Asia
For each pixel in the polygon, I want to calculate monthly sum of a given band for a given year as follows:
month_vec <- 1:12
pr_ls <- list()
for(m in seq_along(month_vec)){
month_ref <- month_vec[m]
pr_ls[[m]] <-
ee$ImageCollection("NASA/NEX-GDDP")$
filterBounds(polygon)$ # filter it by polygon
select('pr')$ # select rainfall
filter(ee$Filter$calendarRange(2000, 2000, "year"))$ # filter the year
filter(ee$Filter$calendarRange(month_ref, month_ref, "month"))$ # filter the month
filter(ee$Filter$eq("model","ACCESS1-0"))$ # filter the model
sum() # sum the rainfall
}
Imagecollection_pr <- ee$ImageCollection(pr_ls)
ee_imagecollection_to_local(
ic = Imagecollection_pr,
region = polygon,
dsn = paste0('pr_')
)
Reading a single month's file
my_rast <- raster(list.files(pattern = '.tif', full.names = TRUE)[1])
Since this raster covers southeast asian countries, I downloaded the shapefile
sea_shp <- getData('GADM', country = c('IDN','MYS','SGP','BRN','PHL'), level = 0)
Plotting them on top of each other:
plot(my_rast)
plot(sea_shp, add = T)
There is a misalignment and I am not sure if it is the right raster that has been
processed for the given polygon. I also checked if their projection is same
crs(my_rast)
CRS arguments: +proj=longlat +datum=WGS84 +no_defs
crs(sea_shp)
CRS arguments: +proj=longlat +datum=WGS84 +no_defs
Both of them have the same projection as well. I cannot figure out what went wrong?
EDIT
As suggested in comments, I defined a new polygon covering Australia as follows:
polygon <- ee$Geometry$Polygon(
list(
c(88.75,-45.26),
c(162.58,-45.26),
c(162.58,8.67),
c(88.75,8.67),
c(88.75,-45.26)
)
)
Map$addLayer(polygon)
and repeated the above code. Plotting the raster again for the month of March on polygon gives me this:
Does anyone know if I can check if my raster is reversed w.r.t to polygon boundaries?
This seems to be related to rgdal rather than to the raster package. Some raster downloaded from GEE have data flipped with respect to y. I solved this problem, as follow:
library(rgee)
library(raster)
ee_Initialize()
polygon <- ee$Geometry$Polygon(
list(
c(91.17, -13.42),
c(154.10, -13.42),
c(154.10, 21.27),
c(91.17, 21.27),
c(91.17, -13.42)
))
month_vec <- 1:12
pr_ls <- list()
for(m in seq_along(month_vec)){
month_ref <- month_vec[m]
pr_ls[[m]] <-
ee$ImageCollection("NASA/NEX-GDDP")$
filterBounds(polygon)$ # filter it by polygon
select('pr')$ # select rainfall
filter(ee$Filter$calendarRange(2000, 2000, "year"))$ # filter the year
filter(ee$Filter$calendarRange(month_ref, month_ref, "month"))$ # filter the month
filter(ee$Filter$eq("model","ACCESS1-0"))$ # filter the model
sum() # sum the rainfall
}
Imagecollection_pr <- ee$ImageCollection(pr_ls) %>% ee_get(0)
exp1 <- ee_imagecollection_to_local(
ic = Imagecollection_pr,
region = polygon,
dsn = "pp_via_drive",
via = "drive" # please always use "drive" or "gcs" until rgee 1.0.6 release
)
# One option
gdalinfo <- try (rgdal::GDALinfo(exp1))
if (isTRUE(attr(gdalinfo, "ysign") == 1)) {
exp1_r <- flip(raster(exp1), direction='y')
}
Recent versions of the earthengine Python API causes some inconsistencies when via = "getInfo" is used, please always use via = "drive" until the release of rgee 1.0.6.
There does not seem to be a misalignment. To plot all these countries in one step, you could do
x <- lapply(c('IDN','MYS','SGP','BRN','PHL'), function(i) getData('GADM', country = i, level = 0))
sea_shp <- bind(x)
I was able to create a nice world map, I used this code for my data and I was able to obtain the point plot using the geom_point.
I want to put the data as a bar chart over the map for each country something like this image
(http://radacad.com/wp-content/uploads/2017/04/mapbarchart.png)
Could you help produce the bar chart over the map?
Here is a producible code for my data
{}
#### create the data
df <- data.frame(matrix(ncol = 8, nrow = 4))
colnames(df) <- c( "X.prj", "Y.prj","country", "Region","V1","V2","V3","V4" )
df$X.prj <- c(8649752.0,17359084.9, -744932.8, -5091132.5)
df$Y.prj <- c(5860666.76, -2263969.57,1659622.59,-4391906.10)
df$country <- c("Mongolia","Niue","Mali","Argentina")
df$Region <- c("Asia","PAC","Africa","GRULAC")
df$V1 <- c(106.4666667,258.8,56.05,1997.55)
df$V2 <- c(1.6,63.4,14.5,0)
df$V3 <- c(205.1333333, 369,169,403)
df$V4 <- c(219.3333333,175,150,247)
###############################################################################
## Create a world cities map using ggplot.
library(rgdal) # for spTransform() & project()
library(ggplot2) # for ggplot()
library(ggrepel) # for geom_text_repel() - repel overlapping text labels
library(data.table)
# =============================================================================
# Load ready to use data from GitHub
# =============================================================================
load(url("https://github.com/valentinitnelav/RandomScripts/blob/master/NaturalEarth.RData?raw=true"))
# This will load 6 objects:
# xbl.X & lbl.Y are two data.frames that contain labels for graticule lines
# They can be created with the code at this link:
# https://gist.github.com/valentinitnelav/8992f09b4c7e206d39d00e813d2bddb1
# NE_box is a SpatialPolygonsDataFrame object and represents a bounding box for Earth
# NE_countries is a SpatialPolygonsDataFrame object representing countries
# NE_graticules is a SpatialLinesDataFrame object that represents 10 dg latitude lines and 20 dg longitude lines
# (for creating graticules check also the graticule package or gridlines fun. from sp package)
# (or check this gist: https://gist.github.com/valentinitnelav/a7871128d58097e9d227f7a04e00134f)
# NE_places - SpatialPointsDataFrame with city and town points
# NOTE: data downloaded from http://www.naturalearthdata.com/
# here is a sample script how to download, unzip and read such shapefiles:
# https://gist.github.com/valentinitnelav/a415f3fbfd90f72ea06b5411fb16df16
# =============================================================================
# Project from long-lat to Eckert IV projection
# =============================================================================
# spTransform() is used for shapefiles and project() in the case of data frame
# for more PROJ.4 strings check the followings
# http://proj4.org/projections/index.html
# https://epsg.io/
# __ give the PORJ.4 string for Eckert IV projection
PROJ <- "+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs"
# or use the short form "+proj=eck4"
# __ project the shapefiles
NE_countries.prj <- spTransform(NE_countries, CRSobj = PROJ)
NE_graticules.prj <- spTransform(NE_graticules, CRSobj = PROJ)
NE_box.prj <- spTransform(NE_box, CRSobj = PROJ)
# __ project long-lat coordinates columns for data frames
# (two extra columns with projected XY are created)
prj.coord <- project(cbind(lbl.Y$lon, lbl.Y$lat), proj = PROJ)
lbl.Y.prj <- cbind(prj.coord, lbl.Y)
names(lbl.Y.prj)[1:2] <- c("X.prj","Y.prj")
prj.coord <- project(cbind(lbl.X$lon, lbl.X$lat), proj = PROJ)
lbl.X.prj <- cbind(prj.coord, lbl.X)
names(lbl.X.prj)[1:2] <- c("X.prj","Y.prj")
# =============================================================================
# Prepare the data table for plotting
# =============================================================================
# melt all variable to one column
df.melt <- melt(df, id= c("X.prj","Y.prj","country","Region"),
measure.vars = 5:8)
=============================================================================
ggplot() +
# __ add layers and labels
# add projected countries
geom_polygon(data = NE_countries.prj,
aes(long,lat, group = group),
colour = "gray70", fill = "gray90", size = .25)+
# Note: "Regions defined for each Polygons" warning has to do with fortify transformation.
# fortify might get deprecated in future!
# alternatively, use use map_data(NE_countries) to transform to data frame and then use project() to change to desired projection.
# add projected bounding box
geom_polygon(data = NE_box.prj,
aes(x = long, y = lat),
colour = "black", fill = "transparent", size = .25)+
# add locations (points); add opacity with "alpha" argument&&&&&&&&&&&&&&&&&&&&&&&&&
geom_point(data = df.melt,
aes(x = X.prj, y = Y.prj, colour = Region, ),
alpha = .5)
## Here I was trying to produce the bar chart which I get a lot of error by using the code below:
for (i in 1:nrow(df)) %>% subplot(barplot(dheight=as.numeric(as.character(unlist(df[i, 5:8], use.names=F))), axes=F,
col=rainbow(4),ylim=range(df[,5:])),
x=df[i, "X.prj"], y=df[i,"Y.prj"], size=c(.6, .6))
How can I extract the whole CONUS SSURGO data from FedData and then how can I combine that rasterstack into a single rasterstack with worldclim data?
# FedData Tester
library(FedData)
library(magrittr)
# Extract data for the Village Ecodynamics Project "VEPIIN" study area:
# http://veparchaeology.org
vepPolygon <- polygon_from_extent(raster::extent(672800, 740000, 4102000, 4170000),
proj4string = "+proj=utm +datum=NAD83 +zone=12")
# Get the NRCS SSURGO data (USA ONLY)
SSURGO.VEPIIN <- get_ssurgo(template = vepPolygon,
label = "VEPIIN")
# Plot the NED again
raster::plot(NED)
# Plot the SSURGO mapunit polygons
plot(SSURGO.VEPIIN$spatial,
lwd = 0.1,
add = TRUE)
...
library(raster)
library(sp)
r <- getData("worldclim",var="bio",res=2.5)