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?

$\endgroup$
  • $\begingroup$ Perhaps you could explain further ... $\endgroup$ – Dr. belisarius Oct 24 '14 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$ – Nasser Oct 24 '14 at 17:41
  • $\begingroup$ Edited with more examples. $\endgroup$ – user21669 Oct 24 '14 at 17:48
  • 2
    $\begingroup$ Hi! Just to clarify: Is this a question about Mathematica? $\endgroup$ – Yves Klett Oct 24 '14 at 19:03
  • $\begingroup$ @YvesKlett Now it is :) $\endgroup$ – Dr. belisarius Oct 24 '14 at 21:22
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

$\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}}
*)
$\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.