QRC.R

richard — Mar 9, 2014, 1:42 PM

## The quantum Randi challenge 
## Vongehr (2012, 2013, ...) http://arxiv.org/abs/1207.5294
##
## Challenge: rewrite the functions generating the hidden variables at the source
## and generating the measurement outcomes at the measurement stations such that
## in repeated experiments, always with 800 runs, 
## you *always* observe perfect anticorrelation
## and you *nearly always* observe violation of Bell's inequality.
##
## Post your code on internet, become famous, and win the Nobel prize.
## Note: the code must also work when the three functions which you
## may reprogram yourself are run on three separate computers:
## a source computer generates the hidden variables;
## two measurement station computers generate the measurement outcomes.
## The measurement *settings* are generated externally to those three.



## Settings for Alice (800 times either 0 x pi/8 or 3 x pi/8)
## Settings for Alice (800 times either 0 x pi/8 or 2 x pi/8)

AliceSetting <- sample(c(0,3), 800, replace = TRUE)
BobSetting <- sample(c(0, 2), 800, replace = TRUE)

## Container for outcomes for Alice and Bob

AliceOutcome <- numeric(800)
BobOutcome <- numeric(800)


## Replace "generateLambda()" defined below by your own function: 
## it should generate the hidden variables for one particle pair

## This particular function chooses outcomes for both of Bob's measurements
## and for one of Alice's completely at random. 
## The outcome for the other Alice measurement is determined by the requirement
## for perfect anti-correlation when settings are equal

generateLambda<- function(){
    lambda <- sample(c(-1, +1), 3, replace = TRUE)
    names(lambda) <- c("A3", "B0", "B2")
    lambda
}

## Replace "AliceFunction()" defined below by your own function: 
## it should generate Alice's measurement outcome, given the hidden 
## variables in one particle from the source and one setting = 0 or 3 
## (thought of as multiples of pi/8)

## This particular function simply reproduces the outcomes predetermined
## at the source

AliceFunction <- function(lambda, setting) {
    ifelse(setting == 0, -lambda["B0"], lambda["A3"])
}

## Replace "BobFunction()" defined below by your own function: 
## it should generate Bob's measurement outcome, given the hidden 
## variables in one particle from the source and one setting = 0 or 2 
## (thought of as multiples of pi/8)

## This particular function simply reproduces the outcomes predetermined
## at the source

BobFunction <- function(lambda, setting) {
    ifelse(setting == 0, lambda["B0"], lambda["B2"])
}

## Do 800 runs

for (i in 1:800) {
    lambda <- generateLambda()
    AliceOutcome[i] <- AliceFunction(lambda, AliceSetting[i])
    BobOutcome[i] <- BobFunction(lambda, BobSetting[i])
}

## Analyse data

N0E <- sum( (AliceOutcome == BobOutcome)[AliceSetting == 0 & BobSetting ==0] )
N1U <- sum( (AliceOutcome != BobOutcome)[AliceSetting == 3 & BobSetting ==2] )
N2E <- sum( (AliceOutcome == BobOutcome)[AliceSetting == 0 & BobSetting ==2] )
N3U <- sum( (AliceOutcome != BobOutcome)[AliceSetting == 3 & BobSetting ==0] )

data <- c(N0E, N1U, N2E, N3U)
names(data) <- c("N0E", "N1U", "N2E", "N3U")
cat("Data from 800 runs\n 0, 1, 2, or 3 stands for difference between Alice and Bob's angle\n U, E stands for outcomes are unequal, equal")
Data from 800 runs
 0, 1, 2, or 3 stands for difference between Alice and Bob's angle
 U, E stands for outcomes are unequal, equal
data
N0E N1U N2E N3U 
  0  93 106 110 

QRC <- N1U - N2E - N3U
names(QRC) <- "QRC"
QRC
 QRC 
-123 

## Here follow the predictions of quantum theory (singlet state..)

E <- 200*c(sin(0*pi/8)^2, cos(pi/8)^2, sin(2*pi/8)^2, cos(3*pi/8)^2)
names(E) <- c("N0E", "N1U", "N2E", "N3U")
cat("QM predictions\n N1U > N2E + N3U; N0E = 0")
QM predictions
 N1U > N2E + N3U; N0E = 0
E
   N0E    N1U    N2E    N3U 
  0.00 170.71 100.00  29.29 



## Quantum predicted QRC = QM Bell quantity (> 0):

QRC <- E["N1U"] - E["N2E"] - E["N3U"]
names(QRC) <- "QRC"
QRC
  QRC 
41.42 

## Here is an estimate of what its standard error would be:

SE <- sqrt((E["N1U"] * (800 - E["N1U"]) + (E["N2E"] + E["N3U"]) * (800 - E["N2E"] - E["N3U"]) + E["N1U"]*(E["N2E"] + E["N3U"]))/800)
names(SE) <- "SE"
SE
   SE 
16.44 

## Here is the result of our attempt to win the QRC: 
## did we get perfect anti-correlation 
## and did we violate Bell's inequality?

## Note: it is not good enough to do this just once. 
## We need to be able to do it time and time again 
## with new random detector settings every time.

if(N0E > 0) cat("Perfect anti-correlation violated, N0E > 0") else 
    cat("Perfect anti-correlation observed, N0E = 0")
Perfect anti-correlation observed, N0E = 0

if(N1U <= N2E + N3U) cat("Bell inequality not violated, N1U <= N2E + N3U") else 
    cat("Bell inequality violated, N1U > N2E + N3U")
Bell inequality not violated, N1U <= N2E + N3U

## We want this to be positive:

N1U - N2E - N3U
[1] -123

## Here is an estimate of its standard error:

sqrt((N1U * (800 - N1U) + (N2E + N3U) * (800 - N2E - N3U) + N1U*(N2E + N3U))/800)
[1] 16.28

## That was the end of the QRC. 
## The following lines calculate also four correlations 
## and check the CHSH inequality

N0U <- sum( (AliceOutcome != BobOutcome)[AliceSetting == 0 & BobSetting ==0] )
N1E <- sum( (AliceOutcome == BobOutcome)[AliceSetting == 3 & BobSetting ==2] )
N2U <- sum( (AliceOutcome != BobOutcome)[AliceSetting == 0 & BobSetting ==2] )
N3E <- sum( (AliceOutcome == BobOutcome)[AliceSetting == 3 & BobSetting ==0] )

N0 <- N0E + N0U
N1 <- N1E + N1U
N2 <- N2E + N2U
N3 <- N3E + N3U
rho0 <- (N0E - N0U) / N0
rho1 <- (N1E - N1U) / N1
rho2 <- (N2E - N2U) / N2
rho3 <- (N3E - N3U) / N3

p0E <- N0E / N0
p1E <- N1E / N1
p2E <- N2E / N2
p3E <- N3E / N3

q0E <- sin(0*pi/8)^2
q1E <- sin(1*pi/8)^2
q2E <- sin(2*pi/8)^2
q3E <- sin(3*pi/8)^2

rhoQ0 <- 2* q0E - 1
rhoQ1 <- 2* q1E - 1
rhoQ2 <- 2* q2E - 1
rhoQ3 <- 2* q3E - 1



## Four observed correlations
c(rho0, rho1, rho2, rho3)
[1] -1.00000 -0.02198  0.07071 -0.13402

## CHSH: is this larger than 2?
rho3 - rho0 - rho1 - rho2
[1] 0.8173

## Standard error
2 * sqrt(p0E*(1 - p0E) / N0 + p1E*(1 - p1E) / N1 + p2E*(1 - p2E) / N2 + p3E*(1 - p3E) / N3)
[1] 0.1248

## Four predicted (quantum) correlations
round(c(rhoQ0, rhoQ1, rhoQ2, rhoQ3), 4)
[1] -1.0000 -0.7071  0.0000  0.7071

## Quantum CHSH: is this larger than 2?
rhoQ3 - rhoQ0 - rhoQ1 - rhoQ2
[1] 2.414


## Quantum predicted standard error
round(2 * sqrt(q0E*(1 - q0E) / 200 + q1E*(1 - q1E) / 200 + q2E*(1 - q2E) / 200 + q3E*(1 - q3E) / 200), 4)
[1] 0.1