7
$\begingroup$

I have a list of replacements and some list they are acting on. However, some RHS of the replacements rules are identical (the LHS is not). I want to use those rules one after another (perhaps cycling after they run out but the amount of replacements and occurrences match in the application I am looking at now).

So for example

replaceOnceOnly[{a, b, a}, {a -> 1, a -> 2, b -> 3}]

would output {1,3,2}. Is there a simple way to achieve this?


I should have included the following: The replacement should act only on the whole of the list entry. I.e. the RHS is always an explicit element of the list the replacement acts on. It should not act on replaceOnceOnly[{f[a]},{a->1}] should not do anything. (Nor shall such an element even occur in the list to be acted on.) Also I want the replacements to act in a clear order: so from left to right for example.

(The other case is certainly interesting too but not what I am looking for.)

$\endgroup$
  • $\begingroup$ Do you want the replacements to apply only to the (whole) expression at level 1? If not, is the order of application to be depth first? Perhaps your use-case is limited, but I'm wondering about b^a + 2 a versus b^a + x a, in which the orderless property sorts the power term into a different position. Also {a b, b, a}. $\endgroup$ – Michael E2 Jul 14 at 15:06
  • $\begingroup$ @MichaelE2, yes I would like it to apply only to the whole expression. $\endgroup$ – Kvothe Jul 14 at 15:57
5
$\begingroup$

One way is to use the following:

GeneralUtilities`ListIterator
GeneralUtilities`IteratorExhausted

Then it can be done with Replace or ReplaceAll:

Needs@"GeneralUtilities`"

Module[{hold},
  SetAttributes[hold, HoldAll];
  
  oneTimeRules[rules_] :=
   
   Normal@Merge[rules, ListIterator] /. Rule -> RuleDelayed /. 
     i_GeneralUtilities`Iterator :> 
      With[{r = Read[i]}, hold[r, r =!= IteratorExhausted]] /. 
    hold -> Condition;
  
  ];

Example:

Replace[{a, b, a, a, b, b}, oneTimeRules@{a -> 1, a -> 2, b -> 3}, 1]
(*  {1, 3, 2, a, b, b}  *)

It does not work with patterns:

Replace[{a, b, a, a, b, b}, 
 oneTimeRules@{x_ -> f[x], x_ -> 2, b -> 3}, 1]
(* {f[x], 2, a, a, 3, b}  <-- should be f[a] *)

Addendum

I thought this modification of @Nasser's approach (now deleted), derived from , seemed a better idea. It seems to work with patterns.

ClearAll[useOnce, useRepeated];
SetAttributes[useRepeated, Listable];
useRepeated[(Rule | RuleDelayed)[pat_, repl_], n_ : 1] :=
  Module[{used = 0},
   pat :> repl /; used++ < n
   ];
useOnce[r_] := useRepeated[r];

Replace[{a, b, a, a, b, b}, useOnce@{a -> 1, a -> 2, b -> 3}, 1]
(*  {1, 3, 2, a, b, b}  *)

Replace[{a, b, a, a, b, b}, useOnce@{x_ -> f[x], x_ -> 2 x, b -> 3}, 1]
(*  {f[a], 2 b, a, a, 3, b}  *)

The function useRepeated lets a rule be applied up to n times, by default 1. The function useOnce is shorthand useRepeated with n = 1. The *Iterator family uses similar internal data to keep track of where an Iterator is, so if I were using this, I'd prefer useOnce.

| improve this answer | |
$\endgroup$
  • $\begingroup$ I'll probably delete it in a bit....since I got @Nasser's to work. $\endgroup$ – Michael E2 Jul 14 at 17:14
  • $\begingroup$ hi Michael. I am busy now, but I see you have a nice answer here. Mine above was just a sketch of possible method. I will delete my answer because not complete as you mentioned, it is no problem at all. $\endgroup$ – Nasser Jul 14 at 17:20
  • $\begingroup$ @MichaelE2 thank you, it seems to work excellently! $\endgroup$ – Kvothe Jul 14 at 17:40
3
$\begingroup$

This uses FirstPosition and ReplacePart. It works on the OP's example, not sure how extensible it is.

replaceOnceOnly[expr_, rules_] := Module[{val = expr, part},
    Function[
        If[Not[MissingQ[part = FirstPosition[val, #]]],
            val = ReplacePart[val, part -> #2]
        ]
    ]@@@rules;
    val
];
In[14]:= replaceOnceOnly[{a, b, a}, {a -> 1, a -> 2, b -> 3}]

Out[14]= {1, 3, 2}
| improve this answer | |
$\endgroup$
3
$\begingroup$

Here a solution which will adjust the behaviour of a set of rules which contains "duplicate" rules:

adjust[strategy_, rules_] :=
  Hold@@@GatherBy[rules, First] //
  Map[With[{vs = #[[All, 2]]}, strategy[RuleDelayed@@{#[[1, 1]], Unevaluated@vs}]]&]

cycle[k_ :> vs_] := Module[{i = 0}, k :> vs[[1+Mod[i++, Length@vs]]]]
oneshot[k_ :> vs_] := Module[{i = 0}, k :> Module[{ii = ++i}, vs[[ii]] /; ii <= Length[vs]]]
padlast[k_ :> vs_] := Module[{i = 0}, k :> vs[[Min[++i, Length[vs]]]]]
normal[k_ :> _[v_, ___]] := k :> v

Multiple Strategies

The various strategies are...

... cycle which cycles through the rules repeatedly:

{a, b, a, b, b, b, a, a} /. adjust[cycle, {a -> 1, a -> 2, b -> 3}]

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

... padlast which reuses the last rule as "padding":

{a, b, a, b, b, b, a, a} /. adjust[padlast, {a -> 1, a -> 2, b -> 3}]

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

... oneshot which just lets the rules run out:

{a, b, a, b, b, b, a, a} /. adjust[oneshot, {a -> 1, a -> 2, b -> 3}]

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

... and normal which is the regular behaviour where extra "duplicates" are ignored:

{a, b, a, b, b, b, a, a} /. adjust[normal, {a -> 1, a -> 2, b -> 3}]

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

RuleDelayed Replacements

The solution also supports replacements that use RuleDelayed (:>).

Given:

$rules =
  { f[x_] :> x, f[x_] :> 10x, f[x_] :> 100x
  , g[x_] :> -x, g[x_] :> -10x
  , h[x_] :> Echo["Evaluation Leak!"]
  };

$exprs = {f[1], g[2], f[3], g[4], f[5], f[6], g[7]};

Then:

$exprs /. adjust[cycle, $rules]
(* {1,-2,30,-40,500,6,-7} *)

$exprs /. adjust[oneshot, $rules]
(* {1,-2,30,-40,500,f[6],g[7]} *)

$exprs /. adjust[padlast, $rules]
(* {1,-2,30,-40,500,600,-70} *)

$exprs /. adjust[normal, $rules]
(* {1,-2,3,-4,5,6,-7} *)

Limited Support for Condition

Beware that the exhibited implementation only supports Condition (/;) on the left-hand side of a rule:

Range[10] /.
  adjust[cycle, {x_ /; x < 7 :> "small", x_ /; x < 7 :> "little"}]

(* {small,little,small,little,small,little,7,8,9,10} *)

It does not support conditions on the right-hand side, whether "bare" or nested within a scoping construct:

1 /. adjust[cycle, {x_ :> "small" /; x < 7}]

(* incorrect result:   small /; 1 < 7 *)
| improve this answer | |
$\endgroup$
2
$\begingroup$

I think this does the trick. It's a bit ugly and procedural though:

useRulesOnce[item_, rules_] := Module[{result, citem = item, rrules},
  rrules = Reap[Do[
      With[{repl = (citem /. r)}, 
        If[repl =!= citem, citem = repl; 
         (* Print["replacing using " <> ToString[r]] *), Sow[r]]];
      , {r, rules}]] /. Null -> Nothing;
  Return[{citem, Flatten[rrules]}]]

replaceOnceList[list_, rules_] := 
 Module[{newItem, remainingRules = rules},
  Reap[Do[
     {newItem, remainingRules} = useRulesOnce[ item , remainingRules];
     Sow[newItem];
     , {item, list}]][[-1, 1]]
  ]

replaceOnceList[{a, b, a}, {a -> 1, a -> 2, b -> 3}]
(* result: {1,3,2} *)

This works with patterns too, and you can see which rules it chose if you enable the Print comment in useRulesOnce:

replaceOnceList[{Sin[4], Sin[5], a, Sin[3], b, a}, 
 {a -> 1, 
  Sin[x_ /; EvenQ[x]] :> 0,
  Sin[x_ /; OddQ[x]] :> -1,
  b -> 4,
  a -> 5}]

(* replacing using Sin[x_ /; EvenQ[x]] :> 0
   replacing using Sin[x_ /; OddQ[x]] :> -1
   replacing using a -> 1
   replacing using b -> 4
   replacing using a -> 5

   {0, -1, 1, Sin[3], 4, 5} *)
| improve this answer | |
$\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.