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")
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment