NotebookDirectory[]

Understanding Bell’s Theorem -- A journey

Mike Ulrey   Wolfram Technology Conference   October 29, 2019

The story of Bell’s Theorem has many parts...

Data generation and data collection in an Aspect-like experiment

Aspect (1982)

Experimental outcomes and statistics of interest

Row[{sPad},Alignment->Center,Background->LightGreen]//TraditionalForm

Bell’s inequality says, that under the assumptions of realism (hidden variables) and locality, it MUST be the case that -2≤(OverHat[(Subscript[s, k])])≤2, for k=1,2,3,4.

Quantum mechanics predictions says only that -2(Sqrt[2])≤(OverHat[(Subscript[s, k])])≤2(Sqrt[2]) and experimental outcomes seem to confirm this (e.g., [Aspect 2002] performed in 1982, plus many later experiments).

Bell’s conclusion is that one must pick any 2 out of 3 (at least one must be abandoned):  Realism (hidden variables), locality, or quantum mechanics.

This is the essence of Bell's Theorem, in the form described in

"Proposed experiment to test local hidden-variable theories," Physical Review Letters, 23: 880–884  (Clauser, J.F., Horne, M.A., Shimony, A., and Holt, R.A., 1969 )

My approach: The generic model

This deviates somewhat from the standard approach

A = random variable representing Alice’s outcome

B = random variable representing Bob’s outcome

(Subscript[D, A]) = random variable representing Alice’s detector setting

(Subscript[D, B]) = random variable representing Bob’s detector setting

(Subscript[δ, "ab"]) = probability that Alice chooses her first detector setting and Bob chooses his first detector setting =                  P((Subscript[D, A])=-1,(Subscript[D, B])=-1)

(Subscript[δ, "ab'"]) = probability that Alice chooses her first detector setting and Bob chooses his second detector setting  =        P((Subscript[D, A])=-1,(Subscript[D, B])=+1)

(Subscript[δ, "a'b"]) = probability that Alice chooses her second detector setting and Bob chooses his first detector setting  =        P((Subscript[D, A])=+1,(Subscript[D, B])=-1)

(Subscript[δ, "a'b'"]) = probability that Alice chooses her second detector setting and Bob chooses his second detector setting = P((Subscript[D, A])=+1,(Subscript[D, B])=+1)

Row[{pmfGenericTable,genericConstraintsTable},Spacer[50],Alignment->Center,Background->LightGreen]//TraditionalForm

“pmf” denotes a “probability mass function” -- a finite ordered list of non-negative real numbers that sum to1.

A model type is determined by the symbolic form of the conditional probabilities (Subscript[γ, k]).

A model instance is determined by  specific numerical values for the conditional probabilities (Subscript[γ, k]).

(Row[({{"Generic Model pmf", , , , }, {"A", "B", "\!\(\*SubscriptBox[\(D\), \(A\)]\)", "\!\(\*SubscriptBox[\(D\), \(B\)]\)", "pmf"}, {-1, -1, -1, -1, (Subscript[γ, 1]) (Subscript[δ, "ab"])}, {-1, -1, -1, 1, (Subscript[γ, 2]) (Subscript[δ, "ab'"])}, {-1, -1, 1, -1, (Subscript[γ, 3]) (Subscript[δ, "a'b"])}, {-1, -1, 1, 1, (Subscript[γ, 4]) (Subscript[δ, "a'b'"])}, {-1, 1, -1, -1, (Subscript[γ, 5]) (Subscript[δ, "ab"])}, {-1, 1, -1, 1, (Subscript[γ, 6]) (Subscript[δ, "ab'"])}, {-1, 1, 1, -1, (Subscript[γ, 7]) (Subscript[δ, "a'b"])}, {-1, 1, 1, 1, (Subscript[γ, 8]) (Subscript[δ, "a'b'"])}, {1, -1, -1, -1, (Subscript[γ, 9]) (Subscript[δ, "ab"])}, {1, -1, -1, 1, (Subscript[γ, 10]) (Subscript[δ, "ab'"])}, {1, -1, 1, -1, (Subscript[γ, 11]) (Subscript[δ, "a'b"])}, {1, -1, 1, 1, (Subscript[γ, 12]) (Subscript[δ, "a'b'"])}, {1, 1, -1, -1, (Subscript[γ, 13]) (Subscript[δ, "ab"])}, {1, 1, -1, 1, (Subscript[γ, 14]) (Subscript[δ, "ab'"])}, {1, 1, 1, -1, (Subscript[γ, 15]) (Subscript[δ, "a'b"])}, {1, 1, 1, 1, (Subscript[γ, 16]) (Subscript[δ, "a'b'"])}}), ({{"γ constraints", "δ constraints"}, {"0≤\!\(\*SubscriptBox[\(γ\), \(k\)]\)≤1 and \n\!\(\*SubscriptBox[\(γ\), \(1 + j\)]\)+\!\(\*SubscriptBox[\(γ\), \(5 + j\)]\)+\!\(\*SubscriptBox[\(γ\), \(9 + j\)]\)+\!\(\*SubscriptBox[\(γ\), \(13 + j\)]\)=1 \nfor \nj=0,1,2,3", "0<\!\(\*SubscriptBox[\(δ\), \(\"a'b\"\)]\),\!\(\*SubscriptBox[\(δ\), \(\"a'b'\"\)]\),\!\(\*SubscriptBox[\(δ\), \(\"ab\"\)]\),\!\(\*SubscriptBox[\(δ\), \(\"ab'\"\)]\)<1, and \n\!\(\*SubscriptBox[\(δ\), \(\"a'b\"\)]\)+\!\(\*SubscriptBox[\(δ\), \(\"a'b'\"\)]\)+\!\(\*SubscriptBox[\(δ\), \(\"ab\"\)]\)+\!\(\*SubscriptBox[\(δ\), \(\"ab'\"\)]\)=1"}})])

Locality

The following definitions represent various mathematical encapsulations of the concept of locality in the literature. 
See for example Abner Shimony’s article on Bell’s Theorem in the Stanford Encyclopedia.  (https://plato.stanford.edu/entries/bell-theorem/)
and Howard Wiseman’s paper “The Two Bell’s Theorems of John Bell” (arXiv:1402.035v1  [quant-ph]  3 Feb 2014).

In the following,  the values of the random variables are suppressed to reduce notational clutter.
For example  P(A,B|(Subscript[D, A]),(Subscript[D, B])) is shorthand for  P(A=s,B=t|(Subscript[D, A])=u,(Subscript[D, B])=v)   for all  (s,t,u,v)∈(({-1,1})^4).

Remote context independence (RCI):

P(A|(Subscript[D, A]),(Subscript[D, B]))=P(A|(Subscript[D, A])) and

P(B|(Subscript[D, A]),(Subscript[D, B]))=P(B|(Subscript[D, B])).

Remote outcome independence (ROI):

P(A|B,(Subscript[D, A]),(Subscript[D, B]))=P(A|(Subscript[D, A]),(Subscript[D, B])) and

P(B|A,(Subscript[D, A]),(Subscript[D, B]))=P(B|(Subscript[D, A]),(Subscript[D, B])).

Local causality (LC):

P(A|B,(Subscript[D, A]),(Subscript[D, B]))=P(A|(Subscript[D, A])) and

P(B|A,(Subscript[D, A]),(Subscript[D, B]))=P(B|(Subscript[D, B])).

Factorization condition (FC):

P(A,B|(Subscript[D, A]),(Subscript[D, B]))=P(A|(Subscript[D, A]))×P(B|(Subscript[D, B])) .

Note: This is the definition of the "Bell local" model type in this presentation (and in my paper).

Reality

EPR argument: Assume Alice can make a definite determination (probability = 1)  of a potential measurement at Bob’s distant location simply by making her own measurement locally, and can do this for conjugate (“complementary”) variables (e.g., position-momentum or  spin up-spin down) -- but not at the same time of course! -- then there must be “elements of reality” that were already there before the measurement(s) was (were) made.

Suppose the “source” of the entangled pair sends

((Subscript[A, 1]),(Subscript[A, 2]))=(±1,±1) to Alice, and

((Subscript[B, 1]),(Subscript[B, 2]))=(±1,±1) to Bob.

Then Alice’s outcome is

A=(Subscript[A, 1]) if her detector setting angle is a, i.e., (Subscript[D, A])=-1.

A=(Subscript[A, 2]) if her detector setting angle is a', i.e., (Subscript[D, A])=+1.

And Bob’s outcome is

B=(Subscript[B, 1]) if his detector setting angle is b, i.e., (Subscript[D, B])=-1.

B=(Subscript[B, 2]) if his detector setting angle is b', i.e., (Subscript[D, B])=+1.

Row[{pmfBellRealismTable,pmfBellRealTable},Spacer[100],Alignment->Center,Background->LightGreen]//TraditionalForm

Then assuming a pmf can be defined on ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2]))  (first table),  this leads to the pmf with respect to (A,B,(Subscript[D, A]),(Subscript[D, B]))  (second table). See my paper for a proof.

The five main modeling types

Row[{conditionalProbsTable1,diagramGeneric},Spacer[100],Alignment->Center,Background->LightGreen]//TraditionalForm

Correlations

There are four correlations (w,x,y,z) between Alice’s and Bob’s outcomes, defined as the expectation of the product A B of their outcomes, conditioned on each of the four possible detector setting combinations, as follows:

w = E[A B|(Subscript[D, A])=-1,(Subscript[D, B])=-1]

x = E[A B|(Subscript[D, A])=-1,(Subscript[D, B])=+1]

y = E[A B|(Subscript[D, A])=+1,(Subscript[D, B])=-1]

z = E[A B|(Subscript[D, A])=+1,(Subscript[D, B])=+1]

Row[{Grid[Prepend[Transpose[Prepend[{Join[{Text@Style["Generic",16]},correlationsMaximal],Join[{Text@Style["QM",16]},correlationsQM],Join[{Text@Style["Bell real",16]},correlationsBellReal],Join[{Text@Style["Bell local",16]},correlationsBellLocal],Join[{Text@Style["Minimal",16]},correlationsMinimal]},{"","w","x","y","z"}]],{Text@Style["Correlations",Bold,Red,16],SpanFromLeft}],ItemStyle->22,Frame->All]},Alignment->Center,Background->LightGreen]//TraditionalForm

CHSH inequalities

The CHSH inequalities are

-2 ≤(({{(Subscript[s, 1])}, {(Subscript[s, 2])}, {(Subscript[s, 3])}, {(Subscript[s, 4])}}))=(({{-w+x+y+z}, {w-x+y+z}, {w+x-y+z}, {w+x+y-z}}))≤+2,

where the inequality is to be interpreted component-wise, so there are 8 inequalities (4 pairs).

“Proposed experiment to test local hidden-variable theories,” Physical Review Letters, 23: 880–884  (Clauser, J.F., Horne, M.A., Shimony, A., and Holt, R.A., 1969 ).

Also see Quantum Processes, Systems, and Information (Schumacher and Westmoreland, Cambridge University Press, 2010).

Bell’s Theorem in a nutshell: Table version

All Bell real and Bell local models have s-functions that satisfy all 8 CHSH inequalities.

Some QM model instances have s-functions that violate at least some of the CHSH inequalities.

Therefore, a theory (model) based on either “Bell reality” or “Bell locality” cannot duplicate all QM predictions.

Row[{Grid[Prepend[Append[Transpose[Prepend[{Join[{Text@Style["QM",16]},sBell.correlationsQM],Join[{Text@Style["Bell real",16]},sBell.correlationsBellReal//Simplify],Join[{Text@Style["Bell local",16]},sBell.correlationsBellLocal//Simplify]},{"","(Subscript[s, 1])","(Subscript[s, 2])","(Subscript[s, 3])","(Subscript[s, 4])"}]],{"Max and Min","+2(Sqrt[2]) and -2(Sqrt[2])","+2 and -2","+2 and -2"}],{Text@Style["s-Functions",Bold,Red,16],SpanFromLeft}],ItemStyle->20,Frame->All]},Alignment->Center,Background->LightGreen]//TraditionalForm

Bell’s Theorem in a nutshell: Picture version

The green square represents the Bell real (or Bell local) upper limit of +2 for the Bell real (Subscript[s, 1])-function.

The yellow surface represents the (3D-slice) of the QM (Subscript[s, 1])-function, as a function of the measurement difference angles (Subscript[θ, 3]) and (Subscript[θ, 4]).  ((Subscript[θ, 1])=(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4]) and (Subscript[θ, 2])=22.5°)

Everything on the QM (Subscript[s, 1]) surface above the green planar surface exceeds the CHSH inequality upper limit of 2.

The purple dot at the maximum of (Subscript[s, 1])=2(Sqrt[2]) for (Subscript[θ, 1])=67.5°,(Subscript[θ, 2])=(Subscript[θ, 3])=(Subscript[θ, 4])=22.5° represents the maximum violation of the CHSH inequality.

Therefore a “Bell real” or “Bell local” model cannot duplicate all of the predictions of QM.

comparoPlot3

Summary of results 1

Relationships among the 5 main model instances:
Venn diagram view

vennGeneric

Summary of results 2

Relationships among the deterministic  model instances

vennDeterminism=Graphics[{Green,Opacity[0.3],Disk[{0,0},2.0],Blue,Opacity[0.2],Disk[{0.7,0.7},1],Brown,Opacity[0.2],Disk[{0.45,0.45},1.4],Red,Opacity[0.05],EdgeForm[Thick],Rectangle[{-3,-3},{3,3}],Opacity[2]},Epilog->{Inset[Text@Style["Type 2 \n(24 Instances)",16],{-0.3,-0.2}],Inset[Text@Style["Type 1 \n(16 instances)",16],{0.7,0.7}],Inset[Text@Style["Type 3 \n(128 Instances)",16],{-1.0,-1.0}],Inset[Text@Style["Type 4 \n(256 Instances)",16],{-1.8,2.5}]}];
descriptionTypes=
Text@Style["Type 1 \n1. Generic deterministic \n2. Satisfies all 8 CHSH inequalities \n3. Satisfies Remote Context Independence (RCI)\n4. Is Bell local (hence also Bell real)
\nType 2 \n1. Generic deterministic \n2. Satisfies all 8 CHSH inequalities \n3. Satisfies Remote Context Independence (RCI)
\nType 3 \n1. Generic deterministic \n2. Satisfies all 8 CHSH inequalities
\nType 4 \n1. Generic deterministic",18,Blue];
GraphicsGrid[{{vennDeterminism,descriptionTypes}},Alignment->Left,ImageSize->1000]

Summary of results 3

Relationships among the model instances and conditions: 
Boxes outlined in red indicates that all instances satsify the CHSH inequalities

LayeredGraphPlot[{"Trivial \n(Minimal)"->"Quantum \nMechanics","Quantum \nMechanics"->"Remote Context \nIndependence","Bell local \n(Factorization condition) \n(Local causality)"->"Bell real","Bell real"->"Remote Context \nIndependence","Bell local \n(Factorization condition) \n(Local causality)"->"Remote Outcome \nIndependence","Remote Context \nIndependence"->"Generic \n(Maximal)","Remote Outcome \nIndependence"->"Generic \n(Maximal)","Trivial \n(Minimal)"->"Bell local \n(Factorization condition) \n(Local causality)","Determinism Type 1"->"Determinism Type 2","Determinism Type 1"->"Bell local \n(Factorization condition) \n(Local causality)","Determinism Type 2"->"Remote Context \nIndependence","Determinism Type 2"->"Determinism Type 3","Determinism Type 3"->"Determinism Type 4","Determinism Type 4"->"Generic \n(Maximal)"},Bottom,PerformanceGoal->"Quality",VertexShapeFunction->(Text[Framed[Style[#2,14, Black],Background->LightYellow],#1]&) ,VertexStyle->{"Bell local \n(Factorization condition) \n(Local causality)"->Red,"Bell real"->Red,"Trivial \n(Minimal)"->Red,"Determinism Type 1"->Red,"Determinism Type 2"->Red,"Determinism Type 3"->Red},AspectRatio->1,PerformanceGoal->"Quality",ImageSize->750]

Selected sets of correlations for selected model types

Pictures of 3D -slices (fixed w) through the 4D-sets of correlations (w,x,y,z) for the five models, where the first correlation w in each case is set to :  w=-1,-1/2,0,1/2,1 from left to right

models5

Simulations

DynamicModule[{tmp,simLength,data,datam1m1,datam1p1,datap1m1,datap1p1,name,distName,distType,probs,outcomes,parameterSubs,ρIndex,θSubsName,θSubs,θSubs1,θSubs2,θSubs3,θSubs4,detectorSubs,ρSubs,em1m1,em1p1,ep1m1,ep1p1(*,(Subscript[θ, 1]),(Subscript[θ, 2]),(Subscript[θ, 3]),(Subscript[θ, 4])*)},

detectorSubs=Table[detectorProbs[[k]]->1/4,{k,1,4}];
outcomes=tuples4;

θSubs1={(Subscript[θ, 3])->67.5°,(Subscript[θ, 2])->22.5°,(Subscript[θ, 1])->22.5°,(Subscript[θ, 4])->22.5°};
	θSubs2={(Subscript[θ, 1])->-90°,(Subscript[θ, 2])->0°,(Subscript[θ, 3])->-90°,(Subscript[θ, 4])->0°};
θSubs3={(Subscript[θ, 1])->135°,(Subscript[θ, 2])->45°,(Subscript[θ, 3])->45°,(Subscript[θ, 4])->45°};

ρSubs=Table[Join[{(Subscript[ρ, k])->1},Table[(Subscript[ρ, j])->0,{j,Complement[Range[16],{k}]}]],{k,1,Length[outcomes]}];
Manipulate[Block[{$ControlActiveSetting=False},
tmp=RandomReal[{-90,90},3];
θSubs4={(Subscript[θ, 1])->Total[tmp]Degree,(Subscript[θ, 2])->tmp[[1]]Degree,(Subscript[θ, 3])->tmp[[2]]Degree,(Subscript[θ, 4])->tmp[[3]]Degree};

probs=Switch[distName,"QM",probsQM,"Bell real",probsBellReal];
distType=EmpiricalDistribution[probs->outcomes];

(*Generate some samples from the(A,B,(Subscript[D, A]),(Subscript[D, B]))random vector with distribution dist.*)
parameterSubs=If[distName=="QM",Switch[θSubsName,"Max deviation",θSubs1,"Deterministic",θSubs2,"Uniform",θSubs3,"Random",θSubs4],ρSubs[[ρIndex]]];
data=RandomVariate[distType/.parameterSubs/.detectorSubs,simLength];

datam1m1=Select[data,#[[{3,4}]]=={-1,-1}&];
datam1p1=Select[data,#[[{3,4}]]=={-1,1}&];
datap1m1=Select[data,#[[{3,4}]]=={1,-1}&];
datap1p1=Select[data,#[[{3,4}]]=={1,1}&];

(*Now compute the four correlations corresponding to each of the four detector-setting pairs of Alice and Bob.*)
em1m1=Total[Table[datam1m1[[k,1]]*datam1m1[[k,2]],{k,1,Length[datam1m1]}]]/Length[datam1m1];
em1p1=Total[Table[datam1p1[[k,1]]*datam1p1[[k,2]],{k,1,Length[datam1p1]}]]/Length[datam1p1];
ep1m1=Total[Table[datap1m1[[k,1]]*datap1m1[[k,2]],{k,1,Length[datap1m1]}]]/Length[datap1m1];
ep1p1=Total[Table[datap1p1[[k,1]]*datap1p1[[k,2]],{k,1,Length[datap1p1]}]]/Length[datap1p1];

(*Put some of the data into a grid in the form of Red and Green outcomes*)
{{Grid[Transpose[Append[Transpose[{Prepend[numberToText/@datam1m1[[1;;Min[25,Length[datam1m1]],1]],"Alice"],
Prepend[numberToText/@datam1m1[[1;;Min[25,Length[datam1m1]],2]],"Bob"]}],{N[em1m1,3],SpanFromAbove}]],Frame->All],Grid[Transpose[Append[Transpose[{Prepend[numberToText/@datam1p1[[1;;Min[25,Length[datam1p1]],1]],"Alice"],
Prepend[numberToText/@datam1p1[[1;;Min[25,Length[datam1p1]],2]],"Bob"]}],{N[em1p1,3],SpanFromAbove}]],Frame->All],Grid[Transpose[Append[Transpose[{Prepend[numberToText/@datap1m1[[1;;Min[25,Length[datap1m1]],1]],"Alice"],
Prepend[numberToText/@datap1m1[[1;;Min[25,Length[datap1m1]],2]],"Bob"]}],{N[ep1m1,3],SpanFromAbove}]],Frame->All],Grid[Transpose[Append[Transpose[{Prepend[numberToText/@datap1p1[[1;;Min[25,Length[datap1p1]],1]],"Alice"],
Prepend[numberToText/@datap1p1[[1;;Min[25,Length[datap1p1]],2]],"Bob"]}],{N[ep1p1,3],SpanFromAbove}]],Frame->All]}//Column,Grid[{{Text@Style["s-functions",12,Blue],SpanFromLeft},{"(Subscript[S, 1])","(Subscript[S, 2])","(Subscript[S, 3])","(Subscript[S, 4])"},N[sBell.{em1m1,em1p1,ep1m1,ep1p1},4]},Frame->All]}],

{{simLength,5000,"Number of simulations"},1,10000,500,Appearance->"Labeled",ControlPlacement->Bottom},
{{distName,"QM","Distribution"},{"QM","Bell real"},ControlType->SetterBar,ControlPlacement->Bottom},
{{θSubsName,"Max deviation","QM parameters"},{"Max deviation","Deterministic","Uniform","Random"},ControlType->SetterBar,ControlPlacement->Bottom},
{{ρIndex,1,"Bell real parameters"},1,16,1,Appearance->"Labeled",ControlType->RadioButtonBar,ControlPlacement->Bottom},
TrackedSymbols->True
]
]

Summary

Summary

Developed a novel framework in which to easily compare and contrast most of the most-discussed models and conditions related to Bell’s Theorem

Based on suitable parameteriztions of a single discrete probability model

Provided pictures to illustrate the main ideas.

Every Bell local model instance is also Bell real

Every set of correlations of a Bell real (and hence Bell local) model is “inside” the surface representing the corresponding set of QM correlations (i.e., corresponding to the same w value.

Nothing looks like the QM correlations -- not Bell real, not Bell local correlations. Much more powerful illustration of the differences between  the QM model predictions and the Bell real or Bell local model predictions than just a simple set of inequalities.

Deterministic correlations are as far away as possible from the Trivial model correlations. This is a visual confirmation of the fact that a “definite” value is the opposite of a uniformly random value.

The Bell local correlation pictures (e.g. the “Pringles potato chips for w=±1) seem to be new. A very few papers have some pictures of the polytopes corresponding to the CHSH inequalities, i.e., the Bell real case in this presentation.

Finally, I think it is interesting that despite the fact that a Bell real model instance is “local” in the RCI sense, and that QM is often called a “non-local” theory, that the two model types are exactly the same in that

All QM and Bell real model instances satisfy Remote Context Independence (RCI), that is, Alice’s outcomes do not depend on Bob’s detector settings, and vice versa, yet

Most QM and Bell real model instances (that are not Bell local!) do not satisfy Remote Outcome Independence (ROI), that is, Alice’s and Bob’s outcomes are not (conditionally) independent for these instances.

(Note that Bell local model instances satisfy both RCI and ROI, hence also satisfy the Factoriztion Condition (FC), and hence are conditionally independent given the pair of detector settings.

There are many deterministic model instances (Types 2 and 3 in fact) that satisfy all 8 CHSH inequalities, yet are not Bell real. This shows that the the necessity part of Fine’s Theorem is weak, that is, if a model instance satifies all 8 CHSH inequalities, then there exists a Bell real model with the same correlations as the given model, but the originl model does not have to be Bell real!

Questions

Is “Bell locality” the same as “Einstein locality”?

For example, what about the quantum theory’s “no communication theorem”, which says that information cannot be transmitted faster than the speed of light using an EPR experiment?

That is, simple correlations that do not allow information to be sent faster-than-light, and hence do not allow instantaneous “control-at-a-distance”, does not really seem to be a violation of Einstein’s Special Theory of Relativity.

Brings back the age-old fundamental problem of distinguishing correlation from cause!

Note that Alice and Bob eventually have to compare their lengthy sequences of results, which requires a quite ordinary speed-limited process.

And the BIG question: Is there an underlying deeper “pre-quantum” theory which simultaneously

Recovers all of the current QM predictions, and

Is either “local” OR explains how non-locality “works”?

Future work

Can a Bell real model be enhanced to re-create QM correlations? Say by

Introducing a “time-varying” pmf of the definite values sent to Alice and Bob by the source?

Introducing a “non-contextual” collection of pmf’s that are “pasted together” somehow to govern the definite values sent to Alice and Bob in such a way that recreates QM predictions?

Cellular automata and causal networks   (NKS -- Stephen Wolfram)

Organizational origins of “physical laws”  (“Re-inventing the physical universe from bottom down” --Robert Laughlin)

Reductionism in its proper place

Understand physical laws on the basis of organization at a given level of elements of lower levels (scales of organization, not just size -- see also Denis Noble on biology and evolution “Dance to the Tune of Life”)

Classical and quantum information  (“Quantum processes, systems, and information” -- Schumacher and Westmoreland)

Explore further the prevalent idea of processes as “all roads taken, one of highest probability emerges” -- Feynman’s book “QED”, Everett’s multiple universes, Noble’s emphasis on evolution as a random process, yes, but mediated and directed by environmental influences, even at the DNA level.

Related to ensemble interpretation of QM phenomena -- can this be revived?

Initialization

Turns a string of -1 and +1’s into a string of R’s and G’s.

numberToText=Switch[#,-1,Text@Style["R",Red],1,Text@Style["G",Green]]&;

sumOfRandomReals[] generates “numberOfTuples” “numberOfSummands”-tuples of random real numbers that sum to “sum”, all bounded below by “min”. Work first with the 3-pair special case of Bell as described above. Then define

Probability calculus.

expectations[outcomesAndProbs_]:=
Total[Table[outcomesAndProbs[[k,1]]*outcomesAndProbs[[k,2]],{k,1,Length[outcomesAndProbs]}]];
sMatrix={{-1,1,1,1},{1,-1,1,1},{1,1,-1,1},{1,1,1,-1}};
s1Function[outcomesAndProbs_]:={1,-1,1,1}.expectations[outcomesAndProbs];

marginalSelect[outcomesAndProbs_,indices_]:=Module[{},
SortBy[Table[{outcomesAndProbs[[k,1,indices]],outcomesAndProbs[[k,2]]},{k,1,Length[outcomesAndProbs]}],First]
];
columnSelect[outcomesAndProbs_,indices_]:=Module[{},
Table[{outcomesAndProbs[[k,1,indices]],outcomesAndProbs[[k,2]]},{k,1,Length[outcomesAndProbs]}]
];
marginalize[outcomesAndProbs_,indices_]:=Module[{select,gather},
select=marginalSelect[outcomesAndProbs,indices];
gather=GatherBy[select,First];
Table[{gather[[k,1,1]],Total[gather[[k,All,2]]]},{k,1,Length[gather]}]
];

marginalizeFull[pmf_,select_]:=Module[{pos,probsNew},
pos=Table[Flatten[Position[pmf[[All,1,select]],pmf[[k,1,select]]]],{k,1,Length[pmf]}];
probsNew=Table[Total[pmf[[pos[[j]],2]]],{j,1,Length[pos]}];
Table[{pmf[[k,1]],probsNew[[k]]},{k,1,Length[pmf]}]
];

probability[pmf_,outcomes_]:=Module[{pos},pos=Flatten[Table[Position[pmf[[All,1]],outcomes[[k]]],{k,1,Length[outcomes]}]];
Total[pmf[[pos,2]]]];

(*Revised to accomodate zero denominators in the conditional proba calculation -- bypass if the pmf16 is symbolic instead of numeric.*)conditionalize[outcomesAndProbs_,conditioned_,conditional_]:=Module[{indicesAll,marginAll,marginRight,gather,indicesLeft,indicesRight,denom},
indicesLeft=Sort[conditioned];
indicesRight=Sort[conditional];
indicesAll=Join[indicesLeft,indicesRight];
marginAll=marginalize[outcomesAndProbs,indicesAll];
marginRight=marginalize[outcomesAndProbs,indicesRight];
(*Notice this next statement ASSUMES that the conditioning variables are in the final -Length[indicesRight] positions!!*)
SortBy[Table[denom=(marginRight[[Position[marginRight[[All,1]],marginAll[[k,1,-Length[indicesRight];;-1]]][[1]],2]][[1]]);{marginAll[[k,1]],If[NumericQ[denom],If[denom≠0,marginAll[[k,2]]/denom,0],marginAll[[k,2]]/denom]//Simplify},{k,1,Length[marginAll]}
],First]];
(*Like conditionalize, except it creates a "full" list of conditioned outcomes16 and probs to "match" the original full list. This, way it is easier to make comparison tables to check for FC, LC, RCI, ROI, etc. that can be interpreted easily, rather than requiring the reader to check corresponding entries in two different tables that don't have the same number of entries.*)
synchronizePMFs[pmf_,conditioned_,conditions_]:=Module[{lstcs,lstms,lstcond,lstMatch,lstNewProbs,indices},
indices=Join[conditioned,conditions];
lstcs=columnSelect[pmf,indices][[All,1]];
lstcond=conditionalize[pmf,conditioned,conditions];
lstMatch=#[[1]]->#[[2]]&/@lstcond;
lstNewProbs=lstcs/.lstMatch;
Table[{lstcs[[k]],lstNewProbs[[k]]},{k,1,Length[lstcs]}]
];

The new “full” conditionalize routine -- see subsequent examples for motivation

Note on the use of the routine “conditionalizeFull”. If the pmf input to the routine contains numeric parameters (especially if some might be 0), be sure to parameterize the pmf first; i.e., numericize the parameters before submitting to “conditionalizeFull”. If it is done afterwards, “conditionalizeFull” will not know about any 0 divisors, which may subsequently lead to indeterminate values.

conditionalizeFull[pmf_,conditioned_,conditional_]:=Module[{condAll,numer,denom},
condAll=Sort[Join[conditioned,conditional]];
numer=marginalizeFull[pmf,condAll][[All,2]];
denom=marginalizeFull[pmf,conditional][[All,2]];
Table[{pmf[[k,1]],If[!NumericQ[denom[[k]]],numer[[k]]/denom[[k]],If[denom[[k]]≠0,numer[[k]]/denom[[k]],"Undefined"]]},{k,1,Length[pmf]}]
];

entropy[pmf_]:=Module[{probs},probs=Table[If[NumericQ[pmf[[k]]],If[pmf[[k]]!=0,-pmf[[k]]Log[pmf[[k]]],0],-pmf[[k]]Log[pmf[[k]]]],{k,1,Length[pmf]}];Total[probs]];

Check the independence of two marginal or conditional pmf’s against their combination. pmf1 and pmf2 are the two components of the combination pmf3. The two smaller ones are independent if it can be shown that for every combination of probability inputs from them, their product is the probability of the associated outcome obtained by joining together the outcomes from the two smaller (space,pmf)’s. The ‘perm’ argument is a permutation (indicated for example by Cycles[{{2,3]]]) which re-orders the outcomes of the pmf products to align with the ordering of the combined pmf. For example, if we want to check (A,(Subscript[D, A])) and (B,(Subscript[D, B])) as being independent, then the combined pmf is in the order (A,(Subscript[D, A]),B,(Subscript[D, B])), but we need it to be in the order  (A,B, (Subscript[D, A]),(Subscript[D, B])) --  so we need to re-order  (for example) a Join[{-1,1},{-1,-1}]= {-1,1,-1,-1} by transposing the middle two elements (Cycles[{{2,3}}]) to present {-1,-1,1,-1} to the probability calculator comparison instead, i.e., in the order (A,B, (Subscript[D, A]),(Subscript[D, B])).

independenceCheck[pmf1_,pmf2_,pmf3_,perm_]:=Module[{outcome,outcomes1,outcomes2,outcomes3,prob,probs1,probs2,probs3,pos},
outcomes1=pmf1[[All,1]];
outcomes2=pmf2[[All,1]];
outcomes3=pmf3[[All,1]];
probs1=pmf1[[All,2]];
probs2=pmf2[[All,2]];
probs3=pmf3[[All,2]];

Table[
outcome=Permute[Join[outcomes1[[i]],outcomes2[[j]]],perm];
pos=Position[outcomes3,outcome][[1,1]];
prob=pmf3[[pos,2]];
probability[pmf1,{outcomes1[[i]]}]*probability[pmf2,{outcomes2[[j]]}]==prob,{i,1,Length[outcomes1]},{j,1,Length[outcomes2]}]
];

Display utilities

Display utility for pmf’s that recognizes the ordering of the r.v.’s (e.g. in a call to ‘marginalize’ or ‘conditionalize’) The resulting outcomes have been re-ordered to respect the marginalization or conditionalization specifications.
Second routine produces three conditional displays (A|(Subscript[D, A])), (B|(Subscript[D, B])), and ((A,(Subscript[D, A]))|(B,(Subscript[D, B]))) plus an “independenceCheck” to give some intuition to any claim of Bell locality.

displayPMF[pmf_,header_]:=Module[{},
Grid[Prepend[Table[Join[ If[ListQ[pmf[[k,1]]],pmf[[k,1]],{pmf[[k,1]]}],{  pmf[[k,2]]}],{k,1,Length[ pmf]}],header],Frame->All]
];
conditionalDisplay[pmf_,perm_,sortBy_,condLeft1_,condRight1_,condLeft2_,condRight2_,subs_,header1_,header2_,header3_]:=Module[{pmf1,pmf2,pmf3,condLeft,condRight},
pmf1=pmf/.subs;
pmf2=conditionalize[pmf1,Sort[Join[condLeft1,condLeft2]],Sort[Join[condRight1,condRight2]]];
pmf3=SortBy[Table[{Permute[pmf2[[k,1]],perm],pmf2[[k,2]]},{k,1,Length[pmf2]}],#[[1,sortBy]]&];
{displayPMF[conditionalize[pmf1,Sort[condLeft1],Sort[condRight1]],header1],displayPMF[conditionalize[pmf1,Sort[condLeft2],Sort[condRight2]],header2],displayPMF[pmf3,header3],
independenceCheck[conditionalize[pmf1,condLeft1,condRight1],conditionalize[pmf1,condLeft2,condRight2],conditionalize[pmf1,Sort[Join[condLeft1,condLeft2]],Sort[Join[condRight1,condRight2]]],perm]//MatrixForm}];

Display utility for pmf’s that recognizes the ordering of the r.v.’s (e.g. in a call to ‘marginalize’ or ‘conditionalize’) The resulting outcomes16 have been re-ordered to respect the marginalization or conditionalization specifications.

“conditionalDisplay” produces three separate conditional displays (A|(Subscript[D, A])), (B|(Subscript[D, B])), and ((A,(Subscript[D, A]))|(B,(Subscript[D, B]))) plus an “independenceCheck” to give some intuition to any claim of Bell locality. Note the ordering of outcomes16 may be different in the different displays.

“conditionalDisplay2” produces a single display of three separate conditional conditional distributions all related to the same underlying pmf16. It may be something like  ((A,(Subscript[D, A]))|(B,(Subscript[D, B]))) and (A|(Subscript[D, A])), (B|(Subscript[D, B])), but can be more complicated, although the last two are intended to be “sub-conditionals” wrt to the first one. The important difference between this one and the original is that the ordering is respected throughout, in fact, it has to be, since they are all displayed together with a single common outcome space of ±1-tuples on the left of the display.

displayPMF[pmf16_,header_]:=Module[{},
Grid[Prepend[Table[Join[ If[ListQ[pmf16[[k,1]]],pmf16[[k,1]],{pmf16[[k,1]]}],{  pmf16[[k,2]]}],{k,1,Length[ pmf16]}],header],Frame->All]
];
conditionalDisplay[pmf16_,perm_,sortBy_,condLeft1_,condRight1_,condLeft2_,condRight2_,subs_,header1_,header2_,header3_]:=Module[{pmf1,pmf2,pmf3,condLeft,condRight},
pmf1=pmf16/.subs;
pmf2=conditionalize[pmf1,Sort[Join[condLeft1,condLeft2]],Sort[Join[condRight1,condRight2]]];
pmf3=SortBy[Table[{Permute[pmf2[[k,1]],perm],pmf2[[k,2]]},{k,1,Length[pmf2]}],#[[1,sortBy]]&];
{displayPMF[conditionalize[pmf1,Sort[condLeft1],Sort[condRight1]],header1],displayPMF[conditionalize[pmf1,Sort[condLeft2],Sort[condRight2]],header2],displayPMF[pmf3,header3],
independenceCheck[conditionalize[pmf1,condLeft1,condRight1],conditionalize[pmf1,condLeft2,condRight2],conditionalize[pmf1,Sort[Join[condLeft1,condLeft2]],Sort[Join[condRight1,condRight2]]],perm]//MatrixForm}];

Display function to utilize the new “full” conditionalize”

displayPMFFull[pmfList_,header_]:=Module[{},
Grid[Prepend[Table[Join[ pmfList[[1,k,1]],{pmfList[[1,k,2]]},Table[pmfList[[j,k,2]],{j,2,Length[pmfList]}]],{k,1,Length[ pmfList[[1]]]}],header],Frame->All]
];

General notation

tuples2=Tuples[{-1,1},2];
tuples4=outcomes=Tuples[{-1,1},4];
tuples4Repeat=Flatten[Table[ConstantArray[tuples4[[k]],4],{k,1,Length[tuples4]}],1];

γ16=Array[(Subscript[γ, #])&,16];
ρ16=Array[(Subscript[ρ, #])&,16];
λ16=Array[(Subscript[λ, #])&,16];
ρ16=Array[(Subscript[ρ, #])&,16];

γ0={(Subscript[γ, 1])->0,(Subscript[γ, 2])->0,(Subscript[γ, 3])->0,(Subscript[γ, 4])->0,(Subscript[γ, 5])->0,(Subscript[γ, 6])->0,(Subscript[γ, 7])->0,(Subscript[γ, 8])->0,(Subscript[γ, 9])->0,(Subscript[γ, 10])->0,(Subscript[γ, 11])->0,(Subscript[γ, 12])->0,(Subscript[γ, 13])->0,(Subscript[γ, 14])->0,(Subscript[γ, 15])->0,(Subscript[γ, 16])->0};
ρ0={(Subscript[ρ, 1])->0,(Subscript[ρ, 2])->0,(Subscript[ρ, 3])->0,(Subscript[ρ, 4])->0,(Subscript[ρ, 5])->0,(Subscript[ρ, 6])->0,(Subscript[ρ, 7])->0,(Subscript[ρ, 8])->0,(Subscript[ρ, 9])->0,(Subscript[ρ, 10])->0,(Subscript[ρ, 11])->0,(Subscript[ρ, 12])->0,(Subscript[ρ, 13])->0,(Subscript[ρ, 14])->0,(Subscript[ρ, 15])->0,(Subscript[ρ, 16])->0};
γ16Repeat=Flatten[Table[ConstantArray[(Subscript[γ, k]),4],{k,1,16}]];
ρ16Repeat=Flatten[Table[ConstantArray[(Subscript[ρ, k]),4],{k,1,16}]];

detectorProbLabels={"ab","ab'","a'b","a'b'"};
detectorProbs=Table[(Subscript[δ, detectorProbLabels[[k]]]),{k,1,Length[detectorProbLabels]}];
δ16=Flatten[Table[detectorProbs,{k,1,4}],1];
δ64=Flatten[Table[δ16,{k,1,4}]];
δCollapseSubs={(Subscript[δ, "ab"])+(Subscript[δ, "ab'"])->(Subscript[δ, a]),(Subscript[δ, "a'b"])+(Subscript[δ, "a'b'"])->(Subscript[δ, a']),(Subscript[δ, "ab"])+(Subscript[δ, "a'b"])->(Subscript[δ, b]),(Subscript[δ, "ab'"])+(Subscript[δ, "a'b'"])->(Subscript[δ, b'])};

Matrices

sBell={{-1,1,1,1},{1,-1,1,1},{1,1,-1,1},{1,1,1,-1}};cMat={{1,0,0,0,-1,0,0,0,-1,0,0,0,1,0,0,0},{0,1,0,0,0,-1,0,0,0,-1,0,0,0,1,0,0},{0,0,1,0,0,0,-1,0,0,0,-1,0,0,0,1,0},{0,0,0,1,0,0,0,-1,0,0,0,-1,0,0,0,1}};
ρMat={{1,1,0,0,1,1,0,0,0,0,0,0,0,0,0,0},{1,0,1,0,1,0,1,0,0,0,0,0,0,0,0,0},{1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0},{1,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0},{0,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0},{0,1,0,1,0,1,0,1,0,0,0,0,0,0,0,0},{0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0},{0,1,0,1,0,0,0,0,0,1,0,1,0,0,0,0},{0,0,0,0,0,0,0,0,1,1,0,0,1,1,0,0},{0,0,0,0,0,0,0,0,1,0,1,0,1,0,1,0},{0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0},{0,0,0,0,1,0,1,0,0,0,0,0,1,0,1,0},{0,0,0,0,0,0,0,0,0,0,1,1,0,0,1,1},{0,0,0,0,0,0,0,0,0,1,0,1,0,1,0,1},{0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1},{0,0,0,0,0,1,0,1,0,0,0,0,0,1,0,1}};

Assumptions

αβAssumptions=(Subscript[α, 1])≥0&&(Subscript[α, 2])≥0&&(Subscript[α, 3])≥0&&(Subscript[α, 4])≥0&&(Subscript[β, 1])≥0&&(Subscript[β, 2])≥0&&(Subscript[β, 3])≥0&&(Subscript[β, 4])≥0&&(Subscript[α, 1])+(Subscript[α, 3])==1&&(Subscript[α, 2])+(Subscript[α, 4])==1&&(Subscript[β, 1])+(Subscript[β, 3])==1&&(Subscript[β, 2])+(Subscript[β, 4])==1;
δAssumptions=And@@Table[detectorProbs[[k]]>0,{k,1,Length[detectorProbs]}]&&Total[detectorProbs]==1;
ρAssumptions=(Subscript[ρ, 1])≥0&&(Subscript[ρ, 2])≥0&&(Subscript[ρ, 3])≥0&&(Subscript[ρ, 4])≥0&&(Subscript[ρ, 5])≥0&&(Subscript[ρ, 6])≥0&&(Subscript[ρ, 7])≥0&&(Subscript[ρ, 8])≥0&&(Subscript[ρ, 9])≥0&&(Subscript[ρ, 10])≥0&&(Subscript[ρ, 11])≥0&&(Subscript[ρ, 12])≥0&&(Subscript[ρ, 13])≥0&&(Subscript[ρ, 14])≥0&&(Subscript[ρ, 15])≥0&&(Subscript[ρ, 16])≥0&&Total[ρ16]==1;
γAssumptions=And@@Table[γ16[[k]]≥0,{k,1,Length[γ16]}]&&(Subscript[γ, 1])+(Subscript[γ, 5])+(Subscript[γ, 9])+(Subscript[γ, 13])==1&&(Subscript[γ, 2])+(Subscript[γ, 6])+(Subscript[γ, 10])+(Subscript[γ, 14])==1&&(Subscript[γ, 3])+(Subscript[γ, 7])+(Subscript[γ, 11])+(Subscript[γ, 15])==1&&(Subscript[γ, 4])+(Subscript[γ, 8])+(Subscript[γ, 12])+(Subscript[γ, 16])==1;


ρ16CondsNonNeg=And@@(#≥0&/@ρ16);
ρ16CondsSum1=Total[ρ16]==1;
ρ16SubsSum1={(Subscript[ρ, 1])+(Subscript[ρ, 2])+(Subscript[ρ, 3])+(Subscript[ρ, 4])+(Subscript[ρ, 5])+(Subscript[ρ, 6])+(Subscript[ρ, 7])+(Subscript[ρ, 8])+(Subscript[ρ, 9])+(Subscript[ρ, 10])+(Subscript[ρ, 11])+(Subscript[ρ, 12])+(Subscript[ρ, 13])+(Subscript[ρ, 14])+(Subscript[ρ, 15])+(Subscript[ρ, 16])->1};
ρ16SubsUniform=Table[(Subscript[ρ, k])->1/16,{k,1,16}];

A bunch of substitution lists

γsubs={(Subscript[γ, 1])+(Subscript[γ, 5])+(Subscript[γ, 9])+(Subscript[γ, 13])->1,(Subscript[γ, 2])+(Subscript[γ, 6])+(Subscript[γ, 10])+(Subscript[γ, 14])->1,(Subscript[γ, 3])+(Subscript[γ, 7])+(Subscript[γ, 11])+(Subscript[γ, 15])->1,(Subscript[γ, 4])+(Subscript[γ, 8])+(Subscript[γ, 12])+(Subscript[γ, 16])->1};
subsθSum={(Subscript[θ, 1])->(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4])};
subsθMinimal={(Subscript[θ, 2])->45 Degree,(Subscript[θ, 3])->45 Degree, (Subscript[θ, 4])->45 Degree};
subsθInfamous={(Subscript[θ, 2])->22.5 Degree,(Subscript[θ, 3])->22.5 Degree, (Subscript[θ, 4])->22.5 Degree};
subsδMinimal={(Subscript[δ, a])->1/2,(Subscript[δ, b])->1/2};
subsδUniform={(Subscript[δ, a])->1/2,(Subscript[δ, b])->1/2,(Subscript[δ, a'])->1/2,(Subscript[δ, b])'->1/2};
subsρMinimal={(Subscript[ρ, 1])->1/16,(Subscript[ρ, 2])->1/16,(Subscript[ρ, 3])->1/16,(Subscript[ρ, 4])->1/16,(Subscript[ρ, 5])->1/16,(Subscript[ρ, 6])->1/16,(Subscript[ρ, 7])->1/16,(Subscript[ρ, 8])->1/16,(Subscript[ρ, 9])->1/16,(Subscript[ρ, 10])->1/16,(Subscript[ρ, 11])->1/16,(Subscript[ρ, 12])->1/16,(Subscript[ρ, 13])->1/16,(Subscript[ρ, 14])->1/16,(Subscript[ρ, 15])->1/16,(Subscript[ρ, 16])->1/16};
subsγMinimal={(Subscript[γ, 1])->(1/16),(Subscript[γ, 2])->(1/16),(Subscript[γ, 3])->(1/16),(Subscript[γ, 4])->(1/16),(Subscript[γ, 5])->(1/16),(Subscript[γ, 6])->(1/16),(Subscript[γ, 7])->(1/16),(Subscript[γ, 8])->(1/16),(Subscript[γ, 9])->(1/16),(Subscript[γ, 10])->(1/16),(Subscript[γ, 11])->(1/16),(Subscript[γ, 12])->(1/16),(Subscript[γ, 13])->(1/16),(Subscript[γ, 14])->(1/16),(Subscript[γ, 15])->(1/16),(Subscript[γ, 16])->(1/16)};
subsγ4={(Subscript[γ, 1])->(1/4),(Subscript[γ, 2])->(1/4),(Subscript[γ, 3])->(1/4),(Subscript[γ, 4])->(1/4),(Subscript[γ, 5])->0,(Subscript[γ, 6])->0,(Subscript[γ, 7])->0,(Subscript[γ, 8])->0,(Subscript[γ, 9])->0,(Subscript[γ, 10])->0,(Subscript[γ, 11])->0,(Subscript[γ, 12])->0,(Subscript[γ, 13])->0,(Subscript[γ, 14])->0,(Subscript[γ, 15])->0,(Subscript[γ, 16])->0};
subsρ4={(Subscript[ρ, 1])->(1/4),(Subscript[ρ, 2])->(1/4),(Subscript[ρ, 3])->(1/4),(Subscript[ρ, 4])->(1/4),(Subscript[ρ, 5])->0,(Subscript[ρ, 6])->0,(Subscript[ρ, 7])->0,(Subscript[ρ, 8])->0,(Subscript[ρ, 9])->0,(Subscript[ρ, 10])->0,(Subscript[ρ, 11])->0,(Subscript[ρ, 12])->0,(Subscript[ρ, 13])->0,(Subscript[ρ, 14])->0,(Subscript[ρ, 15])->0,(Subscript[ρ, 16])->0};
subsδUniform={(Subscript[δ, a])->1/2,(Subscript[δ, a'])->1/2,(Subscript[δ, b])->1/2,(Subscript[δ, b'])->1/2};
subsαβUniform={(Subscript[α, 1])->1/2,(Subscript[α, 3])->1/2,(Subscript[α, 2])->1/2,(Subscript[α, 4])->1/2,(Subscript[β, 1])->1/2,(Subscript[β, 3])->1/2,(Subscript[β, 2])->1/2,(Subscript[β, 4])->1/2};
subsBL1={(Subscript[α, 1])->.1,(Subscript[α, 2])->.6,(Subscript[α, 3])->.9,(Subscript[α, 4])->.4,(Subscript[β, 1])->.3,(Subscript[β, 2])->.5,(Subscript[β, 3])->.7,(Subscript[β, 4])->.5};
subsBL2={(Subscript[α, 1])->1,(Subscript[α, 2])->1,(Subscript[α, 3])->0,(Subscript[α, 4])->0,(Subscript[β, 1])->1,(Subscript[β, 2])->0,(Subscript[β, 3])->0,(Subscript[β, 4])->1};
subs16=Subsets[Range[16]];

Maximal model

condMax=condMaximal=γ16;
probsMax=condMax*δ16;
pmfMax=pmfMaximal=Table[{tuples4[[k]],probsMax[[k]]},{k,1,Length[tuples4]}];

pmfMaximalTable=Grid[Prepend[Table[Join[ pmfMaximal[[k,1]],{ pmfMaximal[[k,2]]}],{k,1,Length[ pmfMaximal]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Maximal model pmf"}],Frame->All];
pmfGenericTable=Grid[Prepend[Prepend[Table[Join[pmfMaximal[[k,1]],{ pmfMaximal[[k,2]]}],{k,1,Length[ pmfMaximal]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","pmf"}],{Text@Style["Generic Model pmf",Bold,Red],SpanFromLeft}],ItemStyle->20,Frame->All];

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/genericPMF.pdf"}];
Export[filepath1,pmfGenericTable,ImageResolution->500];*)

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/maximalPMF.pdf"}];
Export[filepath1,pmfMaximalTable,ImageResolution->500];*)

Maximal model correlations and s-functions

correlationsMaximal=cMat.condMaximal;
sMaximal=sMatrix.correlationsMaximal;
MatrixForm[#]&/@{correlationsMaximal,sMaximal}

Maximize and minimize the s- functions. Do this for all of the models in this way. Easy-peasy!

Table[Maximize[{sMaximal[[k]],γAssumptions},condMaximal],{k,1,Length[sMaximal]}]
Table[Minimize[{sMaximal[[k]],γAssumptions},condMaximal],{k,1,Length[sMaximal]}]

Generic model constraints table

genericConstraintsTable=Grid[{{"γ constraints","δ constraints"},{"0≤(Subscript[γ, k])≤1 and \n(Subscript[γ, 1 + j])+(Subscript[γ, 5 + j])+(Subscript[γ, 9 + j])+(Subscript[γ, 13 + j])=1 \nfor \nj=0,1,2,3","0<(Subscript[δ, "a'b"]),(Subscript[δ, "a'b'"]),(Subscript[δ, "ab"]),(Subscript[δ, "ab'"])<1, and \n(Subscript[δ, "a'b"])+(Subscript[δ, "a'b'"])+(Subscript[δ, "ab"])+(Subscript[δ, "ab'"])=1"}},ItemStyle->18,Frame->All];

QM model

θvars={(Subscript[θ, 1]),(Subscript[θ, 2]),(Subscript[θ, 3]),(Subscript[θ, 4])};
θAssumptions=(Subscript[θ, 1])==(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4]);
θsubs=subsθSum={(Subscript[θ, 1])->(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4])};
θSubsQM={(Subscript[θ, 1])->67.5°,(Subscript[θ, 2])->22.5°,(Subscript[θ, 3])->22.5°,(Subscript[θ, 4])->22.5°,(Subscript[δ, a])->1/2,(Subscript[δ, a'])->1/2,(Subscript[δ, b])->1/2,(Subscript[δ, b'])->1/2};
condQM={(1/2) ((Cos[(Subscript[θ, 1])])^2) ,(1/2) ((Cos[(Subscript[θ, 2])])^2) ,(1/2) ((Cos[(Subscript[θ, 3])])^2) ,(1/2) ((Cos[(Subscript[θ, 4])])^2) ,(1/2) ((Sin[(Subscript[θ, 1])])^2) ,(1/2) ((Sin[(Subscript[θ, 2])])^2) ,(1/2) ((Sin[(Subscript[θ, 3])])^2) ,(1/2) ((Sin[(Subscript[θ, 4])])^2) ,(1/2) ((Sin[(Subscript[θ, 1])])^2) ,(1/2) ((Sin[(Subscript[θ, 2])])^2) ,(1/2) ((Sin[(Subscript[θ, 3])])^2) ,(1/2) ((Sin[(Subscript[θ, 4])])^2) ,(1/2) ((Cos[(Subscript[θ, 1])])^2) ,(1/2) ((Cos[(Subscript[θ, 2])])^2) ,(1/2) ((Cos[(Subscript[θ, 3])])^2) ,(1/2) ((Cos[(Subscript[θ, 4])])^2)};
probsQM=condQM*δ16;
pmfQM=Table[{tuples4[[k]],probsQM[[k]]},{k,1,Length[tuples4]}];

constraintMatQM={
{1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0},
{0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0},
{0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0},
{0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0},
{1,1,0,0,1,1,0,0,0,0,-1,-1,0,0,-1,-1},
{1,0,1,0,1,0,1,0,0,-1,0,-1,0,-1,0,-1},
{1,1,0,0,0,0,-1,-1,1,1,0,0,0,0,-1,-1},
{1,0,1,0,0,-1,0,-1,1,0,1,0,0,-1,0,-1},
{0,0,1,1,0,0,1,1,-1,-1,0,0,-1,-1,0,0},
{0,1,0,1,0,1,0,1,-1,0,-1,0,-1,0,-1,0},
{0,0,1,1,-1,-1,0,0,0,0,1,1,-1,-1,0,0},
{0,1,0,1,-1,0,-1,0,0,1,0,1,-1,0,-1,0},
{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}
};
constraintMatQMFirst=constraintMatQM[[1;;4]];
constraintMatQMLast=constraintMatQM[[5;;-1]];

QM table

Note: Be careful! The definition of the “qmConditionalProbs” assumes the ordering of tuples4 according to ((Subscript[D, A]),(Subscript[D, B]),A,B) ! That is ((Subscript[D, A]),(Subscript[D, B])) vary the slowest --(-1,-1),(-1,-1),(-1,-1),(-1,-1),(-1,1),... “qmProbs” and “pmfQM[[All,2}}” are NOT in the same order!

pmfQMTable=Grid[Prepend[Table[Join[pmfQM[[k,1]],{pmfQM[[k,2]]}],{k,1,Length[pmfQM]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","P(A,B,(Subscript[D, A]),(Subscript[D, B]))"}],Frame->All];

QM correlations and s-functions

correlationsQM=cMat.condQM//Simplify;
sFunctionQM=sBell.correlationsQM//Simplify;

Note: Without a restriction such as (Subscript[θ, 1])=(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4]), that is, if these angles were independent free parameters, the max/min s-function values would be ±4 instead of ±2(Sqrt[2]), the so-called Tsirelson bound. Thus the Tsirelson bound is a consequence of the geometry of Fig. in Table 4, namely that in the set of four angle differences, one of them must be the sum of the other three.

Maximize and minimize the s- functions. Do this for all of the models in this way, even the QM model. This evaluation takes to long -- gave up.

(*Table[Maximize[sFunctionQM[[k]]/.θsubs,Rest[θvars]],{k,1,Length[sFunctionQM]}]
Table[Minimize[sFunctionQM[[k]]/.θsubs,Rest[θvars]],{k,1,Length[sFunctionQM]}]*)

Bell real model

condBR=ρMat.ρ16;
probsBellReal=condBR*δ16;
pmfBR=pmfBellReal=Table[{tuples4[[k]],probsBellReal[[k]]},{k,1,Length[tuples4]}];

Bell real correlations and s-functions

Here is a useful matrix that basically captures the signs in the correlation matrix. Easy way to get the Bell correlations from the Bell realism model ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2]))--

matSigns={{1,1,-1,-1,1,1,-1,-1,-1,-1,1,1,-1,-1,1,1},{1,-1,1,-1,1,-1,1,-1,-1,1,-1,1,-1,1,-1,1},{1,1,-1,-1,-1,-1,1,1,1,1,-1,-1,-1,-1,1,1},{1,-1,1,-1,-1,1,-1,1,1,-1,1,-1,-1,1,-1,1}};
matSigns//MatrixForm;
matSigns.ρ16//MatrixForm

And here is the way to get the Bell real (not realism!) model  (A,B,(Subscript[D, A]),(Subscript[D, B])).

correlationsBellReal=cMat.condBR;
sBellReal=sMatrix.correlationsBellReal//Simplify;

Check that the ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2])) and (A,B,(Subscript[D, A]),(Subscript[D, B])) forms of the Bell real models produce identical correlations. Check.

{matSigns.ρ16//MatrixForm,correlationsBellReal//MatrixForm}
matSigns.ρ16==correlationsBellReal

Maximize and minimize the s- functions. Do this for all of the models in this way. Easy-peasy!

Table[Maximize[{sBellReal[[k]],ρAssumptions},ρ16],{k,1,Length[sBellReal]}]
Table[Minimize[{sBellReal[[k]],ρAssumptions},ρ16],{k,1,Length[sBellReal]}]

QM-Bell real table

pmfQMBellTable=Grid[Prepend[SortBy[Table[Join[pmfQM[[k,1]],{pmfQM[[k,2]]},{pmfBellReal[[k,2]]}],{k,1,Length[pmfQM]}],#[[{3,4}]]&],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","QM P(A,B,(Subscript[D, A]),(Subscript[D, B]))","Bell real P(A,B,(Subscript[D, A]),(Subscript[D, B]))"}],Frame->All];

Basic notation for original Bell space description

Define a function to convert each 4-tuple from ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2])) to a corresponding list of four 4-tuples from ((Subscript[D, A]),(Subscript[D, B]),A,B).
Also the inverse: from ((Subscript[D, A]),(Subscript[D, B]),A,B) to ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2])).

convertBell[lst_]:={{-1,-1,lst[[1]],lst[[3]]},{-1,1,lst[[1]],lst[[4]]},{1,-1,lst[[2]],lst[[3]]},{1,1,lst[[2]],lst[[4]]}};
convertBellInverse[lst_]:={{-1,-1,lst[[1]],lst[[3]]},{-1,1,lst[[1]],lst[[4]]},{1,-1,lst[[2]],lst[[3]]},{1,1,lst[[2]],lst[[4]]}};
convertTuplesBell=Flatten[Table[convertBell[tuples4[[k]]],{k,1,Length[tuples4]}],1];
pmfAliceCombinedOutcomes=Flatten[Table[{Join[tuples4Repeat[[k]],convertTuplesBell[[k]]]},{k,1,Length[tuples4Repeat]}],1];

Define set of all  outcomes associated with  the ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2])) and (A,B,(Subscript[D, A]),(Subscript[D, B])) 4-tuple combinations.

pmfCombinedOutcomes=Flatten[Table[{Join[tuples4Repeat[[k]],convertTuplesBell[[k]]]},{k,1,Length[tuples4Repeat]}],1]

Now define the probabilities associated with the ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2])) and (A,B,(Subscript[D, A]),(Subscript[D, B])) 4-tuple combinations.  The marginalization wrt columns (5,6,7,8) in the definition of pmfBellReal comes from the fact that (A,B,(Subscript[D, A]),(Subscript[D, B])) are in the final 4 positions of ((Subscript[A, 1]),(Subscript[A, 2]),(Subscript[B, 1]),(Subscript[B, 2]),A,B,(Subscript[D, A]),(Subscript[D, B])).

pmfCombinedBellProbabilities=ρ16Repeat*δ64;

pmfBellRealism=Table[{tuples4[[k]],ρ16[[k]]},{k,1,Length[tuples4]}];
pmfBellCombined=Table[{pmfCombinedOutcomes[[k]],pmfCombinedBellProbabilities[[k]]},{k,1,Length[pmfCombinedOutcomes]}];
pmfBellReal=Table[{tuples4[[k]],condBR[[k]]*δ16[[k]]},{k,1,Length[tuples4]}];
(*pmfBellReal=Collect[SortBy[marginalize[pmfBellCombined,{5,6,7,8}],First]//Simplify,detectorProbs];*)
pmfBellRealismTable=Grid[Prepend[Table[Join[ pmfBellRealism[[k,1]],{ pmfBellRealism[[k,2]]}],{k,1,Length[ pmfBellRealism]}],Text@Style[#,Bold,Blue]&/@{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","Bell real pmf"}],ItemStyle->22,Frame->All];
pmfBellRealTable=Grid[Prepend[Table[Join[ pmfBellReal[[k,1]],{ pmfBellReal[[k,2]]}],{k,1,Length[ pmfBellReal]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real pmf"}],ItemStyle->22,Frame->All]
subsγToρ=Table[γ16[[k]]->pmfBellReal[[k,2]],{k,1,Length[γ16]}];

Checks that these definitions have worked. Check!

{subsγToρ//Column,pmfBellRealismTable}

Mother of all tables. Notice that in the final table we have opted for a non-standard ordering to make the the ordering of the probabilities “pretty”.

pmfBellCombinedTable=Grid[Prepend[Table[Join[pmfBellCombined[[k,1]],{pmfBellCombined[[k,2]]}],{k,1,Length[pmfBellCombined]}],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","A","B","(Subscript[D, A])","(Subscript[D, B])","Combined Bell real pmf"}],Frame->All];
(*pmfBellCombinedReducedTable=Grid[Prepend[Table[Join[pmfBellReal[[k,1]],{pmfBellReal[[k,2]]}],{k,1,Length[pmfBellReal]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real pmf"}],ItemStyle->22,Frame->All];*)
pmfBellCombinedNumberedTable=Grid[Transpose[Prepend[Transpose[Prepend[Table[Join[pmfBellCombined[[k,1]],{pmfBellCombined[[k,2]]}],{k,1,Length[pmfBellCombined]}],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real combined pmf"}]],Range[0,64]]],ItemStyle->{Automatic,Automatic,{{51,1}->Red,{51,2}->Red,{51,3}->Red,{51,4}->Red,{51,5}->Red,{51,6}->Red,{51,7}->Red,{51,8}->Red,{51,9}->Red,{51,10}->Red}},Frame->All];
bellPMFComb1=pmfBellCombinedNumberedTable1=Grid[Transpose[Prepend[Transpose[Prepend[Table[Join[pmfBellCombined[[k,1]],{pmfBellCombined[[k,2]]}],{k,1,32}],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real combined pmf"}]],Range[0,32]]],(*ItemStyle->{Automatic,Automatic,{{51,1}->Red,{51,2}->Red,{51,3}->Red,{51,4}->Red,{51,5}->Red,{51,6}->Red,{51,7}->Red,{51,8}->Red,{51,9}->Red,{51,10}->Red}},*)Frame->All];
bellPMFComb2=pmfBellCombinedNumberedTable2=Grid[Transpose[Prepend[Transpose[Prepend[Table[Join[pmfBellCombined[[k,1]],{pmfBellCombined[[k,2]]}],{k,33,64}],{"(Subscript[A, 1])","(Subscript[A, 2])","(Subscript[B, 1])","(Subscript[B, 2])","A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real combined pmf"}]],Join[{"-"},Range[33,64]]]],ItemStyle->{Automatic,Automatic,{{19,1}->Red,{19,2}->Red,{19,3}->Red,{19,4}->Red,{19,5}->Red,{19,6}->Red,{19,7}->Red,{19,8}->Red,{19,9}->Red,{19,10}->Red}},Frame->All];
(*pmfBellCombinedReducedTableDep=Grid[Prepend[Table[Join[pmfBellCombinedReduced[[k,1]],{pmfBellCombinedReduced[[k,2]]}],{k,1,Length[pmfBellCombinedReduced]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real pmf"}],Frame->All]/.{(Subscript[δ, a])(Subscript[δ, b])->(Subscript[δ, "ab"]),(Subscript[δ, a])(Subscript[δ, b'])->(Subscript[δ, "ab'"]),(Subscript[δ, a'])(Subscript[δ, b])->(Subscript[δ, "a'b"]),(Subscript[δ, a'])(Subscript[δ, b'])->(Subscript[δ, "a'b'"])}*)

{pmfBellCombinedNumberedTable,pmfBellCombinedNumberedTable1,pmfBellCombinedNumberedTable2}

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/bellRealPMFComb1.pdf"}];
Export[filepath1,bellPMFComb1,ImageResolution->500];
filepath2=FileNameJoin[{NotebookDirectory[],"Pictures/bellRealPMFComb2.pdf"}];
Export[filepath2,bellPMFComb2,ImageResolution->500];*)

Bell local model

aliceProbs ={(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4])};
bobProbs={(Subscript[β, 1]),(Subscript[β, 2]),(Subscript[β, 3]),(Subscript[β, 4])};
αβconds={(Subscript[α, 3])->1-(Subscript[α, 1]),(Subscript[α, 4])->1-(Subscript[α, 2]),(Subscript[β, 3])->1-(Subscript[β, 1]),(Subscript[β, 4])->1-(Subscript[β, 2])};
αβvars={(Subscript[α, 1]),(Subscript[α, 2]),(Subscript[α, 3]),(Subscript[α, 4]),(Subscript[β, 1]),(Subscript[β, 2]),(Subscript[β, 3]),(Subscript[β, 4])};

condBL=Table[Switch[tuples4[[k,{1,3}]],{-1,-1},(Subscript[α, 1]),{-1,1},(Subscript[α, 2]),{1,-1},(Subscript[α, 3]),{1,1},(Subscript[α, 4])]*Switch[tuples4[[k,{2,4}]],{-1,-1},(Subscript[β, 1]),{-1,1},(Subscript[β, 2]),{1,-1},(Subscript[β, 3]),{1,1},(Subscript[β, 4])],{k,1,Length[tuples4]}];
probsBellLocal=condBL*δ16;
pmfBL=pmfBellLocal=Table[{tuples4[[k]],probsBellLocal[[k]]},{k,1,Length[tuples4]}];

Bell local table

pmfBellLocalTable=Grid[Prepend[Table[Join[pmfBellLocal[[k,1]],{pmfBellLocal[[k,2]]}],{k,1,Length[pmfBellLocal]}],{"A","B","(Subscript[D, A])","(Subscript[D, B])","Bell local pmf"}],Frame->All]
pmfQMBellLocalTable=Grid[Prepend[Table[Join[tuples4[[k]],{pmfQM[[k,2]]},{pmfBellReal[[k,2]]},{pmfBellLocal[[k,2]]}],{k,1,Length[pmfQM]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","QM pmf","Bell real pmf","Bell local pmf"}],Frame->All]
pmfBellRealLocalTable=Grid[Prepend[Table[Join[tuples4[[k]],{pmfBellReal[[k,2]]},{pmfBellLocal[[k,2]]}],{k,1,Length[pmfBellReal]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Bell real pmf","Bell local pmf"}],Frame->All]

Bell local correlations and s-functions

Now compute the correlations and the s-functions. Check!

correlationsBellLocal=cMat.condBL//Simplify;
sBellLocal=sBell.correlationsBellLocal//Simplify;

Maximize and minimize the s- functions. Do this for all of the models in this way. Easy-peasy!

Table[Maximize[{sBellLocal[[k]],αβAssumptions},αβvars],{k,1,Length[sBellLocal]}]
Table[Minimize[{sBellLocal[[k]],αβAssumptions},αβvars],{k,1,Length[sBellLocal]}]

Minimal model

condMin=ConstantArray[1/4,16];
probsMin=condMin*δ16;
pmfMin=pmfMinimal=Table[{tuples4[[k]],probsMin[[k]]},{k,1,Length[tuples4]}];

Minimal model

condMinimal=ConstantArray[(1/4),16];
pmfMinimal=Table[{tuples4[[k]],condMinimal[[k]]*δ16[[k]]},{k,1,Length[tuples4]}];
pmfMinimalTable=Grid[Prepend[Table[Join[pmfMinimal[[k,1]],{pmfMinimal[[k,2]]}],{k,1,Length[pmfMinimal]}],{"A","B","(Subscript[D, A])","(Subscript[D, B])","Minimal pmf"}],Frame->All]

Minimal model correlations and s-functions

correlationsMinimal=cMat.condMinimal//Simplify
sMinimal=sMatrix.correlationsMinimal//Simplify

condMaximal

{unconditionalPMFTable=Grid[Prepend[Prepend[Transpose[{Range[16],pmfQM[[All,2]],pmfBellLocal[[All,2]],pmfBellReal[[All,2]],pmfMaximal[[All,2]],pmfMinimal[[All,2]]}],{"No","QM","Bell local","Bell real","Maximal","Minimal"}],{Text@Style["Complete pmfs",Bold,Blue],SpanFromLeft}],ItemStyle->22,Frame->All],conditionalProbsTable1=Grid[Prepend[Prepend[Append[Table[Join[pmfQM[[k,1]],{condMaximal[[k]]},{condQM[[k]]},{condBR[[k]]},{condBL[[k]]},{condMinimal[[k]] }],{k,1,16}],{"Constraints",SpanFromLeft,SpanFromLeft,SpanFromLeft,"0≤(Subscript[γ, k])≤1,\n(Subscript[γ, 1 + j])+(Subscript[γ, 5 + j])+\n(Subscript[γ, 9 + j])+(Subscript[γ, 13 + j])=1 \nfor \nj=0,1,2,3","(Subscript[θ, 1])=(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4])","(Subscript[ρ, k])≥0, ∑(Subscript[ρ, k])=1","(Subscript[α, k])≥0, (Subscript[β, k])≥0 \n(Subscript[α, 1])+(Subscript[α, 3])=(Subscript[β, 1])+(Subscript[β, 3])=\n(Subscript[α, 2])+(Subscript[α, 4])=(Subscript[β, 2])+(Subscript[β, 4])\n=1","NA"}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Generic \n(Maximal)","QM","Bell real","Bell local","Trivial \n(Minimal)"}],{Text@Style["Conditional Probabilities",Bold,Red],SpanFromLeft}],ItemStyle->22,Frame->All],
conditionalProbsTable2=Grid[Prepend[Prepend[Append[Table[Join[pmfQM[[k,1]],{condMaximal[[k]]},{condBR[[k]]},{condBL[[k]]}],{k,1,16}],{"Constraints",SpanFromLeft,SpanFromLeft,SpanFromLeft,"(Subscript[γ, k])=0 for all k \nexcept \n(Subscript[γ, (Subscript[j, 1])])=(Subscript[γ, (Subscript[j, 2])])=(Subscript[γ, (Subscript[j, 3])])=(Subscript[γ, (Subscript[j, 4])])=1 \nfor some \n(Subscript[j, 1])∈{1,5,9,13} \n(Subscript[j, 2])∈{2,6,10,14} \n(Subscript[j, 3])∈{3,7,11,15} \n(Subscript[j, 4])∈{4,8,12,16}","(Subscript[ρ, k])=1 for some k \nand \n(Subscript[ρ, j])=0 for all j≠k","(Subscript[α, 1]),(Subscript[α, 2,])(Subscript[α, 3]),(Subscript[α, 4])=0 or 1, \n(Subscript[β, 1]),(Subscript[β, 2]),(Subscript[β, 3]),(Subscript[β, 4])=0 or 1, \n(Subscript[α, 1])+(Subscript[α, 3])=(Subscript[β, 1])+(Subscript[β, 3])=\n(Subscript[α, 2])+(Subscript[α, 4])=(Subscript[β, 2])+(Subscript[β, 4])=1"}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Determinism","Bell real \ndeterminism","Bell local \ndeterminism"}],{Text@Style["Conditional probabilities",Bold,Red],SpanFromLeft}],ItemStyle->22,Frame->All]};

Determinism model(s)

correlationsDeterminism={±1,±1,±1,±1};
determinismCorrelationsTable=Grid[Prepend[Transpose[{{"w","x","y","z"},Table[correlationsDeterminism[[k]],{k,1,Length[correlationsDeterminism]}]}],{Text@Style["Determinism correlations",Bold,Blue],SpanFromLeft}],Frame->All];
bellLocalDeterminismCorrelationsTable=Grid[Prepend[Transpose[{{"w","x","y","z"},Table[correlationsDeterminism[[k]],{k,1,Length[correlationsDeterminism]}]}],{Text@Style["Bell local determinism correlations",Bold,Blue],SpanFromLeft}],Frame->All];
determinismSFunctions={"0 or ±2 or ±4","0 or ±2 or ±4","0 or ±2 or ±4","0 or ±2 or ±4"};
bellLocalDeterminismSFunctions={±2,±2,±2,±2};
determinismSFunctionsTable=Grid[Prepend[Transpose[{{"(Subscript[s, 1])","(Subscript[s, 2])","(Subscript[s, 3])","(Subscript[s, 4])","Min and Max"},Join[Table[determinismSFunctions[[k]],{k,1,Length[determinismSFunctions]}],{"-4 and +4"}]}],{Text@Style["Determinism s-functions",Bold,Blue],SpanFromLeft}],Frame->All];
bellLocalDeterminismSFunctionsTable=Grid[Prepend[Transpose[{{"(Subscript[s, 1])","(Subscript[s, 2])","(Subscript[s, 3])","(Subscript[s, 4])","Min and Max"},Join[Table[bellLocalDeterminismSFunctions[[k]],{k,1,Length[bellLocalDeterminismSFunctions]}],{"-2 and +2"}]}],{Text@Style["Bell local determinism \ns-functions",Bold,Blue],SpanFromLeft}],Frame->All];
determinismConstraintsTable=Grid[{{Text@Style["Determinism constraints",Bold,Blue]},{ "(Subscript[γ, k])=0 for all k \nexcept \n(Subscript[γ, (Subscript[j, 1])])=(Subscript[γ, (Subscript[j, 2])])=(Subscript[γ, (Subscript[j, 3])])=(Subscript[γ, (Subscript[j, 4])])=1 \nfor some \n(Subscript[j, 1])∈{1,5,9,13} \n(Subscript[j, 2])∈{2,6,10,14} \n(Subscript[j, 3])∈{3,7,11,15} \n(Subscript[j, 4])∈{4,8,12,16}"}},Frame->All];
bellLocalDeterminismConstraintsTable=Grid[{{Text@Style["Bell local determinism constraints",Bold,Blue]},{ "(Subscript[α, 1]),(Subscript[α, 2,])(Subscript[α, 3]),(Subscript[α, 4])=0 or 1, \n(Subscript[β, 1]),(Subscript[β, 2]),(Subscript[β, 3]),(Subscript[β, 4])=0 or 1, \n(Subscript[α, 1])+(Subscript[α, 3])=(Subscript[β, 1])+(Subscript[β, 3])=\n(Subscript[α, 2])+(Subscript[α, 4])=(Subscript[β, 2])+(Subscript[β, 4])=1"}},Frame->All];

bellRealDeterminismCorrelationsTable=Grid[Prepend[Transpose[{{"w","x","y","z"},Table[correlationsDeterminism[[k]],{k,1,Length[correlationsDeterminism]}]}],{Text@Style["Bell real determinism correlations",Bold,Blue],SpanFromLeft}],Frame->All];
bellRealDeterminismSFunctions={±2,±2,±2,±2};
bellRealDeterminismSFunctionsTable=Grid[Prepend[Transpose[{{"(Subscript[s, 1])","(Subscript[s, 2])","(Subscript[s, 3])","(Subscript[s, 4])","Min and Max"},Join[Table[bellRealDeterminismSFunctions[[k]],{k,1,Length[bellRealDeterminismSFunctions]}],{"-2 and +2"}]}],{Text@Style["Bell real determinism \ns-functions",Bold,Blue],SpanFromLeft}],Frame->All];
bellRealDeterminismConstraintsTable=Grid[{{Text@Style["Bell real determinism constraints",Bold,Blue]},{ "(Subscript[ρ, k])=1 for some k and \n(Subscript[ρ, j])=0 for j≠k"}},Frame->All];

Put it all together in a table

modelsTable=Grid[Append[Prepend[Prepend[Table[Join[tuples4[[k]],{condMaximal[[k]]},{condQM[[k]]},{condBR[[k]]},{condBL[[k]]},{condMinimal[[k]]}],{k,1,Length[tuples4]}],Text@Style[#,Bold,Blue]&/@{"A","B","(Subscript[D, A])","(Subscript[D, B])","Maximal","QM","Bell real","Bell local","Minimal"}],{Text@Style["Outcomes",Bold,Red],SpanFromLeft,SpanFromLeft,SpanFromLeft,Text@Style["The five model pmfs",Bold,Red],SpanFromLeft}],{Text@Style["Parameter \ncontsraints",Bold,Blue],SpanFromLeft,SpanFromLeft,SpanFromLeft,"(Subscript[γ, k])≥0 & ∑(Subscript[γ, k])=1","(Subscript[θ, 1])=(Subscript[θ, 2])+(Subscript[θ, 3])+(Subscript[θ, 4]) \n(Subscript[δ, a])+(Subscript[δ, a'])=1, (Subscript[δ, b])+(Subscript[δ, b'])=1","(Subscript[ρ, k])≥0 & ∑(Subscript[ρ, k])=1 \n(Subscript[δ, a])+(Subscript[δ, a'])=1, (Subscript[δ, b])+(Subscript[δ, b'])=1","(Subscript[α, k])≥0, (Subscript[β, k])≥0 \n(Subscript[α, 1])+(Subscript[α, 3])=(Subscript[β, 1])+(Subscript[β, 3])=1 \n(Subscript[α, 2])+(Subscript[α, 4])=(Subscript[β, 2])+(Subscript[β, 4])=1 \n(Subscript[δ, a])+(Subscript[δ, a'])=1, (Subscript[δ, b])+(Subscript[δ, b'])=1","(Subscript[δ, a])+(Subscript[δ, a'])=1, (Subscript[δ, b])+(Subscript[δ, b'])=1"}],Frame->All];

A useful matrix for solving for α’s and β’s in terms of the ρ’s

αMat={{1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0},{1,1,1,1,0,0,0,0,1,1,1,1,0,0,0,0},{0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1},{0,0,0,0,1,1,1,1,0,0,0,0,1,1,1,1}};
%//MatrixForm
βMat={{1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0},{1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0},{0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1},{0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1}};
%//MatrixForm
αβMat=Join[βMat,αMat,{{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}}];
%//MatrixForm

subsTest={(Subscript[ρ, 1])->.1,(Subscript[ρ, 2])->.2,(Subscript[ρ, 5])->.3,(Subscript[ρ, 6])->.2,(Subscript[ρ, 3])->0,(Subscript[ρ, 4])->0,(Subscript[ρ, 7])->0,(Subscript[ρ, 8])->0,(Subscript[ρ, 9])->.05, (Subscript[ρ, 10])->.05,(Subscript[ρ, 11])->0,(Subscript[ρ, 12])->0,(Subscript[ρ, 13])->.05,(Subscript[ρ, 14])->.05,(Subscript[ρ, 15])->0,(Subscript[ρ, 16])->0};
sBell.(correlationsBellReal/.subsTest)//Chop

From Bellevue talk “Bell Theorem Update 4”

ptsZPlus1={{w,1,1},{-1,-w,1},{1,w,1},{-w,-1,1}};
ptsZMinus1={{w,-1,-1},{1,-w,-1},{-1,w,-1},{-w,1,-1}};
ptsXPlus1={{1,w,1},{1,-1,-w},{1,1,w},{1,-w,-1}};
ptsXMinus1={{-1,w,-1},{-1,1,-w},{-1,-1,w},{-1,-w,1}};
ptsYPlus1={{w,1,1},{-1,1,-w},{1,1,w},{-w,1,-1}};
ptsYMinus1={{w,-1,-1},{1,-1,-w},{-1,-1,w},{-w,-1,1}};

Define some points in 3D and 4D space corresponding to fixed values of the first coordinate w.

ptsw3=DeleteDuplicates[Join[ptsZPlus1,ptsZMinus1,ptsXPlus1,ptsXMinus1,ptsYPlus1,ptsYMinus1]];
%//MatrixForm
ptsw4=Prepend[#,w]&/@ptsw3;
%//MatrixForm
ptsw3Plus1=DeleteDuplicates[ptsw3/.{w->1}];
%//MatrixForm
ptsw3Minus1=DeleteDuplicates[ptsw3/.{w->-1}];
%//MatrixForm
ptsw4Plus1=DeleteDuplicates[ptsw4/.{w->1}];
%//MatrixForm
ptsw4Minus1=DeleteDuplicates[ptsw4/.{w->-1}];
%//MatrixForm
ptsw4Zero=DeleteDuplicates[ptsw4/.{w->0}];
%//MatrixForm
ptsw3Zero=DeleteDuplicates[Rest[#]&/@%%]

For sufficiency part of Fine Theorem proof: Determination of (Subscript[ρ, k])’s that reproduce (Subscript[V, 4]).

lst={};
Table[rSubsTmp=ReplacePart[ρ0,{{i,2}->1/2(1+w),{j,2}->1/2(1-w)}];
corr=correlationsBellReal/.rSubsTmp//Simplify;
pos=Position[ptsw4,corr];
If[pos≠{},AppendTo[lst,{pos[[1,1]],{i,j},corr}]],{i,1,Length[ρ0]-1},{j,i,Length[ρ0]}];
lstTmp=Sort[lst,#1[[1]]<#2[[1]]&];
lst1=Table[lstTmp[[k]],{k,1,Length[lstTmp]-1,2}];
ρSubs1=Table[ReplacePart[ρ0,{{lst1[[k,2,1]],2}->1/2(1+w),{lst1[[k,2,2]],2}->1/2(1-w)}],{k,1,Length[lst1]}];

lst={};
Table[rSubsTmp=ReplacePart[ρ0,{{i,2}->1/2(1-w),{j,2}->1/2(1+w)}];
corr=correlationsBellReal/.rSubsTmp//Simplify;
pos=Position[ptsw4,corr];
If[pos≠{},AppendTo[lst,{pos[[1,1]],{i,j},corr}]],{i,1,Length[ρ0]-1},{j,i,Length[ρ0]}];
lstTmp=Sort[lst,#1[[1]]<#2[[1]]&];
lst2=Table[lstTmp[[k]],{k,1,Length[lstTmp]-1,2}];
ρSubs2=Table[ReplacePart[ρ0,{{lst2[[k,2,1]],2}->1/2(1-w),{lst2[[k,2,2]],2}->1/2(1+w)}],{k,1,Length[lst2]}];

Case w=-1:

ρ16WMinus1Subs1=DeleteDuplicates[(ρ16/.#&)/@ρSubs1/.{w->-1}];
ρ16WMinus1Subs1//MatrixForm
correlationsWMinus1Subs1=DeleteDuplicates[(correlationsBellReal/.#&)/@ρSubs1/.{w->-1}];
extPtsWMinus1Subs1=DeleteDuplicates[ptsw4/.{w->-1}];
{correlationsWMinus1Subs1//MatrixForm,
extPtsWMinus1Subs1//MatrixForm}

Case -1≤w≤1:

ρ16Subs1=(ρ16/.#&)/@ρSubs1;
ρ16Subs1//MatrixForm
correlationsSubs1=(correlationsBellReal/.#&)/@ρSubs1//Simplify;
{correlationsSubs1//MatrixForm,ptsw4//MatrixForm}

r matrix and correlations using ρSubs2. Compare to similar structures above using ρSubs1. ρ16Subs1 has all zeros in the last two columns whereas ρ16Subs2 has all 0’s in the first two columns.

ρ16Subs2=(ρ16/.#&)/@ρSubs2;
ρ16Subs2//MatrixForm
correlationsSubs2=(correlationsBellReal/.#&)/@ρSubs2//Simplify;
{correlationsSubs2//MatrixForm,ptsw4//MatrixForm}

Case w=1: (note we use ρSubs2 here as opposed to ρSubs1 -- ρSubs1 requires 6 (Subscript[r, k])  pmf’s instead of 4)

ρ16WPlus1Subs2=DeleteDuplicates[(ρ16/.#&)/@ρSubs2/.{w->1}];
ρ16WPlus1Subs2//MatrixForm
correlationsWPlus1Subs2=DeleteDuplicates[(correlationsBellReal/.#&)/@ρSubs2/.{w->1}];
extPtsWPlus1Subs2=DeleteDuplicates[ptsw4/.{w->1}];
{correlationsWPlus1Subs2//MatrixForm,
extPtsWPlus1Subs2//MatrixForm}

Plotting

pr1={{-1,1},{-1,1},{-1,1}};
pr105={{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}};

bellRealVertices[ww_]:=Graphics3D[{Red,PointSize[Medium],Point[Rest[#]&/@ptsw4/.{w->ww}]}];
bellLocalVertices[ww_]:=Graphics3D[{Red,PointSize[Medium],Point[Select[Rest[#]&/@ptsw4,#[[3]]==1||#[[3]]==-1&]/.{w->ww}]}];
bellRealVerticesNot[ww_]:=Graphics3D[{Purple,PointSize[Medium],Point[Rest[#]&/@ptsw4/.{w->-ww}]}];
bellLocalVerticesNot[ww_]:=Graphics3D[{Purple,PointSize[Medium],Point[Select[Rest[#]&/@ptsw4,#[[3]]==1||#[[3]]==-1&]/.{w->-ww}]}];

threeDRegions=Table[DeleteDuplicates[Rest[#]&/@(ptsw4/.{w->k})],{k,{-1,-1/2,0,1/2,1}}];
(#//MatrixForm)&/@threeDRegions;
bellRealPlots=ConvexHullMesh[#,MeshCellStyle->{{0,All}->{PointSize[Medium],Red}},Ticks->(*None*){{-1,0,1},{-1,0,1},{-1,0,-1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}},  PlotTheme->"Detailed",(*PlotRange->{{-1,1},{-1,1},{-1,1}},*)ImageSize->100]&/@threeDRegions
cvhSeeThruPlots=ConvexHullMesh[#,MeshCellStyle->{{2,All}->Opacity[0.5,LightBlue](*,{0,All}->{PointSize[Medium],Red}*)}(*,Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)]&/@threeDRegions
threeDRegions2=Table[DeleteDuplicates[Rest[#]&/@(ptsw4/.{w->k})],{k,{-1/2(Sqrt[2]),1/2(Sqrt[2])}}];
(#//MatrixForm)&/@threeDRegions2;
bellRealPlots2=ConvexHullMesh[#(*,MeshCellStyle->{{0,All}->{PointSize[Medium],Red}},Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}},  PlotTheme->"Detailed",ImageSize->100*)]&/@threeDRegions2
cvhSeeThruPlots2=ConvexHullMesh[#,MeshCellStyle->{{2,All}->Opacity[0.5,LightBlue](*,{0,All}->{PointSize[Medium],Red}*)}(*,Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)]&/@threeDRegions2

(*subsαβ={{{(Subscript[α, 1])->1,(Subscript[β, 1])->0},{(Subscript[α, 1])->0,(Subscript[β, 1])->1}},{{(Subscript[α, 1])->1,(Subscript[β, 1])->1/4},{(Subscript[α, 1])->1/4,(Subscript[β, 1])->1}},{{(Subscript[α, 1])->(1/2),(Subscript[β, 1])->1},{(Subscript[α, 1])->1,(Subscript[β, 1])->1/2},{(Subscript[α, 1])->(1/2),(Subscript[β, 1])->1/2}},{{(Subscript[α, 1])->1,(Subscript[β, 1])->(3/4)},{(Subscript[α, 1])->3/4,(Subscript[β, 1])->1}},{{(Subscript[α, 1])->1,(Subscript[β, 1])->1},{(Subscript[α, 1])->0,(Subscript[β, 1])->0}}};
subsαβReduce={(Subscript[α, 3])->1-(Subscript[α, 1]),(Subscript[α, 4])->1-(Subscript[α, 2]),(Subscript[β, 3])->1-(Subscript[β, 1]),(Subscript[β, 4])->1-(Subscript[β, 2])};
corrBellReduce=correlationsBellLocal/.subsαβReduce;*)
(*corrBellTable=(Table[corrBellReduce/.subsαβ[[k]],{k,1,Length[subsαβ]}])//Simplify;*)
(*Keep the Cosine version around in case it's needed later. However, it needs to be updated to include the multiple 'sheets' that the revised version revealed.*)
(*bellLocalPlots=ParametricPlot3D[{{Cos[2 θ2 Degree],Cos[2θ3 Degree],-Cos[2θ2 Degree] Cos[2θ3 Degree]},{Cos[2 θ2 Degree],-Cos[2θ2 Degree] Cos[2θ3 Degree],Cos[2 θ3 Degree]},{-Cos[2θ2 Degree] Cos[2θ3 Degree],Cos[2 θ2 Degree],Cos[2θ3 Degree]}},{θ2,0,90},{θ3,0,90},AxesLabel->{"x","y","z"},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}];*)
(*bellLocalPlots=Table[Show[ParametricPlot3D[Table[Rest[corrBellTable[[k,j]]],{j,1,Length[corrBellTable[[k]]]}],{(Subscript[α, 2]),0,1},{(Subscript[β, 2]),0,1},Ticks->None(*{{-1,0,1},{-1,0,1},{-1,0,-1}}*),PlotStyle->Green,PlotRange->{{-1,1},{-1,1},{-1,1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}](*,bellLocalVertices[{-1,-0.5,0,0.5,1}[[k]]]*)],{k,1,Length[subsαβ]}]*)

bellLocalPlots={
Show[ParametricPlot3D[{x,y,-x y},{x,-1,1},{y,-1,1},Ticks->None,PlotRange->pr1,(*AxesLabel->{"x","y","z"},*)PlotStyle->Green](*,bellLocalVertices[-1]*)],
Show[ParametricPlot3D[{x,y,-2x y},{x,-1,1},{y,-1,1},Ticks->None,PlotRange->pr1,(*AxesLabel->{"x","y","z"},*)PlotStyle->Green](*,bellLocalVertices[-1/2]*)],
Show[ParametricPlot3D[{{x,0,z},{0,x,z},{0,0,z}},{x,-1,1},{z,-1,1},Ticks->None,PlotRange->pr1,(*AxesLabel->{"x","y","z"},*)PlotStyle->Green](*,bellLocalVertices[0]*)],
Show[ParametricPlot3D[{x,y,2x y},{x,-1,1},{y,-1,1},Ticks->None,PlotRange->pr1,(*AxesLabel->{"x","y","z"},*)PlotStyle->Green](*,bellLocalVertices[1/2]*)],
Show[ParametricPlot3D[{x,y,x y},{x,-1,1},{y,-1,1},Ticks->None,PlotRange->pr1,(*AxesLabel->{"x","y","z"},*)PlotStyle->Green](*,bellLocalVertices[1]*)]}

maximalSeeThruPlot=RegionPlot3D[-1≤x≤1&&-1≤y≤1&&-1≤z≤1,{x,-1,1},{y,-1,1},{z,-1,1},Ticks->None,(*Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}},AxesLabel->{"x","y","z"},*)PlotStyle->{LightGreen,Opacity[0.2]},Mesh->None(*,PlotRange->{{-1,1},{-1,1},{-1,1}},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)]
minimalPlot=Graphics3D[{Red,PointSize[Medium],Point[{0,0,0}]},Ticks->None(*,PlotRange->{{-1,1},{-1,1},{-1,1}},Axes->True,Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}},AxesLabel->{"x","y","z"},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)]

qmSeeThruPlots=Table[ParametricPlot3D[{ Cos[2 (α-γ-δ)], Cos[2 γ], Cos[2 δ]}/.{α->angle},{γ,-π/2,π/2},{δ,-π/2,π/2},(*AxesLabel->{"<(Subscript[X, 2])>","<(Subscript[X, 3])>","<(Subscript[X, 4])>"},*)PlotStyle->{Yellow,Opacity[0.4]},Mesh->None,Ticks->None,(*PlotLabel->"QM expectations \n3D-slice at <(Subscript[X, 1])> =  cos("<>ToString[2angle/N[Degree]]<> "°) = "<>ToString[N[Cos[2angle ]]//Chop],*)PlotPoints->50(*,ImageSize->300*)],{angle,{-π/2,-π/4,-π/8,0,π/8,π/4,π/2}}]

qmPlots=Table[ParametricPlot3D[{ Cos[2 (α-γ-δ)], Cos[2 γ], Cos[2 δ]}/.{α->angle},{γ,-π/2,π/2},{δ,-π/2,π/2},Ticks->None(*{{-1,0,1},{-1,0,1},{-1,0,-1}},ImageSize->200,FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)],{angle,{π/2,π/3,π/4,π/6,0}}]
qmSeeThruPlots2=Table[ParametricPlot3D[{ Cos[2 (α-γ-δ)], Cos[2 γ], Cos[2 δ]}/.{α->angle},{γ,-π/2,π/2},{δ,-π/2,π/2},Ticks->None,Mesh->None,PlotStyle->{Yellow,Opacity[0.4]},PlotPoints->50(*AxesLabel->{"x","y>","z"},*)(*Ticks->{{-1,0,1},{-1,0,1},{-1,0,-1}}*)(*FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)(*PlotLabel->"QM and Bell correlations \n3D-slice at w = cos("<>ToString[2angle/N[Degree]]<> "°) = "<>ToString[N[Cos[2angle ]]//Chop],*)(*,ImageSize->200*)],{angle,{π/2,π/3,π/4,π/6,0}}]
qmSeeThruPlots3=Table[ParametricPlot3D[{ Cos[2 (α-γ-δ)], Cos[2 γ], Cos[2 δ]}/.{α->angle},{γ,-π/2,π/2},{δ,-π/2,π/2},(*AxesLabel->{"x","y>","z"},*)Ticks->None,Mesh->None,PlotStyle->{Yellow,Opacity[0.4]},PlotPoints->50(*{{-1,0,1},{-1,0,1},{-1,0,-1}}*)(*FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}}*)(*PlotLabel->"QM and Bell correlations \n3D-slice at w = cos("<>ToString[2angle/N[Degree]]<> "°) = "<>ToString[N[Cos[2angle ]]//Chop],*)(*,ImageSize->200*)],{angle,{67.5 Degree,202.5 Degree}}]

{Show[bellLocalPlots[[1]],cvhSeeThruPlots[[1]],bellRealVertices[-1],bellRealVerticesNot[-1],PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}],Show[bellLocalPlots[[5]],cvhSeeThruPlots[[5]],bellRealVertices[1],bellRealVerticesNot[1],PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}]}

{Show[bellRealVertices[-1],bellRealVerticesNot[-1],Axes->True,PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}],Show[bellRealVertices[1],bellRealVerticesNot[1],Axes->True,PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}]}

Pictures specifically for the paper. Joins the “Selected correlations” and “Selected combinations of correlations” pictures.

{Show[bellRealVertices[-1],(*bellRealVerticesNot[-1],*)Axes->True,PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}],Show[bellRealVertices[1],(*bellRealVerticesNot[1],*)Axes->True,PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}]}
{Show[bellLocalPlots[[1]],cvhSeeThruPlots[[1]],bellRealVertices[-1],(*bellRealVerticesNot[-1],*)PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}],Show[bellLocalPlots[[5]],cvhSeeThruPlots[[5]],bellRealVertices[1],(*bellRealVerticesNot[1],*)PlotRange->{{-1.05,1.05},{-1.05,1.05},{-1.05,1.05}},AxesLabel->{"x","y","z"},Ticks->{{-1,0,1},{-1,0,1},{-1,0,1}}]}

models5=GraphicsGrid[{Join[{Text@Style["QM",24]},qmPlots],Join[{Text@Style["Bell real",24]},Table[Show[bellRealPlots[[k]],bellRealVertices[1/2k-3/2]],{k,1,Length[bellRealPlots]}]] ,Join[{Text@Style["Bell local",24]},Table[Show[bellLocalPlots[[k]],PlotRange->pr1],{k,1,Length[bellLocalPlots]}]],Join[{Text@Style["Maximal",24]},Table[Show[maximalSeeThruPlot],{k,1,5}]],Join[{Text@Style["Minimal",24]},{"","",minimalPlot,"",""}],Join[{Text@Style["Determinism",24]},{bellRealVertices[-1],"","","",bellRealVertices[1]}]},
ImageSize->900,Frame->{False,All}];

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/models5.pdf"}];
Export[filepath1,models5,ImageResolution->500];*)

Table[Show[bellLocalPlots[[k]],qmSeeThruPlots2[[k]],PlotLabel->"QM and Bell local "<>" (w= "<>ToString[0.5k-1.5]<>")"],{k,1,Length[qmSeeThruPlots2]}];

models5Combined=GraphicsGrid[{Join[{Text@Style["QM and \nBell local",24]},Table[Show[bellLocalPlots[[k]],qmSeeThruPlots2[[k]],bellLocalVertices[1/2k-3/2],PlotRange->pr1],{k,1,Length[qmSeeThruPlots2]}]],Join[{Text@Style["QM and \nBell real",24]},Table[Show[bellRealPlots[[k]],qmSeeThruPlots2[[k]],bellRealVertices[1/2k-3/2],PlotRange->pr1],{k,1,Length[qmSeeThruPlots2]}]] ,Join[{Text@Style["Bell real and \nBell local",24]},Table[Show[bellLocalPlots[[k]],cvhSeeThruPlots[[k]],bellRealVertices[1/2k-3/2],PlotRange->pr1],{k,1,Length[cvhSeeThruPlots]}]],Join[{Text@Style["Minimal and \nBell local",24]},Table[If[k==3,Show[bellLocalPlots[[k]],minimalPlot,(*bellLocalVertices[1/2k-3/2],*)PlotRange->pr1],Null],{k,1,Length[bellLocalPlots]}]],
Join[{Text@Style["Determinism + Bell real + Bell local",24]},{Show[bellLocalPlots[[1]],cvhSeeThruPlots[[1]],bellRealVertices[-1],PlotRange->pr1],"","","",Show[bellLocalPlots[[5]],cvhSeeThruPlots[[5]],bellRealVertices[1],PlotRange->pr1]}]},ImageSize->900,Frame->{False,All}]

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/models5Combined.pdf"}];
Export[filepath1,models5Combined,ImageResolution->500];*)

Bell real but not Bell local counterexample.

bellNotLocal=Show[cvhSeeThruPlots[[3]],bellLocalPlots[[3]],Graphics3D[{Purple,PointSize[Large],Point[{1,-1,0}]}],AxesLabel->{"x","y","z"}]

(*filepath1=FileNameJoin[{NotebookDirectory[],"Pictures/bellNotLocalExample.pdf"}];
Export[filepath1,bellNotLocal,ImageResolution->500];*)

Plot showing correlations common to QM and Bell local models.

blLinesMinus1=Graphics3D[{Red,Thick,Line[{{ptsw3Minus1[[3]],ptsw3Minus1[[1]]},{ptsw3Minus1[[3]],ptsw3Minus1[[2]]},{ptsw3Minus1[[4]],ptsw3Minus1[[1]]},{ptsw3Minus1[[4]],ptsw3Minus1[[2]]}}]}];
blLinesPlus1=Graphics3D[{Red,Thick,Line[{{ptsw3Plus1[[3]],ptsw3Plus1[[1]]},{ptsw3Plus1[[3]],ptsw3Plus1[[2]]},{ptsw3Plus1[[4]],ptsw3Plus1[[1]]},{ptsw3Plus1[[4]],ptsw3Plus1[[2]]}}]}];

bellLocalQMPlotMinus1=Show[bellLocalPlots[[1]],qmSeeThruPlots2[[1]],blLinesMinus1,ImageSize->300]
bellLocalQMPlotPlus1=Show[bellLocalPlots[[5]],qmSeeThruPlots2[[5]],blLinesPlus1,ImageSize->300]

blLinesZero1=Graphics3D[{Red,Thick,Line[{{ptsw3Zero[[3]],ptsw3Zero[[7]]},{ptsw3Zero[[6]],ptsw3Zero[[2]]}}]}];
blLinesZero2=Graphics3D[{Red,Thick,Line[{{ptsw3Zero[[1]],ptsw3Zero[[5]]},{ptsw3Zero[[4]],ptsw3Zero[[8]]}}]}];

bellLocalQMPlotZero=Show[bellLocalPlots[[3]],qmSeeThruPlots2[[3]],blLinesZero1,blLinesZero2,AxesLabel->{x,y,z},ImageSize->300]

ptMaxQM=Graphics3D[{Purple,PointSize[Large],Point[{22.5 ,22.5 ,2(Sqrt[2])}]}];
planeOneHalfAchievable=Show[ParametricPlot3D[{x,y,2},{x,-90,0},{y,-90-x,x+90},PlotStyle->Green],ParametricPlot3D[{x,y,2},{x,0,90},{y,x-90,90-x},PlotStyle->Green]];
expQM[β_,γ_,δ_]:={Cos[2(β+γ+δ)],Cos[2β],Cos[2γ],Cos[2δ]};
sQM[β_,γ_,δ_]:={-1,1,1,1}.expQM[β,γ,δ];
sQMDeg[β_,γ_,δ_]:=sQM[β Degree,γ Degree,δ Degree];

comparoPlot3=Show[ParametricPlot3D[{γ,δ,sQMDeg[22.5 ,γ,δ]},{γ,-90,90},{δ,-90,90},PlotPoints->35],
ContourPlot3D[sQMDeg[22.5 ,γ,δ]==2,{γ,-90,90},{δ,-90,90},{z,2-.01,2+.01}],ptMaxQM,planeOneHalfAchievable,AxesLabel->{"(Subscript[θ, 3])°","(Subscript[θ, 4])°","(Subscript[s, 1])"},PlotRange->All,BoxRatios->{1,1,0.5},FaceGrids->{{0,1,0},{-1,0,0},{0,0,-1}},(*PlotLabel->"Green rectangle: Max Bell real (Subscript[s, 1])=2 \nPurple dot: Max QM (Subscript[s, 1]) = 2(Sqrt[2])  \nYellow surface: QM (Subscript[s, 1]) values for w =(1/(Sqrt[2]))  \n Black curve (intersection): Simultaneous Bell real & QM achievable value 2 ",*)ImageSize->500];

Outcome Pads

realmOutcomes=Riffle[Permutations[{1,0,0,0}],Permutations[{-1,0,0,0}]];
realmOutcomes//MatrixForm

pad1Plus={"1","","",""};
pad1Minus={"-1","","",""};
pad2Plus={"","1","",""};
pad2Minus={"","-1","",""};
pad3Plus={"","","1",""};
pad3Minus={"","","-1",""};
pad4Plus={"","","","1"};
pad4Minus={"","","","-1"};
outcomes={pad1Plus,pad1Minus,pad2Plus,pad2Minus,pad3Plus,pad3Minus,pad4Plus,pad4Minus};

pad0=Join[{Text@Style["Trial",Bold,Blue]},Map[Text@Style[#,Bold,Red]&,{"(a,b)","(a,b')","(a',b)","(a',b')"}]];
pad00={"",Text@Style["Detector settings",Bold,Red],SpanFromLeft};
pad000={Text@Style["Aspect experiment statistics",Bold,Purple],SpanFromLeft};
padDots={"...","...","...","...","..."};
padEmpty=Table[{Text@Style[ToString [k],Bold,Blue],"","","",""},{k,1,10}];
padN=Prepend[RandomChoice[outcomes],Text@Style["N",Bold,Blue]];
padSums=Map[Text@Style[#,Bold,Black,14]&,{"Sums","((Subscript[N, 1]^(+)),(Subscript[N, 1]^(-)))","((Subscript[N, 2]^(+)),(Subscript[N, 2]^(-)))","((Subscript[N, 3]^(+)),(Subscript[N, 3]^(-)))","((Subscript[N, 4]^(+)),(Subscript[N, 4]^(-)))"}];

randomOutcomes=Table[Prepend[RandomChoice[outcomes],Text@Style[ToString[k],Bold,Blue]],{k,1,10}];
padExpectations=Map[Text@Style[#,Bold,Black,14]&,{"Correlation \nestimates","(OverHat[w])=\n((Subscript[N, 1]^(+))-(Subscript[N, 1]^(-)))×\n((Subscript[N, 1]^(+))+(Subscript[N, 1]^(-)))^(-1)","(OverHat[x])=\n((Subscript[N, 2]^(+))-(Subscript[N, 2]^(-)))×\n((Subscript[N, 2]^(+))+(Subscript[N, 2]^(-)))^(-1)","(OverHat[y])=\n((Subscript[N, 3]^(+))-(Subscript[N, 3]^(-)))×\n((Subscript[N, 3]^(+))+(Subscript[N, 3]^(-)))^(-1)","(OverHat[z])=\n((Subscript[N, 4]^(+))-(Subscript[N, 4]^(-)))×\n((Subscript[N, 4]^(+))+(Subscript[N, 4]^(-)))^(-1)"}];
padS={Text@Style["(OverHat[s])-statistics",Bold,Black,14],Text@Style["(Subscript[(OverHat[s]), 1]) = -(OverHat[w])+(OverHat[x])+(OverHat[y])+(OverHat[z]) \n(Subscript[(OverHat[s]), 2]) = (OverHat[w])-(OverHat[x])+(OverHat[y])+(OverHat[z]) \n(Subscript[(OverHat[s]), 3]) = (OverHat[w])+(OverHat[x])-(OverHat[y])+(OverHat[z]) \n(Subscript[(OverHat[s]), 4]) = (OverHat[w])+(OverHat[x])+(OverHat[y])-(OverHat[z])",Bold,Black,14],SpanFromLeft};
sPad=Grid[Prepend[Append[Append[Append[Append[Append[Prepend[Prepend[randomOutcomes,pad0],pad00],padDots],padN],padSums],padExpectations],padS],pad000],ItemStyle->22,Frame->All];

xAxis=Graphics[{Blue,Arrowheads[0.1],Thin,Dotted, Arrow[{{0,0},{1.8,0}}]}];
angleVectors=Graphics[{Arrow[{{0,0},d4{Cos[α1 ],Sin[α1 ]}}],Arrow[{{0,0},d3{Cos[α2 ],Sin[α2 ]}}],Arrow[{{0,0},d2{Cos[α3 ],Sin[α3 ]}}],Arrow[{{0,0},d1{Cos[α4 ],Sin[α4 ]}}]}];
angles1={α1->90  Degree,α2->67.5  Degree,α3->43 Degree,α4->22.5  Degree};
angles2={α1->90  Degree,α2->22.5 Degree ,α3->-45  Degree,α4->-112.5  Degree };
angles3={α1->77 Degree,α2->55 Degree ,α3->33  Degree,α4->11  Degree };
distances={d1->1,d2->1,d3->1,d4->1};
distances3={d1->1.8,d2->1.6,d3->1.4,d4->1.2};
distances4={d1->1.2,d2->1.4,d3->1.6,d4->1.8};

arc22p5=Graphics[Circle[{0,0},.6,{22.5 Degree,45 Degree}]];
arc45=Graphics[Circle[{0,0},.6,{45 Degree,67.5 Degree}]];
arc67p5=Graphics[Circle[{0,0},.6,{67.5 Degree,90 Degree}]];
arc67p5Total=Graphics[Circle[{0,0},.2,{22.5 Degree,90 Degree}]];
arc22p5Std=Graphics[Circle[{0,0},1.2,{0 Degree,22.5 Degree}]];
arc45Std=Graphics[Circle[{0,0},1.4,{0 Degree,45 Degree}]];
arc67p5Std=Graphics[Circle[{0,0},1.6,{0 Degree,67.5 Degree}]];
arc90Std=Graphics[Circle[{0,0},1.8,{0 Degree,90 Degree}]];
insetAngles1={
Inset[Text[Style["a",FontSize->16,Bold]],d1{Cos[α1 ],Sin[α1 ]}],
Inset[Text[Style["b",FontSize->16,Bold]],d2{Cos[α2 ],Sin[α2 ]}],
Inset[Text[Style["a'",FontSize->16,Bold]],d3{Cos[α3 ],Sin[α3 ]}],
Inset[Text[Style["b'",FontSize->16,Bold]],d4{Cos[α4 ],Sin[α4 ]}]
};
insetAngles2={
Inset[Text[Style["π/8",FontSize->16,Bold]],1/3({Cos[α1 ],Sin[α1 ]}+{Cos[α2 ],Sin[α2 ]})],
Inset[Text[Style["π/8",FontSize->16,Bold]],1/3({Cos[α2 ],Sin[α2 ]}+{Cos[α3 ],Sin[α3 ]})],
Inset[Text[Style["π/8",FontSize->16,Bold]],1/3({Cos[α3 ],Sin[α3 ]}+{Cos[α4 ],Sin[α4 ]})]
};

insetAngles3={
Inset[Text[Style["3π/8",FontSize->16,Bold]],1/3({Cos[α1 ],Sin[α1 ]}+{Cos[α2 ],Sin[α2 ]})],
Inset[Text[Style["3π/8",FontSize->16,Bold]],1/3({Cos[α2 ],Sin[α2 ]}+{Cos[α3 ],Sin[α3 ]})],
Inset[Text[Style["3π/8",FontSize->16,Bold]],1/3({Cos[α3 ],Sin[α3 ]}+{Cos[α4 ],Sin[α4 ]})]
};

insetAngles4={
Inset[Text[Style["(Subscript[θ, 2])",FontSize->16,Bold]],1/3({Cos[α1 ],Sin[α1 ]}+{Cos[α2 ],Sin[α2 ]})],
Inset[Text[Style["(Subscript[θ, 3])",FontSize->16,Bold]],1/3({Cos[α2 ],Sin[α2 ]}+{Cos[α3 ],Sin[α3 ]})],
Inset[Text[Style["(Subscript[θ, 4])",FontSize->16,Bold]],1/3({Cos[α3 ],Sin[α3 ]}+{Cos[α4 ],Sin[α4 ]})],
Inset[Text[Style["(Subscript[θ, 1])",FontSize->16,Bold]],1/8({Cos[α2 ],Sin[α2 ]}+{Cos[α3 ],Sin[α3 ]})]
};
circle=Graphics[{Blue,Dotted,Circle[{0,0},1]}];

diagramGeneric=Show[circle,xAxis,angleVectors/.angles1/.distances4,arc22p5Std,arc45Std,arc67p5Std,arc90Std,arc22p5,arc45,arc67p5,arc67p5Total,Epilog->{insetAngles1/.angles3/.distances3,insetAngles4/.angles1},ImageSize->350];

modelsGraphPlot=LayeredGraphPlot[{"Trivial \n(Minimal)"->"QM","QM"->"Remote Context \nIndependence","Bell local \nFactorization condition \nLocal causality"->"Bell real","Bell real"->"Remote Context \nIndependence","Bell local \nFactorization condition \nLocal causality"->"Remote Outcome \nIndependence","Remote Context \nIndependence"->"Generic \n(Maximal)","Remote Outcome \nIndependence"->"Generic \n(Maximal)","Trivial \n(Minimal)"->"Bell local \nFactorization condition \nLocal causality","Bell local Determinism"->"Bell real Determinism \n(correlation equivalent)","Bell real Determinism \n(correlation equivalent)"->"Generic \nDeterminism","Generic \nDeterminism"->"Generic \n(Maximal)"},Bottom,PerformanceGoal->"Quality",VertexShapeFunction->(Text[Framed[Style[#2,14, Black],Background->LightYellow],#1]&) ,VertexStyle->{"Bell local \nFactorization condition \nLocal causality"->Red,"Bell real"->Red,"Trivial \n(Minimal)"->Red,"Bell local Determinism"->Red,"Bell real Determinism \n(correlation equivalent)"->Red},AspectRatio->1.5,PerformanceGoal->"Quality",ImageSize->500];

labelsVenn1=Text@Style[#,16]&/@{"QM","Bell real","Bell local","Generic (Maximal)","Trivial \n(Minimal)"};vennGeneric=Show[Graphics[{EdgeForm[Thin],Cyan,Opacity[0.5],Ellipsoid[{0,1},{1,1.5}],Green,Opacity[0.3],Disk[{0,-1},1.8],Blue,Opacity[0.2],Disk[{0,-1},0.8],Red,Opacity[0.05],EdgeForm[Thick],Rectangle[{-3,-3},{3,3}],Opacity[2],PointSize[Large],Point[{0,-0.4}],Arrow[{{-1.8,-0.4},{0,-0.4}}]}],Epilog->{Inset[labelsVenn1[[1]],{0,1.3}],Inset[labelsVenn1[[2]],{0,-2.2}],Inset[labelsVenn1[[3]],{0,-1.1}],Inset[labelsVenn1[[4]],{-2.0,2.5}],Inset[labelsVenn1[[5]],{-2.2,-0.4}]},ImageSize->700];

labelsVenn2=Text@Style[#,16]&/@{"Bell Real \nand","Bell Local \nDeterminism \n(16 Instances)","Bell local","Generic (Maximal)","Trivial \n(Minimal)","Bell Real \n'Correlation Equivalent' \nDeterminism \n(128 Instances)","Generic Determinism \n(256 Instances)"};vennDeterminism=Show[Graphics[{Green,Opacity[0.3],Disk[{0,0},2.0],Blue,Opacity[0.2],Disk[{0.7,0.7},1],Red,Opacity[0.05],EdgeForm[Thick],Rectangle[{-3,-3},{3,3}],Opacity[2]}],Epilog->{Inset[labelsVenn2[[1]],{0.7,1.1}],Inset[labelsVenn2[[2]],{0.7,0.4}],Inset[labelsVenn2[[3]],{-0.7,-0.7}],Inset[labelsVenn2[[4]],{-2.0,2.5}]},ImageSize->700];

End Initialization

Backup Slides

“Can a Quantum-Mechanical Description of Physical Reality Be Considered Complete?”

(Einstein, Podolsky, Rosen 1935)

Note: EPR discussed position and momentum, but the argument is the same as long as non-commuting observables (“complementary” or “conjugate” varibles) are involved.

Abstract of EPR

In a complete theory there is an element corresponding to each element of reality.

A sufficient condition for the reality of a physical quantity is the possibility of predicting it with certainty, without disturbing the system.

(Note: “without disturbing the system” means “separate the two measurement labs by a large distance”)

In quantum mechanics in the case of two physical quantities described by non-commuting operators, the knowledge of one precludes the knowledge of the other.

Then either

(1) the description of reality given by the wave function in quantum mechanics is not complete or

(2) these two quantities cannot have simultaneous reality.

Consideration of the problem of making predictions concerning a system on the basis of measurements made on another system that had previously interacted with it leads to the result that if (1) is false then (2) is also false.

(Note: See diagram above)

One is thus led to conclude that the description of reality as given by a wave function is not complete.

So there!

“On the Einstein Podolsky Rosen Paradox”

John Bell (1964)

Abstract of Bell’s 1964 paper

THE paradox of Einstein, Podolsky and Rosen [1] was advanced as an argument that quantum mechanics
could not be a complete theory but should be supplemented by additional variables.

These additional variables were to restore to the theory causality and locality [2].

In this note that idea will be formulated mathematically and shown to be incompatible with the statistical predictions of quantum mechanics.

It is the requirement of locality, or more precisely that the result of a measurement on one system be unaffected by operations on a distant system with which it has interacted in the past, that creates the essential difficulty .

There have been attempts [3] to show that even without such a separability or locality requirement no "hidden variable" interpretation of quantum mechanics is possible.

These attempts have been examined elsewhere [ 4] and found wanting.

Moreover, a hidden variable interpretation of elementary quantum theory [S] has been explicitly constructed.

(Bell is referring to de Broglie- Bohm Pilot Wave Theory 1927,1952)

That particular interpretation has indeed a grossly nonlocal structure.

This is characteristic, according to the result to be proved here, of any such theory which reproduces exactly the quantum mechanical predictions.

Take that, Al!

Bell’s work pointed the way to a real lab experiment

One version: Photon polarization experiment [Aspect 1982]

If the experiment shows that Bell’s inequality can be violated, then quantum mechanics (QM) is a better description of nature than a deterministic, local description

The deterministic model types

Row[{conditionalProbsTable2},Alignment->Center,Background->LightGreen]//TraditionalForm

s-functions

The s-functions are four linear functions of the correlations defined by:

(({{(Subscript[s, 1])}, {(Subscript[s, 2])}, {(Subscript[s, 3])}, {(Subscript[s, 4])}}))=(({{-1, 1, 1, 1}, {1, -1, 1, 1}, {1, 1, -1, 1}, {1, 1, 1, -1}}))(({{w}, {x}, {y}, {z}}))=(({{-w+x+y+z}, {w-x+y+z}, {w+x-y+z}, {w+x+y-z}})).

Row[{Grid[Prepend[Append[Transpose[Prepend[{Join[{Text@Style["Generic",16]},sBell.correlationsMaximal],Join[{Text@Style["QM",16]},sBell.correlationsQM],Join[{Text@Style["Bell real",16]},sBell.correlationsBellReal//Simplify],Join[{Text@Style["Bell local",16]},sBell.correlationsBellLocal//Simplify],Join[{Text@Style["Minimal",16]},sBell.correlationsMinimal]},{"","(Subscript[s, 1])","(Subscript[s, 2])","(Subscript[s, 3])","(Subscript[s, 4])"}]],{"Max and Min","+4 and -4","+2(Sqrt[2]) and -2(Sqrt[2])","+2 and -2","+2 and -2","0 and 0"}],{Text@Style["s-Functions",Bold,Red,16],SpanFromLeft}],ItemStyle->20,Frame->All]},Alignment->Center,Background->LightGreen]//TraditionalForm

Selected correlations for selected combinations of model types

Some combinations of 3D slices (fixed w) of 4D sets of correlations (w,x,y,z) for the five main model types.  
w=-1,-1/2,0,1/2,1 from left to right

models5Combined

QM and Bell local correlations in common

Red lines indicate (some)sets of correlations common to both 
Bell local and QM models (cases w=-1,0,1 left to right)

{bellLocalQMPlotMinus1,bellLocalQMPlotZero,bellLocalQMPlotPlus1}

Ringing the Bell: The ongoing debate

Why is there still so much activity (papers, conferences, debates) surrounding a paper written in 1964, and going back to ideas from the 1930’s?

Google Scholar citations -- almost 9000 citations of John Bell’s papers in 2018 alone!

https://scholar.google.com/citations?user=Bd9KX0oAAAAJ&hl=en #d=gsc_md _hist&p=&u=

dates= Table[k,{k,1982,2019}];
citations={1073,1073,1250,1123,1189,1067,1234,1356,1540,1549,1665,1607,1837,2047,2117,2169,2282,2516,2644,2772,3060,3094,3361,3869,3876,4016,4320,4596,4598,4958,5743,6125,6021,6029,6265,6952,8956,5904};bellPapers=BarChart[citations,ChartLabels->dates,BarOrigin->Left,AxesLabel->{"Year","Citations"},(*PlotLabel->"Figure 4. Google Citations for John Bell",*)ImageSize->800]

Google search

“Bell’s Theorem” -- 375,000 hits

“Bell’s Theorem in philosophy”  -- 1,510,000 hits

Google Scholar search

“Bell’s Theorem” -- 651,000 hits

“Bell’s Theorem in philosophy”  -- 1,210,000 hits

People are saying...

Henry Stapp declared: “Bell’s theorem is the most profound discovery of science”
 Stapp, Henry P. (1975). “Bell’s Theorem and World Process”. Nuovo Cimento. 29B (2): 270–276. Bibcode:1975NCimB..29..270S. doi:10.1007/BF02728310. (Quote on p. 271)

Andrei Khrennikov, organizer of the Vaxjo Conferences (on quantum theory) said : "At one of the round tables (after two hours of debates with opinions for and against completeness of QM) we had decided to vote on this problem.  Incompleteness advocates have won, but only because a few advocates of completeness voted for incompleteness."

The book “Quantum Nonlocality and Reality: 50 Years of Bell’s Theorem”, edited by Mary Bell and Shan Gao , contains 26 papers by different authors, and they are not all in complete agreement, save the ones rightfully recognizing John Bell’s major contributions to the foundations of quantum theoryMary Bell and Shan Gao, ed.’s,  Quantum Nonlocality and Reality: 50 Years of Bell’s Theorem,  Cambridge University Press, 2016.

EPR

Conceptual models and observation

Some mathematicians/statisticians on mathematical modeling

“All models are wrong. Some are useful.”  -- George Box

“I made a special effort to stress the conceptual
difference between mental constructs and physical reality ... . In physical sciences the theories are so formulated as
to correspond in some useful sense to the real world, whatever
that may mean ... . The physical justification of all the
theoretical conclusions is based on some form of inductive
reasoning.” --  A.  Papoulis 
( forward to Probability, Random Variables and Stochastic Processes—2nd Edition)

What I want to understand

Bell’s Theorem

Premises

Consequences

The connection between

Everyday use of the words "reality", "locality", "determinism",  and

Their codification in the construction of a mathematical model.

Whether or not all of the hoopla -- praise, criticism, debate, controversy --  is justified.

What bothered Einstein about quantum mechanics (QM)
(even though he helped invent it)

A gedankenexperiment

Alice and Bob are experimenters stationed at two different laboratories several light years apart

In between is a source emitter of two “maximally entangled” quantum systems (“particles”)

One particle is sent to Alice and the other is sent to Bob

They remain entangled, so that although the state of the entire system is theoretically knowable, the state of each subsystem cannot be known until measured

First Alice performs a measurement on her particle in her laboratory

Second, Bob performs a measurement on his particle in his laboratory

QM says that Alice can predict Bob’s result before he performs his measurement

Say what?

Possible explanations

There is some sort of “communication” between the two particles that tells Bob’s particle how to “behave” after Alice makes her measurement

This explanation is contrary to Einstein’s Special Theory of Relativity, and he assumes it is obvious to everyone that this CANNOT happen, hence barely mentions it, except as part of the “reality” argument below

The alternative explanation is that Alice and Bob’s portions of the original entangled system were “prepared” at the source with pre-determined outcomes

Reality

Einstein says that since a value can be known in advance without disturbing the other system, that it must be “real”

He concludes that QM is incomplete, since it can say nothing about about the state of the Bob’s system (until it is measured)

There is something “missing” -- the missing elements are later called “hidden variables” (Einstein did not use this terminology originally)

“Reality” and “hidden variables” usually mean the same thing when describing a particular theory about this phenomena