Wednesday, December 25, 2019

Explorations of Tensors


A=ArrayReshape[Array[#1^2 &,8],{2,2,2}];
B=ArrayReshape[{"\[WhiteKing]","\[WhiteQueen]",

"\[WhiteRook]","\[WhiteBishop]"},{2,2}];
{MatrixForm[A],MatrixForm[B]}
{MatrixForm[Dot[A,B]],

MatrixForm[Dot[B,A]],MatrixForm[A*B]}

Graph Styling 3


CET=Function[{g,s},
Flatten[Table[Table[i<->j->ColorData[s]
[i/Length[GraphData[g,"Vertices"]]],
{j,AdjacencyList[GraphData[g],i]}],
{i,GraphData[g,"Vertices"]}]]];
CGP= Function[{g,s},GraphPlot[GraphData[g],
ImageSize->400,VertexLabels->Placed[Automatic,{.5,.4}],
VertexSize->.6,EdgeStyle->CET[g,s],
EdgeShapeFunction->GraphElementData[{"CarvedArcArrow",
"ArrowSize"->.03,Opacity->.8}],
VertexStyle->{RGBColor["Silver"],Opacity[0.5]},
VertexShapeFunction->"ConcaveHexagon"]];
{CGP["GoldbergSnark5","DarkRainbow"],
CGP["WatkinsSnark","Rainbow"]}


Explorations of Color Schemes 2D


L1=Table[{j*Sin[Pi*i/100]+Sin[Pi*i/50],
-j*(1+Cos[Pi*i/100]+Cos[Pi*i/50])},
{j,20 },{i,Range[-100,101,4]}];
L2=Table[{50+j*Sin[Pi*i/100]+Sin[Pi*i/50],
-j*(1+Cos[Pi*i/100]+Cos[Pi*i/50])},
{i,Range[-100,101,4]},{j ,20}];
Show[
ListLinePlot[L1,PlotStyle->"AvocadoColors"],
ListLinePlot[L2,PlotStyle->"FruitPunchColors"],
ImageSize->{800,500},Axes->False,
PlotRange->All,Frame->True]

Interactive 3D Coordinates


Manipulate[Show[Graphics3D[{Hue[(x+y+z)/9],
EdgeForm[Gray],Opacity[.5],Dodecahedron[{x,y,z},1],
Black,Opacity[1],Style[Text[{x,y,z},{x,y,z}],Italic,11]}],
PlotRange->{{-5,5},{-5,5},{-5,5}},Axes->True,
AxesStyle->LightGray,BoxStyle->LightGray,ImageSize->500],
{x,Range[-3,3,1]},{y,Range[-3,3,1]},{z,Range[-3,3,1]}]


Explorations of Color Schemes


SphericalPlot3D[Sin[12\[Theta]]*Tan[\[Phi]/5]+Cos[21\[Phi]],
{\[Theta],0,2 Pi},{\[Phi],0,2 Pi},PlotRange->{{-4,4},{-4,4},{-4,4}},
PlotPoints->30,ImageSize->600,Mesh->False,
Boxed->False,Axes->False,Exclusions->{Cos[\[Phi]]==0},
ColorFunction->Function[{x,y,z,\[Theta],\[Phi],r},
ColorData["BrightBands"][.7-r]]]


HTML Exercises


EmbeddedHTML[" <style>
@import url('https://fonts.googleapis.com/css?family=Ewert');
polygon {fill:#eeeeee; stroke:#3636ff; stroke-width:3; fill-rule:evenodd;};
</style>
<script>
function myFunction() {document.getElementById('demo').innerHTML='Hello, World!';}
</script>
<svg style='background-color:aliceblue;' height='210' width='200'>
<polygon onclick='myFunction();' points='100,10 40,198 190,78 10,78 160,198'/>
<p style='color:#3636ff; font-family:Ewert; font-size:150%;' id='demo'></p></svg>",
ImageSize->{300,300}]



Derivatives


FL={{{x*Cos[u]*z^2-y,x^3*u*v^6-Sin[w*t]},
{t*Tan[u*w],Exp[y]*z*u-w}},
{{y^3*v^5-t,x*Log[w]*z^4},
{x-Exp[z]*w^7,y*t^8*u*v}}}; FL//MatrixForm
Multicolumn[Table[MatrixForm[D[FL,var]]->var,
{var,{x,y,z,u,v,w}}],1]


Graph Styling 2


CET=Flatten[Table[Table[i<->j->ColorData["BrightBands"]
[i/Length[GraphData["SzekeresSnark","Vertices"]]],
{j,AdjacencyList[GraphData["SzekeresSnark"],i]}],
{i,GraphData["SzekeresSnark","Vertices"]}]];
GraphPlot[GraphData["SzekeresSnark"],ImageSize->Large,
EdgeStyle->CET,EdgeShapeFunction->"CarvedArcArrow",
VertexStyle->{RGBColor["Silver"],Opacity[0.7]},
VertexShapeFunction->"ConcaveHexagon",
VertexLabels->Placed[Automatic,{.5,.5}],VertexSize->.5]


Curves as Art Objects


m=15; n=18; k=600;
Graphics[Table[{ColorData["Rainbow"][i/k],
Text["\[WhiteBishop]",{n Cos[2i*Pi/k]+m Cos[n*i*Pi/k],
n Sin[2i*Pi/k]-m Sin[n*i*Pi/k]}]},{ i,k}],
ImageSize->k]


Areas as Creativity Reflections 2


ColTab=Table[RGBColor[col],{col,
{"#FD5B78","#3366FF","#EE34D2","#50BFE6","#FF6037","#66FF66",
"#FFFF66","#FF6EFF","#FFCC33","#AAF0D1","#FF00CC","#CCFF00"}}]
GPP[t_]:=Graphics3D[{Opacity[.7],EdgeForm[None],
Polygon[Table[{(13-t/2) Cos[2Pi k/(13-t)],
(13-t/2) Sin[2 Pi k/(13-t)],3t},{k,13-t}],
VertexColors->Table[ColTab[[k]],{k,13-t}]]}];
Show[Table[GPP[i],{i,Range[1,10,3]}],Boxed->False,ImageSize->500]


Areas as Creativity Reflections


L1=Prepend[Append[Table[{.5+.005*i,1.1+Sin[.03*i]},
{i,200}],{2,0}],{0,0}];
L2={{0,0},{.5,2.3},{1.5,2.3},{2,0},{0,0}};
Show[Graphics[{Texture[ExampleData[{"ColorTexture","MultiSpiralsPattern"}]],
Polygon[L2,VertexTextureCoordinates ->L2],
Style[Line[L2],RGBColor["silver"],Thickness[.015]],Style[Polygon[L1],
RGBColor["#3636ff"]],Style[Line[L1],RGBColor["silver"],
Thickness[.015]]}],PlotPoints->100,ImageSize->400]


Surfaces as Creativity Reflections 2


Table[SphericalPlot3D[Log[2-Sin[T*\[Theta]]]\[Phi],{\[Theta],0,2Pi},{\[Phi],0,2 Pi},
Boxed->False,Axes->False,PlotRange->All,PlotPoints->30,
NormalsFunction->None,PlotStyle->Opacity[.9],Mesh -> None,
ImageSize->500,ColorFunction ->Function[{x,y,z,\[Theta],\[Phi],r},
ColorData["CoffeeTones"][RandomReal[{0,1}]]]],{T,{1,11}}]


Surfaces as Creativity Reflections


FSP[\[Theta]_,\[Phi]_]:=Log[1+\[Theta]]Sin[5\[Phi]]-Cos[2\[Theta]]Floor[2\[Phi]];
SphericalPlot3D[FSP[\[Theta],\[Phi]],{\[Theta],0,2Pi},{\[Phi],0,2Pi},
ImageSize->500,PlotRange->All,PlotPoints->15,Mesh->False,Boxed->False,
Axes->False,PlotStyle->Opacity[0.8],ExclusionsStyle->{None,Gray},
ColorFunction->Function[{x,y,z,\[Theta],\[Phi],r},ColorData["BrightBands"][.8-r]]]


External Files


DC=Import["https://olgabelitskaya.github.io/huge_cities.tsv",
"Dataset", "HeaderLines" -> 1]; DC[1;;5]
PM=Normal[DC[[All,2]]];PC=Values/@Normal[DC[[All,{9,8}]]];
PS=Rescale[Normal[DC[[All,6]]],{2,4}];
TP=Table[Graphics[{ColorData["CandyColors"][i/20],
PointSize[PS[[i]]/2000],Opacity[0.5],Point[PC[[i]]],
Opacity[1],Blue,Style[Text[PM[[i]],PC[[i]]],12]}],{i,20}];
Show[TP,ImageSize->{800,500},AspectRatio->1/2,Axes->False,
GridLines->Automatic,Frame->True,PlotStyle->"CandyColors",
PlotRange->{{-160,160},{-60,60}},AspectRatio->8/5]


Spherical Coordinates as Art Objects


SphericalPlot3D[\[Phi]/3+3Cos[3\[Theta]],{\[Theta],0,2Pi},{\[Phi],0,2Pi},
PlotPoints->20,ImageSize->500,Mesh->False,Boxed->False,
Axes->False,PlotStyle->Opacity[.2],
ColorFunction->Function[{x,y,z},
ColorData["DeepSeaColors"][Cos[x]-Sin[z]]]]


Graph Styling


EL={"\[WhiteKing]"<->"\[WhiteQueen]","\[WhiteKing]"<->"\[WhiteRook]",
"\[WhiteKing]"<->"\[WhiteBishop]","\[WhiteKing]"<->"\[WhiteKnight]",
"\[WhiteQueen]"<->"\[WhiteKnight]","\[WhiteRook]"<->"\[WhiteKnight]",

"\[WhiteRook]"<->"\[BlackKing]","\[WhiteRook]"<->"\[BlackQueen]",
"\[WhiteBishop]"<->"\[WhiteRook]","\[WhiteBishop]"<->"\[BlackKing]",

"\[WhiteKnight]"<->"\[BlackQueen]","\[BlackKing]"<->"\[BlackQueen]",
"\[BlackQueen]"<->"\[BlackRook]","\[BlackQueen]"<->"\[BlackBishop]",

"\[BlackRook]"<->"\[BlackBishop]","\[BlackRook]"<->"\[BlackKnight]"};
EP={"PlanarEmbedding","StarEmbedding",
"LayeredDigraphEmbedding",Automatic};     
EGP[e_]:=GraphPlot[Graph[EL],GraphLayout->e,
VertexLabels->Placed[Automatic,{.5,.5}],
VertexSize->.6,EdgeStyle->RGBColor["#3636ff"],
VertexStyle->{RGBColor["Silver"],Opacity[0.7]},
VertexShapeFunction->"ConcavePentagon",
EdgeShapeFunction->"CarvedArrow",ImageSize->500];
EGP[EP[[1]]]


DictionaryLookup Examples


W=Flatten[Map[(Thread[# ->DeleteCases[Nearest[DictionaryLookup["shall*"],
#,6],#]])&,DictionaryLookup["shall*"]]];
GraphPlot[W,VertexShapeFunction->({Text[Style[#2,20,Italic,
Hue[3-#1],Opacity[1]],#1,Background->White]}&),
EdgeShapeFunction->"CarvedArcArrow",EdgeStyle->Opacity[.2],
GraphLayout->"RadialEmbedding",ImageSize->500]


Graphics as Art Objects


Graphics[Table[{ColorData["BrightBands"][k/108],
Arrowheads[{.005,.005,.02,.025,.03,.035}],
Arrow[BezierCurve[{{0,0},
{Cos[k*Pi/48],Sin[k*Pi/48]},
{Sin[k*Pi/32],Cos[k*Pi/32]},
{Cos[k*Pi/24],Sin[k*Pi/24]}}]]},
{k,108}],ImageSize->500]


Region Plots & Inequalities


RegionPlot[Sin[x^2]Sin[y^2]Sin[x*y]>=.001,
{x,-4,4},{y,-4,4},PlotPoints->100,
BoundaryStyle->{Brown,Dashed},ImageSize->500,
PlotStyle->Texture[ExampleData[{"ColorTexture",
ExampleData["ColorTexture"][[6,2]]}]]]