Detection Loophole EPR Experiment (Chantal Roth)

This is a simple detection loophole experiment that uses one “fudge factor” that influences the percentage of photons that are detected (as a function of the angle) (Thanks Richard Gill for the help in the translation to R! :-)

set.seed(1234)  ## For reproducibility, testing!
factors <- seq(from = 2.3, to = 3.2, by = 0.3)
plotcolors = c("black", rainbow(length(factors)))

delta_angle <- 2.5
angles <- seq(from = 0, to = 360, by = delta_angle) * 2 * pi/360
nrangles <- length(angles)
corrs <- numeric(nrangles)
nra_detected <- numeric(nrangles)
nrb_detected <- numeric(nrangles)
nrboth_detected <- numeric(nrangles)
adetected <- numeric(nrangles)
beta <- 0 * 2 * pi/360
trials <- 10^4
theta <- runif(trials, 0, 2 * pi)

computeCHSH <- function(corrs) {
    ## |R(A1B1) - R(A1B2) + R(A2B1) + R(A2B2)|
    A1 <- 0
    A2 <- 90
    B1 <- 45
    B2 <- 135
    CHSH <- corrs[abs(B1 - A1)/delta_angle] - corrs[abs(B2 - A1)/delta_angle] + 
        corrs[abs(A2 - B1)/delta_angle] + corrs[abs(B2 - A2)/delta_angle]
    return(CHSH)
}
computeCorrs <- function(fudgefactor) {
    for (i in 1:(nrangles - 1)) {
        alpha <- angles[i]
        sA <- sin(theta + alpha)
        sB <- sin(theta + beta)
        ## here we check if the photons were detected or not
        a_detected <- runif(trials) < fudgefactor * abs(sA)
        b_detected <- runif(trials) < fudgefactor * abs(sB)
        good <- (a_detected) & (b_detected)
        N <- sum(good)
        nra_detected[i] <- sum(a_detected/trials)
        nrb_detected[i] <- sum(b_detected/trials)
        corrs[i] <<- sum(sign(sA[good]) * sign(sB[good]))/N
        nrboth_detected[i] <<- N
    }
    corrs[nrangles] <<- corrs[1]
    nrboth_detected[nrangles] <<- nrboth_detected[1]
}

runExperiment <- function(factors, nranglestoplot, legendx, lengendy) {
    n <- nranglestoplot
    plot(angles[1:n] * 180/pi, cos(angles[1:n]), col = "black", pch = ".", cex = 2, 
        main = "Correlation function and percent detected", xlab = "Angle (degrees)", 
        ylab = "Correlation", axes = FALSE)
    axis(side = 1, at = seq(0, nranglestoplot * delta_angle, by = 45))
    axis(side = 2, at = seq(-1, 1, by = 0.5))
    box()
    lines(angles[1:n] * 180/pi, cos(angles[1:n]), col = "black", pch = ".", 
        cex = 2)
    i <- 1
    means <- numeric(length(factors))
    CHSH <- numeric(length(factors))
    values45 <- numeric(length(factors))
    for (factor in factors) {
        result = computeCorrs(factor)
        means[i] <- round(mean(nrboth_detected/trials) * 100, 1)
        CHSH[i] <- round(computeCHSH(corrs), 2)
        points(angles[1:n] * 180/pi, corrs[1:n], type = "l", col = plotcolors[i + 
            1], pch = ".", cex = 2)

        points(angles[1:n] * 180/pi, nrboth_detected[1:n]/trials, type = "l", 
            col = plotcolors[i + 1], pch = "x", cex = 2)

        highlightcorr <- corrs[45/delta_angle]
        values45[i] <- round(highlightcorr, 2)

        i <- i + 1
    }
    legend(x = legendx, y = lengendy, legend = c("Cos", paste("f: ", factors, 
        ", det: ", format(means, nsmall = 0), "%", " c(45): ", values45, " CHSH: ", 
        CHSH)), text.col = plotcolors, lty = 1, col = plotcolors)
}

Draw the plot for several fudge factors. It also plots the % detected (when both photons are detected) for each angle

runExperiment(factors, nrangles, 90, 0.65)

Show a magnified version of the plot for for 0 - 90 degrees

runExperiment(factors, nrangles/4, 0, 0.5)