richard — Jun 2, 2014, 5:17 PM
# R implementation of Michel Fodje ("minkwe")'s epr-simple simulation model
# It is run according to the protocol of a delayed choice, event-ready detectors,
# Bell-CHSH type experiment.
#
# Python original: https://github.com/minkwe/epr-simple
set.seed(1234)
N <- 10000
s <- 1/2
n <- 2*s
e <- runif(N, 0, 2*pi)
ep <- e + 2 * pi * s
alpha <- c(0, 90) * pi / 180 # Alice's possible two settings
beta <- c(45, 135) * pi / 180 # Bob's possible two settings
t <- runif(N, 0, pi/2)
p <- (sin(t)^2)/2
a <- sample(c(1, 2), N, replace = TRUE) # Alice setting names (1, 2)
b <- sample(c(1, 2), N, replace = TRUE) # Bob setting names (1, 2)
ca <- cos(n * (alpha[a] - e))
cb <- cos(n * (beta[b] - ep))
A <- ifelse(abs(ca) > p, sign(((-1)^n) * ca), 0)
B <- ifelse(abs(cb) > p, sign(((-1)^n) * cb), 0)
## The four observed correlations, postselection on "both particles detected"
mean((A*B)[a == 1 & b ==1 & A*B != 0])
[1] -0.6934
mean((A*B)[a == 1 & b ==2 & A*B != 0])
[1] 0.6741
mean((A*B)[a == 2 & b ==1 & A*B != 0])
[1] -0.701
mean((A*B)[a == 2 & b ==2 & A*B != 0])
[1] -0.705
S <- - mean((A*B)[a == 1 & b ==1 & A*B != 0]) +
mean((A*B)[a == 1 & b ==2 & A*B != 0]) -
mean((A*B)[a == 2 & b ==1 & A*B != 0]) -
mean((A*B)[a == 2 & b ==2 & A*B != 0])
S ## CHSH
[1] 2.773
## A glimpse of the data
data.out <- data.frame(a, b, A, B)
head(data.out)
a b A B
1 1 2 -1 -1
2 2 2 1 0
3 2 1 1 -1
4 2 1 1 -1
5 2 2 1 -1
6 2 2 1 -1
nrow(data.out)
[1] 10000
tail(data.out)
a b A B
9995 2 2 -1 1
9996 1 1 1 1
9997 2 1 0 -1
9998 1 1 1 -1
9999 2 2 -1 1
10000 2 1 0 1
# Now we recompute CHSH treating "no detection" as outcome "0"
mean((A*B)[a == 1 & b ==1])
[1] -0.4865
mean((A*B)[a == 1 & b ==2])
[1] 0.4633
mean((A*B)[a == 2 & b ==1])
[1] -0.4825
mean((A*B)[a == 2 & b ==2])
[1] -0.4828
S0 <- - mean((A*B)[a == 1 & b ==1]) +
mean((A*B)[a == 1 & b ==2]) -
mean((A*B)[a == 2 & b ==1]) -
mean((A*B)[a == 2 & b ==2])
S0 ## CHSH
[1] 1.915
# Now we compute CH
# ie we compare outcomes "+1" to outcomes "-1" or "no detection"
Ach <- ifelse(A == 1, 1, -1)
Bch <- ifelse(B == 1, 1, -1)
mean((Ach*Bch)[a == 1 & b ==1])
[1] -0.4776
mean((Ach*Bch)[a == 1 & b ==2])
[1] 0.4794
mean((Ach*Bch)[a == 2 & b ==1])
[1] -0.4657
mean((Ach*Bch)[a == 2 & b ==2])
[1] -0.4659
Sch <- - mean((Ach*Bch)[a == 1 & b ==1]) +
mean((Ach*Bch)[a == 1 & b ==2]) -
mean((Ach*Bch)[a == 2 & b ==1]) -
mean((Ach*Bch)[a == 2 & b ==2])
Sch ## CHSH
[1] 1.889
## Now we look at the Larsson modifed CHSH bound.
## We need to know the experimental efficiency
## the minimal probability Alice has an outcome given Bob does and vice versa
effAB11 <- sum((A !=0 & B != 0)[a == 1 & b == 1]) / sum((B != 0)[a == 1 & b == 1])
effAB12 <- sum((A !=0 & B != 0)[a == 1 & b == 2]) / sum((B != 0)[a == 1 & b == 2])
effAB21 <- sum((A !=0 & B != 0)[a == 2 & b == 1]) / sum((B != 0)[a == 2 & b == 1])
effAB22 <- sum((A !=0 & B != 0)[a == 2 & b == 2]) / sum((B != 0)[a == 2 & b == 2])
effBA11 <- sum((A !=0 & B != 0)[a == 1 & b == 1]) / sum((A != 0)[a == 1 & b == 1])
effBA12 <- sum((A !=0 & B != 0)[a == 1 & b == 2]) / sum((A != 0)[a == 1 & b == 2])
effBA21 <- sum((A !=0 & B != 0)[a == 2 & b == 1]) / sum((A != 0)[a == 2 & b == 1])
effBA22 <- sum((A !=0 & B != 0)[a == 2 & b == 2]) / sum((A != 0)[a == 2 & b == 2])
gamma <- min(c(effAB11, effAB12, effAB21, effAB22,
effBA11, effBA12, effBA21, effBA22))
gamma
[1] 0.8193
delta <- 4*((1/gamma) - 1)
2 + delta
[1] 2.882
S
[1] 2.773
### We could go on from here looking at all the other generalized Bell inequalities
### but I don't think much is going to change