Table to generate colossally abundant numbers not working

Question

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:

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?

Answer 1

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}

Answer 2

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"}}]