13
$\begingroup$

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?

$\endgroup$
  • 4
    $\begingroup$ I flattened this to a single sequence. It is oeis.org/A086645. I haven't tried it in Mathematica yet, but flattening is probably a good first step. $\endgroup$ – mikado Oct 8 '16 at 17:11
  • 4
    $\begingroup$ 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. $\endgroup$ – J. M.'s technical difficulties Oct 8 '16 at 17:16
  • $\begingroup$ Wow, this finding is amazing, thank you! Yes, still wondering if there is a way to proceed in a general case. $\endgroup$ – Kagaratsch Oct 8 '16 at 23:42
  • $\begingroup$ Looks like 1/2 of Pascal's Triangle $\endgroup$ – prog9910 May 23 at 20:41
3
$\begingroup$

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}  *)
| improve this answer | |
$\endgroup$
1
$\begingroup$

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}} *)
| improve this answer | |
$\endgroup$
  • 2
    $\begingroup$ Note that the formula Binomial[2 n, 2 k] is given in the OEIS link. $\endgroup$ – Michael E2 May 23 at 23:10

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.