6
$\begingroup$

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

$\endgroup$
2
  • $\begingroup$ You’ve also sorted the second example in some way, is this desired? $\endgroup$ May 22, 2020 at 4:03
  • 3
    $\begingroup$ The ordering of the three partitions is not essential. I just put them in reverse lexicographic order, like the output of IntegerPartitions[n]. $\endgroup$ May 22, 2020 at 4:08

3 Answers 3

9
$\begingroup$

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}} *)
$\endgroup$
1
  • $\begingroup$ Thanks! I need to update to 12.1 so that I can use SubsetReplace. $\endgroup$ May 22, 2020 at 4:19
5
$\begingroup$

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)

$\endgroup$
9
  • 1
    $\begingroup$ @CATrevillian I have updated as you suggested, re-ran the code checking the output, and removed a couple of 'typos'. (I do not have access to v 12.1). Thanks for the feedback $\endgroup$
    – user1066
    May 22, 2020 at 12:46
  • 2
    $\begingroup$ OrderlessPatternSequence is the hero of this story. Thanks for the updated version clarifications. $\endgroup$ May 22, 2020 at 14:55
  • 1
    $\begingroup$ @Brian, you could minimize the confusion by editing your question to state more clearly your preference of reverse-lexicographic ordering. $\endgroup$ May 22, 2020 at 15:16
  • 1
    $\begingroup$ @BrianHopkins Ooops .... Should have been a___ (triple-blank) instead of a__ (double-blank). (I also make this error in original answer to part 1) $\endgroup$
    – user1066
    May 22, 2020 at 15:17
  • 1
    $\begingroup$ @user1066 you don't need to use an additional b___ in your first example, and the order, before/after the pattern which will be replaced, does not matter. Very nice! I like that this is backward compatible. $\endgroup$ May 25, 2020 at 14:05
3
$\begingroup$

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.

$\endgroup$
2
  • 1
    $\begingroup$ "I didn't quite follow your second example" - the OP just sorted the list reverse-lexicographically again afterwards, but {5, 2, 1, 1} maps to {5, 2 + 2}, and {2, 2, 2, 1, 1, 1} maps to {2, 2, 2 + 3}. Hopefully that clarifies the pattern for you. $\endgroup$ May 22, 2020 at 13:44
  • $\begingroup$ Mr.Wizard, for the second example, you should just be able to use rep[{2, c : (1) ..} -> {2 + c}] -- oddly, though, this does not work. I think that has something to do with scoping of the contexts of the arguments when one uses symbols in this way? I think I said that correctly... $\endgroup$ May 25, 2020 at 14:14

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.