An embedded and charset-unspecified text was scrubbed... Name: not available URL: <https://stat.ethz.ch/pipermail/r-sig-geo/attachments/20100218/27cd622a/attachment.pl>
suggestion to imrpove: Generating Random Transects of Same Length (by marcelino de la cruz)
2 messages · gianni lavaredo, Marcelino de la Cruz
See below:
At 22:40 18/02/2010, gianni lavaredo wrote:
Dear Researchers,
I wish to improve the code of "Generating Random
Transects of Same Length", by Marcellino De la
Cruz to do a forest invetory analysis
I am trying to use with "Stratified Random Point" inside a grid.
the problem is: sometimes the transect line
enter inside another square (if You run the code
you can see very easy the problem). Eventually
with vertices(tiles(Z)) I can change in w=
.....................
# Test if every circle point is inside polygonal boundary
srp.disc.df <- lapply(srp.disc, function(W){
inside.owin(W$bdry[[1]]$x,W$bdry[[1]]$y ,w=mywindow)})
########################### #### START HERE::
library(spatstat) mywindow <- owin(c(0,3000),c(0,2000)) plot(mywindow) # Divide Region into Quadrats Z <- quadrats(mywindow, 10, 10)
# you mean 100 transects i.e. one in each tile npoints <- 100 s <- 1:npoints #create the tiles object: Ztiles <- tiles(Z)
plot(Z, add=T)
# Stratified Random Point
#srp <- rstrat(win=Z, nx=10,k=1)
#plot(srp,pch=20,cex = 0.8, add=T,col="blue")
# better, choose one random point within each tile: srp2 <- lapply(Ztiles, function(x) rpoint(1,w=x)) #one rnadom point within each tile lapply(srp2,plot, pch=20,cex = 0.8, add=T,col="blue")
# transect ltransect <- 100 #srp.xy <- data.frame(srp$x,srp$y)
srp.xy<-t(sapply(srp2, function(k) c(k$x,k$y)))
#compute a circle around each point #srp.disc <- apply(srp.xy,1, function(x) disc(r=ltransect, x))
srp.disc <- lapply(srp2, function(x) disc(r=ltransect, c(x$x,x$y)))
# Plot all circle buffer
for(i in 1:length(srp.disc)) {
plot(srp.disc[[i]],add=T)
}
# the problem is here. I need to change in
w=with the each part of Z(=Divide Region into Quadrats),
# and compte for each points the following test
# Test if every circle point is inside polygonal boundary
#srp.disc.df <- lapply(srp.disc, function(W){
#
inside.owin(W$bdry[[1]]$x,W$bdry[[1]]$y ,w=mywindow)})
# test if every circle point is inside the
polygonal boundary of each tile
srp.disc.df <- NULL
for (i in 1:length(srp.disc)){
srp.disc.df[[i]] <- inside.owin(srp.disc[[i]]$bdry[[1]]$x,
srp.disc[[i]]$bdry[[1]]$y
,w=Ztiles[[i]])
}
# function to sample circle points within the window
samplea2 <- function(srp.xy, l1=srp.disc, l2=srp.disc.df){
result <-c(0,0)
for(i in 1:length(l1)){
truinside<-sum(l2[[i]])
inside
<-cbind(l1[[i]]$bdry[[1]]$x,l1[[i]]$bdry[[1]]$y)[l2[[i]],]
result<-rbind(result, inside[sample(1:truinside, size=1),])
}
result <- result[-1,]
result <- cbind(srp.xy,result)
return(result)
}
# the result is a matrix with x0,y0, x1, y1 for each transect
# Plot the random transects:
segmentos <- samplea2(srp.xy)
segments(segmentos[,1][s],
segmentos[,2][s],segmentos[,3][s], segmentos[,4][s])
Hope this helps! Marcelino
this is the orginal code:
library(spatstat)
# Define polygon, length of transect and number of (points)transects
data(letterR)
mywindow <- letterR
ltransect <- 0.3
npoints <- 100
s <- 1:npoints
# Generate random origin points
cosa <- runifpoint(npoints, w=mywindow)
plot(cosa)
cosaxy <- data.frame(cosa$x,cosa$y)
#compute a circle around each point
cosadisc<- apply(cosaxy,1, function(x) disc(r=ltransect, x))
# Test if every circle point is inside polygonal boundary
cosadisc.df <- lapply(cosadisc, function(W){
inside.owin(W$bdry[[1]]$x,W$bdry[[1]]$y ,w=mywindow)})
#function to sample circle points within the window
samplea2 <- function(cosaxy, l1=cosadisc, l2=cosadisc.df){
result<-c(0,0)
for (i in 1:length(l1)){
truinside<-sum(l2[[i]])
inside
<-cbind(l1[[i]]$bdry[[1]]$x,l1[[i]]$bdry[[1]]$y)[l2[[i]],]
result<-rbind(result,
inside[sample(1:truinside, size=1),])
}
result<-result[-1,]
result<-cbind(cosaxy,result)
return(result)
}
#the result is a matrix with x0,y0, x1, y1 for each transect
#Plot the random transects:
segmentos<-samplea2(cosaxy)
segments(segmentos[,1][s],
segmentos[,2][s],segmentos[,3][s], segmentos[,4][s])
________________________________ Marcelino de la Cruz Rot Departamento de Biolog?a Vegetal E.U.T.I. Agr?cola Universidad Polit?cnica de Madrid 28040-Madrid Tel.: 91 336 54 35 Fax: 91 336 56 56 marcelino.delacruz at upm.es _________________________________