how to permute list of number{1,2,3,...,n},while preserve the order of first m terms as well as the last n-m terms?

Question

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}.

Answer 1

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]  


 ]

Answer 2

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]

Answer 3

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>>}

Answer 4

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]

Answer 5

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

Answer 6

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.