[R-sig-Geo] Help with as.numeric(rownames(over(SpatialPoints(set1, set2, returnList= TRUE)[[1]]))

[chris english]

Hi Alan;
As you say, runs most of the time. I took the liberty of cleaning out the
>'s, removed the call to plyr as it doesn't seem to be used, and the
rm(list=ls()) since I wasn't playing in a sandbox. How frequently does it
misbehave?

I'm sorry I can't offer anything more constructive than the clean up.  I'm
interested in identifying self-avoiding random walks SAW which means I'll
first have to figure out how to implement one, then figure out how to test
for one. And means getting my head around your  "which_next <-
sample(c("bb","dd","ff","hh"),1)" logic.

Chris

## reproducible example code
 #rm(list = ls())
 library(deldir)
 library(sp)
 #library(plyr)
 side_length = 100
 ## Create random SET of XY coordinates (size = 100x100)
 set.seed(11)
 df = data.frame(matrix(sample(1:100,16,replace=TRUE),nrow=8))
 ## Convert df to SPatialPointsDataFrame
 spdf <- SpatialPointsDataFrame(df,df)
 ## deldir() function creates tesselation (voronoi) plot
 z <- deldir(df,plotit=TRUE,wl='te')
 ## tile.list() creates a list of data for tiles
 zz <- tile.list(deldir(df,plotit=TRUE,wl='te'))
 ## Voronoi Polygons Function
 voronoipolygons = function(layer) {
   require(deldir)
   crds = layer at coords
   z = deldir(crds[,1], crds[,2])
   w = tile.list(z)
   polys = vector(mode='list', length=length(w))
   require(sp)
   for (i in seq(along=polys)) {
     pcrds = cbind(w[[i]]$x, w[[i]]$y)
     pcrds = rbind(pcrds, pcrds[1,])
     polys[[i]] = Polygons(list(Polygon(pcrds)), ID=as.character(i))
   }
   SP = SpatialPolygons(polys)
   voronoi = SpatialPolygonsDataFrame(SP, data=data.frame(x=crds[,1],
             y=crds[,2], row.names=sapply(slot(SP, 'polygons'),
             function(x) slot(x, 'ID'))))
 }
 ## Generate SpatialPolygonsDataFrame to use as input for over() function
 vpl <- voronoipolygons(spdf)
 ## Random Walk Function generates North, South East or West movement
 ## with transit from across screen (like PacMan, going out one side,
 ## coming back on the other side) to prevent getting stuck in corner
 random_walk <- function(step_quantity, step_length, plot = FALSE){
   require(ggplot2)

   walker <- data.frame(matrix(c(0,0), nrow = step_quantity, ncol = 3,
 byrow = T))
   names(walker)[1]<-paste("x")
   names(walker)[2]<-paste("y")
   names(walker)[3]<-paste("which")

   ## Seed random initial starting point
   walker[1,1:2] <- matrix(sample(1:100,2,replace=TRUE),nrow=1)
   walker[1,3] <- as.numeric(rownames(over(SpatialPoints(walker[1,1:2]
),vpl,returnList=TRUE)[[1]]))

  where_to <- as.numeric()

   for(i in 2:step_quantity){
     where_to <- as.numeric()
     where_to <- walker[i-1,1:2]
     which_next <- sample(c("bb","dd","ff","hh"),1)

     if (which_next == "bb") {
       if (walker[i-1,2] == side_length) {where_to[1,2] <- 0
       } else {where_to[1,2] <- walker[i-1,2]+step_length}
     }

     else if (which_next == "dd") {
       if (walker[i-1,1] == 0 ) {where_to[1,1] <- side_length
       } else {where_to[1,1] <- walker[i-1,1]-step_length}
     }

    else if (which_next == "ff") {
       if (walker[i-1,1] == side_length) {where_to[1,1] <- 0
       } else {where_to[1,1] <- walker[i-1,1]+step_length}
     }
     else {
       if (walker[i-1,2] == 0) {where_to[1,2] <- side_length
       } else {where_to[1,2] <- walker[i-1,2]-step_length}
     }

     walker[i,1:2] <- where_to
   }

   walker[i,3] <- as.numeric(rownames(over(SpatialPoints(walker[i,1:2]),
                                           vpl,returnList= TRUE)[[1]]))


   if(plot){
   require(ggplot2)
   p <- ggplot(walker, aes(x = x, y = y))
   p <- p + geom_path()
   print(p)
   }

   return(walker)
 }
 try(transits <- random_walk(5000,1),silent=F)

On Sun, Nov 1, 2015 at 1:35 PM, Alan Briggs <awbriggs at gmail.com> wrote:

> Hello.
>
> Below is a fully repeatable R-Script that I'm having trouble with.
> Generally, here's what I'm trying to do:
>
> 1) Randomly generate a tile.list()
> 2) Randomly generate a new point
> 3) Identify which polygon in the tile.list the new randomly generated point
> is in
>
> This works fine MOST of the time. However, occasionally, I get an error
> returned:
>
> Error in `[<-.data.frame`(`*tmp*`, list, 3, value = numeric(0)) :
> >   replacement has length zero
>
>
> While troubleshooting, I realized I get numeric(0) returned for certain
> sets of new random points when I run the command
> as.numeric(rownames(over(SpatialPoints(walker[i,1:2]),vpl,returnList=
> TRUE)[[1]])). I thought maybe this was a boundary issue, but the points
> don't lie on the edge, nor are they the centroid.
>
> Any help you can provide would be greatly appreciated!
>
> Regards,
>
> Alan
>
> R-Script Below:
>
> ### Help Question for  r-sig-geo ###
> > rm(list = ls())
> > library(deldir)
> > library(sp)
> > library(plyr)
> > side_length = 100
> > ## Create random SET of XY coordinates (size = 100x100)
> > set.seed(11)
> > df = data.frame(matrix(sample(1:100,16,replace=TRUE),nrow=8))
> > ## Convert df to SPatialPointsDataFrame
> > spdf <- SpatialPointsDataFrame(df,df)
> > ## deldir() function creates tesselation (voronoi) plot
> > z <- deldir(df,plotit=TRUE,wl='te')
> > ## tile.list() creates a list of data for tiles
> > zz <- tile.list(deldir(df,plotit=TRUE,wl='te'))
> > ## Voronoi Polygons Function
> > voronoipolygons = function(layer) {
> >   require(deldir)
> >   crds = layer at coords
> >   z = deldir(crds[,1], crds[,2])
> >   w = tile.list(z)
> >   polys = vector(mode='list', length=length(w))
> >   require(sp)
> >   for (i in seq(along=polys)) {
> >     pcrds = cbind(w[[i]]$x, w[[i]]$y)
> >     pcrds = rbind(pcrds, pcrds[1,])
> >     polys[[i]] = Polygons(list(Polygon(pcrds)), ID=as.character(i))
> >   }
> >   SP = SpatialPolygons(polys)
> >   voronoi = SpatialPolygonsDataFrame(SP, data=data.frame(x=crds[,1],
> >             y=crds[,2], row.names=sapply(slot(SP, 'polygons'),
> >             function(x) slot(x, 'ID'))))
> > }
> > ## Generate SpatialPolygonsDataFrame to use as input for over() function
> > vpl <- voronoipolygons(spdf)
> > ## Random Walk Function generates North, South East or West movement
> > ## with transit from across screen (like PacMan, going out one side,
> > ## coming back on the other side) to prevent getting stuck in corner
> > random_walk <- function(step_quantity, step_length, plot = FALSE){
> >   require(ggplot2)
> >
> >   walker <- data.frame(matrix(c(0,0), nrow = step_quantity, ncol = 3,
> > byrow = T))
> >   names(walker)[1]<-paste("x")
> >   names(walker)[2]<-paste("y")
> >   names(walker)[3]<-paste("which")
> >
> >   ## Seed random initial starting point
> >   walker[1,1:2] <- matrix(sample(1:100,2,replace=TRUE),nrow=1)
> >   walker[1,3] <-
> > as.numeric(rownames(over(SpatialPoints(walker[1,1:2]),vpl,returnList=
> > TRUE)[[1]]))
> >
> >   where_to <- as.numeric()
> >
> >   for(i in 2:step_quantity){
> >     where_to <- as.numeric()
> >     where_to <- walker[i-1,1:2]
> >     which_next <- sample(c("bb","dd","ff","hh"),1)
> >
> >     if (which_next == "bb") {
> >       if (walker[i-1,2] == side_length) {where_to[1,2] <- 0
> >       } else {where_to[1,2] <- walker[i-1,2]+step_length}
> >     }
> >
> >     else if (which_next == "dd") {
> >       if (walker[i-1,1] == 0 ) {where_to[1,1] <- side_length
> >       } else {where_to[1,1] <- walker[i-1,1]-step_length}
> >     }
> >
> >     else if (which_next == "ff") {
> >       if (walker[i-1,1] == side_length) {where_to[1,1] <- 0
> >       } else {where_to[1,1] <- walker[i-1,1]+step_length}
> >     }
> >     else {
> >       if (walker[i-1,2] == 0) {where_to[1,2] <- side_length
> >       } else {where_to[1,2] <- walker[i-1,2]-step_length}
> >     }
> >
> >     walker[i,1:2] <- where_to
> >   }
> >
> >   walker[i,3] <- as.numeric(rownames(over(SpatialPoints(walker[i,1:2]),
> >                                           vpl,returnList= TRUE)[[1]]))
> >
> >
> >   if(plot){
> >   require(ggplot2)
> >   p <- ggplot(walker, aes(x = x, y = y))
> >   p <- p + geom_path()
> >   print(p)
> >   }
> >
> >   return(walker)
> > }
> > try(transits <- random_walk(5000,1),silent=F)
>
>         [[alternative HTML version deleted]]
>
> _______________________________________________
> R-sig-Geo mailing list
> R-sig-Geo at r-project.org
> https://stat.ethz.ch/mailman/listinfo/r-sig-geo
>

	[[alternative HTML version deleted]]