Simulation for “Symmetric Derivation of the Singlet Correlations 
within a Quaternionic 3-sphere”.
 http://dx.doi.org/10.13140/RG.2.2.15725.46565
Created by Fred Diether  Apr. 2022.  With 3D Vectors!

<<"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*)
ga=GeometricProduct[Da, Ls1];  (*particle - detector interaction*)
gb=GeometricProduct[Ls2, Db];  (*particle - detector interaction*)
ag=GeometricProduct[Ls1, Da];  (*particle - detector interaction*)
bg=GeometricProduct[Db, Ls2];  (*particle - detector interaction*)
A=Sign[Re[ga]];  (*A detection full polarization*)
B=Sign[Re[gb]];  (*B detection full polarization*)
pc=0;
pc=(1/2)(GeometricProduct[ga,gb]+GeometricProduct[ag,bg]);  (*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[[l]]={angle,Re[pc]},{l,m}]

mean=Expand[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.