6
$\begingroup$

How can I find all permutations (ways of exchanging positions of pairs in brackets) in a list? The position of elements not in pair should not change.

list = {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}, V3};

Some examples of results would be:

{V1, {A1, B1}, {A2, B2}, V2, {A3, B3}, V3}
{V1, {A2, B2}, {A1, B1}, V2, {A3, B3}, V3}
{V1, {A3, B3}, {A2, B2}, V2, {A1, B1}, V3}
$\endgroup$

4 Answers 4

5
$\begingroup$
permutepairs[list_] := Module[{pairs},
   pairs = ReplaceList[list, {___, {a_, b_}, ___} :> {a, b}];
   (list /. Thread[pairs -> #]) & /@ Permutations[pairs]];

permutepairs[{V1, {A1, B1}, {A2, B2}, V2, {A3, B3}, V3}]

enter image description here

permutepairs[{V1, {A1, B1}, {A2, B2}, V2, {A3, B3}}]

enter image description here

$\endgroup$
1
  • $\begingroup$ Nice, I spent several hours and couldn't a good way to write it short like this. $\endgroup$
    – internet
    Commented Jun 21 at 14:05
5
$\begingroup$
res =
  MapAt[Reverse, {All, 2 ;; -1}] @
   (Transpose[{Cases[list, _Symbol], #}] & /@ 
     Permutations[Cases[list, {__}]]);

Join @@@ res // Column

enter image description here

$\endgroup$
2
  • $\begingroup$ Hi, it works well for the example but if I modified the list a bit like list = {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}}; it does not work on this case. $\endgroup$
    – internet
    Commented Jun 21 at 8:04
  • $\begingroup$ In this case append V3 with Append[list, V3] and delete it after the calculation of res with res2 = MapAt[Nothing, res, {All, -1, -1}] $\endgroup$
    – eldo
    Commented Jun 21 at 8:18
2
$\begingroup$

An attempt

fn[list_List] := 
 With[{x = Cases[list, {x_, y_}]}, 
  MapApply[Function[Null, Evaluate[Replace[list, 
    Thread[x -> Array[Slot, Length@x]], 2]]]]@Permutations[x, {Length@x}]]
list = {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}, V3};

fn[list]

(* {
     {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}, V3}, 
     {V1, {A1, B1}, {A3, B3}, V2, {A2, B2}, V3}, 
     {V1, {A2, B2}, {A1, B1}, V2, {A3, B3}, V3}, 
     {V1, {A2, B2}, {A3, B3}, V2, {A1, B1}, V3}, 
     {V1, {A3, B3}, {A1, B1}, V2, {A2, B2}, V3}, 
     {V1, {A3, B3}, {A2, B2}, V2, {A1, B1}, V3}
   } *)

list2 = {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}};

fn[list2]

(* {
    {V1, {A1, B1}, {A2, B2}, V2, {A3, B3}}, 
    {V1, {A1, B1}, {A3, B3}, V2, {A2, B2}}, 
    {V1, {A2, B2}, {A1, B1}, V2, {A3, B3}}, 
    {V1, {A2, B2}, {A3, B3}, V2, {A1, B1}}, 
    {V1, {A3, B3}, {A1, B1}, V2, {A2, B2}}, 
    {V1, {A3, B3}, {A2, B2}, V2, {A1, B1}}
}*)
$\endgroup$
2
$\begingroup$

Just for somethinng different:

With[{s = 
   GroupElements[SymmetricGroup[3]] /. 
    Thread[Range[3] -> 
      Flatten[Position[list, _?(Length[#] == 2 &)]]]}, 
 Permute[list, #] & /@ s]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.