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?

$\endgroup$
1
  • $\begingroup$ Your solution is not something I would ever have thought of myself. It's very cunning. $\endgroup$ Aug 25, 2015 at 19:11

2 Answers 2

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]
  ]
$\endgroup$
2
  • $\begingroup$ thanks a lot for your advices (temporary variables and OrderlessPatternSequence) $\endgroup$
    – user32623
    Aug 26, 2015 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, 2015 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.

$\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, 2015 at 19:39
  • $\begingroup$ I don't know whether it is more efficient - I'll test it. (Insert is highly inefficient, I believe.) $\endgroup$ Aug 25, 2015 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$ Aug 25, 2015 at 19:51

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.