My response to the 10,000 + 5,000 Euros challenge by Richard Gill:

## Richard Gill has offered 10,000 Euroes to anyone who can simulate the N
## directions of angular momentum vectors appearing in equation (16) of this
## experimental proposal of mine: http://arxiv.org/abs/0806.3078. Here I am
## attempting to provide such N directions. They are given by the vectors 'u'
## in this simulation. He has also offered further 5,000 Euros to me if my
## proposed experiment is realized successfully. I am hopeful that that will
## happen some day. The details of these challanges by Richard Gill can be
## found here: http://www.sciphysicsforums.com/spfbb1/viewtopic.php?f=6&t=46.
## While this is by no means a perfect simulation of my model, it does meet
## all the stringent conditions set out by Richard Gill for his challenge.

## Since after the explosion the angular momentum vectors 'u' moving along
## the z direction will be confined to the x-y plane, a 2D simulation is good
## enough for my proposed experiment.

set.seed(9875)

## Measurement angles for directions 'a' and 'b' in the equatorial plane

angles <- seq(from = 0, to = 360, by = 1) * 2 * pi/360

K <- length(angles)

corrs <- numeric(K)  ## Container for correlations

L <- numeric(K)

N <- 10^4  ## Sample size. Next try 10^5, or even 10^6

z <- runif(N, -1, 1)

p <- sqrt(1 - z^2)

r <- runif(N, 0, pi)

s <- runif(N, 0, pi)

t <- runif(N, -1, +1)

w <- runif(N, -1, +1)

x <- p * cos(r/0.69) * sign(t)

y <- p * 1.21 * (-1 + (2/(sqrt(1 + (3 * (0.963 * s)/pi))))) * sign(w)

u <- rbind(x, y, z)  ## A 3xN matrix. The N columns of u represent the
## x, y, and z coordinates of points on an approximate 2-sphere, S^2

for (i in 1:K) {
    alpha <- angles[i]
    a <- c(cos(alpha), sin(alpha), 0)  ## Measurement direction 'a'

    for (j in 1:K) {
        beta <- angles[j]
        b <- c(cos(beta), sin(beta), 0)  ## Measurement direction 'b'

        ua <- colSums(u * a)  ## Inner products of 'u' with 'a'
        ub <- colSums(u * b)  ## Inner products of 'u' with 'b'

        corrs[i] <- sum(sign(-ua) * sign(ub))/N

        # corrs[i] <- sum(sign(-ua))/N
    }
}
plot(angles * 180/pi, corrs, type = "l", col = "blue", main = "Two correlation functions", 
    xlab = "Angle (degrees)", ylab = "Correlation")
points(angles * 180/pi, corrs, col = "blue", pch = ".", cex = 2)
lines(angles * 180/pi, -cos(angles), col = "red")
points(angles * 180/pi, -cos(angles), col = "red", pch = ".", cex = 1)

legend(x = 0, y = 0.9, legend = c("S^3", "-cos"), text.col = c("black", "black"), 
    lty = 1, col = c("blue", "red"))

plot of chunk unnamed-chunk-2


for (i in 1:K) {
    alpha <- angles[i]
    a <- c(cos(alpha), sin(alpha), 0)  ## Measurement direction 'a'

    for (j in 1:K) {
        beta <- angles[j]
        b <- c(cos(beta), sin(beta), 0)  ## Measurement direction 'b'

        ua <- colSums(u * a)  ## Inner products of 'u' with 'a'
        ub <- colSums(u * b)  ## Inner products of 'u' with 'b'

        corrs[j] <- sum(sign(-ua) * sign(ub))/N

        # corrs[j] <- sum(sign(-ua))/N

        L[j] <- N

    }
}
plot(angles * 180/pi, corrs, type = "l", col = "blue", main = "Two correlation functions", 
    xlab = "Angle (degrees)", ylab = "Correlation")
points(angles * 180/pi, corrs, col = "blue", pch = ".", cex = 2)
lines(angles * 180/pi, -cos(angles), col = "red")
points(angles * 180/pi, -cos(angles), col = "red", pch = ".", cex = 1)

legend(x = 0, y = 0.9, legend = c("S^3", "-cos"), text.col = c("black", "black"), 
    lty = 1, col = c("blue", "red"))

plot of chunk unnamed-chunk-4

plot(angles * 180/pi, -cos(angles) - corrs, type = "l", col = "blue", ylim = c(-0.04, 
    +0.04), main = "Difference between the -cos (red) and S^3 (blue) correlations, with +/-1 standard error in green")
abline(h = 0, col = "red", lwd = 1)
lines(angles * 180/pi, 1/sqrt(L), col = "green")
lines(angles * 180/pi, -1/sqrt(L), col = "green")

plot of chunk unnamed-chunk-5