2
$\begingroup$

Suppose I have ordered rank-4 indices $1\le i<j<k<l\le n$, where $n$ is a fixed but unspecified integer. I define a function $s(n)$ as follows:

$$s(n)=\sum_{1\le i<j<k<l\le n}(-1)^{\text{number of elements in the intersection }\{i,j,k,l\}\cap\{1,2,3,4\}}.$$

I'm able to implement the above definition in Mathematica:

Remove[a, c, s];
a[n_Integer] :=
  a[n] = 
    Flatten[
      Table[F[i, j, k, l], {l, 1, n}, {k, 1, l - 1}, {j, 1, k - 1}, {i, 1, j - 1}]] 
        /. F[i_, j_, k_, l_] -> {i, j, k, l};
c = {1,2,3,4};
s[n_Integer] := 
  Sum[(-1)^Length[Intersection[a[n][[u]], c]], {u, 1, Length[a[n]]}];

This is giving me correct results if I substitute numerics into it, such as s[5] = -3, s[6] = -1, etc. But I want Mathematica to give me a simplified symbolic result for s[n] in terms of elementary operations like sum, power, factorial, etc. Is there a way to achieve this?

$\endgroup$
  • 1
    $\begingroup$ I think this belongs on the math stack exchange instead. However, in Mathematica notation, I believe the answer is Sum[(-1)^(4 - s) Binomial[n - 4, s] Binomial[4, s], {s, 0, 4}] or 1/24 (4608 - 2566 n + 491 n^2 - 38 n^3 + n^4) $\endgroup$ – Carl Woll Jul 20 '17 at 20:14
  • $\begingroup$ Mathematica tip; a[n_Integer] := a[n] = List@@@Flatten[Table[F[i, j, k, l], {l, 1, n}, {k, 1, l - 1}, {j, 1, k - 1}, {i, 1, j - 1}]] is more concise and faster. $\endgroup$ – m_goldberg Jul 20 '17 at 22:30
  • $\begingroup$ @CarlWoll, I know that result, but I need to consider some more complicated problems with the one I wrote being a prototype. It would be nice if Mathematica can help. $\endgroup$ – Jia Yiyang Jul 21 '17 at 17:05
  • $\begingroup$ @m_goldberg, that's impressively faster, thanks! $\endgroup$ – Jia Yiyang Jul 21 '17 at 17:08
1
$\begingroup$

One possible solution I found is to use InterpolatingPolynomial, since we know the result must be a polynomial in n:

Remove[a, c, s];
   a[n_Integer] := a[n] = List @@@ Flatten[Table[F[i, j, k, l], 
{l, 1, n}, {k, 1, l - 1}, {j, 1, k - 1}, {i, 1, 
   j - 1}]];
c = {1, 2, 3, 4};
s[n_Integer] := 
Sum[  (-1)^Length[Intersection[a[n][[u]], c]], {u, 1, Length[a[n]]}];
pts = Table[{n, s[n]}, {n, 5, 9}];
Expand[InterpolatingPolynomial[pts, x]]

which gives the correct result

192 - (1283 x)/12 + (491 x^2)/24 - (19 x^3)/12 + x^4/24
$\endgroup$

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.