by **jreed** » Fri Aug 21, 2015 4:22 pm

FrediFizzx wrote:Joy Christian wrote:jreed wrote:Joy's simulation and quantum mechanical simulation appear very close.

EPR simple looks very much like the 85% loophole simulation.

John Reed

Thanks, John.

Can you please provide a link to your code? Or you can post it here in some form if you wish. I don't know Mathematica, but at least Fred does.

Yes, you can just copy and paste the code here by using the Code function in the posting interface.

- Code: Select all
`Put your code here`

Thanks.

The code is in PDF format. I copied it and will paste it here:

- Code: Select all
`In[1]:= (* Latest version, Aug 21, 2015 *)`

In[2]:= spin = 1 / 2;

If[spin ⩵ 1 / 2, δ = π / 4];

If[spin ⩵ 1, δ = π / 8];

(* Angle setting for detectors. All will be set at a multiple of δ *)

a1 = 0; a2 = 3 δ;

b1 = 0;

b2 = 2 δ;

In[7]:= (* Remove zero events function

This function does the same thing as the R function length((A*B}[A & B])

which only computes the product if both elements are non zero *)

removeZero[α1_, β1_, A1_, B1_] := Module[{key, k},

{ key = Abs[A1 B1];

k = 1;

Do[{If[key[[i]] ≠ 0, {A[[k]] = A1[[i]],

B[[k]] = B1[[i]], α[[k]] = α1[[i]], β[[k]] = β1[[i]], k++}]}, {i, n}];

nn = k - 1;

A = Take[A, nn];

B = Take[B, nn];

α = Take[α, nn];

β = Take[β, nn];

n = nn};]

In[8]:= (* Hidden variables section, like Sascha's program *)

hiddenVar := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}]; (* a hidden variable *)

A = Table[If[α[[j]] ⩵ 0, 1 - λ[[j, 2]], λ[[j, 1]]], {j, n}] ;

(* Alice's measurements *)

B = Table[λ[[j, If[β[[j]] == 0, 2, 3]]], {j, n}]; (* Bob's measurements *)

remove = False;

id = "Hidden variables particles selected";}

In[9]:= (* quantum section following Sascha's version *)

quantum := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

A = RandomChoice[{0, 1}, n];

B = Table[If[RandomReal[] < Sin[spin (β[[j]] - α[[j]])]^2, A[[j]], 1 - A[[j]]], {j, n}];

remove = False;

id = "Quantum particles selected";}

In[10]:= (* Loophole50 section Expect 50% violations of Bell and CSHS*)

loophole50 := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}];

(* Hidden variable *)

i = Table[4 λ[[j, 1]] + 2 λ[[j, 2]] + λ[[j, 3]], {j, n}];

Do[{

If[i[[j]] ⩵ 2 || i[[j]] ⩵ 5, λ[[j, 1]] = 1 - λ[[j, 1]]]}, {j, n}];

A = Table[If[α[[j]] ⩵ 0, 1 - λ[[j, 2]], λ[[j, 1]]], {j, n}];

B = Table[λ[[j, If[β[[j]] ⩵ 0, 2, 3]]], {j, n}];

remove = False;

id = "Loophole50 selected: 50% Bell and CHSH violations";}

In[11]:= (* Loophole85 section Expect 85% violations of Bell and CSHS*)

loophole85 := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}];

(* Hidden variable *)

i = Table[4 λ[[j, 1]] + 2 λ[[j, 2]] + λ[[j, 3]], {j, n}];

Do[{

If[i[[j]] ⩵ 2 || i[[j]] ⩵ 5, λ[[j, 1]] = 1 - λ[[j, 1]]]}, {j, n}];

A = Table[If[α[[j]] ⩵ 0, If[i[[j]] ⩵ 1, λ[[j, 2]], 1 - λ[[j, 2]]], λ[[j, 1]]], {j, n}];

B = Table[λ[[j, If[β[[j]] ⩵ 0, 2, 3]]], {j, n}];

remove = False;

id = "Loophole85 selected: Expect 85% Bell and CHSH violations";}

In[12]:= (* EPRsimple section *)

EPRsimple := {

n = 10 000;

ϕa = RandomReal[{0, 2 π}, n]; (* E vector *)

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

If[spin ⩵ 1 / 2, ϕb = ϕa + π , ϕb = ϕa + π / 2];

λ = Sin[RandomReal[{0, π / 2}, n]]^2 / 2;

A = Table[

If[Abs[Cos[(α[[j]] - ϕa[[j]])]] > λ[[j]], Sign[Cos[(α[[j]] - ϕa[[j]])]], 0], {j, n}];

B = Table[If[Abs[Cos[(β[[j]] - ϕb[[j]])]] > λ[[j]],

Sign[Cos[(β[[j]] - ϕb[[j]])]], 0], {j, n}];

remove = True;

id = "EPRsimple selected";}

2 Bell EPR.nb

In[13]:= (* Joy's 3D simulation *)

EPR3D := {

n = 10 000;

r = RandomReal[{0, 2 π}, n];

z = RandomReal[{-1, 1}, n];

h = Sqrt[1 - z^2];

e = Table[{h[[i]] Cos[r[[i]]], h[[i]] Sin[r[[i]]], z[[i]]}, {i, n}];

s = RandomReal[{0, π}, n];

λ = -1 + 2 / Sqrt[1 + 3 s / π];

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

αVect = Table[{Cos[α[[i]]], Sin[α[[i]]], 0}, {i, n}];

βVect = Table[{Cos[β[[i]]], Sin[β[[i]]], 0}, {i, n}];

A = ConstantArray[0, n];

B = ConstantArray[0, n];

Do[{

If[Abs[αVect[[i]].e[[i]]] > λ[[i]], A[[i]] = Sign[αVect[[i]].e[[i]]]];

If[Abs[βVect[[i]].e[[i]]] > λ[[i]], B[[i]] = -Sign[βVect[[i]].e[[i]]]];};,

{i, n}];

remove = True;

id = "3D simulation ";}

Bell EPR.nb 3

In[14]:= (* experimental data section from Physics Today, April 1985

You won't be able to execute this version since you won't have the file

of experimental data which I pulled from this article.

The experimental data has 563 observations and gives a cross correlation of 0,

does not violate Bell and has a CHSH of 2.29 *)

experiment := {

NotebookDirectory[];

SetDirectory["C:\\Users\\John\\Desktop\\Bell's Theorem\\EPR\\"];

file = Import["notePad.txt", "List"];

n = Length[file];

α = ConstantArray[0, n];

β = ConstantArray[0, n];

A = ConstantArray[0, n];

B = ConstantArray[0, n];

δ = π / 8;

Do[{

entry = Characters[file[[j]]];

a1 = ToExpression[Part[entry, 1]];

If[a1 != 1 && a1 != 2 && a1 ≠ 3, Break];

Switch[a1, 1, α[[j]] = 0, 2, α[[j]] = 2 δ, 3, α[[j]] = 3 δ];

b1 = ToExpression[Part[entry, 2]];

If[b1 != 1 && b1 != 2 && b1 != 3, Break];

Switch[b1, 1, β[[j]] = 0, 2, β[[j]] = 2 δ, 3, β[[j]] = 3 δ];

idA = Part[entry, 3];

If[idA ≠ "G" && idA ≠ "R", {Print["error in A ", j]; Break}];

If[idA ⩵ "G", A[[j]] = 1, A[[j]] = 0];

idB = Part[entry, 4];

If[idB ≠ "G" && idB ≠ "R", {Print["error in B ", j]; Break}];

If[idB ⩵ "G", B[[j]] = 0, B[[j]] = 1];

}, {j, 1, n}];

remove = False;

id = "experimental data selected";

}

4 Bell EPR.nb

In[15]:= analysis :=

N0 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 0, 1, 0];

N1 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ δ, 1, 0];

N2 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ, 1, 0];

N3 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ, 1, 0] ;

NE0 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 0 && A[[j]] ⩵ B[[j]], 1, 0];

NE1 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ δ && A[[j]] ⩵ B[[j]], 1, 0];

NE2 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ && A[[j]] ⩵ B[[j]], 1, 0];

NE3 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ && A[[j]] ⩵ B[[j]], 1, 0];

NU0 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 0 && A[[j]] ≠ B[[j]], 1, 0];

NU1 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ δ && A[[j]] ≠ B[[j]], 1, 0];

NU2 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ && A[[j]] ≠ B[[j]], 1, 0];

NU3 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ && A[[j]] ≠ B[[j]], 1, 0];

In[16]:= (* methods for the particle generation:

quantum - quantum mechanical calculation

hiddenVar - hidden variables

loophole50 - detection loophole giving 50% violations

loophole85 - detection loophole giving 85% violations

EPRsimple - EPR simple algorithm

EPR3D - Joy's 3D siimulation

experiment - Data from "Is the Moon There..."

*)

Bell EPR.nb 5

In[17]:= (* set up run time parameters:*)

Clear[A, B, α, β, λ, n];

EPR3D; (* method to use, see above *)

removeZeros = True; (* the removal of zero data is optional for some methods *)

If[removeZeros && remove, removeZero[α, β, A, B]];

analysis;

In[21]:= Print["Number of arrivals in each group: ",

"N0=" , N0, " N1=", N1, " N2=", N2, " N3=", N3]

Number of arrivals in each group: N0=1752 N1=1268 N2=1232 N3=1310

In[22]:= Print["Equal correlations: " , "NE0=" ,

NE0, " NE1=", NE1, " NE2=", NE2, " NE3=", NE3]

Equal correlations: NE0=0 NE1=165 NE2=619 NE3=1120

In[23]:= Print["Unequal correlations: ", "NU0=" ,

NU0, " NU1=", NU1, " NU2=", NU2, " NU3=", NU3]

Unequal correlations: NU0=1752 NU1=1103 NU2=613 NU3=190

In[24]:= (* Analysis Section *)

Print[id];

If[NE0 > 0, N[100 - 100 * NE0 / N0]

"% of correct correlation. Model fails to describe correlation

correctly when Alice and Bob happen to measure with the same angle.",

"correlation at equal angles is correct and equals zero"]

If[NU3 + NE2 < NU1,

{"Bell's inequality is violated, NU1 > NU3+NE2! ", "NU1, NU3 + NE2 = ", NU1, NU3 + NE2},

{"Bell is not violated, NU1 < NU3+NE2. ", " NU1, NU3 + NE2 = ", NU1, NU3 + NE2}]

CHSH := {

E0 := (NE0 - NU0) / N0;

E1 := (NE1 - NU1) / N1;

E2 := (NE2 - NU2) / N2;

E3 := (NE3 - NU3) / N3;

CHV = N[Max[Abs[E0 + E1 + E2 - E3],

Abs[E0 + E1 - E2 + E3], Abs[E0 - E1 + E2 + E3], Abs[E1 + E2 + E3 - E0]]],

If[CHV > 2, "CHSH inequality (can not be >2) is violated!",

"CHSH inequality (is not >2) is not violated."]};

CHSH (* this prints out the important results of the run *)

3D simulation

Out[25]= correlation at equal angles is correct and equals zero

Out[26]= {Bell's inequality is violated, NU1 > NU3+NE2! , NU1, NU3 + NE2 = , 1103, 809}

Out[28]= {2.4448, CHSH inequality (can not be >2) is violated!}

6 Bell EPR.nb

[quote="FrediFizzx"][quote="Joy Christian"][quote="jreed"]

Joy's simulation and quantum mechanical simulation appear very close.

EPR simple looks very much like the 85% loophole simulation.

John Reed[/quote]

Thanks, John.

Can you please provide a link to your code? Or you can post it here in some form if you wish. I don't know Mathematica, but at least Fred does.[/quote]

Yes, you can just copy and paste the code here by using the Code function in the posting interface.

[code]Put your code here[/code]

Thanks.[/quote]

The code is in PDF format. I copied it and will paste it here:

[code]In[1]:= (* Latest version, Aug 21, 2015 *)

In[2]:= spin = 1 / 2;

If[spin ⩵ 1 / 2, δ = π / 4];

If[spin ⩵ 1, δ = π / 8];

(* Angle setting for detectors. All will be set at a multiple of δ *)

a1 = 0; a2 = 3 δ;

b1 = 0;

b2 = 2 δ;

In[7]:= (* Remove zero events function

This function does the same thing as the R function length((A*B}[A & B])

which only computes the product if both elements are non zero *)

removeZero[α1_, β1_, A1_, B1_] := Module[{key, k},

{ key = Abs[A1 B1];

k = 1;

Do[{If[key[[i]] ≠ 0, {A[[k]] = A1[[i]],

B[[k]] = B1[[i]], α[[k]] = α1[[i]], β[[k]] = β1[[i]], k++}]}, {i, n}];

nn = k - 1;

A = Take[A, nn];

B = Take[B, nn];

α = Take[α, nn];

β = Take[β, nn];

n = nn};]

In[8]:= (* Hidden variables section, like Sascha's program *)

hiddenVar := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}]; (* a hidden variable *)

A = Table[If[α[[j]] ⩵ 0, 1 - λ[[j, 2]], λ[[j, 1]]], {j, n}] ;

(* Alice's measurements *)

B = Table[λ[[j, If[β[[j]] == 0, 2, 3]]], {j, n}]; (* Bob's measurements *)

remove = False;

id = "Hidden variables particles selected";}

In[9]:= (* quantum section following Sascha's version *)

quantum := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

A = RandomChoice[{0, 1}, n];

B = Table[If[RandomReal[] < Sin[spin (β[[j]] - α[[j]])]^2, A[[j]], 1 - A[[j]]], {j, n}];

remove = False;

id = "Quantum particles selected";}

In[10]:= (* Loophole50 section Expect 50% violations of Bell and CSHS*)

loophole50 := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}];

(* Hidden variable *)

i = Table[4 λ[[j, 1]] + 2 λ[[j, 2]] + λ[[j, 3]], {j, n}];

Do[{

If[i[[j]] ⩵ 2 || i[[j]] ⩵ 5, λ[[j, 1]] = 1 - λ[[j, 1]]]}, {j, n}];

A = Table[If[α[[j]] ⩵ 0, 1 - λ[[j, 2]], λ[[j, 1]]], {j, n}];

B = Table[λ[[j, If[β[[j]] ⩵ 0, 2, 3]]], {j, n}];

remove = False;

id = "Loophole50 selected: 50% Bell and CHSH violations";}

In[11]:= (* Loophole85 section Expect 85% violations of Bell and CSHS*)

loophole85 := {

n = 10 000;

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

λ = RandomChoice[{0, 1}, {n, 3}];

(* Hidden variable *)

i = Table[4 λ[[j, 1]] + 2 λ[[j, 2]] + λ[[j, 3]], {j, n}];

Do[{

If[i[[j]] ⩵ 2 || i[[j]] ⩵ 5, λ[[j, 1]] = 1 - λ[[j, 1]]]}, {j, n}];

A = Table[If[α[[j]] ⩵ 0, If[i[[j]] ⩵ 1, λ[[j, 2]], 1 - λ[[j, 2]]], λ[[j, 1]]], {j, n}];

B = Table[λ[[j, If[β[[j]] ⩵ 0, 2, 3]]], {j, n}];

remove = False;

id = "Loophole85 selected: Expect 85% Bell and CHSH violations";}

In[12]:= (* EPRsimple section *)

EPRsimple := {

n = 10 000;

ϕa = RandomReal[{0, 2 π}, n]; (* E vector *)

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

If[spin ⩵ 1 / 2, ϕb = ϕa + π , ϕb = ϕa + π / 2];

λ = Sin[RandomReal[{0, π / 2}, n]]^2 / 2;

A = Table[

If[Abs[Cos[(α[[j]] - ϕa[[j]])]] > λ[[j]], Sign[Cos[(α[[j]] - ϕa[[j]])]], 0], {j, n}];

B = Table[If[Abs[Cos[(β[[j]] - ϕb[[j]])]] > λ[[j]],

Sign[Cos[(β[[j]] - ϕb[[j]])]], 0], {j, n}];

remove = True;

id = "EPRsimple selected";}

2 Bell EPR.nb

In[13]:= (* Joy's 3D simulation *)

EPR3D := {

n = 10 000;

r = RandomReal[{0, 2 π}, n];

z = RandomReal[{-1, 1}, n];

h = Sqrt[1 - z^2];

e = Table[{h[[i]] Cos[r[[i]]], h[[i]] Sin[r[[i]]], z[[i]]}, {i, n}];

s = RandomReal[{0, π}, n];

λ = -1 + 2 / Sqrt[1 + 3 s / π];

α = RandomChoice[{a1, a2}, n]; (* Alice's angles *)

β = RandomChoice[{b1, b2}, n]; (* Bob's angles *)

αVect = Table[{Cos[α[[i]]], Sin[α[[i]]], 0}, {i, n}];

βVect = Table[{Cos[β[[i]]], Sin[β[[i]]], 0}, {i, n}];

A = ConstantArray[0, n];

B = ConstantArray[0, n];

Do[{

If[Abs[αVect[[i]].e[[i]]] > λ[[i]], A[[i]] = Sign[αVect[[i]].e[[i]]]];

If[Abs[βVect[[i]].e[[i]]] > λ[[i]], B[[i]] = -Sign[βVect[[i]].e[[i]]]];};,

{i, n}];

remove = True;

id = "3D simulation ";}

Bell EPR.nb 3

In[14]:= (* experimental data section from Physics Today, April 1985

You won't be able to execute this version since you won't have the file

of experimental data which I pulled from this article.

The experimental data has 563 observations and gives a cross correlation of 0,

does not violate Bell and has a CHSH of 2.29 *)

experiment := {

NotebookDirectory[];

SetDirectory["C:\\Users\\John\\Desktop\\Bell's Theorem\\EPR\\"];

file = Import["notePad.txt", "List"];

n = Length[file];

α = ConstantArray[0, n];

β = ConstantArray[0, n];

A = ConstantArray[0, n];

B = ConstantArray[0, n];

δ = π / 8;

Do[{

entry = Characters[file[[j]]];

a1 = ToExpression[Part[entry, 1]];

If[a1 != 1 && a1 != 2 && a1 ≠ 3, Break];

Switch[a1, 1, α[[j]] = 0, 2, α[[j]] = 2 δ, 3, α[[j]] = 3 δ];

b1 = ToExpression[Part[entry, 2]];

If[b1 != 1 && b1 != 2 && b1 != 3, Break];

Switch[b1, 1, β[[j]] = 0, 2, β[[j]] = 2 δ, 3, β[[j]] = 3 δ];

idA = Part[entry, 3];

If[idA ≠ "G" && idA ≠ "R", {Print["error in A ", j]; Break}];

If[idA ⩵ "G", A[[j]] = 1, A[[j]] = 0];

idB = Part[entry, 4];

If[idB ≠ "G" && idB ≠ "R", {Print["error in B ", j]; Break}];

If[idB ⩵ "G", B[[j]] = 0, B[[j]] = 1];

}, {j, 1, n}];

remove = False;

id = "experimental data selected";

}

4 Bell EPR.nb

In[15]:= analysis :=

N0 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 0, 1, 0];

N1 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ δ, 1, 0];

N2 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ, 1, 0];

N3 =

j=1

Length[α]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ, 1, 0] ;

NE0 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 0 && A[[j]] ⩵ B[[j]], 1, 0];

NE1 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ δ && A[[j]] ⩵ B[[j]], 1, 0];

NE2 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ && A[[j]] ⩵ B[[j]], 1, 0];

NE3 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ && A[[j]] ⩵ B[[j]], 1, 0];

NU0 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 0 && A[[j]] ≠ B[[j]], 1, 0];

NU1 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ δ && A[[j]] ≠ B[[j]], 1, 0];

NU2 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 2 δ && A[[j]] ≠ B[[j]], 1, 0];

NU3 =

j=1

Length[A]

If[Abs[β[[j]] - α[[j]]] ⩵ 3 δ && A[[j]] ≠ B[[j]], 1, 0];

In[16]:= (* methods for the particle generation:

quantum - quantum mechanical calculation

hiddenVar - hidden variables

loophole50 - detection loophole giving 50% violations

loophole85 - detection loophole giving 85% violations

EPRsimple - EPR simple algorithm

EPR3D - Joy's 3D siimulation

experiment - Data from "Is the Moon There..."

*)

Bell EPR.nb 5

In[17]:= (* set up run time parameters:*)

Clear[A, B, α, β, λ, n];

EPR3D; (* method to use, see above *)

removeZeros = True; (* the removal of zero data is optional for some methods *)

If[removeZeros && remove, removeZero[α, β, A, B]];

analysis;

In[21]:= Print["Number of arrivals in each group: ",

"N0=" , N0, " N1=", N1, " N2=", N2, " N3=", N3]

Number of arrivals in each group: N0=1752 N1=1268 N2=1232 N3=1310

In[22]:= Print["Equal correlations: " , "NE0=" ,

NE0, " NE1=", NE1, " NE2=", NE2, " NE3=", NE3]

Equal correlations: NE0=0 NE1=165 NE2=619 NE3=1120

In[23]:= Print["Unequal correlations: ", "NU0=" ,

NU0, " NU1=", NU1, " NU2=", NU2, " NU3=", NU3]

Unequal correlations: NU0=1752 NU1=1103 NU2=613 NU3=190

In[24]:= (* Analysis Section *)

Print[id];

If[NE0 > 0, N[100 - 100 * NE0 / N0]

"% of correct correlation. Model fails to describe correlation

correctly when Alice and Bob happen to measure with the same angle.",

"correlation at equal angles is correct and equals zero"]

If[NU3 + NE2 < NU1,

{"Bell's inequality is violated, NU1 > NU3+NE2! ", "NU1, NU3 + NE2 = ", NU1, NU3 + NE2},

{"Bell is not violated, NU1 < NU3+NE2. ", " NU1, NU3 + NE2 = ", NU1, NU3 + NE2}]

CHSH := {

E0 := (NE0 - NU0) / N0;

E1 := (NE1 - NU1) / N1;

E2 := (NE2 - NU2) / N2;

E3 := (NE3 - NU3) / N3;

CHV = N[Max[Abs[E0 + E1 + E2 - E3],

Abs[E0 + E1 - E2 + E3], Abs[E0 - E1 + E2 + E3], Abs[E1 + E2 + E3 - E0]]],

If[CHV > 2, "CHSH inequality (can not be >2) is violated!",

"CHSH inequality (is not >2) is not violated."]};

CHSH (* this prints out the important results of the run *)

3D simulation

Out[25]= correlation at equal angles is correct and equals zero

Out[26]= {Bell's inequality is violated, NU1 > NU3+NE2! , NU1, NU3 + NE2 = , 1103, 809}

Out[28]= {2.4448, CHSH inequality (can not be >2) is violated!}

6 Bell EPR.nb[/code]