Pensieve header: Drawing phase portraits and drawing the Willerton Fish on April 4, 2016.

From http://www.math.toronto.edu/drorbn/classes/16-1750-ShamelessMathematica/About.html: Possible Topics (in no particular order). Whatever you may suggest, and the Fibonacci numbers; the Jones polynomial; a more efficient Jones algorithm; a riddle on spheres; Khovanov homology; Γ-calculus; the Hopf fibration; Hilbert’s 13th problem; non-commutative Gaussian elimination; free Lie algebras; the Baker-Campbell-Hausdorff formula; wacky numbers; an order 4 torus; the Schwarz Lantern; knot colourings; the Temperley-Lieb pairing; the dodecahedral link; sound experiments; barycentric subdivisions; a Peano curve; braid closures and Vogel’s algorithm; the insolubility of the quintic; phase portraits; the Mamdelbrot set; shadows of the Cantor Aerogel; quilt plots; some image transformations; De Bruijn graphs; the Riemann series theorem; finite type invariants and the Willerton fish.

Linear Phase Portraits

VectorPlot[{-y,x},{x,-1,1},{y,-1,1}]

(({{1, 3}, {2, 4}}))\[Transpose]

??ParametricPlot

Set[a,b]

a

Set[Evaluate[a],c]

a

b

??Set

With[{A=(({{-2, 0}, {0, -1}}))}, Evaluate[Table[MatrixExp[t A].(({{Cos[θ]}, {Sin[θ]}})), {θ, π/4, 2π, π/4}]]]

A

PP[A_] := Show[VectorPlot[A.(({{x}, {y}})), {x,-1,1}, {y,-1,1}, Frame -> None],
ParametricPlot[Evaluate[Table[MatrixExp[t A].(({{Cos[θ]}, {Sin[θ]}})), {θ, π/4, 2π, π/4}]],{t,-π,π}, ColorFunction -> (Red&)],
ImageSize->150]

PP/@ {(({{-2, 0}, {0, -1}})), (({{-1, 0}, {0, 0}})), (({{-1, 0}, {0, 1}})), (({{0, 0}, {0, 1}})), (({{1, 0}, {0, 2}}))}

PP/@ {(({{-1, 0}, {0, -1}})), (({{0, 0}, {0, 0}})), (({{1, 0}, {0, 1}}))}

PP/@ {(({{-1, -1}, {1, -1}})),(({{0, -1}, {1, 0}})),(({{1, -1}, {1, 1}})),(({{3, -1}, {1, 3}})),(({{1, -2}, {2, 1}}))}

PP/@ {(({{-1, 1}, {0, -1}})),(({{0, 1}, {0, 0}})),(({{1, 1}, {0, 1}}))}

Quadratic Phase Portraits

RandomQuadratic[] := (a (x^2)+(Sqrt[2])b x y+c (y^2)) /. a|b|c :> RandomVariate[NormalDistribution[]];
RandomQuadratic[n_] := Table[RandomQuadratic[], {n}]

RandomQuadratic[2]

Dynamic[$WorkingOn]

Off[NDSolve::ndsz, InterpolatingFunction::dmval];
quads={};
Rasterize[GraphicsGrid[Table[
quad=RandomQuadratic[2];
AppendTo[quads,$WorkingOn={{i,j}->quad}];
Show[Join[
{VectorPlot[(quad/((Norm[quad])^(3/4))), {x,-1,1}, {y,-1,1}, Frame->None]},
Table[
eqns=Join[
Thread[{x'[t], y'[t]} == (quad /. {x->x[t], y->y[t]})],
{x[0]==RandomReal[{-1,1}], y[0]==RandomReal[{-1,1}]}
];
sol=NDSolve[eqns, {x,y}, {t,-1,1}];
ParametricPlot[
Evaluate[{x[t], y[t]} /. sol],
{t,-1,1},
PlotRange -> {{-1,1},{-1,1}}, ColorFunction -> (Red&)
],
{100}
]
]],
{i,5}, {j, 8}
]], ImageSize -> 960]

The Saddle and the Monkey Saddle

GraphicsRow@@(({{ParametricPlot3D[
{r Cos[t],r Sin[t],3(r^2) Cos[2t]},
{r,0,1},{t,0,2Pi},
PlotRange->{-1,1},Axes->False,
PlotPoints->{10,30},
ViewPoint->0.8{2.4,-1.2,1.5}
], ParametricPlot3D[{
{r Cos[t],r Sin[t],3(r^3) Cos[3t]},
{r Cos[t],r Sin[t],1+r^2}/2,
{r Cos[t],r Sin[t],-1-r^2}/2
},{r,0,1},{t,0,2Pi},
PlotRange->{-1,1},Boxed->False,
Axes->False,
PlotPoints->{10,30},
ViewPoint->0.8{2.4,-1.2,1.5}]}}))//Rasterize

z=Assuming[x>0∧y>0,Re[(((x+I y))^3)//Expand]]

Simplify[Re[(((x+I y))^3)//Expand], x>0∧y>0]

z=(x^3)-3 x (y^2)

quad={-(∂_y)z,(∂_x)z}

Show[Join[
{VectorPlot[(quad/((Norm[quad])^(3/4))), {x,-1,1}, {y,-1,1}, Frame->None]},
Table[
eqns=Join[
Thread[{x'[t], y'[t]} == (quad /. {x->x[t], y->y[t]})],
{x[0]==RandomReal[{-1,1}], y[0]==RandomReal[{-1,1}]}
];
sol=NDSolve[eqns, {x,y}, {t,-1,1}];
ParametricPlot[
Evaluate[{x[t], y[t]} /. sol],
{t,-1,1},
PlotRange -> {{-1,1},{-1,1}}, ColorFunction -> (Red&)
],
{100}
]
]]

The Willerton Fish

Willerton: It is amuzing to plot the values of (Subscript[v, 2]) against the values of (Subscript[v, 3]) on a large sample of knots.

<< KnotTheory`

GD[L_] := GD@@PD[L] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Ap[l,i], Am[j,i]];
Column[GD /@ AllKnots[{3,6}]]

From Polyak-Viro’s “Guass Diagram Formulas for Vassiliev Invariants”, IMRN 11 (1994) 445-453: