Pensieve header: October 20: Some Hochschild Homology.

Today. Trees from triangulations, then some Hochschild homology, then whatever you may suggest, then EIWL 9-12, then, if time, Patterns.

Topics (in no particular order). Whatever you may suggest; whatever comes to my mind; the Fibonacci numbers; the Catalan 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 Mandelbrot 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; the Towers of Hanoi; Hochschild homology of (some) coalgebras; convolutions and image improvements.

An Image Manipulation Challenge

The image at http://drorbn.net/bbs/show?shot=17-1750-171016-111042.jpg is pathetic. Can you improve it? Whatever you do, should also work well with all other images at http://drorbn.net/bbs/show.php?prefix=17-1750.

img=

img//FullForm

imgd=img // ImageData

Dimensions[imgd]

imgd/2

Image[imgd/2]

?*Convolution*

?*Convolve*

Trees from Triangulations

triang=ds[d[9,11],d[9,12],d[0,12],d[0,9],d[2,7],d[2,6],d[3,5],d[2,5],d[2,8],d[0,8],d[0,2]];

triang /. ds[ls___] -> Graphics[{ls}] /. d[i_,j_]:>Line[{i,j}] /. j_Integer:>{Cos[((2π j)/14)], Sin[((2π j)/14)]}

d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,●]

d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,●]/. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,p[t1,t2]]

d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,●]//. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,p[t1,t2]]

Last[d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,●] //. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,p[t1,t2]]] // TreeForm

Last[d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,] //. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,p[t1,t2]]]

FromLetterNumber[13]

Last[d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,FromLetterNumber[j+1]] //. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,p[t1,t2]]] // TreeForm

Last[d[0,13](Times@@triang)(∏_(j=0)^12)e[j,j+1,FromLetterNumber[j+1]] //. e[i_,j_,t1_]e[j_,k_,t2_]d[i_,k_] :> e[i,k,StringJoin["(",t1,t2,")"]]]

Some Hochschild Homology

g[x_,y_] := f[y]-f[x+y]+f[x];
1(g[y,z]-g[x+y,z]+g[x,y+z]-g[x,y])

Clear[g]

Clear[d]

(Subscript[d, n_,k_])[ℰ_] := ℰ /. {(Subscript[x, i_])/;i<k:>(Subscript[x, i]), (Subscript[x, i_])/;i==k:>(Subscript[x, k])+(Subscript[x, k+1]), (Subscript[x, i_])/;i>k:>(Subscript[x, i+1])}

(Subscript[d, 2,1])[g[(Subscript[x, 1]),(Subscript[x, 2])]]

(Subscript[d, 2,2])[g[(Subscript[x, 1]),(Subscript[x, 2])]]

(Subscript[d, 2,0])[g[(Subscript[x, 1]),(Subscript[x, 2])]]

(Subscript[d, 2,3])[g[(Subscript[x, 1]),(Subscript[x, 2])]]

(Subscript[d, n_])[ℰ_] := Expand@Sum[(((-1))^k)(Subscript[d, n,k])[ℰ], {k,0,n+1}]

(Subscript[d, 2])[g[(Subscript[x, 1]),(Subscript[x, 2])]]

g[(Subscript[x, 1]),(Subscript[x, 2])] // (Subscript[d, 2]) // (Subscript[d, 3])

g[(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])] // (Subscript[d, 3]) // (Subscript[d, 4])

List@@Expand[((((Subscript[x, 1])+(Subscript[x, 2])+(Subscript[x, 3])))^2)]

With[{n=3,d=4},List@@Expand[(((Sum[(Subscript[x, i]),{i,1,n}]))^d)]]

(Subscript[C, 0,d_]):=If[d==0,{1}, {}];
(Subscript[C, n_,d_]):=Union@@Table[(Subscript[x, n]^k)(Subscript[C, n-1,d-k]), {k,0,d}];

(Subscript[C, 1,2])

(Subscript[C, 3,4])

(Subscript[d, 3])/@(Subscript[C, 3,4])

(Subscript[d, 4])/@ (Subscript[d, 3])/@(Subscript[C, 3,4])

?Coefficient

Coefficient[(((x+y))^3),x (y^2)]

(Subscript[M, n_,p_]):=Table[Coefficient[(Subscript[d, n])[a],b],{b,(Subscript[C, n+1,p])},{a,(Subscript[C, n,p])}]

(Subscript[C, 2,3])

(Subscript[d, 2])/@(Subscript[C, 2,3])

(Subscript[C, 3,3])

Coefficient[(Subscript[d, 2])[(Subscript[x, 1]) (Subscript[x, 2]^2)], (Subscript[x, 1]) (Subscript[x, 2]) (Subscript[x, 3])]

(Subscript[d, 2])[(Subscript[x, 1]) (Subscript[x, 2]^2)]

(Subscript[M, 2,3])

(Subscript[M, 3,3]).(Subscript[M, 2,3])

(Subscript[β, n_,p_]):=Length[NullSpace[(Subscript[M, n,p])]]-MatrixRank[(Subscript[M, n-1,p])]

(Subscript[β, 3,3])

Table[(Subscript[β, n,p]),{n,1,5},{p,1,5}] // MatrixForm