10
$\begingroup$

Let's say I have two lists:

l1={1,2}
l2={a,b}

I want to find legal permutations of combining these two list in a way that the ordering of the members of each list, is preserved. In other words I am looking for a function ConditionalPermutation such that:

ConditionalPermutation[{1,2},{a,b}]=
{{1,2,a,b},{1,a,2,b},{a,b,1,2},{a,1,b,2},{1,a,b,2},{a,1,2,b}}

as you can see, in this simple case, we have 4 elements altogether, so the total number of permutations are 4*3*2=12. Out of these half have 2 appearing before 1 and also half have b appearing before a. Therefore the list of interest has (24/2)/2=6 legal permutations. In general there could be multiple l_i lists and each would have a different size.

I can code it with an imperative implementation, but I am looking for a neater way of doing it in Mathematica.

Ideally I want the solution to accept a general condition, or potentially one for each input list.

|improve this question
$\endgroup$
  • $\begingroup$ Just curious...what is "an imperative implementation" ? $\endgroup$ – JimB Nov 17 '16 at 23:53
  • $\begingroup$ as in like C++ code. not taking advantage of any of the higher order list manipulation functions in Mathematica. $\endgroup$ – Shb Nov 17 '16 at 23:55
  • $\begingroup$ Thanks. I'm not a C++ programmer and hadn't come across that term before. $\endgroup$ – JimB Nov 17 '16 at 23:57
  • $\begingroup$ Imperative is not a C++ term. it's basically the traditional form of writing programs. like writing for loops etc. One high level approach would be to create the full list and then filter it according to some conditions, but although that might look pretty, it's probably not very efficient. $\endgroup$ – Shb Nov 17 '16 at 23:58
  • 3
    $\begingroup$ I thought that type of coding was called procedural. $\endgroup$ – march Nov 18 '16 at 0:34
6
$\begingroup$

We have a list of lists. The function listNumbersToElements here takes such a list, along with a set of indices into it. For each index, it takes the next element from the correct list.

ClearAll[listNumbersToElements];
listNumbersToElements[inds_List, allLists_List] := Block[{c},
  c[_] = 0;
  Function[{listIndex},
    ++c[listIndex]; allLists[[listIndex, c[listIndex]]]] /@ inds]

Example:

In[157]:= listNumbersToElements[{1, 2, 1, 2}, {{1, 2}, {a, b}}]
listNumbersToElements[{1, 1, 2}, {{1, 2}, {a, b}}]
listNumbersToElements[{2, 2, 1, 1}, {{1, 2}, {a, b}}]


Out[157]= {1, a, 2, b}

Out[158]= {1, 2, a}

Out[159]= {a, b, 1, 2}

This function takes the list of lists, fills a list with n copies of each list's index, where n is the length of the respective list, then creates all permutations of the list of indices. Then it applies listNumbersToElements to each permutation, getting the final result as desired.

ClearAll[conditionalPermutation];
conditionalPermutation[lists__List] := 
 Module[{argsAsList = List@lists},
  listNumbersToElements[#, argsAsList] & /@ Permutations[Flatten[
     MapIndexed[Table[First[#2], Length[#1]] &, argsAsList],
     1]]]

Examples:

In[161]:= conditionalPermutation[{1, 2}, {a, b}]
conditionalPermutation[{1, 2}, {a, b, c}]

Out[161]= {{1, 2, a, b}, {1, a, 2, b}, {1, a, b, 2}, {a, 1, 2, b}, {a,
   1, b, 2}, {a, b, 1, 2}}

Out[162]= {{1, 2, a, b, c}, {1, a, 2, b, c}, {1, a, b, 2, c}, {1, a, 
  b, c, 2}, {a, 1, 2, b, c}, {a, 1, b, 2, c}, {a, 1, b, c, 2}, {a, b, 
  1, 2, c}, {a, b, 1, c, 2}, {a, b, c, 1, 2}}
|improve this answer
$\endgroup$
  • $\begingroup$ I get an empty list as the result. It does not appear that l (lowercase L) is defined in Length[l]. Am I missing something? $\endgroup$ – JimB Nov 18 '16 at 2:44
  • $\begingroup$ @Jim thanks for catching that. should be fixed now. accidentally copied an old cell from the notebook. $\endgroup$ – Michael Curry Nov 18 '16 at 3:18
  • 1
    $\begingroup$ +1 Very nice and elegant. And works for multiple lists! $\endgroup$ – JimB Nov 18 '16 at 3:28
  • $\begingroup$ @MichaelCurry beautiful! Out of curiosity, How would you modify conditionalPermutation if you wanted it to accept a general condition, say have the elements in the opposite order, or have the elements from the lists separated by elements from another list, so that say only {1,a,2,b} and {a,1,b,2} would be legal. $\endgroup$ – Shb Nov 18 '16 at 12:54
  • $\begingroup$ hmmm. changes to the ordering would involve changes to listNumbersToElements: basically have it pick out the elements in some other order rather than just first to last. or just reverse the input list. generating all sets satisfying a partial ordering would require more substantial changes $\endgroup$ – Michael Curry Nov 18 '16 at 14:13
5
$\begingroup$

This is an extended comment in that it gives (I hope) the number of arrangements rather than the arrangements. However, I think the steps here will suggest a way to obtain the arrangements:

a = {a1, a2};
b = {b1, b2, b3, b4};
na = Length[a];
nb = Length[b];
ip = IntegerPartitions[nb, Min[na + 1, nb]]
(* {{4},{3,1},{2,2},{2,1,1}} *)
Sum[Binomial[na + 1, Length[ip[[i]]]] Length[Permutations[ip[[i]]] ], {i, Length[ip]}]
(* 15 *)

The logic is that there will be na+1 places to put the numbers from b:

  x  a1  x  a2  x

For this example there are 3 places (na+1) to put items from b. So we look at all of the Min[na+1,nb] integer partitions of b and weight those by the number of associated permutations.

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