Unknown Blogger Mathematica

This post is motivated by this wonderful Mathologer video.

As Mathologer points out the “what’s next?” puzzles are meaningless without a context. As the “trap” sequence illustrates. The context for the particular sequence with lines joining points on circle and counting number of segments.

The following is an implementation in Mathematica for this sequence and some musings re: other sequences that have polynomial closed forms.

ex = Total[
    MapIndexed[#1[[1]] FactorialPower[n, #2[[1]] - 1]/
        Factorial[#2[[1]] - 1] &, 
     NestList[Differences, {1, 2, 4, 8, 16, 31}, 4]]] // 
   FunctionExpand // Simplify

yields: 1/24 (24 + 14 n + 11 n^2 – 2 n^3 + n^4) and

ex /. n -> Range[0, 10]

yields: {1, 2, 4, 8, 16, 31, 57, 99, 163, 256, 386}

A slight generalization (only designed for polynomial cases):

f[x_List, n_] := 
 Total[MapIndexed[#1[[1]] FactorialPower[n, #2[[1]] - 1]/
        Factorial[#2[[1]] - 1] &, 
     NestWhileList[Differences, x, 
      And[Length[#] > 1, Union[#] == #] &]]] // FunctionExpand // 
  Simplify

Examples:

Grid[Table[{StringForm[
     "\!\(\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \
\(n\)]\)\!\(\*SuperscriptBox[\(i\), \(``\)]\)", j], 
    f[Accumulate[Range[0, 10]^j], n]}, {j, 1, 6, 1}], 
  Frame -> All] // TraditionalForm

It is fun to extract the Bernoulli numbers () using

Extending some of the preceding:

s[j_, n_, x_] := 
 Module[{m, a = Expand[f[Accumulate[Range[0, x]^j], n - 1]]},
  m = CoefficientList[a, n];
  {StringForm[
     "\!\(\*SubscriptBox[\(S\), \
\(`1`\)]\)(n)=\!\(\*UnderoverscriptBox[\(\[Sum]\), \(i = 0\), \(n - 1\
\)]\)\!\(\*SuperscriptBox[\(i\), \(`2`\)]\)", j, j] // 
    TraditionalForm, a // TraditionalForm, 
   Reverse@MapIndexed[ ((j + 1) #1)/
       Binomial[j + 1, j - #2[[1]] + 1] &, Rest[m]]}]

Extracting the Bernoulli numbers (last column) with some care in choice of ‘x’ above:

Grid[Table[s[j, n, 30], {j, 10}], Frame -> All]

I have shared this poor code not for its quality but perhaps to motivate anyone who happens upon this to do better.

A brief post. Peace and good will to all during this holiday period.