Friday, December 27, 2019

Polar Plots & Parameters


PPIJK=Function[{i,j,k,t},
i*Log[(j+.9Cos[i^2*t])(1.01+Sin[k*t])]];
Show[Table[PolarPlot[PPIJK[i,j,7,t],{t,0,2Pi},
PlotStyle->Darker[Hue[(j-5)/5],.05i]],
{i,3,7},{j,6,10}],PlotRange->All,
ImageSize->500,Frame->True,Axes->False]


BrownianBridgeProcess VS RandomReal


RR=RandomReal[{-1.5,1.5},{101,3}]; SeedRandom[11];
RW=RandomFunction[BrownianBridgeProcess[{0,0},{1,1}],
{0, 1,.01},3]["ValueList"];
Graphics3D[Table[{Style[Tube[(Transpose@RW)[[i;;i+1]],.03],
ColorData["BrightBands"][.01i]],Style[Tube[RR[[i;;i+1]],.02],
ColorData["DarkBands"][.01i],Opacity[.2]]},{i,100}]]



Color Exploration


PDG[p_]:=Graphics3D[{Opacity[.3],
Tube[PolyhedronData[p,"Edges","Coordinates"],.05],
EdgeForm[Transparent],FaceForm[Opacity[.7],White],
Transpose[{ColorData["Crayola",
"ColorList"][[11;;10+Length[#]]],
#}]}]&@PolyhedronData[p,"Polygons"];
PDT[p_]:=Graphics3D[MapIndexed[Style[Text[ColorData["Crayola"][[3,
1,10+#2[[1]]]],#1],15]&,Mean/@(PolyhedronData[p,
"VertexCoordinates"][[#]]&/@PolyhedronData[p,"FaceIndices"])]];
Show[PDG[PolyhedronData["Archimedean"][[11]]],
PDT[PolyhedronData["Archimedean"][[11]]],
Boxed->False,ImageSize->700,ViewPoint->{-3,-1,3.5}]


Built-in Color Sets


Multicolumn[ColorData["Crayola",
"ColorRules"][[11;;80]],5]


Examples of Problem Solving


Pl[x1_,x2_]:=Plot[{-Log[x],-Log[x]*x},
{x,x1,x2},PlotStyle->{Blue,Magenta}];
Va[x_]:=Graphics[{Blue,Text[Style[N[-Log[x]*x],20],
{x+.1,-Log[x]+.1}],Opacity[.3],Polygon[{{0,0},
{x,0},{x,-Log[x]},{0,-Log[x]}}]}];
xmax=Solve[D[-Log[x]*x,x]\[Equal]0,x][[1,1,2]];
Vmax=Graphics[{Red,Text[Style[-Log[xmax]*xmax,30],
{xmax+.05,-Log[xmax]+.1}],Text[Style["*",30],
{xmax,-Log[xmax]*xmax-.1}],Opacity[.5],
Polygon[{{0,0},{xmax,0},
{xmax,-Log[xmax]},{0,-Log[xmax]}}]}];
Show[Pl[0,1.1],Vmax,Va[.15],Va[.65],
ImageSize->600,GridLines->Automatic]


Recurrence Tables


z[n_]:=Exp[I*Pi*n*2^0.3]; L={{0,0}};
Do[L=Append[L,{Re[L[[i,1]]+I*L[[i,2]]+z[i]],
Im[L[[i,1]]+I*L[[i,2]]+z[i]]}],{i,250}];
Graphics[Table[{Hue[i/250],
Line[{L[[i]],L[[i+1]]}]},{i,250}],
ImageSize->500,Background->RGBColor["silver"]]


PolarPlot & ParametricPlot & ContourPlot


POPMN[m_,n_,k_,\[Theta]_]:=Cos[m*\[Theta]]+Cos[n*\[Theta]]+k;
PAPMN=Function[{m,n,k,t},
{(Cos[m*t]+Cos[n*t]+k+1)Cos[t],
(Cos[m*t]+Cos[n*t]+k+1)Sin[t]}];
CPMN=Function[{m,n,k,x,y},
x^2+y^2-(Cos[m*ArcTan[y/x]]+Cos[n*ArcTan[y/x]]+k+2)^2];
S3P=Function[{m,n,k,c1,c2,c3},
Show[PolarPlot[POPMN[m,n,k,\[Theta]],{\[Theta],0,2Pi},
PlotStyle->ColorData[c1][1-.1k]],
ParametricPlot[PAPMN[m,n,k,t],{t,0,2Pi+.1},
PlotStyle->ColorData[c2][1-.3k]],
ContourPlot[CPMN[m,n,k,x,y]==0,{x,-6,6},{y,-6,6},
ContourStyle->ColorData[c3][1-.5k]],
Axes->False,ImageSize->500,Frame->True]];
S3P[24,12,2,"RoseColors","AvocadoColors","NeonColors"]


PolarPlot Examples of Drawing 3


FXY=Function[{t,i,n},
{Cos[16t+i*Pi/n]+Cos[6t+i*Pi/n]/2+Sin[10t+i*Pi/n]/3,
Sin[16t+i*Pi/n]+Sin[6t+i*Pi/n]/2+Cos[10t+i*Pi/n]/3}];
Show[Table[ParametricPlot[FXY[t,i,3],{t,0,2Pi},
PlotStyle->Hue[i/3]],{i,6}],
PlotRange->All,ImageSize->500,Frame->True,Axes->False]


PolarPlot Examples of Drawing 2


 Show[PolarPlot[3Sin[1.7t],{t,0,11.7Pi},
PlotStyle->{Red,Opacity[.7]}],
PolarPlot[2Sin[1.3t],{t,0,13Pi},
PlotStyle->{Orange,Opacity[.8]}],
PolarPlot[Sin[5.9t],{t,0,9Pi},PlotStyle->Yellow],
ImageSize->500,Frame->True,Axes->False]


PolarPlot Examples of Drawing


F1[t_]:=(9+.9Cos[12t])(1+.05Cos[36t]);
F2[t_]:=(1+.05Cos[216t])(1+Sin[t])
Show[Table[PolarPlot[i*F1[t]*F2[t],{t,0,2Pi},
PlotStyle->Darker[Green,1-.3i]],{i,0,3,.1}],
ImageSize->500,Frame->True,Axes->False]


3D Tube Transformations 2


TPP2[k_]:=Table[{-k*Cos[t]-k*Cos[4t]+5k*Sin[2t],
-5k*Cos[2t]+k*Sin[t]-k*Sin[4t],5k*Cos[4t]},
{t,0,2Pi+.1,.1}];
PV[p_,a_,w_,v_]:=RotationTransform[a,w,v]/@p;
Graphics3D[Table[{Hue[Cos[i*Pi/6]^2],Opacity[.5],
Tube[PV[TPP2[1],i*Pi/6,{0,0,1},{12,12,12}],
.3]},{i,12}],Boxed->False,ImageSize->600]




Graphics3D Animations


Animate[Graphics3D[{RGBColor["#3030ff"],
Opacity[.05],Sphere[{0,0,0},15],
RGBColor["#3030ff"],Opacity[.9],
Sphere[{0,0,0},5],Hue[i/12],Opacity[.8],
Sphere[{0,13Cos[Pi*i/12],7Sin[Pi*i/12]},1]},
Boxed->False,ImageSize->500],{i,24},
AnimationRate->1,AnimationRunning->False]

3D Graphics Objects


SP3D[p_,s_,c_]:=Graphics3D[{c,Opacity[.9],
Table[Style[Sphere[p[[1,1,i]],s],
Specularity[Darker[Green],i]],
{i,Length[p[[1,1]]]}],Darker[Green],
EdgeForm[None],GeometricTransformation[Cylinder[],
{{#{1,0,-1},{1,0,.1},{1,1,-2}},
{-#.1,0,2.1}}]&/@{-1,1}},
Boxed->False,ImageSize->600];
SP3D[PolyhedronData["DeltoidalHexecontahedron"],
1.1,Darker[Blue]]


HighDimensionalEmbedding Examples


CP3D[g_]:=Graphics3D[Table[{FaceForm[{Hue[1-i/Length[g]],
Opacity[.4]}],EdgeForm[Gray],Cube[g[[i]],.9]},
{i,Length[g]}],Boxed->False,ImageSize->600];
HTCG=Graph3D[GraphData["HundredTwentyCellGraph",
"Edges"],GraphLayout->"HighDimensionalEmbedding"];
CP3D[GraphEmbedding[HTCG]]


Classifiers as Exercises

images=RandomSample[ResourceData["MNIST"],10000];
test=images[[1;;3000]]; train=images[[3001;;10000]];
queries=Keys[ RandomSample[test,5]];
#->Nearest[Keys[train],#,3]&/@queries//TableForm
fe=FeatureExtraction[Keys[images]];
fetrain=fe[Keys[train]]; fetest=fe[Keys[test]];


CLF=Classify[Table[fetrain[[i]]->Values[train][[i]],{i,7000}],
Method->"NeuralNetwork"]
CM=ClassifierMeasurements[CLF,
Table[fetest[[i]]->Values[test][[i]],{i,3000}]];
Transpose[Table[CM/@ {"FScore"}//r,
{r,{Keys,Values}}]]//TableForm
CM/@{"Accuracy", "ConfusionMatrixPlot"}




3D Tube Transformations


TPP[k_]:=Table[{-3k*Cos[t]-k*Cos[4t]+5k*Sin[2t],
-5k*Cos[2t]+3k*Sin[t]-k*Sin[4t],7k*Cos[3t]},
{t,0,2Pi+.3,.3}]
Graphics3D[Table[{Hue[i/20],Opacity[.4],
Tube[TPP[i],1]},{i,20}],
Boxed->False,ImageSize->500]

Combined Plots 3


Show[Table[ParametricPlot[{Sin[t],(.5+.1j)Cos[(1+i)t]},
{t,0,2Pi},ImageSize->500,PlotRange->All,
PlotStyle->ColorData["GreenPinkTones"][.1i]],
{i,10},{j,5}]]


Combined Plots 2


PPE[N_]:=Plot[{Exp[-x^2]Cos[N*Pi*x^2]Sin[N*Pi*x^(-2)],
Exp[-x^2],-Exp[-x^2]},{x,-2,2},ImageSize->400,
ColorFunction->Function[{x,y},Hue[x+y]],
Background->Black,AxesStyle->White,AspectRatio->1];
{PPE[1],PPE[10]}


Combined Plots


PF=Function[{w,w0},
Plot[Cos[w*t]-Cos[w0*t]-2Sin[(w+w0)t/2]Sin[(w-w0)t/2],
{t,0,Pi},PlotStyle->Hue[w0/w]]];
Show[PF[64,62],PF[64,49],PF[64,16],ImageSize->600]

Exercises with Complex Functions 2


BF=Function[p0,Module[{i=1,maxi=30,p=p0},
While[i<maxi && Abs[p]<2,p=p^6+p0;i++ ];i]];
ArrayPlot[Table[BF[x+I y],
{x,-1.2,1.2,.01},{y,-1.2,1.2,.01}],
ColorFunction->"BrightBands",
ImageSize->500,PlotLegends->Automatic]


Exercises with Complex Functions


z[n_]:=Exp[I*Pi*n*Log[n/8]*2^0.5];
L={{0,0}}; n1=100;n2=1500;
Do[L=Append[L,{Re[L[[i,1]]+I*L[[i,2]]+z[i]],
Im[L[[i,1]]+I*L[[i,2]]+z[i]]}],{i,n2}];
LL=Table[{Hue[(i-n1)/n2],
Line[{{k1*L[[i,1]],k2*L[[i,2]]},
{k1*L[[i+1,1]],k2*L[[i+1,2]]}}],
Hue[1-(i-n1)/n2],
Line[{{k1*L[[i,2]],k2*L[[i,1]]},
{k1*L[[i+1,2]],k2*L[[i+1,1]]}}]},
{i,n1,n2},{k1,{-1,1}},{k2,{-1,1}}];
Graphics[LL,ImageSize->500,
Background->RGBColor["slategray"]]