Sunday, December 29, 2019

Random Polygons as Layers


PPRT3D[col_,s_]:=Module[{a,b,c,d},
a=RandomInteger[{3,8}];b=RandomInteger[{9,16}];
c=RandomInteger[{3,25}];d=RandomInteger[{5,11}];
PF=Function[{i,t,a,b,c,d},
{Cos[2i*t/d+2i*Pi/c]+Cos[2a*i*t/d+2i*Pi/c]+
Cos[2b*i*t/d+2i*Pi/c],
Sin[2i*t/d+2i*Pi/c]-Sin[2a*i*t/d+2i*Pi/c]+
Sin[2b*i*t/d+2i*Pi/c],
5i/c}];
Show[Table[ParametricPlot3D[PF[i,t,a,b,c,d],
{t,0,a*b*c*d*Pi},PlotStyle->{ColorData[col][i/c],
Thickness[.001]}],{i,c}],PlotPoints->100,
PlotRange->All,Axes->False,Boxed->False,ImageSize->s]]
PPRT3D["Pastel",600]

Linear Programming as Exercises​


Minimize ax+(a+4)y, subject to constraints  bx+y>=3 & x+4y>=c
and implicit non-negative constraints

LPT[a_,b_,c_]:=Table[Max[Table[{LinearProgramming[{a,
a+4},{{b,1}},{3}],LinearProgramming[{a,
a+5},{{1,4}},{c}]}[[i,j]],{i,2}]],{j,2}];
LPTP[a_,b_,c_]:=Module[{x,y},
T=Flatten[{Table[a*x+(a+4)*y==1+.5i,
{i,7}],b*x+y==3,x+4y==c}];
PL=Flatten[{Table[1+.5i,{i,7}],{3,c}}];
ContourPlot[Evaluate[T],{x,-.1,5},{y,-.1,1},
PlotRange->All,Axes->True,Frame->False,
ContourStyle->{Dotted,Dotted,Dotted,Dotted,
Dotted,Thick,Dashed,Thick,Thick},
PlotLegends->PL,Background->RGBColor["silver"],
Epilog->Style[Circle[LPT[a,b,c],.1],
Darker[Magenta,.7]],ImageSize->500]];
LPTP[1,2,4]


Modules with Parametric Functions


PPF[a_,b_,n_,col_,s_]:=Module[{},
X[t_]:=Cos[t]+Cos[a*t]/2+Sin[(a+b)t]/3;
Y[t_]:=Sin[t]+Sin[a*t]/2+Cos[(a+b)t]/3;
Show[Table[ParametricPlot[{X[t],Y[t]},
{t,2(i-1)*Pi/n,2i*Pi/n},
PlotStyle->ColorData[col][i/n]],{i,n}],
ImageSize->s,PlotRange->All,Axes->False]];
{PPF[15,12,12,"BrightBands",400],
PPF[7,16,36,"BrightBands",400]}


ComplexPlot Options


ComplexPlot[2Exp[Log[z^8]+1]/(z^8-1),
{z,-1.5-1.5I,1.5+1.5I},PlotPoints->100,
ColorFunctionScaling->False,
ColorFunction->{Hue[16#8/(8+#7)]&},
Mesh->{Range[-100,100,5],Range[-100,100,5]},
MeshStyle->{RGBColor["#33FF33"],RGBColor["#FF33FF"]},
MeshFunctions->{8Re[#2]&,2Im[#2]&},ImageSize->500]


Polygon Rotations


RP[a_,k_]:=Module[{v},
v={{{k,k,k},{k,k,k-1},{k-1,k,k},
{k,k-1,k}},{{k-1,k-1,k},
{k-1,k-1,k-1},{k-1,k,k},
{k,k-1,k}},{{k,k,-k},{k,k,-k+1},
{k-1,k,-k},{k,k-1,-k}},
{{k-1,k-1,-k},{k-1,k-1,-k+1},
{k-1,k,-k},{k,k-1,-k}}};
RotationTransform[a,{0,1,1}]/@v//N];
CC[t_]:=ColorData["Crayola"][t+10];
RPG[n_,k_,s_]:=Graphics3D[Table[{CC[i],
Opacity[.3],EdgeForm[Gray],
Polyhedron[RP[i*Pi/n,k]]},{i,2n}],
Boxed->False,ImageSize->s,
ViewPoint->{k+1,k+1,k}];
RPG[11,1,600]

AdjacencyGraph & RotationTransform



AG[m_]:=AdjacencyGraph[ExampleData[{"Matrix",
m},"Matrix"]["PatternArray"],DirectedEdges->False];
RTAG[a_,m_]:=RotationTransform[a,{0,
0}]/@ResourceFunction["VertexCoordinateList"][AG[m]]//N;
RAG[m_,k_,s_,col_]:=Show[Table[GraphPlot[AG[m],
VertexStyle->Transparent,VertexShape->"",
EdgeStyle->ColorData[col][Cos[4Pi*i/k]^2],
PlotStyle->Opacity[.8],
VertexCoordinates->RTAG[2i*Pi/k,m]],
{i,k}],ImageSize->s];
RAG["HB/dwt_1005",18,600,"CherryTones"]
{RAG["HB/bcspwr01",36,300,"Pastel"],
RAG["CAN292",12,300,"CandyColors"]}


Plotting Matrices 2


EDMP=ExampleData[{"Matrix","CAN715"},
"Matrix"]["PatternArray"];
AdjacencyGraph[EDMP,ImageSize->500,
Background->RGBColor["slategray"],
AspectRatio->1,EdgeStyle->Green,
VertexStyle->Transparent,VertexShape->""]

Plotting Matrices


EDM=ExampleData[{"Matrix","Boeing/nasa1824"},"Matrix"];
EEDM=GraphPlot[EDM][[1,2,1,2,1]]; L=Length[EEDM]
TEEDM=Table[EEDM[[i,1]]<->EEDM[[i,2]]->Hue[255*i/L],{i,L}];
GraphPlot[EDM,ImageSize->500,EdgeStyle->TEEDM,
VertexStyle->Transparent,VertexShape->""]


Lists of ExampleData Matrices


EDL=ExampleData["Matrix"][[801;;950,2]];
TableForm[Table[EDL[[5*(i-1)+1;;5i]],{i,30}]]