Replacing a sub-partition (unordered list; multiset)

Question

I am working on a bijection for integer partitions and would appreciate help with two steps.

First, I want to replace each occurrence of (4, 2, 1, 1) with (3, 3, 2). One complication is that the 4, 2, 1, and 1 need not be adjacent. For example, the input

{{4, 4, 2, 2, 1, 1, 1}, {4, 4, 2, 2, 2, 1}}

should lead to the output

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

since the first partition does include (4, 2, 1, 1), even with the extra 2, and the second does not.

Second, in a later step, I need a 2 and all ones, suppose there are $k$ of them, to be changed to the single number $k+2$, e.g., input

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

should lead to the output

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

Edit: I put the part 2 output in the standard reverse lexicographic order used for partitions, which unfortunately caused some confusion. Partition by partition, the intent is

{5, 2, 1, 1} $\mapsto$ {5, 4},

{4, 3, 1, 1} $\mapsto$ {4, 3, 1, 1},

{2, 2, 2, 1, 1, 1} $\mapsto$ {5, 2, 2}.

Answer 1

Here is my solution to the first part of your question:

ReverseSort/@
  SubsetReplace[{4, 2, 1, 1} -> Sequence[3, 3, 2]]/@
    {{4, 4, 2, 2, 1, 1, 1}, {4, 4, 2, 2, 2, 1}}

(* Out: {{4, 3, 3, 2, 2, 1}, {4, 4, 2, 2, 2, 1}} *)

For the second part, this is as close as I got so far:

ReverseSort/@
  SubsetReplace[{2, p: Repeated[1, Infinity]} :> Length[{p}] + 2]/@
    {{5, 2, 1, 1}, {4, 3, 1, 1}, {2, 2, 2, 1, 1, 1}}

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

Answer 2

Update

---

As pointed out by CA Trevillian, b___ in the answer to Part 1 is superfluous, and the order after a___ does not matter, which improves things quite a bit.

A more succinct solution is as follows:

Replace[lst1, {OrderlessPatternSequence[a___,1,1,2,4]}:> ReverseSort[{a,2,3,3}],{1}]

---

Original Answer

 Replace[lst1, {OrderlessPatternSequence[a___,4,2,1,1,b___]}:> ReverseSort[{a,3,3,2,b}],{1}]

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

If order is unimportant:

Replace[lst1,  {OrderlessPatternSequence[a___,4,2,1,1,b___]}:> {a,3,3,2,b},{1}]

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

Part 2 (if I understand correctly):

Replace[lst2, {OrderlessPatternSequence[a___,2,c:Repeated[1]]}:> ReverseSort[{a,c+2}],{1}]

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

In response to comment by OP

Replace[lst3, {OrderlessPatternSequence[a___,2,c:Repeated[1]]}:> ReverseSort[{a,c+2}],{1}]

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

data

lst1={{4, 4, 2, 2, 1, 1, 1}, {4, 4, 2, 2, 2, 1}};

lst2={{5, 2, 1, 1}, {4, 3, 1, 1}, {2, 2, 2, 1, 1, 1}};
lst3={{5, 2, 1, 1}, {4, 3, 1, 1}, {2, 2, 2, 1, 1, 1},{2,1,1,1}};

Update (Mathematica version)

Obtained with Wolfram Language 12.0.0 Engine for Microsoft Windows (64-bit)

OrderlessPatternSequence was introduced in 2015 (10.1)

Replace was introduced in 1988 (1.0), but was updated in 2014 (10.0)

Answer 3

First part in version 10.1:

rep[{a__} -> {b__}] :=
  {OrderlessPatternSequence[x___, a]} :> Reverse@Sort@{x, b}

{{4, 4, 2, 2, 1, 1, 1}, {4, 4, 2, 2, 2, 1}} /. rep[{4, 2, 1, 1} -> {3, 3, 2}]

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

I didn't quite follow your second example; I'll update if I see the pattern.

Answer 4

list = {{4, 4, 2, 2, 1, 1, 1}, {4, 4, 2, 2, 2, 1}};

A variant of 1066's answer using SequenceReplace (new in 11.3)

SequenceReplace[list, {{OrderlessPatternSequence[a___, 1, 1, 2, 4]}} :>
   ReverseSort[{a, 2, 3, 3}]]

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