Alan, Possibly a nonsensical way of testing but I ran
rep(try(transits <- random_walk(5000,1),silent=F), 100) and it completed without issue. Chris On Mon, Nov 2, 2015 at 5:33 AM, chris english <englishchristoph...@gmail.com > wrote: > 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@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 <awbri...@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@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@r-project.org >> https://stat.ethz.ch/mailman/listinfo/r-sig-geo >> > > [[alternative HTML version deleted]] _______________________________________________ R-sig-Geo mailing list R-sig-Geo@r-project.org https://stat.ethz.ch/mailman/listinfo/r-sig-geo