In[]:=
(*Mathematica*)(*Minkowski4d2x2group*)
In[]:=
s[1]={{1,0},{0,1}}
Out[]=
{{1,0},{0,1}}
In[]:=
s[2]={{I,0},{0,-I}}
Out[]=
{{,0},{0,-}}
In[]:=
s[3]={{0,1},{-1,0}}
Out[]=
{{0,1},{-1,0}}
In[]:=
s[4]={{0,1},{1,0}}
Out[]=
{{0,1},{1,0}}
In[]:=
Clear[a,b,c,d]
In[]:=
m=a*s[1]+b*s[2]+c*s[3]+d*s[4]
Out[]=
{{a+b,c+d},{-c+d,a-b}}
In[]:=
d=d/.Solve[Det[m]1,d][[2]]
Out[]=
-1+++
2
a
2
b
2
c
In[]:=
(*sphereprojection*)
In[]:=
a=Sin[t]*Sin[p]b=Cos[t]*Sin[p]c=Cos[p]
Out[]=
Sin[p]Sin[t]
Out[]=
Cos[t]Sin[p]
Out[]=
Cos[p]
(*twomatricesat{Pi/4,3Pi/4}90degressapart*)
In[]:=
N[m/.tPi/4/.pPi/4]
Out[]=
{{0.5+0.5,0.707107},{-0.707107,0.5-0.5}}
In[]:=
N[m/.t3*Pi/4/.p3*Pi/4]
Out[]=
{{0.5-0.5,-0.707107},{0.707107,0.5+0.5}}
In[]:=
(*StartLimitset*)
In[]:=
Clear[cr,cols,cr2,cr3,cr4,firstCols]allColors=ColorData["Legacy"][[3,1]];firstCols={"White","AliceBlue","LightBlue","Cyan","ManganeseBlue","DodgerBlue","Blue","Magenta","Purple","Pink","Tomato","Red","DarkOrange","Orange","DeepNaplesYellow","Gold","Banana","Yellow","LightYellow","Orange","Pink","LightPink","Yellow","LightYellow","LightPink","White","DeepNaplesYellow","Orange","DarkOrange","Tomato","Red","Tomato","Pink","LightPink","DeepNaplesYellow","Orange","DarkOrange","Tomato","White","Pink","Banana","LightBlue","DodgerBlue","Cyan","White","Purple","DarkOrchid","Magenta","ManganeseBlue","DeepNaplesYellow","Orange","DarkOrange","Tomato","GoldOchre","LightPink","Magenta","Green","DarkOrchid","LightSalmon","LightPink","Sienna","Green","Mint","DarkSlateGray","ManganeseBlue","SlateGray","DarkOrange","MistyRose","DeepNaplesYellow","GoldOchre","SapGreen","Yellow","Yellow","Tomato","DeepNaplesYellow","DodgerBlue","Cyan","Red","Blue","DeepNaplesYellow","Green","Magenta","DarkOrchid","LightSalmon","LightPink","Sienna","Green","Mint","DarkSlateGray","ManganeseBlue","SlateGray","DarkOrange","MistyRose","DeepNaplesYellow","GoldOchre","SapGreen","Yellow","LimeGreen"};cols=ColorData["Legacy",#]&/@Join[firstCols,Complement[allColors,firstCols]];rotate[theta_]:={{Cos[theta],-Sin[theta]},{Sin[theta],Cos[theta]}};cr[n_]:=cr[n]=cols[[n]];cr2[n_]:=cr2[n]=cols[[n+4]];
In[]:=
cr3[n_]:=cr3[n]=cols[[n+8]];
In[]:=
cr4[n_]:=cr4[n]=cols[[n+12]];
In[]:=
cr5[n_]:=cr5[n]=cols[[n+16]]
In[]:=
Clear[w,ww,n,m,a0,a,b,A,B,c0,b0]
In[]:=
Clear[f1,f2,f3,m,z,s]s[1]={{1+I,1},{1,1-I}}s[2]={{0.5`+0.5`,0.7071067811865475`},{-0.7071067811865475`,0.5`-0.5`}}s[3]={{0.5`-0.5`,-0.7071067811865475`},{0.7071067811865475`,0.5`+0.5`}}s[4]=Inverse[s[1].s[2].s[3]]Table[Det[s[i]],{i,4}]Table[Tr[s[i]],{i,4}]
Out[]=
{{1+,1},{1,1-}}
Out[]=
{{0.5+0.5,0.707107},{-0.707107,0.5-0.5}}
Out[]=
{{0.5-0.5,-0.707107},{0.707107,0.5+0.5}}
Out[]=
{{1.-1.,-1.+0.},{-1.+0.,1.+1.}}
Out[]=
{1,1.+0.,1.+0.,1.+0.}
Out[]=
{2,1.+0.,1.+0.,2.+0.}
In[]:=
s0={{I,0},{1,I}};
In[]:=
{a,b,A,B}=Table[N[s[i]],{i,4}]
Out[]=
{{{1.+1.,1.},{1.,1.-1.}},{{0.5+0.5,0.707107},{-0.707107,0.5-0.5}},{{0.5-0.5,-0.707107},{0.707107,0.5+0.5}},{{1.-1.,-1.+0.},{-1.+0.,1.+1.}}}
In[]:=
Det[a]Tr[a]Det[b]Tr[b]Det[A]Tr[A]Det[B]Tr[B]
Out[]=
1.+0.
Out[]=
2.+0.
Out[]=
1.+0.
Out[]=
1.+0.
Out[]=
1.+0.
Out[]=
1.+0.
Out[]=
1.+0.
Out[]=
2.+0.
In[]:=
Affine[{z1_,z2_}]:=0.00001Round[(z1/z2)/0.00001];Children[{z_,n_}]:={Affine[{a,b,A,B}[[#]].{Conjugate[z],1}],#}&/@Delete[Range[4],{3,4,1,2}[[n]]];aa1={Re[#[[1]]],Im[#[[1]]]}&/@Nest[Union[Flatten[Children/@#,1]]&,ParallelTable[{Affine[{a,b,A,B}[[i]].{0,1}],i},{i,1,4}],12];ll=Length[aa1]
1
0.+0.
1
0.+0.
1
0.+0.
Out[]=
482577
In[]:=
Last[aa1]
Out[]=
{Indeterminate,Indeterminate}
In[]:=
In[]:=
aa=Delete[Union[aa1],Length[Union[aa1]]];
In[]:=
(*aa=ParallelTable[{aa0[[i,1]]+aa0[[i,2]],-aa0[[i,1]]+aa0[[i,2]]}/Sqrt[2],{i,Length[aa0]}];*)
In[]:=
g0=Rasterize[ListPlot[aa,AspectRatioAutomatic,PlotStyle{Black,PointSize[0.001]},ImageSize2000,PlotRange{{-2.1,2.1},{-2.1,2.1}}],RasterSize2000,ImageSize2000];