9
$\begingroup$

I'm a Mathematica beginner.

I am exploring the use of patterns and (only for fun) am trying to implement a permutations function.

My (dirty) code is:

permutations[l:{e___}] := 
   Module[{f, p}, 
     SetAttributes[f, {Orderless}];
     p = Table[Pattern @@ {Unique[], _}, {Length @ l}];
     ReplaceList[f[e], f @@ p -> p[[All, 1]]]];

permutations[{a, b, c}]

It returns:

{{a, b, c}, {a, c, b}, {b, a, c}, {b, c, a}, {c, a, b}, {c, b, a}}

Have you got a cleaner solution without use of the Unique?

Improve this question
$\endgroup$
1
  • $\begingroup$ Your solution is not something I would ever have thought of myself. It's very cunning. $\endgroup$ – Patrick Stevens Aug 25 '15 at 19:11
7
$\begingroup$

I have used a method similar to your "dirty code" myself and I don't see an apparent alternative as Pattern requires a true Symbol for its first parameter. I will note that your Unique Symbols should be made Temporary, or you can generate them with Module to add this attribute automatically. And since you are trying things for fun you could use Map in place of Table. Finally you may consider OrderlessPatternSequence rather than assigning an attribute, which brings us:

permutations[l_List] :=
  With[{p = Pattern @@ {Module[{x}, x], _} & /@ l},
    ReplaceList[l, {OrderlessPatternSequence @@ p} -> p[[All, 1]]]
  ]

Which could also be written:

permutations[l_List] :=
  With[{p = Module[{x}, x] & /@ l},
    ReplaceList[l, {OrderlessPatternSequence @@ (Pattern[#, _] &) /@ p} -> p]
  ]
Improve this answer
$\endgroup$
2
  • $\begingroup$ thanks a lot for your advices (temporary variables and OrderlessPatternSequence) $\endgroup$ – user32623 Aug 26 '15 at 10:01
  • $\begingroup$ @Olivier You're welcome. I note however that you posted a second comment as an answer; you need to register an account to make full use of this site. You should then use the contact form to request a merge of that new account with your old one. $\endgroup$ – Mr.Wizard Aug 26 '15 at 13:25
6
$\begingroup$

The first thing I came up with was:

Permutations[l]

The second thing I came up with was an inductive answer:

perms[l_] := 
 Flatten[With[{p = perms[Rest@l]}, 
  Function[{n}, Insert[#, First[l], n] & /@ p] /@ Range[Length[l]]], 
 1]

perms[{a_}] := {{a}}

I can't think of a pattern-based one at the moment, but I'm sure there's a clever one.

Improve this answer
$\endgroup$
3
  • $\begingroup$ thanks for your answer My implementation is not at all efficient, it's only a stylistic exercise to improve my practice of patterns... Your recursive solution is of course more efficient ;-) $\endgroup$ – user32616 Aug 25 '15 at 19:39
  • $\begingroup$ I don't know whether it is more efficient - I'll test it. (Insert is highly inefficient, I believe.) $\endgroup$ – Patrick Stevens Aug 25 '15 at 19:49
  • $\begingroup$ @Olivier: yours is much faster for an 8-element list. Mine took 0.1135s, yours 0.0798s, the inbuilt 0.03404s. $\endgroup$ – Patrick Stevens Aug 25 '15 at 19:51

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.