Tuesday, December 31, 2019

AnglePath 3D Layers


CT[col_,s_]:=Module[{r,t,n},
r=RandomReal[10,90];
t=AnglePath[Flatten[Table[r*Pi+.1^3,
{i,100}]]];n=Length[t];
t=Table[Flatten[{t[[i]],.1^3i}],{i,n}];
l=Table[{ColorData[col][Cos[i]^2],
Line[{t[[i]],t[[i+1]]}]},{i,n-1}];
Graphics3D[l,Boxed->False,ImageSize->s]];
CT["AuroraColors",500]

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}]]



Saturday, December 28, 2019

Dimensionality Reduction as Exercises 2


digits= ExampleData[{"MachineLearning","MNIST"},
"Data"]; sample=RandomSample[digits,3000];
Delete[digits]; sample[[1;;7]]
features=DimensionReduce[sample[[All,1]],
2,Method->"AutoEncoder"];
ListPlot[MapThread[Style[Labeled[#1,#2],
Hue[.1Values[#2]]]&,{features[[1;;320]],
sample[[1;;320]]}],ImageSize->600]


Regression as Exercises


train=ExampleData[{"MachineLearning",
"BostonHomes"},"TrainingData"];
test=ExampleData[{"MachineLearning",
"BostonHomes"}, "TestData"];
MLP=NetChain[{LinearLayer[13*4],
BatchNormalizationLayer[],ElementwiseLayer[Ramp],
LinearLayer[512],BatchNormalizationLayer[],
ElementwiseLayer[Ramp],LinearLayer[1]},
"Input"->13,"Output"->"Scalar" ]
results=NetTrain[MLP,train,All,
ValidationSet->test,MaxTrainingRounds->500]
{TrainedMLP,ValLosses}=results[{"TrainedNet",
"ValidationLossList"}]; Min[ValLosses]


Predictions= Predict[train,
Method->"GradientBoostedTrees",PerformanceGoal->"Quality"]
testpreds=Predictions[test[[All,1]]];
ListLinePlot[{test[[All,2]],testpreds},ImageSize->600,
PlotLegends->{"Real Data","Predictions"},
PlotLabel->{"Mean Square"->PredictorMeasurements[Predictions,
test,"MeanSquare"]}]

Dimensionality Reduction as Exercises


digits= ExampleData[{"MachineLearning","MNIST"},
"Data"];sample=RandomSample[digits,2000];
Delete[digits];sample[[1;;7]]
features=DimensionReduce[sample[[All,1]],2,
Method->"TSNE",PerformanceGoal->"Quality"];
bydigits=GroupBy[Thread[features->sample[[All,2]]],
Last->First];
ListPlot[Values[bydigits],PlotLegends->Keys[bydigits],
ImageSize->600,AspectRatio->1,Frame->True]


Graphics3D Exercises


TK[k_]:={{k,-k,k},{0,0,0},{k,k,k},
{-k,k,k},{-k,-k,k},{k,-k,k},
{k,k,k},{k,k,-k},{-k,k,-k},
{-k,-k,-k},{k,-k,-k},{k,k,-k},
{0,0,0},{k,-k,-k},{k,-k,k}};
Graphics3D[Table[{FaceForm[{ColorData["BrightBands"][.07i],
Opacity[.6]}],Tube[TK[1][[i;;i+1]],.1],
Opacity[1],Sphere[TK[1][[i]],.15]},{i,14}],
Boxed->False,Background->Black,
ViewPoint->{3,-1,0},ImageSize->500]


Examples of Shadow Effects


PPK[a_,b_,c_]:=Module[{ppt,pps},
ppt=Table[{c*Sin[a*t]^2,b*Cos[b*t]^3,
a*Sin[c*t]*Log[t+1]},{t,0,6Pi,.05}];
pps=GeometricTransformation[Tube[ppt,.1],
RotationTransform[Pi,{0, 0, 1}]];
Show[Graphics3D[{FaceForm[{Darker[Gray],Opacity[.3]}],pps}],
Graphics3D[{FaceForm[{Blue,Opacity[.9]}],Tube[ppt,.1]}],
Boxed->False,Background->RGBColor["silver"],
AspectRatio->1,ImageSize->500]];
PPK[4,3,2]


PPTS:=Function[{a,b,c},
img=Graphics3D[{RGBColor["#3636ff"],
Tube[Table[{c*Sin[a*t]^2,b*Cos[b*t]^3,
a*Sin[c*t]*Log[t+1]},{t,0,6Pi,.03}],.1]},
Boxed->False,AspectRatio->1,PlotRange->All,
ImageSize->{600,500},Background->RGBColor["silver"]];
ImageCompose[Lighter@Blur[img,10],SetAlphaChannel[img,
ColorNegate[img]],Scaled[{.38,.52}]]]
PPTS[4,3,2]


RotationMatrix Applying


RGS[n_,m_]:=Module[{rt,rm},
rt=RandomReal[{-1,1},{n,2}];rm=RotationMatrix[Pi/m];
Graphics[{Opacity[.4],Style[Polygon[rt.MatrixPower[rm,#]],
ColorData["BrightBands"][1-#/(2m)]]&/@Range[2m]},
Background->RGBColor["silver"],ImageSize->600]];
  RGS[128,6]


Parameter Influence


FP1[x_,k_]:=(.12k*x)^2-12x^2+((.12k)^2-3^1.5*.12k+6)*x;
FP2[k_]:=(.12k)^2-3^0.5*(.12k)-6;
Show[Table[Plot[FP1[x,k]+FP2[k],{x,-2,2},PlotStyle->Hue[k/32],
PlotLegends->Hue[k/32]->.12k],{k,Range[0,31,1]}],
PlotRange->{{-2,2},{-8,2}},Frame->True,GridLines->Automatic,
ImageSize->500,AspectRatio->1,Background->Lighter[Gray,.8]]