0

座標(0,0)から始まるランダムウォークをシミュレートしています。ループでそれを行うと、うまく機能します：

require(ggplot2)
n <- 1000   #number of walks 

# first solution, w/ loop... works but is SLOOOW
coord <- data.frame (x=0, y=0, step=0) #origin
for (i in 1:n){
  dir <- sample(c("w", "e", "n", "s"), 1) #random direction
  step <- sample(1:4, 1) #how far to go in each walk
  startx <- coord[nrow(coord), 1]
  starty <- coord[nrow(coord), 2]
  endx <- ifelse (dir=="w", startx-step, ifelse(dir=="e", startx+step, startx))
  endy <- ifelse (dir=="n", starty+step, ifelse(dir=="s", starty-step, starty))
  newcoord <- data.frame (x=endx, y=endy, step=step)
  coord <- rbind(coord, newcoord)
}
rw <- ggplot(coord, aes(x=x, y=y))
rw + geom_path() + 
  ggtitle(paste(n, "walks")) + 
  geom_point(aes(x=0, y =0), color="green", size=I(5)) +
  geom_point(aes(x=endx, y =endy), color="red", size=I(5))

ただし、n>10,000 では非常に遅くなるため、ループを回避して何らかの形式の「適用」を使用したいと考えていますが、行 n と n-1 から座標の値を追加する方法がわかりません。助けてください、ありがとう。

# second solution
d <- data.frame(dir=sample(c("w", "e", "n", "s"), n, replace=T), step=sample(1:4, n, replace=T))
xy <- data.frame(x=0, y=0)
x. <- data.frame(x=with(d, ifelse (dir=="w", -step, ifelse(dir=="e", step, 0))))
y. <- data.frame(y=with(d, ifelse (dir=="s", -step, ifelse(dir=="n", step, 0))))
x.y. <- cbind(x.,y.)
xy <- rbind(xy, x.y.)
head(xy)
# ... stuck here
4

4 に答える 4

3

data.tableこの種の問題では速いです...

walk.dt.f<-function(n=10000L, stepsize=1L:4L) {
  # lookup table with direction vector info
  dir.dt<-data.table(dir=c("w", "e", "n", "s"), xdir=c(-1L,1L,0L,0L), ydir=c(0L,0L,1L,-1L), key="dir")

  # initial position for random walk table
  walk.ini.dt<-data.table(rowid=0L,dir="n",step=0L)

  # generate table with random walk info
  walk.dt<-rbindlist(list(data.table(rowid=1L:n, dir=sample(dir.dt[,dir],n,replace=T), step=sample(stepsize,n,replace=T)), walk.ini.dt))

  # join the two tables, and multiply the step info by the direction vectors
  setkey(walk.dt,dir)
  walk.dt[dir.dt,c("xstep","ystep"):=list(step*xdir,step*ydir)]

  # update the key and reorder the rows
  setkey(walk.dt,rowid)

  # update the walk info table with the cumulative position
  walk.dt[,c("x","y"):=list(cumsum(xstep),cumsum(ystep))]

}

system.time(walk.dt.f(10000L))
## user  system elapsed 
## 0       0       0 

system.time(walk.dt.f(1e6L))
## user  system elapsed
## 0.25    0.00    0.25

編集：開始位置を（0,0）に設定します

于 2013-02-14T19:51:15.030 に答える
2

近づいていると思います。すでに投稿されているコメントを読むと、はるかに速くすることができます。だから私はこれを見ないことをお勧めします：

n=10000
x.=sample(-4:4,n,rep=T)
y.=sample(-4:4,n,rep=T)
x=cumsum(x.)
y=cumsum(y.)

coord=data.frame(x,y)

次に、あなたがした方法を正確にプロットします。

rw <- ggplot(coord, aes(x=x, y=y))
rw + geom_path() + 
  ggtitle(paste(n, "walks")) + 
  geom_point(aes(x=0, y =0), color="green", size=I(5)) +
  geom_point(aes(x=startx, y =starty), color="red", size=I(5))

更新：nが10 ^ 5より大きい場合、プロットは非常に遅くなります。たぶんベースグラフィックスはもっと速いでしょう。

update2：これはjoranの応答とほぼ同じくらい遅い/速いです。

于 2013-02-14T19:15:53.553 に答える
2

2Dランダムウォークを試みているので、4x4の可能な変位があります。1から16までの数値でエンコードできます。ただし、計算を減らし、これらのエンコードされた数値を方向と変位量にマッピングするために、ちょっとしたトリックを実行しました。ステップを1:16でエンコードしませんでしたが、c(-7:0,4:11)

d <- sample(c(-7:0,4:11),n,replace=T)
delta <- d%%4+1
dir <- d%/%4
xd <- dir
xd[xd%%2 ==0]=0
yd <- dir
yd[xd%%2 ==1]=0
yd <- yd/2
x=c(0,xd*delta)
y=c(0,yd*delta)
x=cumsum(x)
y=cumsum(y)

coords<-data.frame(x,y)

このバージョンはベクトル化された操作のみを使用し、オーバーヘッドはわずかです。data.table以前に示したベースのソリューションに近いパフォーマンスを発揮すると思います。

于 2013-02-14T20:11:53.097 に答える
2

ガッ！これが、R の愚かな「for ループは本質的に遅い」カナードを押しつぶすという私の目標を促進することを期待して、40 倍以上高速なfor ループを使用して、最初のバージョンを作り直します。

ランダムウォークの実装がまったく理にかなっているのかどうかも考慮していません。ここでの私のポイントは、「遅い」for ループを使用しながら、元のコードの結果をはるかに高速に達成する方法を指摘することです。

#My version
foo <- function(n){ 
    coord <- matrix(NA,nrow = n,ncol = 3) #origin
    coord[1,] <- c(0,0,0)
    dir <- sample(c("w", "e", "n", "s"), n,replace = TRUE) #random direction
    step <- sample(1:4, n,replace = TRUE) #how far to go in each walk
    for (i in 2:n){
      startx <- coord[i-1, 1]
      starty <- coord[i-1, 2]
      endx <- ifelse (dir[i]=="w", startx-step[i], ifelse(dir[i]=="e", startx+step[i], startx))
      endy <- ifelse (dir[i]=="n", starty+step[i], ifelse(dir[i]=="s", starty-step[i], starty))
      coord[i,] <- c(endx,endy,step[i])
    }
}

#Your version    
foo2 <- function(n){
    coord <- data.frame (x=0, y=0, step=0) #origin
    for (i in 1:n){
      dir <- sample(c("w", "e", "n", "s"), 1) #random direction
      step <- sample(1:4, 1) #how far to go in each walk
      startx <- coord[nrow(coord), 1]
      starty <- coord[nrow(coord), 2]
      endx <- ifelse (dir=="w", startx-step, ifelse(dir=="e", startx+step, startx))
      endy <- ifelse (dir=="n", starty+step, ifelse(dir=="s", starty-step, starty))
      newcoord <- data.frame (x=endx, y=endy, step=step)
      coord <- rbind(coord, newcoord)
    }
}


system.time(foo(10000))
   user  system elapsed 
  0.353   0.001   0.353 
> system.time(foo2(10000))
   user  system elapsed 
 11.374   2.061  13.308

ここで行ったことは次のとおりです。

  1. 止まる。使用中。RBIND。そして、事前に割り当てます。
  2. マトリックスに切り替えます。
  3. sample呼び出しをループ外に移動します。
于 2013-02-14T19:17:30.217 に答える