programming - Find permutations with constraints without using Permutations

EDIT: To clarify, the bottleneck right now is available RAM, so any answer should keep that in mind (I cannot store all T! lists of length T and filter out those that satisfy the condition a posteriori.)

I want to find all permutations of the elements of Range[0,T-1] that satisfy a condition, but where T may be too large for Permutations to be useable: first generating and storing all permutations simply consumes too much RAM. The condition is always such that cond = {c[1],c[2],...,c[T]} means that the first element of the permutation must be larger than or equal to c[1], the second element must be larger than or equal to c[2] etc. The condition is sorted in increasing order, and we can assume that the condition is not so strict that no permutations survive.

I have managed to implement what I want, but in a very procedural way using a recursive function (the details here are not that important):

recuPerm[level_] :=
 If[level == 0,

  res[[1]] = Total[avail];
  Sow[res],
  ((res[[level + 1]] = #; avail[[First[#] + 1]] = 0; 
       recuPerm[level - 1];
       avail[[
         First[#] + 1]] = #) & /@ ({(allow[[level + 1]].avail)} /. 
       Plus -> Sequence));
  ]

and I call it from the wrapper function:

listPerm[T_, cond_] :=
 Block[
  {a, avail, allow, res = ConstantArray[1, T], rip},
  avail = a /@ Range[0, T - 1];
  allow = 
   Table[PadLeft[ConstantArray[1, T - cond[[i]]], T], {i, 
     T}];
  rip = Reap[recuPerm[T - 1]][[2]];
  If[rip == {}, {}, rip[[1]]]
  ]

(The dummy head a is simply there so I can use Total and Dot in order to pick out allowed elements.)

Do you know of an approach that is more functional in nature and/or can better take advantage of the strengths of Mathematica? If it's more memory efficient (or faster) than my (unelegant) attempt then that's of course a bonus!

Answer

This is pretty functional:

f = Module[{comps, r = Reverse@Range[#2, #1 - 1]},
    comps[l1_, l2_] := Join @@ Map[Thread[{Sequence @@ #, Complement[l2, #]}] &, l1];
    Reverse /@ Fold[comps, Transpose@{First@r}, Rest@r]] &;

This is about 10-15% faster, very slightly higher memory use (but still far below your current solution):

fz = With[{r = Reverse@Range[#2, #1 - 1]}, 
          Fold[(Join @@ MapThread[Thread[{Sequence @@ #1, #2}] &, 
               {#1, Outer[Complement, {#2}, #1, 1][[1]]}]) &, 
               Transpose@{r[[1]]}, Rest@r][[All, -1 ;; 1 ;; -1]]] &;

Comparing and including djp's interesting solution:

t = 11;
c = cond = {0, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6};

lp = listPerm[t, c]; // Timing // First


Timing[
  possibleElements = Range[cond, Length@cond - 1];
  fn[{{last_}}] := {{last}};
  fn[{most__List, last_List}] := Table[{fn[{most} /. i -> Sequence[]], i}, {i, last}];
  intermediate = fn[possibleElements];
  result = intermediate //. {x : {{__Integer} ..}, i_Integer} :> Sequence @@ (Append[#, i] & /@ x);
  ] // First

fr = f[t, c]; // Timing // First


fzr = fz[t, c]; // Timing // First

(lp /. a[x_] :> x) == result == fr == fzr

(*

8.704856

6.661243


2.839218

2.464816

True

*)

Timings on an old netbook, but ~3X faster. Memory utilization s/b close to optimal: it never grows the intermediate results list to more than the ultimate results list length. Fails gracefully - if restrictions have no results, it returns no permutations (your current code, I'm sure you're aware, goes bonkers ;-} ). This s/b easy to adapt to a staggered restriction range, that is, differing lower and upper bounds for each position, should you so desire.

Neat puzzle, BTW...

Side note: You'll beat these by doing things iteratively... bodging up a function generator that builds such a solution based on parameters was 60% faster than my own fastest on some quick tests...