Fred, you still do not see the error of your ways. Joy does not want to look, his loss. The requirement is for the statements
a <- c(cos(alpha), sin(alpha))
b <- c(cos(beta), sin(beta))
ca <- colSums(u * a) ## Inner products of cols of 'u' with 'a'
cb <- colSums(v * b) ## Inner products of cols of 'v' with 'b'
E_alpha_beta <- sum(sign(ca) * sign(-cb))/N
to have ca and cb lengths = N, not something else. You have ca and cb lengths of 10000, but divide by the value 7070 = N in your program. How convenient! It is equivalent to rescaling the results by roughly a factor of sqrt(2), but quite out of bounds and has absolutely nothing to do with 3-sphere geometry. 7070 is nothing more than the last count of true "good"s in the nested for loops in what amounts to genning up a totally non-local method to match -cos(a-b), which it does quite well as can be seen by running the included program. This program includes the E_ calculations for the agreed on Alice and Bob directions and the final inequality abs() within the for loops such that every i,j pass is analyzed, not just the one with terminal i,j as you and Joy do in your R programs. Guess what? The inequality sum is always abs(-2) and -cos(a-b) is matched in a clearly non-local fashion roughly within +/- 0.03. So what does the program you and Joy are touting actually do? It demonstrates the well known fact you can beat Bell's Inequality if you give up locality. This is not Joy's position in his book or writings, so at best the program the two of you are promoting does not apply to his work. If the two of you can't see this, then you either have your heads in the sand or are beyond my ability to help.
- Code: Select all
## Richard Gill has offered 10,000 Euroes to anyone who can simulate the N
## directions of angular momentum vectors appearing in equation (16) of my
## experimental proposal: http://arxiv.org/abs/0806.3078. In this simulation
## I 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=52#p1898.
## While this is by no means the most perfect simulation of my model, it does
## meet all of the conditions set out by Richard Gill for his challenge.
## The theoretical description of the model can be found in this paper:
## http://arxiv.org/abs/1405.2355 (see also http://lccn.loc.gov/2013040705).
## 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)
M <- 10^4 ## Sample size. Next, try 10^5, or even 10^6
angles <- seq(from = 0, to = 360, by = 10) * pi/180
K <- length(angles)
Ns <- numeric(K) ## Container for number of non-local states
corrs <- matrix(nrow = K, ncol = K, data = 0) ## Container for non-local correlations
E_0_45 <- matrix(nrow = K, ncol = K, data = 0)
E_0_135 <- matrix(nrow = K, ncol = K, data = 0)
E_90_45 <- matrix(nrow = K, ncol = K, data = 0)
E_90_135 <- matrix(nrow = K, ncol = K, data = 0)
ineq <- matrix(nrow = K, ncol = K, data = 0) ## container for Bell's inequality for each non-local ensemble e
corrErrs <- matrix(nrow = K, ncol = K, data = 0) ## Container for non-local correlation deviation from -cas(alph - bet)
r <- runif(M, 0, 2 * pi)
s <- runif(M, 0, pi)
x <- cos(r)
y <- sin(r)
u <- rbind(x, y)
## 'u' is a 2xM matrix. The M columns of 'u' represent the x and y
## coordinates of points on a unit circle in the equatorial plane.
p <- 1.21 * (-1 + (2/(sqrt(1 + (3 * s/pi)))))
minIneq = 10 ##values to force initial replacements
maxIneq = -10
minCorrErr = 10
maxCorrErr = -10
for (i in 1:K) {
alph <- angles[i]
ai <- c(cos(alph), sin(alph))
for (j in 1:K) {
bet <- angles[j]
bj <- c(cos(bet), sin(bet))
ca <- colSums(u * ai) ## Inner products of cols of 'u' with i loop 'a'
cb <- colSums(u * bj) ## Inner products of cols of 'u' with j loop 'b'
good <- abs(ca) > p & abs(cb) > p ## Sets the topology to that of S^3??????
N <- sum(good)
corrs[i, j] <- sum(sign(ca[good]) * sign(-cb[good]))/N
corrErrs[i, j] = corrs[i, j] + cos(alph-bet)
if(corrErrs[i, j] > maxCorrErr) maxCorrErr <- corrErrs[i, j]
if(corrErrs[i, j] < minCorrErr) minCorrErr <- corrErrs[i, j]
Ns[i] <- N
t <- x[good]
w <- y[good]
e <- rbind(t, w)
alpha <- 0 * pi/180
beta <- 45 * pi/180
a <- c(cos(alpha), sin(alpha))
b <- c(cos(beta), sin(beta))
ca <- colSums(e * a) ## Inner products of cols of 'e' with 'a'
cb <- colSums(e * b) ## Inner products of cols of 'e' with 'b'
E_0_45[i, j] <- sum(sign(ca) * sign(-cb))/N
alpha <- 0 * pi/180
beta <- 135 * pi/180
a <- c(cos(alpha), sin(alpha))
b <- c(cos(beta), sin(beta))
ca <- colSums(e * a) ## Inner products of cols of 'e' with 'a'
cb <- colSums(e * b) ## Inner products of cols of 'e' with 'b'
E_0_135[i, j] <- sum(sign(ca) * sign(-cb))/N
alpha <- 90 * pi/180
beta <- 45 * pi/180
a <- c(cos(alpha), sin(alpha))
b <- c(cos(beta), sin(beta))
ca <- colSums(e * a) ## Inner products of cols of 'e' with 'a'
cb <- colSums(e * b) ## Inner products of cols of 'e' with 'b'
E_90_45[i, j] <- sum(sign(ca) * sign(-cb))/N
alpha <- 90 * pi/180
beta <- 135 * pi/180
a <- c(cos(alpha), sin(alpha))
b <- c(cos(beta), sin(beta))
ca <- colSums(e * a) ## Inner products of cols of 'e' with 'a'
cb <- colSums(e * b) ## Inner products of cols of 'e' with 'b'
E_90_135[i, j] <- sum(sign(ca) * sign(-cb))/N
ineq[i, j] <- abs(E_0_45[i, j] - E_0_135[i, j] + E_90_45[i, j] + E_90_135[i, j])
if(ineq[i, j] > maxIneq) maxIneq <- ineq[i, j]
if(ineq[i, j] < minIneq) minIneq <- ineq[i, j]
}
}
maxCorrErr
minCorrErr
maxIneq
minIneq
par(mar = c(0, 0, 2, 0))
persp(x = angles, y = angles, z = corrErrs, zlim = c(-0.1, 0.1), col = "pink", theta = 135,
phi = 30, scale = FALSE, xlab = "alpha", ylab = "beta")