Thursday, August 23, 2012

A Visual Exploration of Two Dimensional Random Walks


# Let's create N variable vectors that will hold our different random walks.
N <- 7

# Now let's speficy the number of walks to take
S <- 50

# Create a matrix to hold X and Y values
X <- Y <- matrix(0,nrow = S, ncol = N)

# I am going to save my graphs to the "Rplots" directory
setwd("c:/Rplots")

# For each value of X and Y add a random normal draw each of the S rounds
for (s in 2:S) {
  Xmov <- rnorm(N)
  X[s,] <- X[s-1,]+Xmov
  Ymov <- rnorm(N)
  Y[s,] <- Y[s-1,]+Ymov
}

# We can see a pure random walk looks pretty abrupt

par(bg="black")

plot(X,Y, type="n",frame.plot=F , axes=FALSE, xlab="",ylab="")

for (n in 1:N) {
  arrows(x0=X[1:S-1,n], y0=Y[1:S-1,n], x1=X[2:S,n], y1=Y[2:S,n], col = rainbow(N)[n], length=.05)
}

savePlot(filename = "2012_8_23_rand_walk1.png",
         type = "png")




# However, let's allow for some momentum (whatever speed the point had at the previous step that speed is retained during this step plus some random movement.  This is in effect a data source that exhibits a random walk even after first differencing.

X2 <- Y2 <- matrix(0,nrow = S, ncol = N)

for (s in 3:S) {
  # Add an inertia term
  Xinertia <- X2[s-1,] - X2[s-2,]
  Xmov <- rnorm(N) + Xinertia
  X2[s,] <- X2[s-1,]+Xmov

  Yinertia <- Y2[s-1,] - Y2[s-2,]
  Ymov <- rnorm(N)  + Yinertia
  Y2[s,] <- Y2[s-1,]+Ymov
}

# We can see a pure random walk looks pretty abrupt
par(bg="black")

plot(X2,Y2, type="n",frame.plot=F , axes=FALSE, xlab="",ylab="")

for (n in 1:N) {
  arrows(x0=X2[1:S-1,n], y0=Y2[1:S-1,n], x1=X2[2:S,n], y1=Y2[2:S,n], col = rainbow(N)[n], length=.05)
}

savePlot(filename = "2012_8_23_rand_walk2.png",
         type = "png")


# We can see the movement seems to be much smoother but cause rapid divergence in individual draws

# Lets try one more specification.  First we will cause there to be a common current vector (1,1) pushing the different strands towards the positive direction.  Also, there will be more momentum.


X3 <- Y3 <- matrix(0,nrow = S, ncol = N)

for (s in 7:S) {
  # Add an inertia term
  Xinertia <- 5*(X3[s-1,] - X2[s-2,]) +
              4*(X3[s-2,] - X2[s-3,]) +
              3*(X3[s-3,] - X2[s-4,]) +
              2*(X3[s-4,] - X2[s-5,]) +
              1*(X3[s-5,] - X2[s-6,])
  Xmov <- rnorm(N) + Xinertia/750 + 1
  X3[s,] <- X3[s-1,]+Xmov

  Yinertia <- 5*(Y3[s-1,] - Y2[s-2,]) +
              4*(Y3[s-2,] - Y2[s-3,]) +
              3*(Y3[s-3,] - Y2[s-4,]) +
              2*(Y3[s-4,] - Y2[s-5,]) +
              1*(Y3[s-5,] - Y2[s-6,])
  Ymov <- rnorm(N) + Yinertia/750 + 1
  Y3[s,] <- Y3[s-1,]+Ymov
}

par(bg="black")

plot(X3,Y3, type="n",frame.plot=F , axes=FALSE, xlab="",ylab="")

for (n in 1:N) {
  arrows(x0=X3[1:S-1,n], y0=Y3[1:S-1,n], x1=X3[2:S,n],
         y1=Y3[2:S,n], col = rainbow(N)[n], length=.05)
}

savePlot(filename = "2012_8_23_rand_walk3.png",
         type = "png")


No comments:

Post a Comment