如何停止随机游走

时间:2014-01-18 18:21:55

标签: r loops for-loop random-walk

plot(0:70,0:70, type="n", xlab="X", ylab="Y")

x<-40
y<-40

x2<-60
y2<-60

points(x, y, pch=16, col="red", cex=1.5)
points(x2, y2, pch=16, col="green", cex=1.5)

for (i in 1:10000){
    xi<-sample(c(1,0,-1),1)
    yi<-sample(c(1,0,-1),1)
    x2i<-sample(c(1,0,-1),1)
    y2i<-sample(c(1,0,-1),1)
    lines(c(x,x+xi),c(y,y+yi))
    lines(c(x2,x2+x2i),c(y2,y2+y2i), col="red")
    x<-x+xi
    y<-y+yi
    x2<-x2+x2i
    y2<-y2+y2i
    if(x2==x && y==y2) {
        break
    }
}

我随机走了两条线,当两条线相遇时我需要它停止。

首先,我绘制了一个空图和两个起点。然后我将这个for循环移动,在绘图上绘制它们并获得下一次迭代的新起点。

我尝试在线路遇到时停止使用:if(x2==x && y==y2) { break }但是只有当它们在同一点并且同时(在同一次迭代中)时才会停止,我需要它们停止其中一个穿过另一个。如果一个人穿过已经为另一条线绘制的任何点。我认为问题是已绘制的点不会保存在任何地方,所以我无法将它们与线的点进行比较。也许我需要将这些点保存在循环之外?有人知道如何阻止它吗?

1 个答案:

答案 0 :(得分:3)

N      <- 10000
D      <- 1
coef.1 <- matrix(NA,N,2)
coef.2 <- matrix(NA,N,2)
path.1 <- matrix(NA,N,2)
path.2 <- matrix(NA,N,2)
path.1[1,] <- c(40,40)
path.2[1,] <- c(60,60)
d.start    <- sqrt(sum((path.1[1,]-path.2[1,])^2))
ch <- "."
set.seed(1)
system.time({
  for (i in 2:N){
    if (i%%50==0) cat(ch)
    path.1[i,] <- path.1[i-1,] + sample(-D:D,2)
    path.2[i,] <- path.2[i-1,] + sample(-D:D,2)
    coef.1[i,] <- get.line(path.1[(i-1):i,])
    coef.2[i,] <- get.line(path.2[(i-1):i,])
    r.1 <- sqrt(max(rowSums((path.1[1:i,]-path.1[1,])^2)))
    r.2 <- sqrt(max(rowSums((path.2[1:i,]-path.2[1,])^2)))
    if (r.1+r.2 < d.start) next  # paths do not overlap
    ch <- "1"
    d.1 <- sqrt(min(rowSums((path.2[1:i,]-path.1[1,])^2)))
    d.2 <- sqrt(min(rowSums((path.1[1:i,]-path.2[1,])^2)))
    if (d.1>r.1 & d.2>r.2) next
    ch <- "2"
    cross <- sapply(2:i,
               function(k){seg.intersect(path.2[(k-1):k,],path.1[(i-1):i,],k)})
    if (any(cross)) break
    cross <- sapply(2:i,
               function(k){seg.intersect(path.1[(k-1):k,],path.2[(i-1):i,],k)})
    if (any(cross)) break
  }
})
# 11111111112222222222222222222222
#    user  system elapsed 
# 1016.82    0.13 1024.18
print(paste("End at Step: ",i))
# [1] "End at Step:  1624"
plot(0:100,0:100, type="n", xlab="X", ylab="Y")
points(path.1[1,1],path.1[1,2], pch=16, col="red", cex=1.5)
points(path.2[1,1],path.2[1,2], pch=16, col="green", cex=1.5)
lines(path.1[1:i,])
lines(path.2[1:i,],col="red")

正如@CarlWitthoft指出的那样,在每一步中,您必须检查所有之前的线段以进行交叉。这会产生严重问题,因为在每个新步骤i中,都有2*(i-1)次跨越测试。因此,如果您在步骤k进入过境点,则会进行2*k*(k+1)次测试。如果k ~O(10000),则可能有100MM测试。

为了提高效率,我们不仅存储每一步的两个新点,还存储新创建的线段的斜率和截距。这避免了在每个步骤重新计算所有先前线段的斜率和截距。另外,我们计算每一步的每条路径的路径半径r。这是起点和距离起点最远的路径上的点之间的距离。如果路径起点与其他路径上最近点之间的距离大于路径半径,则不能有交叉点,我们可以跳过此步骤的各个段比较。

由于其他原因,您的问题很有趣。测试交叉的常规方法是确定两条线之间的交点是否在任一段上。这很麻烦但很简单。但是有很多特殊情况:这些线是否平行?如果是这样,他们是否一致?如果是,那么这些段是否重叠?垂直线(斜率= Inf)怎么样?因为您在[-1,1]上将增量设置为随机整数,所以这些可能性很可能最终发生在具有10000步的路径中。所以上面的函数seg.intersect(...)必须考虑到所有这些可能性。你会认为R中有一个函数可以做到这一点,但我找不到一个函数,所以这里有一个(杂乱的)版本:

get.line <- function(l) {        # returns slope and intercept 
  if (diff(l)[1]==0) return(c(Inf,NA))
  m <- diff(l)[2]/diff(l)[1]
  b <- l[1,2]-m*l[1,1]
  return(c(m,b))
}
is.between <- function(x,vec) {  # test if x is between values in vec
  return(x>=range(vec)[1] & x<=range(vec)[2])
}
special.cases = function(l1,l2, coeff) {
  # points coincide: not a line segment!
  if (rowSums(diff(l1)^2)==0 | rowSums(diff(l2)^2)==0) return(c(NA,FALSE))
  # both lines vertical
  if (is.infinite(coeff[1,1]) & is.infinite(coeff[2,1])) {
    if (l1[1,1]!=l2[1,1]) return(c(NA,FALSE))
    t1 <- is.between(l1[1,2],l2[,2]) | is.between(l1[2,2],l2[,2])
    t2 <- is.between(l2[1,2],l1[,2]) | is.between(l2[2,2],l1[,2])
    return(c(NA,t1|t2))
  }
  # only l1 is vertical
  if (is.infinite(coeff[1,1]) & is.finite(coeff[2,1])) {
    x <- l1[1,1]
    y <- c(x,1) %*% coeff[2,]
    return(c(x,y))
  }
  # only l2 is vertical
  if (is.finite(coeff[1,1]) & is.infinite(coeff[2,1])) {
    x <- l2[1,1]
    y <- c(x,1) %*% coeff[1,]
    return(c(x,y))
  }
  # parallel, non-coincident lines
  if (diff(coeff[,1])==0 & diff(coeff[,2])!=0) return(c(NA,FALSE))
  # parallel, coincident lines
  if (diff(coeff[,1])==0 & diff(coeff[,2])==0) {
    x <- l1[1,1]
    y <- l1[1,2]
    return(c(x,y))
  }
  # base case: finite slopes, not parallel
  x <- -diff(coeff[,2])/diff(coeff[,1])
  y <- c(x,1) %*% coeff[1,]
  return(c(x,y))   
}
seg.intersect <- function(l1,l2,i){
  pts   <- list(l1,l2)
  coeff <- rbind(coef.1[i,],coef.2[i,])
  z <- special.cases(l1,l2, coeff)
  if (is.na(z[1])) return (z[2])
  #  print(coeff)
  #  print(z)
  found <- do.call("&",
    lapply(pts,function(x){is.between(z[1],x[,1]) & is.between(z[2],x[,2])}))
  return(found)
}