First evaluate in place all subexpressions matching pattern before substituting result
In case you do have some knowledge about the expressions to be replaced and you can confidently predict that Position
will not lead to nested replacements, you might still want to use a hash table to hold the intermediate results.
ReplaceAllOnceH2[expr_, rules_List] :=
With[{p = Position[expr, Alternatives @@ rules[[All, 1]]],
t = System`Utilities`HashTable[]},
ReplacePart[expr,
Thread[p ->
Extract[expr, p,
If[System`Utilities`HashTableContainsQ[t, #],
System`Utilities`HashTableGet[t, #],
With[{w = Replace[#, rules]},
System`Utilities`HashTableAdd[t, #, w]; w]] &]]]]
Edit: Carl Woll's answer made me realize it should be done differently. The code below Sow
s the replacement values (wrapped by eval
and Hold
), because these may be non-injective wrt. the variables in the patterns.
eval
prevents the second ReplaceAll
from replacing parts that didn't match the pattern in the first place. Hold
prevents evaluation until the association is constructed (whereby duplicates are deleted). First
is applied to release Hold
.
replaceOnce[expr_, rules_] := Module[{eval, expr2, reap},
{expr2, {reap}} = Reap[expr /. Fold[MapAt[#2, #, {All, 2}] &, rules, {Hold, eval, Sow}]];
expr2 /. First @@@ AssociationThread[reap -> reap]]
replaceOnce[expr, rules] // AbsoluteTiming
{2.0040347, (a + 2 b + c) (d + 2 e + f)}
Old answer:
You can use ReplaceAll
to find the cases and Sow
them as non-delayed rules. By putting the non-delayed rules in an Association
, duplicates are automatically deleted. The association holds the evaluation, however, so Map[Identity]
is applied.
Even if your rules
is short, there may be many distinct matches, and if that is case replacing with an Association
is usually preferable.
evaluateRules[expr_, rules_List] :=
Module[{eval, rules2 = rules},
rules2[[All, 1]] = eval /@ rules2[[All, 1]];
Identity /@ (Association[Reap[expr /. #;][[2, 1]]] /. rules2) &[
Pattern[a, #] :> Sow[a -> eval[a]] & /@ rules[[All, 1]]]]
expr /. evaluateRules[expr, rules] // AbsoluteTiming
{3.0014318, (a + 2 b + c) (d + 2 e + f)}
1.05174 seconds
This is very simple, first get the Position
, then evaluate only the rules that are been used (non empty Position
list ) using ParallelTable
to avoid sequential evaluation. Using Table
would take 2 seconds.
expr := (a parity[1] + b parity[2] + c parity[3])*(d parity[1] +
e parity[2] + f parity[3]);
rules = {
parity[x_Integer?OddQ] :> (Pause[1]; 1),
parity[x_Integer?EvenQ] :> (Pause[1]; 2),
nonexistent[_] :> (Pause[1]; 0)
};
LaunchKernels[]
ClearAll[replacerh];
replacerh[expr_, rules_] := With[
{pos = Position[expr, #] & /@ rules[[All, 1]]},
ReplacePart[expr,
ParallelTable[
If[
Length[pos[[k]]] > 0,
pos[[k]] -> rules[[k, 2]],
Nothing
]
, {k, Length[pos]}
]
]
]
replacerh[expr, rules] // AbsoluteTiming
(* {1.05174, (a + 2 b + c) (d + 2 e + f)} *)