Number of sequences with a certain condition

Question

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?

Answer 1

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]

---

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

Answer 2

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}}
*)