In[]:=
(*Mathematica*)Clear[f,dlst,pt,cr,ptlst,M,in,it,n0,x,y,aa,bb,in2]allColors=ColorData["Legacy"][[3,1]];firstCols=Join[{"Red","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"},{"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]];cr[n_]:=cr[n]=cols[[n]];dlst=ParallelTable[Random[Integer,{1,2}],{n,1000000}];
In[]:=
rotate[theta_]:={{Cos[theta],-Sin[theta]},{Sin[theta],Cos[theta]}};
In[]:=
NSolve[x^3-x-10,x]an=Table[Arg[x^n]/.NSolve[x^3-x-10,x][[1]],{n,1,5,4}]
Out[]=
{{x-0.662359-0.56228},{x-0.662359+0.56228},{x1.32472}}
Out[]=
{-2.43773,0.377696}
In[]:=
(*quasiconformaltransform:{5,2}*)
In[]:=
g={{5,2},{2,5}}/Sqrt[Det[{{5,2},{2,5}}]]
Out[]=
,,,
5
21
2
21
2
21
5
21
In[]:=
g1=Inverse[g]
Out[]=
,-,-,
5
21
2
21
2
21
5
21
In[]:=
qtd=g.Inverse[{{1,-Sqrt[7]},{Sqrt[7],1}}/2].g1
Out[]=
-+,-,-,-+
2+
5
4
3
1
2
21
21
5-+
1
2
3
5
4
21
21
5+
5
4
3
1
2
21
21
2-+
1
2
3
5
4
21
21
5-+
5
4
3
1
2
21
21
2+
1
2
3
5
4
21
21
2-+
5
4
3
1
2
21
21
5+
1
2
3
5
4
21
21
In[]:=
b[1]=1;b[5]=2;
In[]:=
M0=Table[(Abs[x^n]/.NSolve[x^3-x-10,x][[1]])*rotate[an[[b[n]]]],{n,1,5,4}]
Out[]=
{{{-0.662359,0.56228},{-0.56228,-0.662359}},{{0.460202,-0.182582},{0.182582,0.460202}}}
In[]:=
M=Table[g.M0[[i]].g1,{i,2}]
Out[]=
{{{-1.19786,0.776481},{-0.776481,-0.126855}},{{0.63409,-0.252137},{0.252137,0.286314}}}
In[]:=
In[]:=
in=Table[{Re[x^n]/.NSolve[x^3-x-10,x][[1]],Im[x^n]/.NSolve[x^3-x-10,x][[1]]},{n,1,5,4}]
Out[]=
{{-0.662359,-0.56228},{0.460202,0.182582}}
In[]:=
f[j_,{x_,y_}]:=M[[j]].{x,y}+in[[j]]
In[]:=
pt={0.5,0.5};
In[]:=
aa=ParallelTable[pt=f[dlst[[j]],pt],{j,Length[dlst]}];
In[]:=
(*ListPlot[aa,PlotStyleRed]*)
In[]:=
ptlst=Point[Developer`ToPackedArray[aa],VertexColorsDeveloper`ToPackedArray[cr/@dlst]];
In[]:=
gout=Graphics[{PointSize[.001],ptlst},AspectRatio1,PlotRangeAll,ImageSizeFull,AxesFalse,BackgroundBlack,ImageSize2000];
In[]:=
Export["Akiyama_quasiconformal52_1000000.gif",gout]
Out[]=
Akiyama_quasiconformal52_1000000.gif
In[]:=
(*end*)
In[]:=
(*cr[n_]=If[n-10,RGBColor[0,0,1],If[n-20,RGBColor[0,1,0],If[n-30,RGBColor[1,0,0],RGBColor[0,0,0]]]];ptlst[n_]:=Table[{cr[dlst[[j]]],Point[pt=f[dlst[[j]],Sequence[pt]]]},{j,Length[dlst]}];gout=Table[Show[Graphics[Join[{PointSize[.001]},ptlst[n]]],AspectRatio->Automatic,PlotRange->All],{n,0,20}];Export["Riddle_tame_dragon50000.gif",gout]"Riddle_tame_dragon50000.gif"*)