[R-sig-Geo] Help with as.numeric(rownames(over(SpatialPoints(set1, set2, returnList= TRUE)[[1]]))
chris english
englishchristophera at gmail.com
Mon Nov 2 11:50:42 CET 2015
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 <englishchristophera at 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 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]]
More information about the R-sig-Geo
mailing list