Wednesday, December 11, 2019

Polygon Plotting with Random Coefficients 3


Polygon Plotting with Random Coefficients 2


Polygon Plotting with Random Coefficients


Plotting with Random Coefficients


A Fun App with Several Code Lines 2


A Fun App with Several Code Lines


Rotations of Graph Plots 2


Rotations of Graph Plots


Transformations of Polar Plots


PPRT[n_,col_,l_,s_]:=Module[{a,b,c,d,u},
u=Pi/n; a=RandomInteger[{4,12}]; b=RandomInteger[{12,18}];
c=RandomInteger[{25,81}]; d=RandomInteger[{216,256}];
PF1[i_,t_]:=(a+.9Cos[b*t+u*i])(1+.1Cos[c*t+u*i]);
PF2[i_,t_]:=(1+.05Cos[d*t+u*i])(1+Sin[t+u*i]);
Show[Table[PolarPlot[PF1[i,t]*PF2[i,t],{t,-Pi,Pi},
PlotStyle->{Thickness[l],ColorData[col][.1Mod[i,Floor[n/2]]]}],
{i,2n+1}],Axes->False,ImageSize->s,PlotPoints->50]]
{PPRT[16,"BrightBands",.01,300],PPRT[4,"Rainbow",.001,300]}


PPRT[8,"CherryTones",0,600]

RotationTransform - Pattern Array Examples


AGRTP[m_,k_,s_,col_]:=Module[{ag},
ag=AdjacencyGraph[ExampleData[
{"Matrix",ExampleData["Matrix"][[m,2]]},"Matrix"]["PatternArray"],
DirectedEdges->False,VertexSize->0];
CS[i_]:=ColorData[col][6Mod[i,Round[k/6]]/k];
RTAG[i_]:=RotationTransform[
2i*Pi/k,{0,0}]/@ResourceFunction["VertexCoordinateList"][ag]//N;
Show[Table[GraphPlot[ag,
VertexCoordinates->RTAG[i],EdgeStyle->CS[i]],{i,k}],ImageSize->s]]
{AGRTP[277,30,300,"CherryTones"],
AGRTP[420,24,300,"CoffeeTones"]}

AGRTP[269,24,600,"CandyColors"]

RotationTransform - 3D Graph Examples


RTPT[poly_,n_,d_,p_,s_]:=Graphics3D[
Table[Tube[RotationTransform[i*Pi/n,{0,0,1},
p]/@PolyhedronData[poly,"Edges","Coordinates"],d],{i,2n}],
Boxed->False,ViewPoint->Top,
Background->Black,ImageSize->s];
{RTPT["EscherSolid",8,.02,{1.2,1.2,1.2},300],
RTPT["Dodecahedron",8,.07,{1,1,1},300]}


RTPT["GyroelongatedPentagonalBirotunda",
4,.02,{1.3,1.3,1.3},600]


RotationTransform - Graph Examples


LFG[g_,n_,s_]:=Module[{edges,vertices,rtv},
edges=GraphData[g,"Edges"];
vertices=GraphData[g,"VertexCoordinates"];
rtv=Table[RotationTransform[j*Pi/n,{1.3,1.3}]/@vertices,{j,2n}];
lt[j_]:=Table[{rtv[[j]][[edges[[i,1]]]],
rtv[[j]][[edges[[i,2]]]]},{i,Length[edges]}];
Graphics[Table[Line[lt[j]],{j,2n}],ImageSize->s]]
{LFG["HundredTwentyCellGraph",3,300],
LFG["DoubleStarSnark",9,300]}

LFG["SixHundredCellGraph",4,900]


Relief Plotting for Complex Functions

RPC1[m_,n_,s_,col_]:=With[{z=x+I y},ReliefPlot[Table[Cos[m*#]*Sin[#],
{x,##2},{y,##2}]&[If[Abs[z]>1.1 ,0,#]&@Arg[Sum[(z^n+10^(-3)z)^k!,{k,4}]],
-1.11,1.11,.005],ImageSize->s,ColorFunction->col]];
{RPC1[81,8,300,"GrayTones"],RPC1[64,5,300,"CherryTones"]}


RPC2[m_,n_,col_]:=With[{z=x+I y},ReliefPlot[Table[Cos[m*#],
{x,##2},{y,##2}]&[If[Abs[z]>1.15 ,0,#]&@Arg[Sum[(Sin[3z]*z)^k!,{k,4}]],
-1.2,1.2,.005],ImageSize->600,ColorFunction->col]];
RPC2[81,8,"BrassTones"]