Many users have asked how to check whether polygons intersect, however, current answers to those questions are not working for my case.
I have two objects. One is a "Large SpatialPolygons" named "farms". This object has several polygons (total of 2011), and each polygon indicates the limits of a different farm (see print screen).
My second object is a "Large SpatialPolygons DataFrame" named slope_RJ_100m. That object divides a large area into several square polygons with area of 10.000m^2 each (total of 310000 polygons).
For each of the squares (polygons) in "slope_RJ_100m", I would like to know whether they intersect any of the polygons in "farms". In other words, I want to know whether each particular square in "slope_RJ_100m" has a farm inside (even if just a piece of a farm).
I was expecting the outcome to be something with 310000 rows and two variables, one indicating the polygon in slope_RJ_100m, and the other with TRUE or FALSE for whether that polygon has a farm.
I have tried:
inters = gIntersection(slope_RJ_100m, farms)
This one produces an output of about 1500 polygons.
I am not sure how to use this to know which of my 310000 polygons has a farm in it.
inters = raster::intersect(slope_RJ_100m, farms)
The output has 29144 polygons. As in the previous case, not sure how I can use this to know whether the square has a farm.
and
inters = st_intersects(slope_RJ_100m, farms)
Error in UseMethod("st_intersects") :
no applicable method for 'st_intersects' applied to an object of class "c('SpatialPolygonsDataFrame', 'SpatialPolygons', 'Spatial', 'SpatialPolygonsNULL', 'SpatialVector', 'SPNULL')"
I am sure my question is trivial and I apologize beforehand.
Here is an example with terra (to run this you need terra 1.1-17)
library(terra)
# polygons
p1 <- vect("POLYGON ((0 0, 8 0, 8 9, 0 9, 0 0))")
p2 <- vect("POLYGON ((5 6, 15 6, 15 15, 5 15, 5 6))")
p3 <- vect("POLYGON ((8 2, 9 2, 9 3, 8 3, 8 2))")
p4 <- vect("POLYGON ((2 6, 3 6, 3 8, 2 8, 2 6))")
p5 <- vect("POLYGON ((2 12, 3 12, 3 13, 2 13, 2 12))")
p6 <- vect("POLYGON ((10 4, 12 4, 12 7, 11 7, 11 6, 10 6, 10 4))")
p <- rbind(p1, p2, p3, p4, p5, p6)
plot(p, col=rainbow(6, alpha=.5))
lines(p, lwd=2)
text(p)
relate(rbind(p1, p2), rbind(p3,p4,p5,p6), "intersects")
# [,1] [,2] [,3] [,4]
#[1,] TRUE TRUE FALSE FALSE
#[2,] FALSE FALSE FALSE TRUE
With your SpatialPolygons* you should be able to do the following:
s <- vect(slope_RJ_100m)
f <- vect(farms)
x <- relate(s, f, "intersects")
Likewise, to use st_intersects, you need to use sf objects, not Spatial* objects. Something like
library(sf)
ss <- st_as_sf(slope_RJ_100m)
ff <- st_as_sf(farms)
inters <- st_intersects(ss, ff)
With the example data from above
s1 < st_as_sf(rbind(p1, p2))
s2 <- st_as_sf(rbind(p3,p4,p5,p6))
st_intersects(s1, s2)
#Sparse geometry binary predicate list of length 2, where the predicate was `intersects'
# 1: 1, 2
# 2: 4
Related
I am using the R package "pt" to calculate the cummulative prospect theory value.
The first input is the following:
choice_ids <- c(1, 1, 1, 1, 2, 2, 2, 2)
gamble_ids <- c(1, 1, 1, 2, 1, 1, 2, 2)
outcome_ids <- c(1, 2, 3, 1, 1, 2, 1, 2)
objective_consequences <- c(2500, 2400, 0, 2400,2500, 0, 2400, 0)
probability_strings <- c("0.33", "0.66", "0.01", "1.0","0.33", "0.67", "0.34", "0.66")
my_choices <- Choices(choice_ids=choice_ids,gamble_ids=gamble_ids,outcome_ids=outcome_ids,objective_consequences=objective_consequences,probability_strings=probability_strings)
Afterwards
tk_1992_utility <- Utility(fun="power", par=c(alpha=0.88, beta=0.88, lambda=2.25))
linear_in_log_odds_prob_weight <- ProbWeight(fun="linear_in_log_odds", par=c(alpha=0.61, beta=0.724))
comparePT(my_choices,prob_weight_for_positive_outcomes=linear_in_log_odds_prob_weight,prob_weight_for_negative_outcomes=linear_in_log_odds_prob_weight,utility=tk_1992_utility, digits=4)
## cid gid ev pt ce rp
## 1 1 1 2409 881.3 2222 187
## 2 1 2 2400 943.2 2400 -0.000000000001819
## 3 2 1 825 312.6 684.2 140.8
## 4 2 2 816 307.2 670.9 145.1
The comparePT comands hase the pt value as output but also quite a lot of other values. However, I would like to only have the pt value as output, is this somehow possible? I looked into the package but could not find the formula in there, unfortunately.
Appears pt is taken off CRAN, but can be installed from the github archive:
library(devtools)
install_github("cran/pt")
comparePT() is an S4 function. Inspecting these are a little different from the regular S3 kind. First you use showMethods() to see the available methods, before you use getMethod() for the method you are interested in.
showMethods("comparePT")
# Function: comparePT (package pt)
# object="Choices"
getMethod("comparePT", "Choices")
# Method Definition:
#
# function ...
However, the output from comparePT() is just a regular data.frame, so you can subset it by using $ as normal. And wrap as.numeric() around it, as its coded as character.
as.numeric(comparePT(my_choices, linear_in_log_odds_prob_weight,
linear_in_log_odds_prob_weight, tk_1992_utility, 4)$pt)
# [1] 881.3 943.2 312.6 307.2
Basically, I computed a global distribution probability model in the form of ASCII, say:
gdpm. gdpm's values are all between 0 and 1.
Then I imported a local map from shape file:
shape <- file.choose()
map <- readOGR(shape, basename(file_path_sans_ext(shape)))
The next step, I rasterized gdpm, and cropped using the local map:
ldpm <- mask(gdpm, map)
Then, I reclassified this continuous model into a discrete model (I divided the model into 6 levels):
recalc <- matrix(c(0, 0.05, 0, 0.05, 0.2, 1, 0.2, 0.4, 2, 0.4, 0.6, 3, 0.6, 0.8, 4, 0.8, 1, 5), ncol = 3, byrow = TRUE)
ldpmR <- reclassify(ldpm, recalc)
I've got a cropped and reclassified raster, now I need to summarize land cover, that is, to each level, I want to calculate its proportion of area in each region of the local map. (I don't know how to describe it in terminology). I found and followed an example (RobertH):
ext <- raster::extract(ldpmR, map)
tab <- sapply(ext, function(x) tabulate(x, 10))
tab <- tab / colSums(tab)
But I'm not sure if it works, since the output of tab is confusing.
So how to compute land cover area correctly? How can I apply the correct method within each polygon?
My original data is too large, I can only provide an alternative raster (I think this example should apply a different reclassify matrix):
Example raster
Or you can generate a test raster (RobertH):
library(raster)
s <- stack(system.file("external/rlogo.grd", package="raster"))
writeRaster(s, file='testtif', format='GTiff', bylayer=T, overwrite=T)
f <- list.files(pattern="testtif_..tif")
I also have a question about plotting a raster:
r <- as(r, "SpatialPixelsDataFrame")
r <- as.data.frame(r)
colnames(r) <- c("value", "x", "y")
I do this conversion to make a raster plot-able with ggplot2, is there a more concise method?
loki's answer is OK, but this can be done the raster way, which is safer. And it is important to consider whether the coordinates are angular (longitude/latitude) or planar (projected)
Example data
library(raster)
r <- raster(system.file("external/test.grd", package="raster"))
r <- r / 1000
recalc <- matrix(c(0, 0.05, 0, 0.05, 0.2, 1, 0.2, 0.4, 2, 0.4, 0.6, 3, 0.6, 0.8, 4, 0.8, 2, 5), ncol = 3, byrow = TRUE)
r2 <- reclassify(r, recalc)
Approach 1. Only for planar data
f <- freq(r2, useNA='no')
apc <- prod(res(r))
f <- cbind(f, area=f[,2] * apc)
f
# value count area
#[1,] 1 78 124800
#[2,] 2 1750 2800000
#[3,] 3 819 1310400
#[4,] 4 304 486400
#[5,] 5 152 243200
Approach 2. For angular data (but also works for planar data)
a <- area(r2)
z <- zonal(a, r2, 'sum')
z
# zone sum
#[1,] 1 124800
#[2,] 2 2800000
#[3,] 3 1310400
#[4,] 4 486400
#[5,] 5 243200
If you want to summarize by polygons, you can do something like this:
# example polygons
a <- rasterToPolygons(aggregate(r, 25))
Approach 1
# extract values (slow)
ext <- extract(r2, a)
# tabulate values for each polygon
tab <- sapply(ext, function(x) tabulate(x, 5))
# adjust for area (planar data only)
tab <- tab * prod(res(r2))
# check the results, by summing over the regions
rowSums(tab)
#[1] 124800 2800000 1310400 486400 243200
Approach 2
x <- rasterize(a, r2)
z <- crosstab(x, r2)
z <- cbind(z, area = z[,3] * prod(res(r2)))
Check results:
aggregate(z[, 'area', drop=F], z[,'Var2', drop=F], sum)
Var2 area
#1 1 124800
#2 2 2800000
#3 3 1310400
#4 4 486400
#5 5 243200
Note that if you are dealing with lon/lat data you cannot use prod(res(r)) to get the cell size. In that case you will need to use the area function and loop over classes, I think.
You also asked about plotting. There are many ways to plot a Raster* object. The basic ones are:
image(r2)
plot(r2)
spplot(r2)
library(rasterVis);
levelplot(r2)
More tricky approaches:
library(ggplot2) # using a rasterVis method
theme_set(theme_bw())
gplot(r2) + geom_tile(aes(fill = value)) +
facet_wrap(~ variable) +
scale_fill_gradient(low = 'white', high = 'blue') +
coord_equal()
library(leaflet)
leaflet() %>% addTiles() %>%
addRasterImage(r2, colors = "Spectral", opacity = 0.8)
Seems like you can get the area by the number of pixels.
Let's start with a reproducible example:
r <- raster(system.file("external/test.grd", package="raster"))
plot(r)
Since, the values in this raster are in another range than your data, let's adapt them to your values:
r <- r / 1000
r[r>1,] <- 1
Afterwards, we apply your reclassification:
recalc <- matrix(c(0, 0.05, 0, 0.05, 0.2, 1, 0.2, 0.4, 2, 0.4, 0.6, 3, 0.6, 0.8, 4, 0.8, 1, 5), ncol = 3, byrow = TRUE)
r2 <- reclassify(r, recalc)
plot(r2)
Now, how do we get the area?
Since you are working with a projected raster, you can simply use the number of pixels and the raster resolution. Therefore, we first need to check the resolution and the map units of the projection:
res(r)
# [1] 40 40
crs(r)
# CRS arguments:
# +init=epsg:28992
# +towgs84=565.237,50.0087,465.658,-0.406857,0.350733,-1.87035,4.0812 +proj=sterea
# +lat_0=52.15616055555555 +lon_0=5.38763888888889 +k=0.9999079 +x_0=155000
# +y_0=463000 +ellps=bessel +units=m +no_defs
Now, we know that we are dealing with pixels of 40 x40 meters, since we have a metric CRS.
Let's use this information to calculate the area of each class.
app <- res(r)[1] * res(r)[2] # area per pixel
table(r2[]) * app
# 1 2 3 4 5
# 124800 2800000 1310400 486400 243200
For the plotting of georeferenced rasters, I would like to refer you to an older question here on SO
Due to the nature of my specification, the results of my regression coefficients provide the slope (change in yield) between two points; therefore, I would like to plot these coefficients using the slope of a line between these two points with the first point (0, -0.7620) as the intercept. Please note this is a programming question; not a statistics question.
I'm not entirely sure how to implement this in base graphics or ggplot and would appreciate any help. Here is some sample data.
Sample Data:
df <- data.frame(x = c(0, 5, 8, 10, 12, 15, 20, 25, 29), y = c(-0.762,-0.000434, 0.00158, 0.0000822, -0.00294, 0.00246, -0.000521, -0.00009287, -0.01035) )
Output:
x y
1 0 -7.620e-01
2 5 -4.340e-04
3 8 1.580e-03
4 10 8.220e-05
5 12 -2.940e-03
6 15 2.460e-03
7 20 -5.210e-04
8 25 -9.287e-05
9 29 -1.035e-02
Example:
You can use cumsum, the cumulative sum, to calculate intermediate values
df <- data.frame(x=c(0, 5, 8, 10, 12, 15, 20, 25, 29),y=cumsum(c(-0.762,-0.000434, 0.00158, 0.0000822, -0.00294, 0.00246, -0.000521, -0.00009287, -0.0103)))
plot(df$x,df$y)
I need to calculate the product of the edges attributes of the shortest path between two vertices in my graph.
For example:
data<-as.data.frame(cbind(c(1,2,3,4,5,1),c(4,3,4,5,6,5),c(0.2,0.1,0.5,0.7,0.8,0.2)))
G<-graph.data.frame(data, directed=FALSE)
set.edge.attribute(G, "V3", index=E(G), data$V3)
If I calculate the shortest path according to the attribute I have two posibilities, the first tell me the steps:
get.shortest.paths (G, 2, 6, weights=E(G)$V3)
2 3 4 1 5 6
The second tell me the sum of the attribute along the path.
shortest.paths (G, 2, 6, weights=E(G)$V3)
1.8
Since I need to make a product, I would need to have a vector of the edge attributes between the nodes of my path. In this example I should get 0.8 0.2 0.2 0.5 0.1, whose product would be 0.0016.
Can anyone suggest me how to do it?
Use the output argument of get.shortest.paths:
library(igraph)
data <- data.frame(from =c(1, 2, 3, 4, 5, 1),
to =c(4, 3, 4, 5, 6, 5),
weight=c(0.2,0.1,0.5,0.7,0.8,0.2))
G <- graph.data.frame(data, directed=FALSE)
esp26 <- get.shortest.paths(G, 2, 6, output="epath")[[1]]
esp26
# [1] 2 3 1 6 5
prod(E(G)$weight[esp26])
# [1] 0.0016
plot(G, edge.label=paste("Id:", 1:ecount(G), "\n", "W:",
E(G)$weight, sep=""))
I have a dataset of species and their rough locations in a 100 x 200 meter area. The location part of the data frame is not in a format that I find to be usable. In this 100 x 200 meter rectangle, there are two hundred 10 x 10 meter squares named A through CV. Within each 10 x 10 square there are four 5 x 5 meter squares named 1, 2, 3, and 4, respectively (1 is south of 2 and west of 3. 4 is east of 2 and north of 3). I want to let R know that A is the square with corners at (0 ,0), (10,0), (0,0), and (0,10), that B is just north of A and has corners (0,10), (0,20), (10,10), and (10,20), and K is just east of A and has corners at (10,0), (10,10), (20,0), and (20,10), and so on for all the 10 x 10 meter squares. Additionally, I want to let R know where each 5 x 5 meter square is in the 100 x 200 meter plot.
So, my data frame looks something like this
10x10 5x5 Tree Diameter
A 1 tree1 4
B 1 tree2 4
C 4 tree3 6
D 3 tree4 2
E 3 tree5 3
F 2 tree6 7
G 1 tree7 12
H 2 tree8 1
I 2 tree9 2
J 3 tree10 8
K 4 tree11 3
L 1 tree12 7
M 2 tree13 5
Eventually, I want to be able to plot the 100 x 200 meter area and have each 10 x 10 meter square show up with the number of trees, or number of species, or total biomass
What is the best way to turn the data I have into spatial data that R can use for graphing and perhaps analysis?
Here's a start.
## set up a vector of all 10x10 position tags
tags10 <- c(LETTERS,
paste0("A",LETTERS),
paste0("B",LETTERS),
paste0("C",LETTERS[1:22]))
A function to convert (e.g.) {"J",3} to the center of the corresponding sub-square.
convpos <- function(pos10,pos5) {
## convert letters to major (x,y) positions
p1 <- as.numeric(factor(pos10,levels=tags10)) ## or use match()
p1.x <- ((p1-1) %% 10) *10+5 ## %% is modulo operator
p1.y <- ((p1-1) %/% 10)*10+5 ## %/% is integer division
## sort out sub-positions
p2.x <- ifelse(pos5 <=2,2.5,7.5) ## {1,2} vs {3,4} values
p2.y <- ifelse(pos5 %%2 ==1 ,2.5,7.5) ## odd {1,3} vs even {2,4} values
c(p1.x+p2.x,p1.y+p2.y)
}
usage:
convpos("J",2)
convpos(mydata$tenbytenpos,mydata$fivebyfivepos)
Important notes:
this is a proof of concept, I can pretty much guarantee I haven't got the correspondence of x and y coordinates quite right. But you should be able to trace through this line-by-line and see what it's doing ...
it should work correctly on vectors (see second usage example above): I switched from switch to ifelse for that reason
your column names (10x10) are likely to get mangled into something like X10.10 when reading data into R: see ?data.frame and ?check.names
Similar to what #Ben Bolker has done, here's a lookup function (though you may need to transpose something to make the labels match what you describe).
tenbyten <- c(LETTERS[1:26],
paste0("A",LETTERS[1:26]),
paste0("B",LETTERS[1:26]),
paste0("C",LETTERS[1:22]))
tenbyten <- matrix(rep(tenbyten, each = 2), ncol = 10)
tenbyten <- t(apply(tenbyten, 1, function(x){rep(x, each = 2)}))
# the 1234 squares
squares <- matrix(c(rep(c(1,2),10),rep(c(4,3),10)), nrow = 20, ncol = 20)
# stick together into a reference grid
my.grid <- matrix(paste(tenbyten, squares, sep = "-"), nrow = 20, ncol = 20)
# a lookup function for the site grid
coordLookup <- function(tbt, fbf, .my.grid = my.grid){
x <- col(.my.grid) * 5 - 2.5
y <- row(.my.grid) * 5 - 2.5
marker <- .my.grid == paste(tbt, fbf, sep = "-")
list(x = x[marker], y = y[marker])
}
coordLookup("BB",2)
$x
[1] 52.5
$y
[1] 37.5
If this isn't what you're looking for, then maybe you'd prefer a SpatialPolygonsDataFrame, which has proper polygon IDs, and you attach data to, etc. In that case just Google around for how to make one from scratch, and manipulate the row() and col() functions to get your polygon corners, similar to what's given in this lookup function, which only returns centroids.
Edit: getting SPDF started:
This is modified from the function example and can hopefully be a good start:
library(sp)
# really you have a 20x20 grid, counting the small ones.
# c(2.5,2.5) specifies the distance in any direction from the cell center
grd <- GridTopology(c(1,1), c(2.5,2.5), c(20,20)))
grd <- as.SpatialPolygons.GridTopology(grd)
# get centroids
coords <- coordinates(polys)
# make SPDF, with an extra column for your grid codes, taken from the above.
# you can add further columns to this data.frame(), using polys#data
polys <- SpatialPolygonsDataFrame(grd,
data=data.frame(x=coords[,1], y=coords[,2], my.ID = as.vector(my.grid),
row.names=getSpPPolygonsIDSlots(grd)))