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

Improve this question
$\endgroup$
20
  • 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$ Commented Jul 14, 2016 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$ Commented Jul 15, 2016 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$ Commented Jul 15, 2016 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$ Commented Jul 15, 2016 at 16:48
  • 1
    $\begingroup$ @Mr.Wizard - hey, keep me out of the cat herding. .. $\endgroup$ Commented Jul 15, 2016 at 20:05

6 Answers 6

Reset to default
9
$\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]
Improve this answer
$\endgroup$
3
  • $\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$ Commented Jul 14, 2016 at 12:04
  • 1
    $\begingroup$ @Kuba The title contradicts that interpretation, even though the special case in the question text coincide with it $\endgroup$ Commented Jul 14, 2016 at 12:10
  • $\begingroup$ You are right, I have misinterpreted the question $\endgroup$ Commented Jul 14, 2016 at 12:11
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

Improve this answer
$\endgroup$
11
  • 1
    $\begingroup$ I don't think it's ugly. $\endgroup$ Commented Jul 14, 2016 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$ Commented Jul 14, 2016 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$ Commented Jul 14, 2016 at 12:16
  • $\begingroup$ Generality is always nice however! $\endgroup$ Commented Jul 14, 2016 at 12:17
  • $\begingroup$ This may have been the problem I was remembering and it is certainly not a duplicate: (32404) $\endgroup$ Commented Jul 14, 2016 at 12:53
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>>}
Improve this answer
$\endgroup$
5
$\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]
Improve this answer
$\endgroup$
6
  • $\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$ Commented Jul 15, 2016 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$ Commented Jul 15, 2016 at 5:15
  • $\begingroup$ By "we" I expressly meant you and me. $\endgroup$ Commented Jul 15, 2016 at 5:28
  • $\begingroup$ @Mr.Wizard - I know - it was a joke, hope not taken the wrong way. Court jester fail... $\endgroup$ Commented Jul 15, 2016 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$ Commented Jul 15, 2016 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$.

Improve this answer
$\endgroup$
4
  • $\begingroup$ This seems to miss some cases, e.g. 2 is never the last element. $\endgroup$ Commented Jul 14, 2016 at 21:27
  • 2
    $\begingroup$ @N.J.Evans Please, notice that in my example m=3and therefore 2 cannot be the last element. $\endgroup$ Commented Jul 14, 2016 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$ Commented Jul 15, 2016 at 13:02
  • 1
    $\begingroup$ @N.J.Evans Now a note is added and additionally an illustration is provided $\endgroup$ Commented Jul 15, 2016 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.

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.