_______________________________________ 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 ). 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 +)))) `----