4
$\begingroup$

I need to find all compositions of an integer L wherein all parts do not exсeed l and parts less then l cound not be neighbor. Here is my code

test[arr0_, ll0_] :=
  Module[{arr = arr0, ll = ll0},
   result = True;
   For[i = 1, i < Length[arr], i++, 
    If[arr[[i]] < ll && arr[[i + 1]] < ll, result = False]];
   result
   ];
frag[L0_, l0_] :=
  Module[{L = L0, l = l0},
   part = IntegerPartitions[L, 2*Ceiling[L/l] + 1, Range[l]];
   part = Flatten[Map[Permutations[#] &, part], 1];
   Select[part, test[#, l] &]
   ];
frag[9, 3]

Output: {{3, 3, 3}, {3, 2, 3, 1}, {3, 1, 3, 2}, {2, 3, 3, 1}, {2, 3, 1, 3}, {1, 3, 3, 2}, {1, 3, 2, 3}, {1, 3, 1, 3, 1}}

I guess Mathematica allows to solve this problem much more easier

$\endgroup$
  • $\begingroup$ aren't there some lists missing in your output, such as e.g. {1,2,1,2,1,2}? $\endgroup$ – Pinguin Dirk Oct 21 '13 at 9:19
  • $\begingroup$ "parts less then l cound not be neighbor" in my case l=3, so 1 and 2 cannot be neighbor $\endgroup$ – Филипп Цветков Oct 21 '13 at 9:21
  • $\begingroup$ ah, ok, I understood 1 and 1 (and also 2 and 2) cannot be neighbor. Got it! $\endgroup$ – Pinguin Dirk Oct 21 '13 at 9:22
5
$\begingroup$

The problem of solutions posted so far (including yours) is that they could not take into account the limitation on the size and placement of parts of the partitions, and therefore had to consider a much larger search space, unnecessarily.

Here is a recursive solution based on linked lists and not using any built-in functions:

ClearAll[parts];
parts[accum_,0,_]:= parts[Flatten[accum]];
parts[_,_?Negative,_]:={};
parts[accum:{_,last_},num_,lim_]/;last<lim:=
    parts[{accum,lim},num-lim,lim];
parts[accum_,num_,lim_]:=
    (parts[{accum,#1},num-#1,lim]&)/@Range[lim];
parts[num_,lim_]:=
    Cases[parts[{},num,lim],parts[x_List]:>x,\[Infinity]];

What it does is to build a tree and then pick the valid combinations from it, using Cases (bad combinations result in {}, while valid ones have the form parts[combination]). Since here I have the access to the fine-grained details of the algorithm, I can ensure that a number of bad combinations will be filtered out right when we are building the tree, which reduces the search space significantly.

For example:

parts[9, 3]

(* 
   {{1, 3, 1, 3, 1}, {1, 3, 2, 3}, {1, 3, 3, 2}, {2, 3, 1, 3}, 
   {2, 3, 3, 1}, {3, 1, 3, 2}, {3, 2, 3, 1}, {3, 3, 3}}
*)

This one is also quite reasonable in terms of run-time and memory efficiency:

parts[40,5]//Short//AbsoluteTiming

(* {0.163907,{{1,5,1,5,1,5,1,5,1,5,1,5,4},<<6825>>,{5,5,5,5,5,5,5,5}}} *)
|improve this answer|||||
$\endgroup$
  • $\begingroup$ This is wonderful $\endgroup$ – ubpdqn Oct 21 '13 at 13:18
  • $\begingroup$ ... it took me longer to understand how you exactly do it than to write my answer. Big +1. $\endgroup$ – Pinguin Dirk Oct 21 '13 at 13:33
  • $\begingroup$ @PinguinDirk Thanks, but this means that I didn't explain it well. I thought the code is more or less self-explanatory. Perhaps I should have added links to similar solutions I posted before. $\endgroup$ – Leonid Shifrin Oct 21 '13 at 13:36
  • $\begingroup$ @LeonidShifrin: don't base it on my opinion alone, your explanation is great as it is - it just took a bit till I got my head around the accum (I just had to work an example, further expl. wouldn't change that, I guess) $\endgroup$ – Pinguin Dirk Oct 21 '13 at 13:39
  • $\begingroup$ @ubpdqn Thanks. I find linked lists useful in such cases as this. $\endgroup$ – Leonid Shifrin Oct 21 '13 at 13:54
3
$\begingroup$

I hope I understood it right, how about this:

doIt[int_Integer, l_Integer] := 
   DeleteCases[
     Flatten[Permutations /@ IntegerPartitions[int, int, Range[l]], 1], 
     {___, Alternatives @@ Range[l - 1], Alternatives @@ Range[l - 1], ___}];

doIt[9, 3]

{{3, 3, 3}, {3, 2, 3, 1}, {3, 1, 3, 2}, {2, 3, 3, 1}, {2, 3, 1, 3}, {1, 3, 3, 2}, {1, 3, 2, 3}, {1, 3, 1, 3, 1}}

are you going to use this on large numbers? That'll be slow... (using IntegerPartitions and Permutation)

|improve this answer|||||
$\endgroup$
  • $\begingroup$ Yes, I would like to use it for Large numbers $\endgroup$ – Филипп Цветков Oct 21 '13 at 12:00
  • $\begingroup$ ok, well, you will definitely like @LeonidShifrin's answer then! $\endgroup$ – Pinguin Dirk Oct 21 '13 at 13:13
1
$\begingroup$

Not neat but another approach...agree scaling issues

f[p_, n_] := 
  Select[Select[IntegerPartitions[p], And @@ (# <= n & /@ #) &], 
   Count[#, n] >= Floor[Length[#]/2] &];
test[x_, n_] := 
  Length[Cases[Partition[x, 2, 1], {_?(# < n &), _?(# < n &)}]] == 0;
frag[x_, n_] := 
 Join @@ Map[Select[Permutations[#], test[#, n] &] &, f[x, n]]

frag[9,3] yields:

    {{3, 3, 3}, {3, 2, 3, 1}, {3, 1, 3, 2}, {2, 3, 3, 1}, {2, 3, 1, 
  3}, {1, 3, 3, 2}, {1, 3, 2, 3}, {1, 3, 1, 3, 1}}

frag[10,3]:

{{3, 3, 3, 1}, {3, 3, 1, 3}, {3, 1, 3, 3}, {1, 3, 3, 3}, {3, 2, 3, 
  2}, {2, 3, 3, 2}, {2, 3, 2, 3}, {2, 3, 1, 3, 1}, {1, 3, 2, 3, 
  1}, {1, 3, 1, 3, 2}}
|improve this answer|||||
$\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.