MathGroup Archive 2009

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

Search the Archive

constant, scale, entropy

  • To: mathgroup at smc.vnet.net
  • Subject: [mg103651] constant, scale, entropy
  • From: Roger Bagula <rlbagula at sbcglobal.net>
  • Date: Thu, 1 Oct 2009 06:39:58 -0400 (EDT)
  • Reply-to: rlbagulatftn at yahoo.com

I'll try to explain my current project
which isn't specifically about computing the decimals of Pi,
but how the BBP type algorithm works as based on probability ideas.

I don't know since this whole thing went in layers:
1) the idea of BBP as probability based time series: p[n]
Sum[p[n]/scale^n,{n,0,infinity]]
2) the idea of conjugate constants based on summing;1-p[n]
Sum[(1-p[n])/scale^n,{n,0,infinity]]
3) the idea of using scaled or binary probability based
entropy on Pi and e ( which came out near -1 and 1)
Sum[-p[n]*Log[p[n]]/Log[scale],{n,0,infinity]]
http://en.wikipedia.org/wiki/Entropy_(information_theory)
4) finally the idea that there should "exist" constants
at scales that would have Riemann type attractors {0,1,Infinity}
and zero being the perfect second and third law of thermodynamics crystal.
5) manufacture of a unitary ( binary) entropy probability based constant.

Alexander Povolotsky gave me the original idea:
 > What do you think of Ray Solomonoff's approach ?
which gave the idea of "Algorithmic Probability".
All I did was figure out a way to compute
probability in terms of scaled BBP/ Infinite sums.
Looking at the idea that the fundamental constants
involve the metamathamatics of the physical universe
made me think that they might have information
in an information theory sense, that is entropy.

Mathematica: constant from entropy one for scale=5/3;
Clear[p, n, s]
$MaxExtraPrecision = 200
s = 2*Sum[1/(5/3)^n, {n, 0, Infinity}]
Solve[-x*Log[x]/Log[5/3] - 2/(3*(5/3)^n) == 0, x]
p[n_] := -(2/3)*(3/5)^n*Log[5/3]/(ProductLog[-(2/3)*(3/5)^n*Log[5/3]])
a = Sum[p[n + 1]/(5/3)^(n + 1), {n, 0, Infinity}]
N[a, 100]
1.286440035403290152912874911399834673243151932466`32.460965191217305
hinfinity = Sum[-p[n + 1]*Log[p[n + 1]]/Log[5/3], {n, 0, Infinity}];
N[hinfinity, 100]
0.9999999999999999999999999999999999999999999999999999999999999999999999999999\
999999999999999999999999999999990237736`99.99999999999999
I have :
{constant, scale, entropy}
I've plotted: (d means change in);
dconstant=0->{scale, entropy}
dentropy=0->{scale,constant}

Mathematica: {scale, entropy}
Adjusted BBP probability scale 16:
p[n_] = (4/(8*n + 1) - 2/(8*n + 4) - 1/(8*n + 5) - 1/(8*n + 6))/3
Entropy with a scale adjusted to the 3 factor:
H2 = NSum[
If[(Log[16] - Log[3]/n) == 0, 0, -p[n]*Log[p[n]]/(Log[16] -
Log[3]/n)], {n,
0, 3000}]=0.17745078078631668
Adjusted BBP probability scale -4:
p[n_] = (2/(4*n + 1) + 2/(4*n + 2) + 1/(4*n + 3))/(10/3)
H4 = NSum[-p[n]*Log[p[n]]/(Log[4] - n*Log[10/3]), {n, 0, 3000}]
1.2117464664787847
Plotting them scale against entropy:
gs = ListPlot[{{16, 0.17745078078631668}, {1.27027, 1}, {-4,
1.2117464664787847}}, PlotRange -> All]
f[x_] = Fit[{{16,
0.17745078078631668}, {1.27027, 1}, {-4, 1.2117464664787847}},
{1, x},
x]
1.0291016273151843`\[InvisibleSpace]- 0.05260689003919656` x
gf = Plot[f[x], {x, -4, 16}]
Show[{gs, gf}]
Solve[f[x] == 0, x]
{{x -> 19.56210729333015`}}

Mathematica:{scale,constant}
A Log-Log plot is so close to a straight line I can't tell the difference:
Clear[a, f, x]
a = {{13/11, 5.4227041737281112595241530114}, {7/5,
2.35393585633642797823710759429933667508}, {5/3,
1.286440035403290152912874911399834673243151932466}, {11/7,
1.559550279837293356950821926157407483062757001262}, {3
2, 1.82740905983796915010704207935249600767}, {2,
0.686629058774636524727177681922570452477616696159231117628}, {9/4,
0.451602960675484109819053842676760298465418949713455586409}, {5/2,
0.342094896339662908190559282804991508710626891203682536403231929525},
{Exp[1], 0.
2756537624243540786252399242156404011726816158816906053869825902541}, {3,
0.2142786905703549758956998106959198895804518465563930517685670854527799702468\
8}}
(* makes up the log-log array*)
b = Table[{Log[a[[n]][[1]]], Log[a[[n]][[2]]]}, {n, 1, Length[a]}]
g1 = ListPlot[b]
f[x_] = Fit[b, {1, x}, x]
g2 = Plot[f[x], {x, 0, 1.25}]
Show[{g1, g2}]
That result gives the relationship as:
Log[constant]=2.034595683218906257862054432 -
3.375606246451309569435876213 *Log[scale]
gg=Plot[constant[x], {x, 1, 5}]
ga = ListPlot[a]
Show[{gg, ga}]
Is resulting graph is very close to right on.

Log-Log plots are used in fractals to get the dimension of
relationships;for instance, entropy dimension in box counting
of fractal pictures.

-- 
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


  • Prev by Date: Re: Histogram
  • Next by Date: Re: Re: Replace not spotting a replacement
  • Previous by thread: Re: Histogram
  • Next by thread: Re: Re: Replace not spotting a replacement