Interesting Mersenne identities and a prime based graph sequence
- To: mathgroup at smc.vnet.net
- Subject: [mg99887] Interesting Mersenne identities and a prime based graph sequence
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Mon, 18 May 2009 02:32:26 -0400 (EDT)
My original line of thought this identity: Mod[2^n-1,3] =Mod[n,2] Are there others? Table[Mod[2^(2^n - 1) - 1, 7], {n, 1, 10}] {1, 0, 1, 0, 1, 0, 1, 0, 1, 0} Mod[2^(2^n - 1) - 1, 7]=Mod[n,2] What about? Mod[2^(2^(2^n - 1) - 1) - 1, 15] Mod[2^(2^(2^(2^n - 1) - 1) - 1) - 1, 31] That gave me the idea for: t[n,m]=Mod[Prime[n]^m-2,Prime[n+1] where t[n,m]=0 The pairs {n,m} seems to form a connected graph to n=m=10 at least. http://www.geocities.com/rlbagulatftn/prime_graph100.gif The idea of a way of connecting the primes to some graph pattern seems a new one at least to me. The graph isn't connected at 20 and appears more random. At 100 primes which is about what I can get out of my Mathematica version on my old computer, the graph begins to look like a random natural network ( the appearance of the primes is sometimes said to be "normal"). This method at least gives a visualization of that chaos. It also gives a quantization in terms of spectral graph theory in which roots can be associated to different levels of primes. It seems very lucky that I noticed a pattern in the appearance of these zeros. Mathematica: << DiscreteMath`GraphPlot`; << DiscreteMath`ComputationalGeometry` << DiscreteMath`Combinatorica` t[n_, m_] = Mod[Prime[n]^m - 2, Prime[n + 1]] n0 = 20 g1 = Delete[Union[Flatten[Table[If[t[n, m] == 0, {n, m}, {}], {n, 1, n0}, {m, 1, n0}], 1]], 1] g2 = Table[Reverse[g1[[n]]], {n, 1, Length[g1]}] Length[%] g3 = Join[g1, g2] Length[%] a = Table[0, {n, n0}, {m, n0}]; Table[If[n == g3[[k, 1]] && m == g3[[k, 2]], a[[n, m]] = 1, {}], {k, 1, Length[g3]}, {n, n0}, {m, n0}]; a CharacteristicPolynomial[a, x] gc60 = FromAdjacencyMatrix[a] "⁃Graph:< 27 20 "Undirected">⁃ GraphPlot3D[a] What I'm wondering is if there is a way to get a correspondence of NSolve[CharacteristicPolynomial[a, x]==0,x] type roots to the primes involved: new root<->{ Prime[n],Prime[n+1]}<->{n,m} edge Roger Bagula