trouble with entropy scaled calculation of infinite sums
- To: mathgroup at smc.vnet.net
- Subject: [mg103736] trouble with entropy scaled calculation of infinite sums
- From: Roger Bagula <rlbagula at sbcglobal.net>
- Date: Sun, 4 Oct 2009 05:36:22 -0400 (EDT)
- Reply-to: rlbagulatftn at yahoo.com
I found this method of doing probability scale EXP[1]=e type
infinite sums.
Mathematica expample for scale=11:
$MaxExtraPrecision = 200
p[n_] = 11^(n - 4)/n!
Table[N[p[n]], {n, 0, 20}]
Sum[p[n]/11^(n - 4), {n, 0, Infinity}]
h = Sum[-p[n]*Log[p[n]]/Log[11], {n, 0, Infinity}]
N[h, 100]
2.0491
When I tried to generalize the result I get different
entropies:
$MaxExtraPrecision = 200
offset[m_] = If[n â?¤ 3, n - 1, If[n > 3 && n < 9, 3, 4]]
p[n_] = m^(n - offset[m])/n!
Sum[p[n]/m^(n - offset[m]), {n, 0, Infinity}]
h = Table[Sum[-p[n]*Log[p[n]]/Log[m], {n, 0, Infinity}], {m, 2, 10}]
a = N[h, 100]
g1 = ListPlot[%]
f[x_] = Fit[a, {1, x}, x]
g2 = Plot[f[x], {x, 1, 10}]
Show[{g1, g2}]
(*a = {-2.90117869114589008263607311799541723082`25.19764247392701, \
-5.61747693461947158172664019763556648038`22.01392866733195, \
-8.0430284269112488827062685772`19.45005195473023, \
-10.3961759266392159176499409268`17.107259954035108, \
-12.7523614402263114777860738659`15.518032672389245, \
-15.1879714346591139519676022492`13.438410763485622, \
-17.8085703678062761261219369147`11.146588581999028, \
-20.7693946164903020243877987482`11.038909940936808, \
-24.3128827385636922819`10.403604749016184}*)
The calculated ones that I got by the first method were:
a = {{1, 0.828647127671878508038916946855867263032224616143}, {2, \
2.12152973041735031031308637092718171875}, {3, \
2.2928360342354146306076068033268164293}, {4, \
2.1150848873802090954797262985}, {5, 1.499558368971973532906421064}, {6, \
1.7455761749282651908476095034}, {7, 1.9989160419828100415205186208}, {8, \
1.9200373452197238231646713457}, {9, 1.2908802474205237430529254129}, {10,
1.6948514808559158028}, {11, 2.0491395524030780178}, {12, \
1.8754092475621356939},
{13, 1.1704313091632859227},
{14, 1.6319067147114207574}}
Length[a]
g1 = ListPlot[a]
f[x_] = Fit[a, Table[x^n, {n, 0, Length[a] - 1}], x]
g2 = Plot[f[x], {x, 0, 15}]
Show[{g1, g2}]
What I want to know is why Mathematica is getting a different answer
for what should be the same infinite sums?
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