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$
  • $\begingroup$ You’ve also sorted the second example in some way, is this desired? $\endgroup$ – CA Trevillian May 22 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$ – Brian Hopkins May 22 at 4:08
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}} *)
| improve this answer | |
$\endgroup$
  • $\begingroup$ Thanks! I need to update to 12.1 so that I can use SubsetReplace. $\endgroup$ – Brian Hopkins May 22 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)

| improve this answer | |
$\endgroup$
  • 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 at 12:46
  • 2
    $\begingroup$ OrderlessPatternSequence is the hero of this story. Thanks for the updated version clarifications. $\endgroup$ – CA Trevillian May 22 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$ – J. M.'s technical difficulties May 22 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 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$ – CA Trevillian May 25 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.

| improve this answer | |
$\endgroup$
  • 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$ – J. M.'s technical difficulties May 22 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$ – CA Trevillian May 25 at 14:14

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.