1
$\begingroup$

Suppose I have the sequence {2, 4, 6, 8, 10, 12, 14, 16}.

How could I calculate the number of tuples so that for every term save the first one, the difference from two consecutive terms is no greater than 3.

Example: Suppose we had the sequence 2, 4, 6. The sequences that are valid would be {2,4,6}, {2,6,4}, {4,2,6}, {6,4,2}

The sequences {4,6,2} and {6,2,4} would not be valid because in {4,6,2}, 6-2=4>3, and in {6,2,4}, 6-2=4>3.

If we had a sequence such as 2, 10, 8, 6, 4, it would be valid.

However, a sequence such as 4, 6, 8, 10, 2 would not be valid because 10-2=8>3.

How can I use Mathematica to count such sequences?

Improve this question
$\endgroup$
5
  • $\begingroup$ Perhaps you could explain further ... $\endgroup$ Commented Oct 24, 2014 at 17:40
  • $\begingroup$ the left term is no greater than 3 This is not clear and your example sheds little lite on what it means. $\endgroup$ Commented Oct 24, 2014 at 17:41
  • $\begingroup$ Edited with more examples. $\endgroup$ Commented Oct 24, 2014 at 17:48
  • 2
    $\begingroup$ Hi! Just to clarify: Is this a question about Mathematica? $\endgroup$ Commented Oct 24, 2014 at 19:03
  • $\begingroup$ @YvesKlett Now it is :) $\endgroup$ Commented Oct 24, 2014 at 21:22

2 Answers 2

Reset to default
1
$\begingroup$

I don't know if this is better than calculating the Tuples[] and then filtering, but it's surely more fun:

f[set_, {}, forbid_] := f[set, {#}, forbid] & /@ set; f[set_, curr_, forbid_] := Module[{comp = Complement[set, curr]}, If[comp != {}, f[set, Append[curr, #], forbid] & /@ Select[comp, (Last[curr] - # <= forbid &)], curr] ] f1[set_, forbid_] := Partition[Flatten[f[set, {}, forbid]], Length@set]

Let's forbid a difference of 2 or greater.

f1[Range@4, 1] (* {{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 2, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {3, 2, 1, 4}, {4, 3, 2, 1}} *)

Let's calculate something a little bigger. This is the number of permutation of Range@10 surviving after forbidding differences greater than 2.

r10 = f1[Range@10, 1]; Length@r10 (* 512 *)

Consider that the unrestricted length is 10! == 3628800

The distribution of the differences is:

Histogram[-Differences /@ r10 // Flatten]

Mathematica graphics

Let's try a bibliographical research:)

rr7 = f1[Range@7, #] & /@ Range[1, 6]; Length /@ rr7 (* {64, 486, 1536, 3000, 4320, 5040} *)

We can search that sequence at OEIS

and quickly find that these kind of sequences do have a name:

A104001 Triangle T(n,k) read by rows: number of permutations in S_n avoiding all k-length patterns starting with fixed m, 2

Improve this answer
$\endgroup$
0
$\begingroup$

You can easily generalize the method provided in my previous answer to forbid sequences based on a more general function, like this:

f[set_, {}, forbidFunc_] := f[set, {#}, forbidFunc] & /@ set; f[set_, curr_, forbidFunc_] := Module[{comp = Complement[set, curr]}, If[comp != {}, f[set, Append[curr, #], forbidFunc] & /@ Select[comp, forbidFunc[curr, #] &], curr]] f1[set_, forbidFunc_] := Partition[Flatten[f[set, {}, forbidFunc]], Length@set] forbidFunc[currList_, el_] := (Last[currList] - el <= 1) Sort@f1[Range@4, forbidFunc] (* {{1, 2, 3, 4}, {1, 2, 4, 3}, {1, 3, 2, 4}, {1, 4, 3, 2}, {2, 1, 3, 4}, {2, 1, 4, 3}, {3, 2, 1, 4}, {4, 3, 2, 1}} *)
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.