13
$\begingroup$

For example, starting from {1,2,3,4}, I want to generate all permutations like {1,3,2,4},{1,3,4,2},{3,4,1,2} which preserve the order of e.g first two terms {1,2} and the order of e.g. last two terms {3,4}

I've tried to use the Permutation function, but it cannot preserve the order of {1,2} and {3,4}.

$\endgroup$
  • 3
    $\begingroup$ Please include the "last n-m terms" in the body of your question; it should not be necessary to read the title to answer the question. $\endgroup$ – Mr.Wizard Jul 14 '16 at 9:36
  • 1
    $\begingroup$ @Mr.Wizard - not at all - it's simply a case of prompting to see if the effort to code up an idea is warranted - I see problem, play code in head, guesstimate performance benefit, usually close... in this case, I was thinking of the extended interpretation (which can be done more quickly than what's here), but realized after re-reading question the OP is after simple shuffle-product as noted elsewhere. If OP says they need other interpretation and speed matters, I'll happily code up idea. $\endgroup$ – ciao Jul 15 '16 at 5:19
  • 1
    $\begingroup$ I cannot seem to post this as an answer: Pick[#, OrderedQ /@ (# /. (1 | 2 | 3) -> Nothing)] &@ Pick[#, OrderedQ /@ (# /. (4 | 5 | 6 | 7) -> Nothing)] &@ Permutations[Range[7]] $\endgroup$ – user1066 Jul 15 '16 at 9:23
  • 1
    $\begingroup$ @Mr. Wizard. I accept that your code is more efficient. But is seems to me it is also quite complex and 'non-obvious' for a relatively simple task? I do not like the way you closed this question only after a number of users (including yourself) had posted informative answers, and where now no-one else can contribute. It is such behaviour that has made me (and others) become very disillusioned with SO. It used to be that anyone could ask a question, and that anyone could answer a question. $\endgroup$ – user1066 Jul 15 '16 at 16:48
  • 1
    $\begingroup$ @Mr.Wizard - hey, keep me out of the cat herding. .. $\endgroup$ – ciao Jul 15 '16 at 20:05
9
$\begingroup$
pos = {{1, 2}, {4, 5}};
list = {a, b, c, d, e};

This answer is more general, OP wants to split the list on two parts while I'm allowing not covered elements to be permuted freely, thus unnecessarily complicated.

  • we replace elements in the same group with the same unique symbol e.g {x, x, c, y, y}
  • we take advantage of the fact that Permutations considers repeated elements identical,
  • we replace unique symbol ocurrences with consecutive elements from old groups

Ugly implementation

Module[{
  temp = list,      
  uni = Unique[] & /@ pos,      
  elements = list[[#]] & /@ pos,
  i
  },

 MapThread[(temp[[#]] = #2 ) &, {pos, uni}];

 Fold[
   (i = 1; # /. #2[[1]] :> #2[[2, i++]]) &,
   #, 
   Transpose[{uni, elements}]
 ] & /@ Permutations[temp]  


 ]

enter image description here

$\endgroup$
  • $\begingroup$ I don't think it's ugly. $\endgroup$ – Szabolcs Jul 14 '16 at 10:32
  • $\begingroup$ This method seems familiar. I have a suspicion that this question has been asked before. Nevertheless +1 for some nice coding! $\endgroup$ – Mr.Wizard Jul 14 '16 at 12:13
  • $\begingroup$ @Mr.Wizard Thanks, and I think so. p.s. I overdid it since I allowed to specify parts which don't contain whole list, while OP only needs to split the list on two parts. As Coolwater shows. $\endgroup$ – Kuba Jul 14 '16 at 12:16
  • $\begingroup$ Generality is always nice however! $\endgroup$ – Mr.Wizard Jul 14 '16 at 12:17
  • $\begingroup$ This may have been the problem I was remembering and it is certainly not a duplicate: (32404) $\endgroup$ – Mr.Wizard Jul 14 '16 at 12:53
8
$\begingroup$

I think one should avoid Permutations, because it imposes unnecessarily high complexity. E.g:

go[L_, m_] := Normal[SparseArray[Flatten[With[{R = Range[Length[L]]},
 MapIndexed[Thread[Thread[{First[#2],
  Join[#, Complement[R, #]]}] -> L] &, Subsets[R, {m}]]], 1]]]

go[{1, 2, 3, 4, 5}, 2]
$\endgroup$
  • $\begingroup$ @Kuba I put the first m elements at whichever ordered positions are possible (from Subset). I put the rest n-m elements (in order because of Complement) on remaining positions, so i wouldn't expect that. $\endgroup$ – Coolwater Jul 14 '16 at 12:04
  • 1
    $\begingroup$ @Kuba The title contradicts that interpretation, even though the special case in the question text coincide with it $\endgroup$ – Coolwater Jul 14 '16 at 12:10
  • $\begingroup$ You are right, I have misinterpreted the question $\endgroup$ – Kuba Jul 14 '16 at 12:11
6
$\begingroup$

Working with Kuba's redacted method (which had problems) I came up with this:

oP2[list_, groups_] :=
  Module[{idx, ele},
    idx = ArrayComponents[
      Range @ Length @ list, 1,
      MapIndexed[Alternatives @@ # -> #2[[1]] &, groups]
    ];
    ele = list[[Ordering @ idx]];
    ele[[#]] & /@ Ordering /@ Ordering /@ Permutations @ idx
  ]

It appears to work correctly:

oP2[{"w", "i", "z", "a", "r", "d"}, {{3, 6}, {1, 2, 4}}] // Shallow
{{w,i,z,a,r,d},{w,i,z,a,d,r},{w,i,z,r,a,d},{w,i,z,r,d,a},{w,i,z,d,a,r},
 {w,i,z,d,r,a},{w,i,a,z,r,d},{w,i,a,z,d,r},{w,i,a,r,z,d},{w,i,r,z,a,d},<<50>>}
$\endgroup$
4
$\begingroup$

Several interpretations that seem to do other than what the OP is asking for resulting in unnecessary code complexity..

This is simply a shuffle-product as stated in OP (the first N of length M shuffled with the remaining M-N of the list.)

This uses some code for the SP I did long ago, with a TakeDrop tacked on to provide specification of N per OP. Quite good performance, and if OP needs functionality of other interpretations (e.g., first N and last N of list with rest fully permuted, etc.), easily adapted to such cases.

op = With[{j = Join @@ {##}, sp = Permutations[Join @@ ConstantArray @@@Transpose[{Range@Length@{##}, Length /@ {##}}]]},
      Partition[j[[Flatten[Ordering[Ordering[#]] & /@ sp]]], Length[j]]] & @@ TakeDrop@## &;

Use, (e.g. list of length 7 with first 3 and last 4 properly ordered):

op[{1,2,3,4,5,6,7},3]
$\endgroup$
  • $\begingroup$ Ah, now I finally see the interpretation you were referring to. I somehow was blind to "n" being the same value. However by this interpretation the question is a duplicate of (41614) and should be closed as such. Should we edit it to instead be the generalization that Kuba addressed, or close it and post a new question with that description? $\endgroup$ – Mr.Wizard Jul 15 '16 at 5:10
  • $\begingroup$ @Mr.Wizard - Is that "we" a nosism? ;=} As the OP is written, I'd consider it a duplicate, but the generalization is interesting, so.... your call, I had no plan to close-vote as dupe. $\endgroup$ – ciao Jul 15 '16 at 5:15
  • $\begingroup$ By "we" I expressly meant you and me. $\endgroup$ – Mr.Wizard Jul 15 '16 at 5:28
  • $\begingroup$ @Mr.Wizard - I know - it was a joke, hope not taken the wrong way. Court jester fail... $\endgroup$ – ciao Jul 15 '16 at 5:32
  • $\begingroup$ I did not take it the wrong way, you made your mood clear with an emoji; I however did not, so "fail" on my end. Seriously, little bits of humor from you, belisarius, Daniel, Simon, and others really add to the experience here; please don't stop. $\endgroup$ – Mr.Wizard Jul 15 '16 at 5:40
3
$\begingroup$
n = 5; m = 3;
a = Range[n];
left = Subsets[a, {m}];
right = Complement[a, #] & /@ left;
perm = MapThread[Join, {left, right}]
Permute[a, #] & /@ perm//TableForm

Explanation: We prepare first a list of all possible permutations using Subsets and Complement. Subsequently we Join permutations for the left $m$ and right $n-m$ objects and apply permutations by using Permute. As a result we obtain:

$\left( \begin{array}{ccccc} \mathbf{1} & \mathbf{2} & \mathbf{3} & 4 & 5 \\ \mathbf{1} & \mathbf{2} & 4 & \mathbf{3} & 5 \\ \mathbf{1} & \mathbf{2} & 4 & 5 & \mathbf{3} \\ \mathbf{1} & 4 & \mathbf{2} & \mathbf{2} & 5 \\ \mathbf{1} & 4 & \mathbf{2} & 5 & \mathbf{3} \\ \mathbf{1} & 4 & 5 & \mathbf{2} & \mathbf{3} \\ 4 & \mathbf{1} & \mathbf{2} & \mathbf{3} & 5 \\ 4 & \mathbf{1} & \mathbf{2} & 5 & \mathbf{3} \\ 4 & \mathbf{1} & 5 & \mathbf{2} & \mathbf{3} \\ 4 & 5 & \mathbf{1} & \mathbf{2} & \mathbf{3} \\ \end{array} \right)$

Notice, this example is slightly different from the one in OP. Here $n=5$, $m=3$.

$\endgroup$
  • $\begingroup$ This seems to miss some cases, e.g. 2 is never the last element. $\endgroup$ – N.J.Evans Jul 14 '16 at 21:27
  • 2
    $\begingroup$ @N.J.Evans Please, notice that in my example m=3and therefore 2 cannot be the last element. $\endgroup$ – yarchik Jul 14 '16 at 21:57
  • $\begingroup$ noted! I was expecting the same output provided by OP. I should have read more closely. I can't change my vote w/o an edit now :( If you edit to point out that you've given a different case from OP's example I'll upvote it. $\endgroup$ – N.J.Evans Jul 15 '16 at 13:02
  • 1
    $\begingroup$ @N.J.Evans Now a note is added and additionally an illustration is provided $\endgroup$ – yarchik Jul 15 '16 at 14:13
1
$\begingroup$

You can use Fold to apply patterns repeatedly to cull the list of permutations:

list = {1, 2, 3, 4};
patterns = {___, #1, ___, #2, ___} & @@@ Partition[list, 2];

This generates the patterns {{___, 1, ___, 2, ___}, {___, 3, ___, 4, ___}} which can be applied using Fold:

Fold[
 Cases[#1, #2] &,
 Permutations[list],
 patterns
 ]

The meat of the answer is the application of Fold and Cases to a list of patterns that you want to apply. The first application selects all cases where 1,2 are ordered, and the second takes only the cases of that subset in which 3,4 are ordered.

$\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.