A pattern condition involving OrderedQ

Question

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

Answer 1

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}}} *)

Answer 2

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}}]

Answer 3

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