14

There is a function FindSequenceFunction in Mathematica, that can identify a sequence of integers based on a few first elements. But what if I have a set of finite sequences sec[n] that grows with n? For example:

sec[0]={1}
sec[1]={1, 1}
sec[2]={1, 6, 1}
sec[3]={1, 15, 15, 1}
sec[4]={1, 28, 70, 28, 1}
sec[5]={1, 45, 210, 210, 45, 1}
sec[6]={1, 66, 495, 924, 495, 66, 1}
sec[7]={1, 91, 1001, 3003, 3003, 1001, 91, 1}
sec[8]={1, 120, 1820, 8008, 12870, 8008, 1820, 120, 1}

Is there a way to use Mathematica to find the general expression to continue this sequence of sequences?

LCarvalho
  • 9,233
  • 4
  • 40
  • 96
Kagaratsch
  • 11,955
  • 4
  • 25
  • 72
  • 4
    I flattened this to a single sequence. It is https://oeis.org/A086645. I haven't tried it in Mathematica yet, but flattening is probably a good first step. – mikado Oct 08 '16 at 17:11
  • 4
    More concisely: you have a (Riordan) triangle of integers that you want to identify. @mikado, that's when you're lucky and your triangle is listed in the OEIS. The question of how one might find a tentative formula for a given integer triangle is still an interesting one, tho. – J. M.'s missing motivation Oct 08 '16 at 17:16
  • Wow, this finding is amazing, thank you! Yes, still wondering if there is a way to proceed in a general case. – Kagaratsch Oct 08 '16 at 23:42
  • Looks like 1/2 of Pascal's Triangle – prog9910 May 23 '20 at 20:41
  • A simple idea is to use FindSequenceFunction on the columns of the triangular sequence. For example, FindSequenceFunction[{1,6,15,28,45,66,91}] and FindSequenceFunction[{1,15,70,210,495,1001,1820}]. – Somos Jul 11 '23 at 00:01

2 Answers2

4

FindSequenceFunction can find the each individual sequence sec[k] in terms of a recursion with polynomial coefficients:

FindSequenceFunction[PadRight[sec[5], 20]]
(*
  DifferenceRoot[
   Function[{\[FormalY], \[FormalN]}, {(-66 + 23 \[FormalN] - 
          2 \[FormalN]^2) \[FormalY][\[FormalN]] + \[FormalN] (-1 + 
          2 \[FormalN]) \[FormalY][1 + \[FormalN]] == 
      0, \[FormalY][1] == 1}]]
*)

Therefore, it can be used again to try to find the sequence of the coefficients as functions of k, which it can do in this case. 

k0 = 3;
{y0coeff, y1coeff} = FindSequenceFunction /@ Transpose@
    Table[
     Normal@Last@CoefficientArrays[
        First[FindSequenceFunction@PadRight[sec[k], 20]][y, n] // 
         First,
        {y[n], y[1 + n]}],
     {k, k0 + 1, 8}] /. n -> #2
(*
{-28 + 15 #2 - 2 #2^2 - 15 #1 + 4 #2 #1 - 2 #1^2 &,
 #2 (-1 + 2 #2) &}
*)

The function secFN[k, n] can be used to generate sec[k]:

secFN = Function[{k, n},
   DifferenceRoot[
     Function[{\[FormalY], \[FormalN]},
      {y0coeff[k - k0, \[FormalN]] \[FormalY][\[FormalN]] + 
         y1coeff[k - k0, \[FormalN]] \[FormalY][1 + \[FormalN]] == 0,
       \[FormalY][1] == 1}
      ]
     ][n + 1]
   ];

Example:

Table[secFN[5, n], {n, 0, 5}]
(*  {1, 45, 210, 210, 45, 1}  *)
Michael E2
  • 235,386
  • 17
  • 334
  • 747
1

How is this?

fx[x_, n_] := (x + 1)^n
f[n_] := Map[Part[fx[y, n] // ExpandAll, {#}] /. y -> 1 &, 
  Range[Length[fx[y, n] // ExpandAll]]]
Map[f[#] &, Range[2, 20, 2]]
(* Out: {{1, 2, 1}, {1, 4, 6, 4, 1}, {1, 6, 15, 20, 15, 6, 1}, {1, 8, 28, 56, 
  70, 56, 28, 8, 1}, {1, 10, 45, 120, 210, 252, 210, 120, 45, 10, 
  1}, {1, 12, 66, 220, 495, 792, 924, 792, 495, 220, 66, 12, 1}, {1, 
  14, 91, 364, 1001, 2002, 3003, 3432, 3003, 2002, 1001, 364, 91, 14, 
  1}, .. *)

Map[#[[1 ;; ;; 2]] &, %]
(* Out: {{1, 1}, {1, 6, 1}, {1, 15, 15, 1}, {1, 28, 70, 28, 1}, {1, 45, 210, 
  210, 45, 1}, {1, 66, 495, 924, 495, 66, 1}, {1, 91, 1001, 3003, 
  3003, 1001, 91, 1}, {1, 120, 1820, 8008, 12870, 8008, 1820, 120, 
  1}, {1, 153, 3060, 18564, 43758, 43758, 18564, 3060, 153, 1}, {1, 
  190, 4845, 38760, 125970, 184756, 125970, 38760, 4845, 190, 1}} *)
prog9910
  • 630
  • 4
  • 10