Joy Christian’s updated (S^3) model using Geometric Algebra with 3D vectors
Created by Fred Diether Mar. 2022

<<"clifford.m"
w=0;t=0;u=0;
m=20000;
plotpc=Table[{0,0},m];
I3=Pseudoscalar[3];

Do[aa=RandomPoint[Sphere[]];
a=({e[1], e[2],e[3]}).aa;  (*convert to GA*)
bb=RandomPoint[Sphere[]];
b=({e[1], e[2],e[3]}).bb;  (*convert to GA*)
ss=RandomPoint[Sphere[]]; (*Singlet spin vector*)
s=({e[1], e[2],e[3]}).ss;  (*convert to GA*)
Da=InnerProduct[I3,a];  (*detector bivector*)
Db=InnerProduct[I3,b];
Ls1=InnerProduct[I3,s];  (*spin bivector to A*)
Ls2=-Ls1;  (*spin bivector to B, conservation of angular momentum*)
Aq=InnerProduct[Da, Ls1];  (*particle - detector interaction*)
Bq=InnerProduct[Ls2, Db];  (*particle - detector interaction*)
A=Sign[Aq];  (*A detection full polarization*)
B=Sign[Bq];  (*B detection full polarization*)
ra=({e[1], e[2],e[3]}).Cross[aa,ss];
rb=({e[1], e[2],e[3]}).Cross[-ss,bb];
r0=Expand[({e[1], e[2],e[3]}).(Aq*Limit[Cross[s2,bb]+0.000001,s2->Sign[Bq]bb]+Bq*Limit[Cross[aa,s1]+0.000001,s1->Sign[Aq]aa]-Cross[Limit[Cross[aa,s1]+0.000001,s1->Sign[Aq]aa],Limit[Cross[s2,bb]+0.000001,s2->Sign[Bq]bb]])/
(Sin[ArcCos[aa.bb]])];
Lr0=InnerProduct[I3,r0];
pc=0;
pc={InnerProduct[Da,Ls1]*InnerProduct[Ls2,Db]-InnerProduct[ra,rb],Lr0[[1]],Lr0[[2]],Lr0[[3]]};  (*product calculation*)
w=w+pc;
t=t+A;
u=u+B;
ϕA=ArcTan[aa[[2]],aa[[1]]];
ϕB=ArcTan[bb[[1]],bb[[2]]];
If[ϕA*ϕB>0,angle=ArcCos[aa.bb]/Degree, angle=(-ArcCos[aa.bb])/Degree+360];
plotpc[[i]]={angle,pc[[1]]},{i,m}]

mean=N[w/m] ;  (*shows the vanishing of cross products*)
aveA=N[t/m];
aveB=N[u/m];
Print[" <A> = ",aveA,"  <B> = ",aveB];
Print["Cross products vanish, mean = ",mean];
simulation=ListPlot[plotpc,PlotMarkers->{Automatic,Small},AspectRatio->9/16,Ticks->{{{90,90°},{180,180°},{0,0°},{270,270°},{360,360°}},Automatic},
GridLines->Automatic,AxesOrigin->{0,-1.0}];
negcos=Plot[-Cos[x Degree],{x,0,360},PlotStyle->{Magenta}];
p1=Plot[-1+2x1 Degree/π,{x1,0,180},PlotStyle->{Gray,Dashed}];
p2=Plot[3-2x2 Degree/π,{x2,180,360},PlotStyle->{Gray,Dashed}];
Show[simulation,p1,p2, negcos ]

Blue is correlation data, magenta is the negative cosine curve for an exact match.