[R-sig-Geo] suggestion to imrpove: Generating Random Transects of Same Length (by marcelino de la cruz)

[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
_________________________________