Spectral graph theory of the Buckyball
- To: mathgroup at smc.vnet.net
- Subject: [mg99655] Spectral graph theory of the Buckyball
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Sun, 10 May 2009 05:17:22 -0400 (EDT)
So lets look at vibrations: From Fan Chung's book:A the adjacency matrix, L the Laplacian ( d^2Phi(x)/dx^2) L=IdentityMatix-A/k where k means k regular: I take that to be ( k is the basic vibrational scale) k=vertices/graph_edges=60/90 What it does is introduce a zero root when the polynomial is calculated and the root plot on the complex plane is a lemon shape with some interior roots. This Lapacian leaves the graph unchanged. Looking at that root set seems to expain why the this sphere isn't polynomial symmetric. Those interior roots are larger than the exterior roots of the Lemon shape. The Laplacian is what you use when you do "drum" calculations for vibrations. Those lemon roots are the ones on the sphere surface itself, I guess. The external and internal root would be the ones that produce radiation probably... ?! 1) two low outside -below{0., 0}, {0.0811339, 0} These are the low amplitude IR's 2) Four real inside These are three Raman symmetrical 3) 8 complex inside These 8 are the big IR solutions. That matches the observed spectrum to the roots. You can get a "scale" from the vibrations. Spectral graph theory Lapacian: Clear[g0, h, g1] (* pentagon vetrex data from Mathematica demo project*) g0 = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16, 17, 18, \ 19, 20}, {21, 22, 23, 24, 25}, {26, 27, 28, 29, 30}, {31, 32, 33, 34, 35}, { 36, 37, 38, 39, 40}, {41, 42, 43, 44, 45}, {46, 47, 48, 49, 50}, {51, 52, 53, 54, 55}, {56, 57, 58, 59, 60}} h = Join[g0, Table[Reverse[g0[[n]]], {n, 1, Length[g0]}]] g1 = Join[Flatten[Table[{{h[[n, 1]], h[[n, 5]]}, {h[[n, 5]], h[[n, 1]]}}, {n, 1, 24}], 1], Flatten[ Table[{h[[n, m]], h[[n, m + 1]]}, {n, 1, 24}, {m, 1, 4}], 1]] (* hexagon vertix data*) Clear[g0, h, g2] g0 = Flatten[{{{1, 11, 12, 32, 31, 2}}, {{1, 11, 15, 42, 41, 5}}, {{3, 16, 17, 35, 31, 2}}, {{3, 16, 20, 47, 46, 4}}, {{5, 41, 45, 50, 46, 4}}, {{ 6, 21, 22, 37, 36, 7}}, {{6, 21, 25, 43, 44, 10}}, {{ 8, 26, 27, 40, 36, 7}}, {{ 8, 26, 30, 48, 49, 9}}, {{10, 44, 45, 50, 49, 9}}, {{14, 24, 25, 43, 42, 15}}, {{14, 24, 23, 52, 51, 13}}, {{12, 32, 33, 55, 51, 13}}, {{19, 29, 30, 48, 47, 20}}, {{ 19, 29, 28, 57, 56, 18}}, {{17, 35, 34, 60, 56, 18}}, {{22, 37, 38, 53, 52, 23}}, {{27, 40, 39, 58, 57, 28}}, {{33, 55, 54, 59, 60, 34}}, {{38, 53, 54, 59, 58, 39}}}, 1] Table[Reverse[g0[[n]]], {n, 1, Length[g0]}] h = Join[g0, Table[Reverse[g0[[n]]], {n, 1, Length[g0]}]] g2 = Join[Flatten[Table[{{h[[n, 1]], h[[n, 6]]}, {h[[n, 6]], h[[n, 1]]}}, {n, 1, Length[h]}], 1], Flatten[Table[{h[[n, m]], h[[n, m + 1]]}, {n, 1, Length[h]}, {m, 1, 5}], 1]] (* making edge matyrix*) e = Union[Join[g1, g2]] Length[%] (* adjacency matrix*) a = Table[0, {n, 60}, {m, 60}]; Table[If[n == e[[k, 1]] && m == e[[k, 2]], a[[n, m]] = 1, {}], {k, 1, Length[e]}, {n, 60}, {m, 60}]; a (* Spectral graph theory Lapacian*) b = IdentityMatrix[60] - (60/180)*a CharacteristicPolynomial[b, x] NSolve[CharacteristicPolynomial[b, x] == 0, x] Table[{Re[x], Im[x]} /. NSolve[ CharacteristicPolynomial[b, x] == 0, x][[n]], {n, 1, 60}] (* complex plane root plot*) << DiscreteMath`GraphPlot`; << DiscreteMath`ComputationalGeometry` << DiscreteMath`Combinatorica` gc60 = FromAdjacencyMatrix[a] "â??Graph:<"\[InvisibleSpace]90\[InvisibleSpace]", "\[InvisibleSpace]60\[InvisibleSpace]", "\[InvisibleSpace]"Undirected"\ \[InvisibleSpace]">â??" (* Lacacian leaves the graph invariant*) GraphPlot3D[b]