_______________________________________

		 INDEX OF POLYHEDRAL TUTTE POLYNOMIALS

			      Dylan Holmes
		_______________________________________


			      2021/Jan/17


Table of Contents
_________________

1. A brief introduction
2. A less-brief introduction
3. Encoding scheme
4. Table of computed values
.. 1. Tetrahedron
.. 2. Cube & Octahedron
.. 3. Dodecahedron & Icosahedron
5. Appendix: The Tutte polynomial definition
.. 1. Appendix: Code





1 A brief introduction
======================

  TLDR: I have computed the Tutte polynomial for each of the platonic
  solids. I have recorded those polynomials in this index for easy
  reference.


2 A less-brief introduction
===========================

  The Tutte polynomial of a graph is a polynomial T(x,y) that encodes
  many of its counting/combinatorial properties.

  For example, T(k,0) tells you how many different ways you can color
  the vertices of the graph, if you have a palette of k colors and
  neighbors can't match. T(1,1) tells you how many ways there are to
  turn the graph into a tree or forest. T(2,0) tells you how many ways
  there are to turn the undirected graph into a directed acyclic graph
  by choosing directions for each edge.

  For me, one of the most important values is T(-1,-1), which tells you
  how many separate strands you need to braid a celtic knotwork through
  the edges of the graph (see
  <http://logical.ai/polyknot/org/celtic.html>). Specifically, the
  absolute value of T(-1,-1) is equal to 2^{number_of_threads-1}.

  I first experimented with knotwork on polyhedral graphs---graphs made
  by turning the edges of a polynomial into a graph. Surprisingly,
  according to Steinitz's theorem, every polyhedral graph is a
  3-vertex-connected planar graph and (!)  vice-versa. The planarity
  means you can make Celtic knotwork out of them.

  In this document, I present the Tutte polynomials for each of the
  platonic solids by listing out their coefficients.


3 Encoding scheme
=================

  Let me show the encoding scheme by way of example. The polynomial

        T(x,y) = x^3 + 3x^2 + 2x + 2y + 4xy + 3y^2 + y^3

  can be represented with a map that associates each pair of exponents
  with its coefficient. So a single term like 3x^2 is represented by the
  map {[2 0], 3}. The pair of integers represents x^2y^0 and the
  associated value is 3, the coefficient.

  Altogether, this polynomial is represented by the map:

  ,----
  | {[3 0] 1, [2 0] 3, [1 0] 2, [0 1] 2, [1 1] 4, [0 2] 3, [0 3] 1}
  `----


4 Table of computed values
==========================

  Note that the dual shapes cube-octahedron and dodecahedron-icosahedron
  have the same Tutte polynomial except with x and y exchanged. This is
  a general property of Tutte polynomials for dual graphs.


4.1 Tetrahedron
~~~~~~~~~~~~~~~

  ,----
  | {[3 0] 1, [2 0] 3, [1 0] 2, [0 1] 2, [1 1] 4, [0 2] 3, [0 3] 1}
  `----


4.2 Cube & Octahedron
~~~~~~~~~~~~~~~~~~~~~

  CUBE
  ,----
  | {[2 2] 12,
  |  [1 0] 11,
  |  [1 1] 46,
  |  [0 5] 1,
  |  [3 0] 40,
  |  [4 1] 6,
  |  [1 3] 8,
  |  [0 3] 20,
  |  [7 0] 1,
  |  [0 2] 25,
  |  [2 0] 32,
  |  [0 4] 7,
  |  [3 1] 24,
  |  [2 1] 52,
  |  [5 0] 15,
  |  [6 0] 5,
  |  [1 2] 39,
  |  [0 1] 11,
  |  [4 0] 29}
  `----

  OCTAHEDRON
  ,----
  | {[2 2] 12,
  |  [1 0] 11,
  |  [0 6] 5,
  |  [1 1] 46,
  |  [0 5] 15,
  |  [3 0] 20,
  |  [1 4] 6,
  |  [1 3] 24,
  |  [0 3] 40,
  |  [0 7] 1,
  |  [0 2] 32,
  |  [2 0] 25,
  |  [0 4] 29,
  |  [3 1] 8,
  |  [2 1] 39,
  |  [5 0] 1,
  |  [1 2] 52,
  |  [0 1] 11,
  |  [4 0] 7}
  `----


4.3 Dodecahedron & Icosahedron
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  DODECAHEDRON
  ,----
  | {[7 1] 167140,
  |  [11 2] 306,
  |  [4 3] 112365,
  |  [2 2] 218682,
  |  [2 8] 30,
  |  [1 0] 4412,
  |  [8 4] 30,
  |  [2 3] 185071,
  |  [2 5] 27817,
  |  [7 2] 50850,
  |  [18 0] 11,
  |  [15 0] 989,
  |  [7 4] 270,
  |  [8 3] 1350,
  |  [0 6] 10431,
  |  [3 3] 174870,
  |  [5 4] 7175,
  |  [1 1] 38864,
  |  [6 3] 19810,
  |  [0 5] 21540,
  |  [3 4] 57719,
  |  [11 0] 31792,
  |  [17 0] 66,
  |  [7 3] 5870,
  |  [12 2] 30,
  |  [4 2] 275910,
  |  [3 0] 72110,
  |  [9 0] 91740,
  |  [12 1] 2610,
  |  [1 9] 20,
  |  [5 3] 53350,
  |  [9 3] 220,
  |  [13 1] 660,
  |  [6 5] 60,
  |  [13 0] 7216,
  |  [0 9] 170,
  |  [8 0] 132920,
  |  [4 1] 320990,
  |  [5 2] 193791,
  |  [4 6] 140,
  |  [1 4] 82542,
  |  [10 2] 1674,
  |  [12 0] 16016,
  |  [8 2] 19980,
  |  [16 0] 286,
  |  [10 0] 56852,
  |  [1 3] 115448,
  |  [15 1] 12,
  |  [1 5] 38306,
  |  [1 8] 330,
  |  [1 7] 2542,
  |  [6 4] 1620,
  |  [8 1] 96400,
  |  [0 3] 30686,
  |  [5 1] 316256,
  |  [6 1] 250692,
  |  [5 6] 12,
  |  [0 7] 3693,
  |  [10 1] 21530,
  |  [5 5] 468,
  |  [14 1] 120,
  |  [2 7] 610,
  |  [11 1] 8198,
  |  [2 4] 90844,
  |  [3 6] 1240,
  |  [9 2] 6510,
  |  [4 5] 2775,
  |  [9 1] 48710,
  |  [7 0] 170690,
  |  [0 2] 17562,
  |  [2 0] 25714,
  |  [0 4] 31540,
  |  [0 10] 19,
  |  [19 0] 1,
  |  [3 1] 245880,
  |  [2 1] 128918,
  |  [0 11] 1,
  |  [1 6] 12046,
  |  [4 4] 24132,
  |  [3 7] 60,
  |  [2 6] 5390,
  |  [5 0] 176968,
  |  [6 2] 108884,
  |  [6 0] 189934,
  |  [1 2] 95646,
  |  [10 3] 20,
  |  [3 5] 11230,
  |  [0 8] 950,
  |  [3 2] 295915,
  |  [14 0] 2871,
  |  [0 1] 4412,
  |  [4 0] 131380}
  `----

  ICOSAHEDRON
  ,----
  | {[7 1] 2542,
  |  [4 3] 57735,
  |  [2 2] 218682,
  |  [3 9] 220,
  |  [2 8] 19980,
  |  [1 0] 4412,
  |  [2 3] 295915,
  |  [2 5] 193791,
  |  [7 2] 610,
  |  [0 6] 189934,
  |  [3 3] 174870,
  |  [5 4] 2775,
  |  [0 19] 1,
  |  [1 1] 38864,
  |  [6 3] 1240,
  |  [0 5] 176968,
  |  [3 4] 112365,
  |  [11 0] 1,
  |  [1 12] 2610,
  |  [7 3] 60,
  |  [1 15] 12,
  |  [4 2] 90860,
  |  [0 18] 11,
  |  [3 0] 30686,
  |  [9 0] 170,
  |  [1 13] 660,
  |  [1 9] 48710,
  |  [0 13] 7216,
  |  [5 3] 11230,
  |  [0 17] 66,
  |  [4 7] 270,
  |  [0 15] 989,
  |  [0 14] 2871,
  |  [1 10] 21530,
  |  [2 9] 6510,
  |  [6 5] 12,
  |  [0 9] 91740,
  |  [8 0] 950,
  |  [4 1] 82550,
  |  [5 2] 27825,
  |  [4 6] 1620,
  |  [1 4] 320990,
  |  [1 11] 8198,
  |  [8 2] 30,
  |  [10 0] 19,
  |  [1 3] 245880,
  |  [4 8] 30,
  |  [1 5] 316256,
  |  [1 8] 96400,
  |  [1 7] 167140,
  |  [6 4] 140,
  |  [8 1] 330,
  |  [2 12] 30,
  |  [0 3] 72110,
  |  [5 1] 38322,
  |  [6 1] 12046,
  |  [2 11] 306,
  |  [5 6] 60,
  |  [0 7] 170690,
  |  [5 5] 468,
  |  [2 7] 50850,
  |  [2 4] 275910,
  |  [3 6] 19810,
  |  [0 12] 16016,
  |  [4 5] 7175,
  |  [9 1] 20,
  |  [7 0] 3693,
  |  [0 16] 286,
  |  [0 2] 25714,
  |  [2 0] 17562,
  |  [0 4] 131380,
  |  [0 10] 56852,
  |  [3 1] 115448,
  |  [3 10] 20,
  |  [2 1] 95646,
  |  [1 14] 120,
  |  [3 8] 1350,
  |  [0 11] 31792,
  |  [1 6] 250692,
  |  [4 4] 24140,
  |  [3 7] 5870,
  |  [2 10] 1674,
  |  [2 6] 108884,
  |  [5 0] 21548,
  |  [6 2] 5390,
  |  [6 0] 10439,
  |  [1 2] 128918,
  |  [3 5] 53350,
  |  [0 8] 132920,
  |  [3 2] 185071,
  |  [0 1] 4412,
  |  [4 0] 31540}
  `----


5 Appendix: The Tutte polynomial definition
===========================================

  The Tutte polynomial of a[n undirected] graph G is a two-variable
  polynomial T(x,y) that is based on the graph and encodes many of its
  different counting properites. For example, T(1,1) will tell you how
  many different spanning trees you can make out of G. T(2,0) will tell
  you how many different directed acyclic graphs you can make out of G
  by choosing a direction for each edge. T(k,0) will tell you how many
  different ways you can color the vertices of G if you have a palette
  of k colors and neighbors can't match. And there are other examples.


  The Tutte polynomial of a graph can be defined recursively, in terms
  that break the graph into smaller and smaller components. We need a
  special vocabulary of terms to describe how we will break the graph
  into smaller components.

  There are two kinds of move that break the graph into smaller
  components. The first is edge deletion: remove an edge from the graph,
  without changing any vertices. The second is edge contraction: shrink
  the edge to a point so that its two endpoints merge into a single
  vertex and the edge disappears.  We write edge deletion like this:
  G-e, and edge contraction like this: G/e.



  There are also two special kinds of edge that we will want to
  identify. A /loop/ is an edge from one vertex to itself. A /bridge/ is
  an edge that, when deleted, breaks the graph into two disconnected
  islands.

  Armed with this vocabulary, we can define the Tutte polynomial of a
  graph G as follows:

  1. In the base case, G is made up of only bridges and loops and no
     other edges; supposing it has p bridges and q loops, its Tutte
     polynomial is x^p y^q.

  2. In the recursive case, G has at least one edge that isn't a bridge
     or loop. Pick any one such edge---call it e. The Tutte polynomial
     of the graph is the sum of the Tutte polynomials for G-e and G/e.

     In this way, we have reduced the problem to two smaller subproblems
     (with one less edge each).

     Note that although it's not obvious, your polynomial result will be
     the same no matter which edge e you pick for the recursive step.


  There is a second, equivalent, definition of the Tutte polynomial
  which for some situations is easier to think about:

  1. If the graph is empty, its Tutte polynomial is the constant 1.
  2. Otherwise, pick an edge:
     - If the edge is a loop, compute the Tutte polynomial of the
       deletion G-e and multiply it by y.
     - If the edge is a bridge, compute the Tutte polynomial of the
       contraction G/e and multiply it by x.
     - Otherwise, compute the Tutte polynomials of G/e and G-e and add
       them together.


5.1 Appendix: Code
~~~~~~~~~~~~~~~~~~

  I used a bare-bones Clojure script to compute the Tutte polynomials of
  these graphs. I defined my own undirected graph object, and a
  brute-force search procedure for checking whether two graphs are
  isomorphic. Knowing whether graphs are isomorphic allows you to
  memoize (cache and reuse) some of the partial results from the Tutte
  calculation, which saves a significant amount of time especially on
  the icosahedron/dodecahedron.

  ,----
  | (def ugraph {:edges '() :nodes '()})
  | 
  | (defn add-node [graph x]
  |       (assoc graph :nodes
  | 	     (conj (get graph :nodes) x)))
  | 
  | (defn add-edge [graph [x y]]
  |       (assoc graph :edges
  | 	     (conj (get graph :edges) (set [x y]))))
  | 
  | 
  | (defn remove-first [pred coll]
  |       ((fn [[m n]]
  | 	   (concat m (rest n)))
  |        (split-with (comp not pred) coll)))
  | 
  | (defn remove-edge [graph e]
  |       (assoc graph :edges
  | 	     (remove-first (partial = e) (get graph :edges)))
  | 
  | 	     )
  | 
  | (defn graph-substitution [graph m]
  |       (-> graph
  | 	  (assoc :nodes
  | 		 (map #(get m % %) (get graph :nodes)))
  | 
  | 	  (assoc :edges
  | 		 (map (comp set (partial map #(get m % %))) (get graph :edges)))))
  | 
  | 
  | (defn contract-edge [graph edge]
  |       (let [x (first edge)
  | 	    y (second edge)]
  |       (-> graph
  | 	  (assoc :nodes (remove (partial = y) (get graph :nodes)))
  | 	  (remove-edge edge)
  | 	  (graph-substitution {x y}))))
  | 
  | (defn in? [coll x]
  |       (cond (empty? coll) false (= x (first coll)) true :else (recur (rest coll) x)))
  | 
  | (defn degree [graph node]
  |       (count (filter #(in? % node) (:edges graph))))
  | 
  | (defn degrees [graph]
  |       (into {}
  | 	    (for [node (:nodes graph)]
  | 		 [node (filter #(in? % node) (:edges graph))])))
  | 
  | (defn connections [graph node]
  |       (loop [agenda [(list node)]
  | 	     seen #{}]
  | 		  (if-let [path (first agenda)]
  | 			      (let [head (first path)]
  | 
  | 				   (if-not (seen head)
  | 					   (recur (concat (rest agenda)
  | 							  (for [next (->> (get graph :edges)
  | 									  (filter #(% head))
  | 									  (map (comp first #(disj % head))) ;; neighbor vertex
  | 									  (remove nil?) ;; no self-loops
  | 									  (remove (partial in? path)) ;; no loops
  | 									  )]
  | 							       (cons next path)))
  | 						  (conj seen head))
  | 					   (recur (rest agenda) seen)))
  | 
  | 			      seen
  | 					   )))
  | 
  | (defn connected-components [graph]
  |       (distinct (map (comp set (partial connections graph)) (get graph :nodes))))
  | 
  | (defn self-loop? [graph edge]
  |       (and (= 1 (count edge))
  | 	   (in? (get graph :edges) edge)))
  | 
  | (defn connected? [graph]
  |       (= 1 (count (connected-components graph))))
  | 
  | (defn bridge? [graph edge]
  |       (< (count (connected-components graph))
  | 	 (count (connected-components (remove-edge graph edge)))))
  | (def graph-1
  |   (-> ugraph
  |       (add-node :a)
  |       (add-node :b)
  |       (add-node :c)
  |       (add-node :d)
  | 
  |       (add-edge [:a :b])
  |       (add-edge [:b :c])
  |       (add-edge [:c :a])
  | 
  |       (add-edge [:a :d])
  |       (add-edge [:b :d])
  |       (add-edge [:c :d])
  | 
  |       ))
  | 
  | (def graph-2
  |   (-> ugraph
  |       (add-node :a)
  |       (add-node :b)
  |       (add-node :c)
  |       (add-node :d)
  | 
  |       (add-edge [:a :b])
  |       (add-edge [:b :c])
  |       (add-edge [:c :d])
  |       (add-edge [:d :a])
  | 
  |       (add-edge [:b :d])))
  | 
  | (def graph-cube
  |   (reduce add-edge
  | 	  (reduce add-node ugraph [:a :b :c :d :e :f :g :h])
  | 	  (list [:a :b]
  | 		[:b :c]
  | 		[:c :d]
  | 		[:d :a]
  | 
  | 		[:e :f]
  | 		[:f :g]
  | 		[:g :h]
  | 		[:h :e]
  | 
  | 		[:a :e]
  | 		[:b :f]
  | 		[:c :g]
  | 		[:d :h])))
  | 
  | 
  | (def graph-tetra
  |   (reduce add-edge
  | 	  (reduce add-node ugraph [:a :b :c :d])
  | 	  (list [:a :b]
  | 		[:b :c]
  | 		[:c :a]
  | 		[:d :a]
  | 		[:d :b]
  | 		[:d :c])))
  | 
  | (def graph-icosa
  |     (reduce
  |       add-edge
  |       (reduce add-node ugraph [:a :b :c :d :e :f :g :h :i :j :k :l])
  |       (list
  | 	  [:a :b]
  | 	  [:b :c]
  | 	  [:c :a] ;; outer triangle
  | 
  | 	  [:a :d]  ;; outer to middle, one spoke
  | 	  [:b :f]
  | 	  [:c :h]
  | 
  | 	  [:e :a] ;; outer to middle, two spokes
  | 	  [:e :b]
  | 	  [:g :b]
  | 	  [:g :c]
  | 	  [:i :a]
  | 	  [:i :c]
  | 
  | 	  [:d :e] ;; middle perimeter
  | 	  [:e :f]
  | 	  [:f :g]
  | 	  [:g :h]
  | 	  [:h :i]
  | 	  [:i :d]
  | 
  | 	  [:d :j]  ;; middle to inner, two spokes
  | 	  [:d :k]
  | 	  [:f :k]
  | 	  [:f :l]
  | 	  [:h :l]
  | 	  [:h :j]
  | 
  | 	  [:i :j] ;; middle to inner, one spoke
  | 	  [:e :k]
  | 	  [:g :l]
  | 
  | 	  [:j :k]
  | 	  [:k :l]
  | 	  [:l :j])))
  | 
  | 
  | (defn ** [base expt]
  |       (reduce * 1 (repeat expt base) ))
  | 
  | (defn check-bindings? [graph-1 graph-2 bindings]
  |       (let [names (map (fn [x] (keyword (gensym))) (range))
  | 	    names (remove (into (set (:nodes graph-1) ) (:nodes graph-2)) names)
  | 
  | 	    bind-1 (zipmap (keys bindings) names)
  | 	    bind-2 (zipmap (vals bindings) names)
  | 
  | 	    names (set (vals bind-1))
  | 
  | 	    graph-1 (graph-substitution graph-1 bind-1)
  | 	    graph-2 (graph-substitution graph-2 bind-2)
  |       ]
  | 
  | 
  | 	   (every? true?
  | 	    (for [[node-1 node-2] bindings]
  | 		(let [n (get bind-1 node-1)
  | 		      edges-1 (filter #(in? % n) (:edges graph-1))
  | 		      edges-2 (filter #(in? % n) (:edges graph-2))
  | 
  | 		      edges-1 (filter (partial every? names) edges-1)
  | 		      edges-2 (filter (partial every? names) edges-2)]
  | 
  | 
  | 		     (= (sort (map (comp vec sort) edges-1))
  | 			(sort (map (comp vec sort) edges-2)))
  | 		)))
  | ))
  | 
  | (defn isomorphism
  |   [graph-1 graph-2]
  |       (when-not (or (not= (count (:nodes graph-1)) (count (:nodes graph-2)))
  | 		    (not= (count (:edges graph-1)) (count (:edges graph-2)))
  | 		    (not= (sort (map count (vals (degrees graph-1))))
  | 			  (sort (map count (vals (degrees graph-2))))))
  | 
  | 		(loop [agenda [{}]]
  | 		      (when-let [bindings (first agenda)]
  | 				(if-let [n (first (remove (set (keys bindings)) (:nodes graph-1)))]
  | 					(let [candidates
  | 					      (->> (:nodes graph-2)
  | 						   (remove (set (vals bindings))) ;; assignments must be unique
  | 						   (filter #(= (degree graph-1 n) (degree graph-2 %)))
  | 						   (filter #(check-bindings? graph-1 graph-2
  | 							    (assoc bindings n %)))
  | 
  | 
  | 						   )]
  | 					     (recur (concat (rest agenda)
  | 							    (map (partial assoc bindings n) candidates))))
  | 					(if (check-bindings? graph-1 graph-2 bindings) ;; check for consistency
  | 					    bindings
  | 					    (recur (rest agenda)))
  | 					)))))
  | 
  | (do
  | (def memo (atom {}))
  | (defn memoize-and-return [input output]
  |       (swap! memo assoc input output)
  |       output)
  | 
  | (defn tutte-polynomial* [graph]
  | 
  |       (if-let [match (->> (keys @memo)
  | 			  (filter (comp not nil? (partial isomorphism graph)))
  | 			  first
  | 			  )]
  | 
  | 	      (get @memo match)
  | 
  |       (memoize-and-return graph
  | 	(if-let [e (->> (:edges graph)
  | 		      (remove (partial self-loop? graph))
  | 		      (remove (partial bridge? graph))
  | 		      first)]
  | 		      (concat (tutte-polynomial* (remove-edge graph e))
  | 			      (tutte-polynomial* (contract-edge graph e)))
  | 	      (list
  | 		[(count (filter (partial bridge? graph) (:edges graph)))
  | 		 (count (filter (partial self-loop? graph) (:edges graph)))
  | 	      ])))))
  | 
  | 
  | 
  | (defn tutte-polynomial-fn
  | 
  |       ([graph]
  |       (let [P (tutte-polynomial graph)]
  | 	   (fn [x y]
  | 	       (reduce +
  | 		       (for [[[m n] k] P]
  | 			    (* k (** x m) (** y n)))))))
  | 
  |       ([graph x y]
  |        ((tutte-polynomial-fn graph) x y)
  | 			    ))
  | 
  | (def tutte-polynomial (comp frequencies tutte-polynomial*))
  | 
  | 
  | (defn thread-count [graph]
  |       (->> (tutte-polynomial* graph)
  | 	   (map (partial apply +))))
  `----