extract value from raster stack from spatialpolygondataframe - r

I have a raster stack with 27 rasters in it. I have 27 corresponding polygons in a spatial polygon data frame. I want to take polygon[i] overlay it on raster[i], extract and sum the values from raster [i], get a count of the number of cells within the polygon[i] and then divide the sum value by the # of cells. In other words, the raster is a utilization distribution or a kernel density of use. I want to know much use is occurring in the area of the polygon where it is overlapping the raster. I want to divide by the number of cells in the polygon to take into account the size of the polygon.
I have a script that was given to me that does this, only it was written with the intention of extracting data from 1 raster only by any number of spatial polygons in the data frame. It works, its ugly, and I now would like to convert it to something more stream line. I only wish I had someone around me who could help because this might take a while?
This is code Ive been given and my summary of what I think is going on:
msum99Kern07 = SpatialPolygonDataFrame (many polygons)
KERNWolfPIX07m = Raster (this is a single raster, I have 27 rasters I put into a stack
)
#Extracting value from raster to many polygons
sRISK_Moose07m<- extract(KERNWolfPIX07m, msum99Kern07,df=FALSE,method='bilinear')
#Calculate THE SUM FOR EACH polygon#
sRISK_Moose07m<-unlist(lapply(sRISK_Moose07m, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA ))
sRISK_Moose07m<-as.data.frame(sRISK_Moose07m)
#Im not sure why these next commands are needed Im only guessing
#data.frame(levels) as there are many polygons creating a dataframe to put the info into
ID_SUM_07<-as.data.frame(levels(as.factor(msum07locs$ID2)))
#ADD ID TO THE risk data frame
sRISK_Moose07m$ID<-ID_SUM_07[,1]
#NUMBER OF CELLS WITHIN POLYGON EXTRACT CELLS/ POLYGON
NB_SUM2007m<-cellFromPolygon(KERNWolfPIX07m, msum99Kern07)
NB_SUM07m<-unlist(lapply(NB_SUM2007m, function(x) if (!is.null(x)) length(x) else NA ))
#####CONVERT TO DATA FRAME
NB_SUM07m<-as.data.frame(NB_SUM07m)
###ADD THE NB OF CELLS TO THE RISK_SUM FILE###
sRISK_Moose07m$NB_CELLS<-NB_SUM07m[,1]
###DIVIDING VALUE by NB CELLS##
sRISK_Moose07m$DIVID<-sRISK_Moose07m$sRISK_Moose07m/sRISK_Moose07m$NB_CELLS
Now, I have my spatial polygon data frame with 27 polygons and my raster stack with 27 rasters. I want to select the raster[i] and polygon[i] and extract, sum, and calculate the kernel density of the overlapping area. One side thing to keep in mind, I may get an error because it is possible that the polygon and raster do not overlap...I don't know how to check for this in R at all.
My script I have started:
moose99kern = spatial polygon data frame 27 moose
Rastwtrial = stack of 27 rasters having the same unique name as the ID in moose99kern
mkernID=unique(moose99kern$id)
for (i in length(mkernID)){
r = Rastwtrial[Rastwtrial[[i]]== mkernID[i]] #pick frm Rasterstack the raster that has the same name
mp = moose99kern[moose99kern$id == mkernID[i]] #pick from spatialpolygondataframe the polygon that has the same name
RISK_MooseTrial<- extract(r, mp, df=T, method'bilinear')
risksum = (RISK_MooseTrial, function(x) if (!is.null(x)) sum(x, na.rm=TRUE) else NA )#sum all the values that were extracted from the raster
My script doesn't even start to work because I don't know how to index a raster stack. But even still, going through 1 raster/1polygon at a time, Im not sure what to do next in the code. If this is too much for StackOverflow I apologize. Im just seriously stuck and have no where to turn.
Here is test data with 2 individuals for polygons
dput(mtestpoly)
new("SpatialPolygonsDataFrame"
, data = structure(list(id = structure(1:2, .Label = c("F01001_1", "F07002_1"
), class = "factor"), area = c(1259.93082578125, 966.364499511719
)), .Names = c("id", "area"), row.names = c("F01001_1", "F07002_1"
), class = "data.frame")
, polygons = list(<S4 object of class structure("Polygons", package = "sp")>,
<S4 object of class structure("Polygons", package = "sp")>)
, plotOrder = 1:2
, bbox = structure(c(6619693.77161797, 1480549.31292137, 6625570.48348294,
1485861.5586371), .Dim = c(2L, 2L), .Dimnames = list(c("x", "y"
), c("min", "max")))
, proj4string = new("CRS"
, projargs = NA_character_
dput(Rastwtest)
new("RasterStack"
, filename = ""
, layers = list(<S4 object of class structure("RasterLayer", package = "raster")>,
<S4 object of class structure("RasterLayer", package = "raster")>)
, title = character(0)
, extent = new("Extent"
, xmin = 1452505.6959799
, xmax = 1515444.7110552
, ymin = 6575235.1959799
, ymax = 6646756.8040201
)
, rotated = FALSE
, rotation = new(".Rotation"
, geotrans = numeric(0)
, transfun = function ()
NULL
)
, ncols = 176L
, nrows = 200L
, crs = new("CRS"
, projargs = NA_character_
)
, z = list()
, layernames = "Do not use the layernames slot (it is obsolete and will be removed)\nUse function 'names'"
)

Maybe I miss something , but I think you over complicated the problem. For me you have :
stack of raster : a list of raster : ss
a list of polygons of the same size as ss : polys
You need to apply extract for each pair(layer,poly) from (ss,polys)
sapply(1:nlayers(ss), function(i) {
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
d
})
Here an example of 2 legnths since you don't give a reproducible example :
## generate some data
library(raster)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
## In your case you need something like SpatialPolygons(moose99kern)
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
r1 <- raster(ncol=36, nrow=18)
r1[] <- seq(-1,-2,length.out=ncell(r1))
ss <- stack(r,r1)
## density compute
sapply(1:nlayers(ss), function(i) {
## sum of values of the cells of a Raster ss[[i]] covered by the poly polys[i]
m <- extract(ss[[i]],polys[i], method='bilinear', na.rm= T)[[1]]
d <- ifelse (!is.null(m) , sum(m)/length(m), NA)
})
[1] 387.815789 -1.494714

When you are asking questions about R, always use simple reproducible examples, not your own data; unless perhaps what you want to do works for such an example, but not for your data, but then still show the example that works and the error message you are getting. You can typically start with the examples in the help files, as in below from ?extract
r <- raster(ncol=36, nrow=18)
r[] <- 1:ncell(r)
s <- stack(r, r*2)
cds1 <- rbind(c(-180,-20), c(-160,5), c(-60, 0), c(-160,-60), c(-180,-20))
cds2 <- rbind(c(80,0), c(100,60), c(120,0), c(120,-55), c(80,0))
polys <- SpatialPolygons(list(Polygons(list(Polygon(cds1)), 1),
Polygons(list(Polygon(cds2)), 2)))
v <- extract(s, polys, small=TRUE)
#cellnumbers for each polygon
sapply(v, NROW)
# mean for each polygon
sapply(v, function(x) apply(x, 2, mean, na.rm=T))
the functions in sapply need to be refined if some of your polgyons our outside of the raster (i.e. returning NULL, but the "small=TRUE" option should avoid problems with very small polygons inside the raster. Also note that there is no "method" argument when extracting with SpatialPolygon* objects.
Do not use a loop, unless to prevent memory problems if you have very many cells for each polygon.

Related

R: mask() and rasterize() with spatialPolygonsDataFrame having holes

I have a spatialPolygonsDataFrame consisting of 3 polygons. The third polygon has the same shape as the first but has a hole where the second polygon is located.
I built the hole in the using the answer from another question (How to add a hole to a polygon within a SpatialPolygonsDataFrame?).
library(raster)
library(sp)
# create rasters and store them in a list
r1 <- raster(xmn=1, xmx=5, ymn=1, ymx=5, nrows=4, ncols=4)
r1[] <- 1:length(r1)
# create SpatialPolygonsDataFrame
Sr1 = Polygon(cbind(c(1,5,4,1,1),c(1,2,5,4,1)))
Sr2 = Polygon(cbind(c(2,4,3,2),c(3,2,4,3)))
SpP = SpatialPolygons(list(Polygons(list(Sr1), "s1"), Polygons(list(Sr2), "s2")),
1:2)
dat = data.frame(ID = c("s1", "s2"), value = c("a", "b"))
row.names(dat) <- c("s1", "s2")
p <- SpatialPolygonsDataFrame(SpP, data = dat,
match.ID = TRUE)
AddHoleToPolygon <-function(poly,hole){
# invert the coordinates for Polygons to flag it as a hole
coordsHole <- hole#polygons[[1]]#Polygons[[1]]#coords
newHole <- Polygon(coordsHole,hole=TRUE)
# punch the hole in the main poly
listPol <- poly#polygons[[1]]#Polygons
listPol[[length(listPol)+1]] <- newHole
punch <- Polygons(listPol,poly#polygons[[1]]#ID)
# make the polygon a SpatialPolygonsDataFrame as the entry
new <- SpatialPolygons(list(punch),proj4string=poly#proj4string)
new <- SpatialPolygonsDataFrame(new,data=as(poly,"data.frame"))
return(new)
}
punchedPoly <-AddHoleToPolygon(p[1,],p[2,])
p1 <- rbind(p, punchedPoly, makeUniqueIDs = TRUE)
p1 <- p1[2:3,]
When I use mask() to "crop" the raster r1, then the hole is created, although the triangular polygon has a value and indeed is not a real hole. But it gets "overridden" by the third polygon with the hole:
masked_hole <- mask(r1, p1)
plot(masked_hole)
When I change the order of the polygons, then no hole is created:
m3 <- mask(r1, p1[c(2,1),])
plot(m3)
The function rasterize is affected in the same manner:
r2 <- rasterize(p1, r1, field = "value")
plot(r2)
r3 <- rasterize(p1[c(2,1),], r1, field = "value")
plot(r3)
In my real data I have holes where there are no "filling" polygons and those ones I want to keep as holes.
How can I fix the spatialPolygonsDataFrame for polygons that are creating holes where there are none?
How can I fix this issue without reordering but "transform" the hole-creating polygons?
It was a bug in the raster package which has been fixed meanwhile (see https://github.com/rspatial/raster/issues/60).

r longest line for each polygon spatial dataframe?

how can i get the length of the longest line (side) of each polygon? what package would be least problematic? I wonder if there is any function other than iterating point by point (some dummy example below)? Other than that I wonder if there is any method of getting bearings and or angles of each segment versus neighbours, but as some experts are overly sensitive about asking only one question at a time I will leave it for any other time;) Thanks in advance
r1 = cbind(c(180114, 180553, 181127, 180114), c(332349, 332057, 332342, 332349))
r2 = cbind(c(180042, 180545, 180553, 180042), c(332373, 332026, 331426, 332373))
r3 = cbind(c(179110, 179907, 180433, 179110), c(331086, 330620, 330494, 331086))
r4 = cbind(c(180304, 180403,179632,180304), c(332791, 333204, 333635, 332791))
sr1=Polygons(list(Polygon(r1)),"r1")
sr2=Polygons(list(Polygon(r2)),"r2")
sr3=Polygons(list(Polygon(r3)),"r3")
sr4=Polygons(list(Polygon(r4)),"r4")
sr=SpatialPolygons(list(sr1,sr2,sr3,sr4))
srdf=SpatialPolygonsDataFrame(sr, data.frame(cbind(1:4,5:2),
row.names=c("r1","r2","r3","r4")))
Using an R package called GeoAxe you can split geospatial objects into pieces. Once you have the segments individually, you can use another package called SpatialLines to get the segments' lengths. From here you can select the greatest one.
A possible downside of this method for you is that the data must be a spatial format e.g. .shp for input but luckily there is also a package for creating these.
Does this help ?
splitPolygon <- function(x){
st_segment = function(r){st_linestring(t(matrix(unlist(r), 2, 2)))}
m <- data.frame(st_coordinates(x)[, 1:2])
nr <- nrow(m)
m2 <- cbind(m[-nr,], m[-1,])
names(m2) <- c("Xstart", "Ystart", "Xend", "Yend")
m3 <- rbind(m2,
data.frame(Xstart = m$Xend[nr],
Ystart = m$Yend[nr],
Xend = m$Xend[1],
Yend = m$Yend))
m3$geom = st_sfc(sapply(1:nrow(m3),
function(i){st_segment(m3[i,])},simplify=FALSE))
st_sf(m3, crs = st_crs(x))
}
longest_side_of_polygon <- function(x){
df <- splitPolygon(x)
l <- st_length(df)
lmat <- st_coordinates(df[which.max(l), ])[,1:2]
st_sfc(st_linestring(rbind(lmat[1,], lmat[2,])),
crs = st_crs(x))
}

foreach and dopar not creating objects, but returning NULL

I'm using Maxent for some spatial analysis. I have a long script with many outputs that I collect in lists. It works just fine with a for loop and low resolution climatic predictors in a rasterstack (in my core i5, 6gb notebook) . But I need to use a high resolution set of rasters, and all the problems come from this issue. Even using a 16 core, 32gb virtual machine, the proccessing is veeeery slow, and after 3 days, memory is not enought and the run is closed after about 50 turns in my loop (which has 92 species). I'm trying to improve this script by collecting garbage to clean the memory and using doParallel. After the new script is cleanly running with the low resolution predictors, I'll try it with the high resolution predictors
So, I changed my script to use foreach instead of for, and with %dopar%
But so far, I'm getting this as result:
[[1]]
NULL
[[2]]
NULL
[[3]]
NULL
[[4]]
NULL
I saw another question about the same issue, but the very simple solution the guy needed doesn't apply for me.. So, any tips are very welcome
#install.packages("dismo")
library(dismo)
#install.packages("scales")
library(scales)
#install.packages("rgdal")
library(rgdal)
#install.packages("rgeos")
library(rgeos)
#install.packages("rJava")
library(rJava)
#install.packages("foreach")
library(foreach)
#install.packages("doParallel")
library(doParallel)
#Colors to use in the plots
MyRbw2<-c('#f4f4f4','#3288bd','#66c2a5','#e6f598','#fee08b','#f46d43','#9e0142')
colfunc_myrbw2<-colorRampPalette(MyRbw2)
#Create empty lists to recieve outputs
xm_list<-list()
xm_spc_list<-list()
e_spc_list<-list()
px_spc_list<-list()
tr_spc_list<-list()
spc_pol1<-list()
spc_pol5<-list()
tr<-list()
#Create empty data frame to recieve treshold values for each species
tr_df<-data.frame(matrix(NA, nrow=92, ncol=7))
tr_df[,1]<-as.character(tree_list)
names(tr_df)<- c('spp',"kappa","spec_sens","no_omission","prevalence","equal_sens_spec","sensitivity")
# Assigning objects to run Maxent
data_points <- tree_cd_points # this is a list with SpatialPoints for 92 species
data_list <- tree_list # list with the species names
counts_data<- counts_tree_cd # number of points for each species
predictors2<-predictors_low # rasterStack of Bioclim layers (climatic variables), low resolution
#Stablishing extent for Maxent predictions
xmin=-120; xmax=-35; ymin2=-40; ymax=35
limits2 <- c(xmin, xmax, ymin2, ymax)
# Making the cluster for doParallel
cores<-detectCores() # I have 16
cl <- makeCluster(cores[1]-1) #not to overload your computer
registerDoParallel(cl)
#Just to keep track of time
ptime1 <- proc.time()
pdf("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/treesp_maxent_20170823.pdf",
paper = "letter", height = 11, width=8,5, pointsize=12,pagecentre = TRUE)
#I have 92 species, but I'll run just the first 4 to test
foreach(i=1:4, .packages=c("dismo","scales","rgdal","rgeos","rJava")) %dopar% { #Runs only species with 5 or more points to avoid maxent problems
if (counts_data$n[i]>4) { #If the species has more than 4 occurrence points, run maxent
tryCatch({ #makes the loop go on despite errors
#Sets train, test and total points for Maxent
group <- kfold(x=data_points[[i]], 5)
pres_train<- data_points[[i]][group != 1, ]
pres_test <- data_points[[i]][group == 1, ]
spoints<- data_points[[i]]
#Sets background points for Maxent
backg <- randomPoints(predictors2, n=20000, ext=limits2, extf = 1.25)
colnames(backg) = c('lon', 'lat')
group <- kfold(backg, 5)
backg_train <- backg[group != 1, ]
backg_test <- backg[group == 1, ]
#The maxent itself (put the xm in the empty list that I created earlier to store all xms)
xm_spc_list[[i]] <- maxent(x=predictors2, p=spoints, a=backg ,
factors='ecoreg',
args=c('visible=true',
'betamultiplier=1',
'randomtestpoints=20',
'randomseed=true',
'linear=true',
'quadratic=true',
'product=true',
'hinge=true',
'threads=4',
'responsecurves=true',
'jackknife=true',
'removeduplicates=false',
'extrapolate=true',
'pictures=true',
'cache=true',
'maximumiterations=5000',
'askoverwrite=false'),
path=paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm/",data_list[i]), overwrite=TRUE)
par(mfrow=c(1,1),mar = c(2,2, 2, 2))
plot(xm_spc_list[[i]], main=paste(data_list[i]))
response(xm_spc_list[[i]])
#Evaluating how good is the model and putting the evaluation values in a list
e_spc_list[[i]] <- evaluate(pres_test, backg_test, xm_spc_list[[i]], predictors2)
#Predicting the climatic envelopes and Sending to a list os predictions
px_spc_list[[i]] <- predict(predictors2, xm_spc_list[[i]], ext=limits2, progress='text',
filename=paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm/",data_list[i],"/",gsub('\\s+', '_', data_list[i]),"_pred.grd"), overwrite=TRUE)
tr_df[i,2:7]<-threshold(e_spc_list[[i]])
tr[[i]]<-threshold(e_spc_list[[i]], 'spec_sens')
#Pol 1 will be the regular polygon, default treshold
spc_pol1[[i]] <- rasterToPolygons(px_spc_list[[i]]>tr[[i]],function(x) x == 1,dissolve=T)
writeOGR(obj = spc_pol1[[i]], dsn = paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm1/",data_list[i]), driver = "ESRI Shapefile",
layer = paste0(gsub('\\s+', '_', data_list[i]),"_pol"), overwrite_layer = TRUE )
#Pol 5 will be a 100km^2 circle around the occurrence points
circ <- circles(spoints, d=5642,lonlat=TRUE)
circ <- circ#polygons
crs(circ)<-crs(wrld_cropped)
circ <- gIntersection(wrld_cropped, circ, byid = TRUE, drop_lower_td = TRUE)
#To write de polygon to a file, the function writeOGR needs an object SPDF, so...
#Getting Polygon IDs
circ_df<- as.data.frame(sapply(slot(circ, "polygons"), function(x) slot(x, "ID")))
#Making the IDs row names
row.names(circ_df) <- sapply(slot(circ, "polygons"), function(x) slot(x, "ID"))
# Make spatial polygon data frame
circ_SPDF <- SpatialPolygonsDataFrame(circ, data =circ_df)
#Save the polygon, finally
writeOGR(obj = circ_SPDF, dsn = paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm5/",data_list[i]), driver = "ESRI Shapefile",
layer = paste0(gsub('\\s+', '_', data_list[i]),"_pol"), overwrite_layer = TRUE )
spc_pol5[[i]]<-circ_SPDF
#Now the plots
par(mfrow=c(2,3),mar = c(2,1, 1, 1))
plot(px_spc_list[[i]], axes=FALSE, legend=TRUE, legend.shrink=1, col=colfunc_myrbw2(20), main=paste((data_list[i]),' - Maxent'))
plot(wrld_cropped,add=TRUE, border='dark grey',axes=FALSE)
points(data_points[[i]], pch=21,col="white", bg='hotpink', lwd=0.5, cex=0.7)
plot(wrld_cropped, border='dark grey', col="#f9f9f9",axes=FALSE, main='px>tr')
plot(spc_pol1[[i]] , main=paste((data_list[i]),' - Range'), add=TRUE, col=alpha("green3",0.8),border=alpha("green3",0.8),axes=FALSE)
points(data_points[[i]], pch="°",col="black", cex=0.7)
plot(wrld_cropped, border='dark grey', col="#f9f9f9",axes=FALSE, main=paste(data_list[i],"circles"))
plot(circ, add=TRUE, col=alpha("green3",0.8),border=alpha("green3",0.8) )
}, error=function(e){cat("Warning message:",conditionMessage(e), "\n")})
#But sometimes, even with >4 occurrence points, Maxent fails...
#So I'll make sure that if I have >4 points but maxent didn't work, I get the circles anyway
f<-paste("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm/",data_list[i],"/",gsub('\\s+', '_', data_list[i]),"_pred.grd", sep="")
gc() #Just collecting garbage to speed up the process
if (!file.exists(f)){ # then, if f (maxent output) doesn't exist, create the circles at least
spoints<- data_points[[i]]
circ <- circles(spoints, d=5642,lonlat=TRUE)
circ <- circ#polygons
crs(circ)<-crs(wrld_cropped)
circ <- gIntersection(wrld_cropped, circ, byid = TRUE, drop_lower_td = TRUE)
#To write de polygon to a file, the function writeOGR needs an object SPDF, so...
#Getting Polygon IDs
circ_df<- as.data.frame(sapply(slot(circ, "polygons"), function(x) slot(x, "ID")))
#Making the IDs row names
row.names(circ_df) <- sapply(slot(circ, "polygons"), function(x) slot(x, "ID"))
# Make spatial polygon data frame
circ_SPDF <- SpatialPolygonsDataFrame(circ, data =circ_df)
#Save the polygon, finally
#dir.create(paste("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm5/",data_list[i],sep=""))
writeOGR(obj = circ_SPDF, dsn = paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm5/",data_list[i],sep=""), driver = "ESRI Shapefile",
layer = paste0(gsub('\\s+', '_', data_list[i]),"_pol"), overwrite_layer = TRUE )
spc_pol5[[i]]<-circ_SPDF
plot(wrld_cropped, border='dark grey', col="#f9f9f9",axes=FALSE, main=data_list[i])
plot(circ, add=TRUE, col=alpha("green3",0.8),border=alpha("green3",0.8) )
#plot(spoints,pch=21,col="white", bg='hotpink', lwd=0.1, cex=0.5, add=TRUE)
}
} else { #If the species does not have more than 4 points,
#do not run maxent, but create a circles polygon
spoints<- data_points[[i]]
#For the circle to have 100km2, d should be 5641.9 ...
circ <- circles(spoints, d=5642,lonlat=TRUE)
circ <- circ#polygons
crs(circ)<-crs(wrld_cropped)
circ <- gIntersection(wrld_cropped, circ, byid = TRUE, drop_lower_td = TRUE)
circ_df<- as.data.frame(sapply(slot(circ, "polygons"), function(x) slot(x, "ID")))
row.names(circ_df) <- sapply(slot(circ, "polygons"), function(x) slot(x, "ID"))
circ_SPDF <- SpatialPolygonsDataFrame(circ, data =circ_df)
writeOGR(obj = circ_SPDF, dsn = paste0("C:/Users/thai/Desktop/Ecologicos/w2/SpDistModel/SEM9/spp/xm5/",data_list[i],sep=""), driver = "ESRI Shapefile",
layer = paste0(gsub('\\s+', '_', data_list[i]),"_pol"), overwrite_layer = TRUE )
par(mfrow=c(1,1),mar = c(2,2, 2, 2))
plot(wrld_cropped, border='dark grey', col="#f9f9f9",axes=FALSE, main=data_list[i])
plot(circ, add=TRUE, col=alpha("green3",0.8),border=alpha("green3",0.8) )
spc_pol5[[i]]<-circ_SPDF
gc() #collecting garbage before a nuw run
}
}
dev.off()
dev.off() #to close that pdf I started before the loop
ptime2<- proc.time() - ptime1 #just checking the time
ptime2
You could call foreach specifying a "collector" variable such as in:
results <- foreach(i=1:4, .packages=c("dismo","scales","rgdal","rgeos","rJava")) %dopar%
Then, before the end of the foreach loop you can collect all your result variable in a common list and return them:
out <- list(xm_spc_list= xm_spc_list,
e_spc_list = e_spc_list,
px_spc_list = px_spc_list,
... = ...,
... = ....)
return(out)
}
Notice that in the foreach you can avoid to use constructs such as xm_spc_list[[i]] <- because foreach will take care of that for you by "binding" the results in a (ordered) list of lists.
To retrieve the "single" outputs from the results list of lists after the foreach, you can then use something like:
xm_spc_list <- data.table::rbindlist(do.call(c,lapply(results, "[", 1)))
e_spc_list <- data.table::rbindlist(do.call(c,lapply(results, "[", 2)))
....
....
HTH (though impossible to test, given the example at hand)

can raster create multi-layer objects with different modes?

Can a raster object (in R) have layers of different mode (data type)?
On the face of it it seems we are always forced to one type:
library(raster)
## create a SpatialPixelsDataFrame with (trivially) two different "layer" types
d <- data.frame(expand.grid(x = 1:10, y = 2:11), z = 1:100, a = sample(letters, 100, replace = TRUE), stringsAsFactors = FALSE)
coordinates(d) <- 1:2
gridded(d) <- TRUE
## now coerce this to a raster brick or stack and our "a" is crushed to numeric NA
all(is.na(getValues(brick(d)[[2]])))
[1] TRUE
Is there anything like a rasterDataFrame?
Also, note that we presumably cannot use R's factors since the raster#data is a matrix, or otherwise coerced to numeric/integer. Am I missing something?
The raster package provides the ability to create rasters with a categorical variable, and the rasterVis package includes functions for plotting them. The ratify function allows a raster to include a lookup table relating the underlying raster integer values to other values, which can be character. This directly allows the use of any other mode of value in the levels part of the ratified raster.
Here's an example.
library(rasterVis)
r <- raster(xmn = 0, xmx = 1, ymn = 0, ymx = 2, nrow = 10, ncol = 11,
crs = as.character(NA))
r[] <- sample(seq_along(letters[1:5]), ncell(r), replace = TRUE)
## ratify the raster, and set up the lookup table
r <- ratify(r)
rat <- levels(r)[[1]]
rat$value <- letters[1:5]
rat$code <- 1:5
## workaround for limitation as at 2013-05-01
## see https://stat.ethz.ch/pipermail/r-sig-geo/2013-May/018180.html
rat$code <- NULL
levels(r) <- rat
levelplot(r)
There are coming updates to rasterVis that make the workaround above unnecessary.

get coordinates of a patch in a raster map (raster package in R)

I have a raster map with many patches (clumps of continguous cells with the same value). What I need to do is to obtain the coordinates of the center (or close to the center) of each patch.
I am very unexperienced with raster package but it seems I can get coordinates only if I know the position of the cells in the map. Is there any way to get coordinates giving a value of the cells instead? Thank you
If by patch you mean clumps, Raster package allows you to find , and isolate, clumps. Taking the clump() raster package example, and extending it:
library(raster)
library(igraph)
detach("package:coin", unload=TRUE)
r <- raster(ncols=12, nrows=12)
set.seed(0)
r[] <- round(runif(ncell(r))*0.7 )
rc <- clump(r)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
plot(r)
plot(rc)
text(df[df$is_clump == T, 1:2], labels = df[df$is_clump == T, 3])
May not be as interesting as you could expect.
You do it all over with directions = 4
rc <- clump(r, directions = 4)
clump_id <- getValues(rc)
xy <- xyFromCell(rc,1:ncell(rc))
df <- data.frame(xy, clump_id, is_clump = rc[] %in% freq(rc, useNA = 'no')[,1])
df[df$is_clump == T, ]
to get
and maybe clump 'centroids'
dfm <- ddply(df[df$is_clump == T, ], .(clump_id), summarise, xm = mean(x), ym = mean(y))
plot(rc)
text(dfm[, 2:3], labels = dfm$clump_id)
Notes:
There will be an error if you try to use clump() without first
detach modeltools library. modeltools is called by coin and maybe
other statistical libraries.
You could take the mean of the coordinates of each patch:
# some dummy data
m <- matrix(c(
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,4,4,0,
0,0,0,0,0,0,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,
0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,
0,0,2,3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow=20, byrow=T)
# create a raster
r <- raster(m)
# convert raster to points
p <- data.frame(rasterToPoints(r))
# filter out packground
p <- p[p$layer > 0,]
# for each patch calc mean coordinates
sapply(split(p[, c("x", "y")], p$layer), colMeans)

Resources