Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2007
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2007

[Date Index] [Thread Index] [Author Index]

Search the Archive

exceptional group symmetry breaking as a binary entropy process

  • To: mathgroup at smc.vnet.net
  • Subject: [mg75483] exceptional group symmetry breaking as a binary entropy process
  • From: Roger Bagula <rlbagula at sbcglobal.net>
  • Date: Wed, 2 May 2007 03:56:32 -0400 (EDT)

Continuation of my work on entropy in the early universe and information 
theory;
Thought experiment:
Suppose we had a worm hole from the remote past when the universe was E8
symmetry to the present and you could represent the state as a graph:
GE8->ME8 ( matrix for the graph)
Gpresent-> Mpresent
Then you would necessarily have a transform T that would take place in
the worm hole as:
GE8->Gpresent
as
Mpresent=T*ME8
For the information to be conserved T would have to be a unitary
Jacobian like transform:
Information Entropy as
H(present)=H(E8)+Log[Measure[T]]/Log[2]
I get the the Limit :
Limit[Measure[T], t-> Large]=0
This single approach gave me two copies of a group with 98 elements.
A symmetry breaking linear approach with two "target" groups also gave 
an unexpected result:
E8-> -37*"7" +39*"13"
507->507
E8*E8 and SO(32) are 496 =507-11
Entropy excess is ( inflation's heating origin?) :
0.003310557481995602
which is less than alpha/2.
"7"-> U(1)*SO(4)->(in hyperbolic terms) U(1)*SO(3,1)

I'm having trouble getting the {x,y} out of the "a" array.
Mathematica:
Clear[En,a,b,x,y,n,m]
(*Binary Information Entropy for a group with n elements:*)
En[n_]=Sum[-(m/n)*Log[m/n]/Log[2],{m,1,n}]

a = Flatten[Table[Table[ Flatten[{n, m, x /. NSolve[{x*N[En[n]] + 
y*N[En[m]] - En[248] == 0, x*n + y*m - 248 == 0}], y /. 
NSolve[{x*N[En[n]] + y*N[En[m]] - En[248] == 0, x*n + y*m - 248 == 
0}]}], {n, 1, m}], {m, 1, 50}], 1]

x = 100; y = 100;
b = Table[Abs[Round[a[[n,
  3]]]*N[En[a[[n, 1]]]] + Round[a[[n, 4]]]*N[
              En[a[[n, 2]]]] - N[En[248]]], {n, 1, Length[a]}]
Min[b]
0.003310557481995602`
Flatten[Table[If[b[[n]] - Min[b] == 0, a[[n]], {}], {n, 1, Length[a]}]]
{7, 13, -36.996957416987826`, 38.99836168607037`}


  • Prev by Date: Re: Logical comparisons of items in a two lists
  • Next by Date: Re: Logical comparisons of items in a two lists
  • Previous by thread: Re: Running a loop for Maximizing problem
  • Next by thread: Re: Fourier and InverseFourier