#### Joy Christian's http://rpubs.com/jjc/84238
#### Two lines inserted in order to catch sample sizes, one line to plot them.
#### Nothing else changed.
####
#### It is interesting to also study the overlap between the different samples.
#### I'm thinking about how to visualise that in a sensible way.
####
#### For the time being, I give the numbers for the four CHSH setting pairs.
#### For each setting pair, Christian claims he is looking at the same
#### "ensemble" (a sub-ensemble of his "pre-ensemble).
#### I look at the overlap between two of the "ensembles".
#### Note added June 6: JJC updated his code on June 5, and now also shows us an impressive contour map
#### of the constant function "1". The size of the (a, b) ensemble is the number of
#### 1's in the binary vector "t". JJC subsets several length M pre-ensemble vectors by t,
#### and, lo and behold, gets shorter vectors which all have the same length as
#### one another (at least - for the same values of a and b).
#### He divides one of those lengths by another, and finds ... the constant, 1.
#### The actual lengths of those vectors unfortunately depend on (a, b) and my
#### plot shows you exactly how.
#### It's a pity that RPubs does not have automatic "version control".
Angles = seq(from = 0, to = 360, by = 7.2) * 2 * pi/360
K = length(Angles)
corrs = matrix(nrow = K, ncol = K, data = 0)
Ns = matrix(nrow = K, ncol = K, data = 0) ## Here I will store the sample sizes
M = 10^5 # Size of the pre-ensemble.
r = runif(M, 0, 2 * pi)
z = runif(M, -1, +1)
h = sqrt(1 - z^2)
x = h * cos(r)
y = h * sin(r)
u = rbind(x, y, z) # A 3xM matrix. The M columns of u-vector represent the
# x, y, and z coordinates of uniformly distributed points on a 2-sphere, S^2
# So far we have set the variables in R^3. We now construct a metric on S^3
s = runif(M, 0, pi)
f = -1 + (2/sqrt(1 + ((3 * s)/pi))) # For details see the paper arXiv:1405.2355
g = function(v, w) {
ifelse((abs(colSums(v * w))) > f, colSums(v * w), 0) # g = 0 if |v.w| < f
} # Defines an inner product on S^3, thus changing the space from R^3 to S^3
# colSums(v * w) = v.w = the standard inner product between v and w in R^3
# v and w are orthogonal to each other in S^3 when abs(colSums(v * w)) < f
t = function(v1, w1, v2, w2) {
abs((sign(g(v1, w1))) * (sign(g(v2, w2)))) > 0
} # Puts a topological constraint on the distance function g(v, w) on S^3
# The pair {g, t} defines together a metric on S^3 constraining its topology
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'
A = +sign(g(a, u)) # Alice's measurement results A(a, u) = +/-1
B = -sign(g(b, u)) # Bob's measurement results B(b, u) = -/+1
N = length((A * B)[t(a, u, b, u)]) # Total number of simultaneous events
# Metric {g, t} forbids the results (0,+), (0,-), (+,0), (-,0), and (0,0)
corrs[i, j] = sum(A * B)/N
Ns[i, j] <- N ## store the number of particle pairs used for this correlations
}
}
par(mar = c(0, 0, 2, 0))
persp(x = Angles, y = Angles, main = "Correlations predicted by the 3-sphere model",
z = corrs, zlim = c(-1, 1), col = "pink", theta = 135, phi = 30, scale = FALSE,
xlab = "alpha; in [0, 2 pi]", ylab = "beta; in [0, 2 pi]",
zlab = "corr; in [-1, 1]")
persp(x = Angles, y = Angles, main = "Sample sizes (fraction of M), from 0 to 1",
z = Ns/M, zlim = c(0, 1), col = "lightblue", theta = 135, phi = 30, scale = FALSE,
xlab = "alpha; in [0, 2 pi]", ylab = "beta; in [0, 2 pi]", zlab ="N / M; in [0, 1]",
expand = 4, axes = TRUE)
max(Ns/M)
## [1] 0.66955
min(Ns/M)
## [1] 0.48333
## We now give the *complete* statistics of the four Bell-subtests,
## for the four standard pairs of values of a and b.
alpha <- 0 * pi/180
beta <- 45 * pi/180
a <- c(cos(alpha), sin(alpha), 0) # Measurement direction 'a'
b = c(cos(beta), sin(beta), 0) # Measurement direction 'b'
A11 = +sign(g(a, u)) # Alice's measurement results A(a, u) = +/-1
B11 = -sign(g(b, u)) # Bob's measurement results B(b, u) = -/+1
table(A11, B11)
## B11
## A11 -1 0 1
## -1 3757 7162 22536
## 0 7047 19047 7066
## 1 22285 7261 3839
alpha <- 0 * pi/180
beta <- 135 * pi/180
a <- c(cos(alpha), sin(alpha), 0) # Measurement direction 'a'
b = c(cos(beta), sin(beta), 0) # Measurement direction 'b'
A12 = +sign(g(a, u)) # Alice's measurement results A(a, u) = +/-1
B12 = -sign(g(b, u)) # Bob's measurement results B(b, u) = -/+1
table(A12, B12)
## B12
## A12 -1 0 1
## -1 22331 7305 3819
## 0 7203 18802 7155
## 1 3910 7074 22401
alpha <- 90 * pi/180
beta <- 45 * pi/180
a <- c(cos(alpha), sin(alpha), 0) # Measurement direction 'a'
b = c(cos(beta), sin(beta), 0) # Measurement direction 'b'
A21 = +sign(g(a, u)) # Alice's measurement results A(a, u) = +/-1
B21 = -sign(g(b, u)) # Bob's measurement results B(b, u) = -/+1
table(A21, B21)
## B21
## A21 -1 0 1
## -1 3885 7259 22472
## 0 7022 18998 7149
## 1 22182 7213 3820
alpha <- 90 * pi/180
beta <- 135 * pi/180
a <- c(cos(alpha), sin(alpha), 0) # Measurement direction 'a'
b = c(cos(beta), sin(beta), 0) # Measurement direction 'b'
A22 = +sign(g(a, u)) # Alice's measurement results A(a, u) = +/-1
B22 = -sign(g(b, u)) # Bob's measurement results B(b, u) = -/+1
table(A22, B22)
## B22
## A22 -1 0 1
## -1 3910 7266 22440
## 0 7180 18794 7195
## 1 22354 7121 3740
## We take a look at the "overlap" between the particle pairs selected
## for the 1,1 experiment and those selected for the 1,2 experiment
## According to Christian, these two "actual-ensembles" of the "pre-ensemble"
## of M = 10^5 pairs should be identical
sum(abs(A11*B11*A12*B12)) # number common to the 1,1 and the 1,2 ensembles
## [1] 39570
sum(abs(A11*B11)) # number in ensemble for the 1,1 experiment
## [1] 52417
sum(abs(A12*B12)) # number in ensemble for the 1,2 experiment
## [1] 52461