3
$\begingroup$

I have the following simple code:

z = {a, b, c}
{{1, 2, 3}, {1, 3, 2}, {3, 2, 
   1}} /. {a_Integer, b_Integer, c_Integer} /; OrderedQ[z] ->   1

which returns the output:

{1,1,1}

But my desired behaviour is that of:

{{1, 2, 3}, {1, 3, 2}, {3, 2, 
   1}} /. {a_Integer, b_Integer, c_Integer} /; 
   OrderedQ[{a, b, c}] ->   1

{1, {1, 3, 2}, {3, 2, 1}}

How to work with z and yet get my desired behaviour? How to ensure that z in my code refers to local instances of {a,b,c} that are matched when a pattern is encountered?

Edit 1:

Fred's answer solves my original problem. But doesn't solve the real problem I had at hand, i.e.

Attributes[f] = Orderless;
ReplaceList[f @@ {1, 2, 3, 4, 5}, 
 f @@ (t : 
      MapThread[
       Pattern[#1, Repeated[_, {#2}]] &, {{x1, x2, x3}, {1, 2, 
         2}}]) /; (OrderedQ[List /@ t]) -> {{x1}, {x2}, {x3}}]

doesn't work, whereas

Attributes[f] = Orderless;
ReplaceList[f @@ {1, 2, 3, 4, 5}, 
 f @@ (MapThread[
      Pattern[#1, Repeated[_, {#2}]] &, {{x1, x2, x3}, {1, 2, 
        2}}]) /; (OrderedQ[ {{x1}, {x2}, {x3}}]) -> {{x1}, {x2}, \
{x3}}]

works

What is going wrong here?

Edit 2:

This question was a precursor to the my earlier related question: Totally orderless partition

$\endgroup$
  • $\begingroup$ @Fred Simons I want to find a way to name a pattern which will not directly be matched but a function of that pattern will be. The naming becomes crucial as I have OrderedQ as my pattern test. $\endgroup$ – Subho May 15 '18 at 8:42
5
$\begingroup$

This is an answer to your original question:

{{1,2,3},{1,3,2},{3,2,1}}/.z:{a_Integer,b_Integer,c_Integer}/;OrderedQ[z]->1

(* {1, {1, 3, 2}, {3, 2, 1}} *)

Or, since a, b,c are not in your result,

{{1,2,3},{1,3,2},{3,2,1}}/.z:{__Integer}/;OrderedQ[z]->1

(* {1,{1,3,2},{3,2,1}} *)

With respect to the question in your Edit, the first line does not work due to an incorrect positioning of the pattern name t. As remarked by Henrik Schumacher as well, you should use t:f@@Mapthread[.. instead.

However, then you get a larger output than produced by your second line. Sorting each of the results in this output and then removing the duplicates gives the answer you are looking for:

Attributes[f]=Orderless;
result=ReplaceList[f[1,2,3,4,5],t:f@@(MapThread[Pattern[#1,Repeated[_,{#2}]]&,{{x1,x2,x3},{1,2,2}}])/;(OrderedQ[List/@t])->{{x1},{x2},{x3}}];
DeleteDuplicates [Sort /@ result]

(* {{{1},{2,3},{4,5}},{{1},{2,4},{3,5}},{{1},{2,5},{3,4}},{{2},{1,3},{4,5}},
   {{2},{1,4},{3,5}},{{2},{1,5},{3,4}},{{3},{1,2},{4,5}},{{3},{1,4},{2,5}},
   {{3},{1,5},{2,4}},{{4},{1,2},{3,5}},{{4},{1,3},{2,5}},{{4},{1,5},{2,3}},
   {{5},{1,2},{3,4}},{{5},{1,3},{2,4}},{{5},{1,4},{2,3}}} *)

In your comment on this solution, you asked if this could not be done by a clever use of pattern matching and pattern test only.

After some playing I found the following:

Attributes[f]=Orderless;
ReplaceList[f[1,2,3,4,5],f[x1:Repeated[_,{1}],x2:Repeated[_,{2}],x3:Repeated[_,{2}]]:>{{x1},{x2},{x3}}  /; {x2}[[1]]<{x3}[[1]]]

(* {{{1},{2,3},{4,5}},{{1},{2,4},{3,5}},{{1},{2,5},{3,4}},
{{2},{1,3},{4,5}},{{2},{1,4},{3,5}},{{2},{1,5},{3,4}},{{3},{1,2},{4,5}},
{{3},{1,4},{2,5}},{{3},{1,5},{2,4}},{{4},{1,2},{3,5}},{{4},{1,3},{2,5}},
{{4},{1,5},{2,3}},{{5},{1,2},{3,4}},{{5},{1,3},{2,4}},{{5},{1,4},{2,3}}} *)

But this is a very subtle solution. Observe that we do not require that the sequences x2 and x3 are ordered. That was explained by @Martin Ender in his comment on an answer given here. Pattern matching with orderless functions is by no means trivial. If your only reason for using them is to run through all permuations of the arguments, then I would strongly prefer a solution that does not use pattern matching at all, for example:

({#[[{1}]], #[[{2,3}]], #[[{4,5}]]}& /@ Select[Permutations[Range[5]], #[[2]]<#[[3]]&&#[[4]]<#[[5]]&&#[[2]]<#[[4]]&]) 

(*{{{1},{2,3},{4,5}},{{1},{2,4},{3,5}},{{1},{2,5},{3,4}},
{{2},{1,3},{4,5}},{{2},{1,4},{3,5}},{{2},{1,5},{3,4}},{{3},{1,2},{4,5}},
{{3},{1,4},{2,5}},{{3},{1,5},{2,4}},{{4},{1,2},{3,5}},{{4},{1,3},{2,5}},
{{4},{1,5},{2,3}},{{5},{1,2},{3,4}},{{5},{1,3},{2,4}},{{5},{1,4},{2,3}}} *)
$\endgroup$
  • $\begingroup$ Please check my updated question. $\endgroup$ – Subho May 15 '18 at 6:36
  • $\begingroup$ Can one not do this by a clever use of pattern mtaching and pattern test only? $\endgroup$ – Subho May 15 '18 at 9:25
  • $\begingroup$ The last two approaches are nice. Thanks for sharing them. $\endgroup$ – Subho May 15 '18 at 14:38
3
$\begingroup$

f@@ t: MapThread[...] replaces Pattern by f, but you want List (produced by MapThread) replaced by f.

Try

ReplaceList[f @@ {1, 2, 3, 4, 5}, 
 t : (f @@ 
      MapThread[
       Pattern[#1, Repeated[_, {#2}]] &, {{x1, x2, x3}, {1, 2, 
         2}}]) /; (OrderedQ[List /@ t]) -> {{x1}, {x2}, {x3}}]
$\endgroup$
  • $\begingroup$ This is exactly my comment on the question :)... But it returns a larger output than the OP seems to want to have, so I think that the condition in terms of t should be reformulated. $\endgroup$ – Fred Simons May 15 '18 at 8:53
  • $\begingroup$ Fred, I'm sorry, really. I shoul have read the comment, first. Feel free to edit your answer and I will delete mine. $\endgroup$ – Henrik Schumacher May 15 '18 at 8:55
  • $\begingroup$ Henrik, I edited my answer, with some further processing to arrive at the result that the OP seems to want to have. No reason for deleting you answer. Things like that happen to me too often. $\endgroup$ – Fred Simons May 15 '18 at 9:18
0
$\begingroup$

After a lot of tinkering, using a scoping construct did the trick. Seems like the pattern condition needed the evaluated form of List/@list and With allowed me to do just that.

Attributes[f] = Orderless;
list = {x1, x2, x3};
ReplaceList[f @@ {1, 2, 3, 4, 5}, 
 With[{list = list, list2 = List /@ list}, 
  f @@ (MapThread[
       Pattern[#1, Repeated[_, {#2}]] &, {list, {1, 2, 2}}]) /; 
    OrderedQ[list2] -> List /@ list]]

This is the same function that is wrapped inside a Module:

OrderlessPartition[set_List, part_List] := 
 Module[{f, part2, list}, Attributes[f] = Orderless;
  part2 = Sort@part;
  list = Unique["x", Temporary] & /@ part2; 
  ReplaceList[f @@ set, 
   With[{list1 = list, list2 = List /@ list}, 
    f @@ (MapThread[
         Pattern[#1, Repeated[_, {#2}]] &, {list1, part2}]) /; 
      OrderedQ[list2] -> List /@ list1]]]

The special case at hand:

OrderlessPartition[Range[5], {1, 2, 2}]

{{{1}, {2, 3}, {4, 5}}, {{1}, {2, 4}, {3, 5}}, {{1}, {2, 5}, {3, 4}}, {{2}, {1, 3}, {4, 5}}, {{2}, {1, 4}, {3, 5}}, {{2}, {1, 5}, {3, 4}}, {{3}, {1, 2}, {4, 5}}, {{3}, {1, 4}, {2, 5}}, {{3}, {1, 5}, {2, 4}}, {{4}, {1, 2}, {3, 5}}, {{4}, {1, 3}, {2, 5}}, {{4}, {1, 5}, {2, 3}}, {{5}, {1, 2}, {3, 4}}, {{5}, {1, 3}, {2, 4}}, {{5}, {1, 4}, {2, 3}}}

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