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]