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]