Pensieve header: The package “Perm”.

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; some Peano curves; 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; the 8-5-3 milk jug problem; a cow problem, a permutations package.

gcd[0,n_] := n;
gcd[n_,m_] /; m<n := gcd[m,n];
gcd[n_,m_] /; m≥n := gcd[n,m-n];

gcd[42,54]

?GCD

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.

The 8-5-3 Milk Jug Problem

Challenge. Draw the state graph of this problem (no spilling allowed!).

NCGE Challenge

Update the NCGE program to contain “backtracking information”. Use it to find how to turn the lower face of a Rubik’s cube by turning all but the lower face of that cube.

The Mathematica Package “Perm”

Challenge. Re-implement permutations, though using the standard “list of images” notation for permutations: Perm[5,2,3,1,4], etc. Your package should know σ∘τ, (σ^(-1)), σ[[i]], Pivot[σ], IdentityPermutation[n], it should interact well with Cycles, and its internals should be hidden.

σ_Perm ∘ τ_Perm /; Length[σ]==Length[τ] := Perm@@Table[σ[[τ[[i]]]], {i,Length[σ]}];

Perm[1,3,4,2]∘Perm[2,3,1,4]

{a,b,c}[[2]]

{a,b,c}[[{3,2}]]

σ_Perm ∘ τ_Perm /; Length[σ]==Length[τ] :=σ[[List@@τ]];

??SmallCircle

Perm[1,3,4,2]∘Perm[2,3,1,4]

?Position

σ=Perm[3,4,1,2]

Position[σ, 1]

Expand[(((a+b))^2)]

Position[Expand[(((a+b))^2)], b]

(((σ_Perm))^(-1)) := Table[Position[σ,i][[1,1]], {i,Length[σ]}]

Perm /:(((σ_Perm))^(-1)) /; PermutationQ[σ]:= Perm@@Table[Position[σ,i][[1,1]], {i,Length[σ]}]

Can you make this more efficient?

Perm /:(((σ_Perm))^(-1)) /; PermutationQ[σ]:= (
τ=σ;
Do[τ[[σ[[i]]]]=i, {i,Length[σ]}];
τ
)

((Perm[2,3,1])^(-1))

σ

((Perm[2,3,1])^(-1))

(σ^(-1))

PermutationQ[σ_Perm] := Sort[List@@σ]===Range[Length[σ]]

PermutationQ[Perm[2,3,1]]

PermutationQ[Perm[1,2,2]]

?Context

Context[]

cow=7

Context[cow]

Context[Plus]

?Contexts

Contexts[] // Short

?$ContextPath

$ContextPath

?$Context

$Context

$Context="Horse`"

cow

sheep=8

Context[sheep]

Context[cow]

?BeginPackage

Perm::usage = "Perm[5,2,3,1,4] means the permutation that maps 1->5, 2->2, 3->3, 4->1, 5->4."

?Perm

?Begin

?End

?EndPackage