3
$\begingroup$

I'm trying to tabulate the first 8 colossally abundant numbers defined by critical epsilon values, with epsilon listed in descending order (Broughan lists the first few here, although note that the errata for his book here add one missing critical epsilon value, which I have included in the list below). I'm listing them in TeXForm form simply because it's easier to decipher visually. However, the same values are already entered in the Mathematica code that follows. Those epsilon values are

$\epsilon_1=\frac{\log \left(\frac{3}{2}\right)}{\log (2)}$, $\epsilon_2=\frac{\log \left(\frac{4}{3}\right)}{\log (3)}$, $\epsilon_3=\frac{\log \left(\frac{7}{6}\right)}{\log (2)}$, $\epsilon_4=\frac{\log \left(\frac{6}{5}\right)}{\log (5)}$, $\epsilon_5=\frac{\log \left(\frac{15}{14}\right)}{\log (2)}$, $\epsilon_6=\frac{\log \left(\frac{13}{12}\right)}{\log (3)}$, $\epsilon_7=\frac{\log \left(\frac{8}{7}\right)}{\log (7)}$, $\epsilon_8=\frac{\log \left(\frac{31}{302}\right)}{\log (2)}$

I compose these into a table...

Quiet[
   xList = Range[8];
   caNumbers = {2, 6, 12, 60, 120, 360, 2520, 5040}; 
   epsilon =
       Table[ϵ, {ϵ, {Log[3/2]/Log[2], Log[4/3]/Log[3],
       Log[7/6]/Log[2],  Log[6/5]/Log[5], Log[15/14]/Log[2], Log[13/12]/Log[3],
       Log[8/7]/Log[7],  Log[31/30]/Log[2]}}];
   epsilonN =
       Table[N[ϵ], {ϵ, {Log[3/2]/Log[2], Log[4/3]/Log[3],
       Log[7/6]/Log[2],  Log[6/5]/Log[5], Log[15/14]/Log[2], Log[13/12]/Log[3],
       Log[8/7]/Log[7],  Log[31/30]/Log[2]}}];
   colossalNumber = 
       Table[N[Product[p^(Floor[ Log[(p^(1 + ϵ) - 1)/
       (p^ϵ - 1)]/Log[p]] -  1), 
       {p, Prime[Range[25]]}]], {ϵ, {Log[3/2]/Log[2], Log[4/3]/Log[3],
       Log[7/6]/Log[2],  Log[6/5]/Log[5], Log[15/14]/Log[2], Log[13/12]/Log[3],
       Log[8/7]/Log[7],  Log[31/30]/Log[2]}}]; 
   criticalEpsilonValueTable = 
       Transpose[
       Join[{xList, epsilon, epsilonN, N[colossalNumber], caNumbers}, 2]]; 
   TableForm[criticalEpsilonValueTable,
       TableHeadings -> {None, {"x", "ϵ", "ϵ (numeric)",
       "\!\(\*SubscriptBox[\(n\), \(ϵ\)]\) ∈ CA", 
       "xth CA number"}}]
   ]

...and the value of n for x = 3 is wrong. In fact, the third CA number is missing entirely:

enter image description here

Larger tables produce similar results - missing values of n.

It's possible I've made some mathematical error; I am aware that there is more than one CA number associated with each critical value of epsilon. But the numbers listed under xth CA number are the lowest of each set... So, I wonder if it's to do with machine precision?

Does anyone have any suggestions?

$\endgroup$
5
$\begingroup$

Your problem is that Floor is unable to return an exact result for Log[8]/Log[2], which is why you needed to use Quiet:

Floor[Log[8]/Log[2]]

Floor::meprec: Internal precision limit $MaxExtraPrecision = 50.` reached while evaluating Floor[Log[8]/Log[2]].

Floor[Log[8]/Log[2]]

Then, you used N which converts the argument to an approximate machine number result. Unfortunately, the approximate machine number is ever so slightly smaller than 3:

N[Log[8]/Log[2]] //InputForm

2.9999999999999996

This is why you get an incorrect result. See this answer which discusses the issue further. As a workaround, you could use the following substitute for Floor

floor[e_] := Quiet@Check[Floor[e], Floor[FullSimplify[e]]]

Then:

Table[
    Product[p^(floor[Log[(p^(1+ϵ)-1)/(p^ϵ-1)]/Log[p]]-1),{p, Prime[Range[25]]}],
    {ϵ, epsilon}
]

{2, 6, 12, 60, 120, 360, 2520, 5040}

$\endgroup$
1
$\begingroup$

Use FullSimplify rather than N

xList = Range[8];

caNumbers = {2, 6, 12, 60, 120, 360, 2520, 5040};

epsilon = {Log[3/2]/Log[2], Log[4/3]/Log[3], Log[7/6]/Log[2], Log[6/5]/Log[5],
    Log[15/14]/Log[2], Log[13/12]/Log[3], Log[8/7]/Log[7], Log[31/30]/Log[2]};

colossalNumber = 
  Table[Product[
      p^(Floor[Log[(p^(1 + ϵ) - 1)/(p^ϵ - 1)]/Log[p]] - 
         1), {p, Prime[Range[25]]}] // FullSimplify, {ϵ, epsilon}] //
    Quiet;

criticalEpsilonValueTable = 
  Transpose[Join[{xList, epsilon, epsilon // N, colossalNumber, caNumbers}, 
    2]];

TableForm[criticalEpsilonValueTable, 
 TableHeadings -> {None, {"x", "ϵ", "ϵ (numeric)", 
    "\!\(\*SubscriptBox[\(n\), \(ϵ\)]\) ∈ CA", 
    "xth CA number"}}]

enter image description here

$\endgroup$
  • $\begingroup$ Did you mean to say "FullSimplify instead of N"? $\endgroup$ – Carl Woll Sep 26 '19 at 18:41
  • $\begingroup$ Yes, I'll correct. Thanks $\endgroup$ – Bob Hanlon Sep 26 '19 at 18:44
  • $\begingroup$ Hello both. Incredibly useful feedback, thank you. @Bob Hanlon, your answer is fantastic and incredibly useful. I feel obliged given the similarity of both answers to mark the first as the answer. But I'm very grateful to you both. $\endgroup$ – Richard Burke-Ward Sep 26 '19 at 20:52

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.