epr-simple.R

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