graph recursion of a cube sort
- To: mathgroup at smc.vnet.net
- Subject: [mg101035] graph recursion of a cube sort
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Sun, 21 Jun 2009 07:07:55 -0400 (EDT)
- References: <h13vq8$8q5$1@smc.vnet.net>
http://www.geocities.com/rlbagulatftn/5d_cube.gif I figured out a way to make a recursive square-cube like graph product: here are the matrices : Line: {{0, 1}, {1, 0}}, Square: {{0, 1, 1, 0}, {1, 0, 0, 1}, {1, 0, 0, 1}, {0, 1, 1, 0}}, Cube: {{0, 1, 1, 0, 1, 0,0, 0}, {1, 0, 0, 1, 0, 1, 0, 0}, {1, 0, 0, 1, 0, 0, 1, 0}, {0, 1, 1, 0, 0, 0, 0, 1}, {1, 0, 0, 0, 0,1, 1, 0}, {0, 1, 0, 0, 1, 0, 0, 1}, {0, 0, 1, 0, 1, 0, 0, 1}, {0, 0, 0, 1, 0, 1, 1, 0}}, 4d cube ( Tesseract): {{0, 1, 1, 0, 1, 0, 0, 0,1, 0, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0}, {1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 1, 1, 0, 0, 0, 0, 1, 0, 0,0, 1, 0, 0, 0, 0}, {1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0}, {0, 1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0}, {0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0}, {0, 0, 0, 1,0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1}, {1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0}, {0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 1, 0, 0}, {0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1}, {0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 1, 1, 0}}} As I said before they are a lot like Hadamards. But not orthogonal or block form that I can find. Triangle from the polynomial is: {{-1, 0, 1}, {0, 0, -4, 0, 1}, {9, 0, -28, 0, 30, 0, -12, 0,1}, {0, 0, 0, 0, 0, 0, -4096, 0, 4352, 0, -1792, 0, 352, 0, -32, 0, 1}} {1476225, 0, -15641424, 0, 75436920, 0, -218887920, 0,425462940, 0, -583700560, 0, 580113224, 0, -421986160, 0, 224447430, 0, -86417520, 0, 23674440, 0, -4516176, 0, 586140, 0, -50160, 0, 2680, 0, -80, 0, 1}} As you can see it is the odd levels that don't have a lot of zeros. Mathematica: << DiscreteMath`GraphPlot`; << DiscreteMath`ComputationalGeometry` << DiscreteMath`Combinatorica` Clear[g, n, gm] g[0] := CompleteGraph[2] g[1] := GraphProduct[CompleteGraph[2], g[0]] g[n_] := g[n] = GraphProduct[g[n - 1], g[0]] Table[g[n], {n, 0, 3}] gm = Table[ToAdjacencyMatrix[g[n]], {n, 0, 4}] Table[CoefficientList[CharacteristicPolynomial[ToAdjacencyMatrix[g[n]], x], x], {n, 0, 4}] Table[ToAdjacencyMatrix[g[n]].Transpose[ToAdjacencyMatrix[g[n]]], {n, 0, 3}] Table[Dimensions[gm[[n]]], {n, 1, 4}] Table[GraphPlot3D[gm[[n]]], {n, 1, 5}] -- Respectfully, Roger L. Bagula 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :http://www.geocities.com/rlbagulatftn/Index.html alternative email: rlbagula at sbcglobal.net > > >