2
$\begingroup$

Edit:

I attempted to use the method of repeatedly using Replace instead of ReplaceRepeated as suggested by Mr.Wizard, but the issues still remains. The simplest example I could think of is this:

PlusRule = { Plus[x_NumSymb,y_NumSymb,b___] :> Plus[NumSymb[Unique[]],b] };

(* just a sum of 16 NumSymb objects *)
testSum = Sum[NumSymb[Unique[]],{i,1,16}];

Table[Timing[Replace[testSum[[Range@n]],PlusRule,{0,Infinity}]][[1]],{n,1,16}]

(*
{0.000059, 0.000079, 0.000055, 0.000087, 0.000191, 0.000534, \
0.001428, 0.001097, 0.003493, 0.010644, 0.033112, 0.102373, 0.314284, \
0.980085, 3.05019, 9.41216}
*)

Table[Timing[ReplaceAll[testSum[[Range@n]],PlusRule]][[1]],{n,1,16}]

(*
{0.000043, 0.000059, 0.000047, 0.000073, 0.000183, 0.000548, \
0.001664, 0.001987, 0.003545, 0.010998, 0.034157, 0.102945, 0.326322, \
1.0214, 3.12903, 9.52135}
*)

Table[Timing[ReplaceRepeated[testSum[[Range@n]],PlusRule]][[1]],{n,1,16}]

(*
{0.000063, 0.000063, 0.00006, 0.000109, 0.000265, 0.000785, 0.002295, \
0.002188, 0.005639, 0.015812, 0.048789, 0.151387, 0.487731, 1.5194, \
4.65665, 14.1617}
*)

The timings get much worse with more terms. I still do not see what is so bad about the replacement, especially with an expression so simple.

End Edit

I have a rational expression with very large numerical coefficients, which I want to replace with placeholder symbols to improve the runtime in later operations.

My idea was to replace each coefficient with some unique object NumSymb[$1234] via

expr //.{Times[a_/;And[!MatchQ[a,_NumSymb],AllTrue[{Mu1,MuTilde1},FreeQ[a,#]&]],b___]:>Times[NumSymb[Unique[]],b],
         Plus[a_/;And[!MatchQ[a,_NumSymb],AllTrue[{Mu1,MuTilde1},FreeQ[a,#]&]],b___]:>Plus[NumSymb[Unique[]],b]}

where {Mu1,MuTilde1} are the free variables in expr. In my special case this leads to

NumSymb[$22929]*(NumSymb[$22930]*(NumSymb[$22936] + NumSymb[$22938]*(NumSymb[$22966]*(NumSymb[$23010] + Mu1*MuTilde1*NumSymb[$23041] + NumSymb[$23064]/(Mu1*MuTilde1)) + 
      (NumSymb[$22983]*(NumSymb[$22992] + Mu1^2*MuTilde1^2*NumSymb[$23002]))/(NumSymb[$23030] + Mu1*MuTilde1*NumSymb[$23066] + NumSymb[$23084]/(Mu1*MuTilde1))) + 
    NumSymb[$22939]*(NumSymb[$22956] + NumSymb[$22962]*(NumSymb[$23003]*(NumSymb[$23057] + Mu1*MuTilde1*NumSymb[$23086] + NumSymb[$23100]/(Mu1*MuTilde1)) + 
        (NumSymb[$23022]*(NumSymb[$23033] + Mu1^2*MuTilde1^2*NumSymb[$23046]))/(NumSymb[$23079] + Mu1*MuTilde1*NumSymb[$23102] + NumSymb[$23108]/(Mu1*MuTilde1))))) + 
  NumSymb[$22931]*(NumSymb[$22937] + NumSymb[$22940]*(NumSymb[$22970]*(NumSymb[$23014] + Mu1*MuTilde1*NumSymb[$23048] + NumSymb[$23070]/(Mu1*MuTilde1)) + 
      (NumSymb[$22987]*(NumSymb[$22997] + Mu1^2*MuTilde1^2*NumSymb[$23007]))/(NumSymb[$23036] + Mu1*MuTilde1*NumSymb[$23072] + NumSymb[$23089]/(Mu1*MuTilde1))) + 
    NumSymb[$22941]*(NumSymb[$22959] + NumSymb[$22965]*(NumSymb[$23008]*(NumSymb[$23062] + Mu1*MuTilde1*NumSymb[$23091] + NumSymb[$23103]/(Mu1*MuTilde1)) + 
        (NumSymb[$23027]*(NumSymb[$23039] + Mu1^2*MuTilde1^2*NumSymb[$23053]))/(NumSymb[$23083] + Mu1*MuTilde1*NumSymb[$23105] + NumSymb[$23109]/(Mu1*MuTilde1))))))

To further reduce size I am trying to expand this expression, and combine sums or products into single NumSymb objects. For products this works well, and is very fast:

Timing[Expand[%]//.{
        Times[a1_NumSymb,a2_NumSymb,b__] :> Times[NumSymb[Unique[]],b],
        Times[a1_NumSymb,a2_NumSymb] :> NumSymb[Unique[]]
    }]
(*
{0.000608, NumSymb[$23991] + NumSymb[$23992] + NumSymb[$24015] + NumSymb[$24016] + NumSymb[$24037] + NumSymb[$24038] + Mu1*MuTilde1*NumSymb[$24039] + 
  Mu1*MuTilde1*NumSymb[$24040] + NumSymb[$24043]/(Mu1*MuTilde1) + NumSymb[$24044]/(Mu1*MuTilde1) + 
  NumSymb[$24045]/(NumSymb[$23887] + Mu1*MuTilde1*NumSymb[$23923] + NumSymb[$23941]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$24046])/(NumSymb[$23887] + Mu1*MuTilde1*NumSymb[$23923] + NumSymb[$23941]/(Mu1*MuTilde1)) + 
  NumSymb[$24048]/(NumSymb[$23893] + Mu1*MuTilde1*NumSymb[$23929] + NumSymb[$23946]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$24049])/(NumSymb[$23893] + Mu1*MuTilde1*NumSymb[$23929] + NumSymb[$23946]/(Mu1*MuTilde1)) + NumSymb[$24057] + NumSymb[$24058] + 
  Mu1*MuTilde1*NumSymb[$24059] + Mu1*MuTilde1*NumSymb[$24060] + NumSymb[$24061]/(Mu1*MuTilde1) + NumSymb[$24062]/(Mu1*MuTilde1) + 
  NumSymb[$24063]/(NumSymb[$23936] + Mu1*MuTilde1*NumSymb[$23959] + NumSymb[$23965]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$24064])/(NumSymb[$23936] + Mu1*MuTilde1*NumSymb[$23959] + NumSymb[$23965]/(Mu1*MuTilde1)) + 
  NumSymb[$24065]/(NumSymb[$23940] + Mu1*MuTilde1*NumSymb[$23962] + NumSymb[$23966]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$24066])/(NumSymb[$23940] + Mu1*MuTilde1*NumSymb[$23962] + NumSymb[$23966]/(Mu1*MuTilde1))}
*)

However, attempting to coalesce the sums of NumSymbs in a similar manner is very slow. Just trying this on the first 21 terms takes almost 40 seconds:

Timing[%[[2]][[Range@21]]//.{
        Plus[a1_NumSymb,a2_NumSymb,b__] :> Plus[NumSymb[Unique[]], b],
        Plus[a1_NumSymb,a2_NumSymb] :> NumSymb[Unique[]]
    }]
(*
{38.768701, Mu1*MuTilde1*NumSymb[$25170] + Mu1*MuTilde1*NumSymb[$25171] + NumSymb[$25174]/(Mu1*MuTilde1) + NumSymb[$25175]/(Mu1*MuTilde1) + 
  NumSymb[$25176]/(NumSymb[$25018] + Mu1*MuTilde1*NumSymb[$25054] + NumSymb[$25072]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$25177])/(NumSymb[$25018] + Mu1*MuTilde1*NumSymb[$25054] + NumSymb[$25072]/(Mu1*MuTilde1)) + 
  NumSymb[$25179]/(NumSymb[$25024] + Mu1*MuTilde1*NumSymb[$25060] + NumSymb[$25077]/(Mu1*MuTilde1)) + 
  (Mu1^2*MuTilde1^2*NumSymb[$25180])/(NumSymb[$25024] + Mu1*MuTilde1*NumSymb[$25060] + NumSymb[$25077]/(Mu1*MuTilde1)) + Mu1*MuTilde1*NumSymb[$25190] + 
  Mu1*MuTilde1*NumSymb[$25191] + NumSymb[$25192]/(Mu1*MuTilde1) + NumSymb[$25193]/(Mu1*MuTilde1) + 
  NumSymb[$25194]/(NumSymb[$25067] + Mu1*MuTilde1*NumSymb[$25090] + NumSymb[$25096]/(Mu1*MuTilde1)) + NumSymb[$25204]}
*)

What is the problem with this last replacement rule? I would have naively expected similar speeds as in the product case.

Improve this question
$\endgroup$
6
  • $\begingroup$ Your use of Unique makes it a little difficult for me to tell if the output is the same, but I suspect you will get better performance by using Replace, multiple times if necessary, versus ReplaceRepeated for reasons explained in (20181). I also recommend reading (56062). $\endgroup$
    – Mr.Wizard
    Jun 17, 2020 at 12:46
  • $\begingroup$ Thank you, that basically solved the problem. I did not even know that Replace and ReplaceRepeated where traversing expressions differently, so I definitely learned something new today. Though it does still seem weird that ReplaceRepeated was not able to handle the expression above, since it is neither very larger nor very nested. $\endgroup$
    – Hausdorff
    Jun 17, 2020 at 18:34
  • $\begingroup$ Sorry, I was experimenting on an expression which just happened to work out. Once the number becomes large enough, Replace also grinds to a halt. I added a simple example in my question. $\endgroup$
    – Hausdorff
    Jun 18, 2020 at 21:47
  • $\begingroup$ Your updated example is much better. Sorry that I didn't spot the right problem before, but hopefully the Replace thing and traversal knowledge comes in handy later. The actual problem arises from the Flat and Orderless attributes of Plus. I am going to try to find another question I recall that relates to this that should help to explain things. $\endgroup$
    – Mr.Wizard
    Jun 19, 2020 at 5:46
  • 1
    $\begingroup$ Thank you, I think I have a working version now. Particularly the comment in (130984) about matching against NumSymb[_] rather than _NumSymb was very helpful, as that does seem to improve the efficiency dramatically. $\endgroup$
    – Hausdorff
    Jun 19, 2020 at 11:15

2 Answers 2

Reset to default
5
$\begingroup$

Use the rule:

HoldPattern @ Plus[__NumSymb] :> NumSymb[Unique[]]

instead. For example:

Table[
    testSum[[Range@n]] /. HoldPattern @ Plus[__NumSymb] :> NumSymb[Unique[]],
    {n, 16}
] //AbsoluteTiming

{0.000197, {NumSymb[$11], NumSymb[$275], NumSymb[$276], NumSymb[$277],
NumSymb[$278], NumSymb[$279], NumSymb[$280], NumSymb[$281], NumSymb[$282], 
NumSymb[$283], NumSymb[$284], NumSymb[$285], NumSymb[$287], NumSymb[$288],
NumSymb[$289], NumSymb[$290]}}

Update

For your example in the comments:

What's happening is that Plus is both Flat and Orderless, which means that applying patterns can be slow, since all groupings and sorts need to be tried. If you have many symbols, it is better to suppress this behavior somehow. One idea is to use Verbatim to hide the attributes of Plus from the pattern matcher:

testSum = Sum[a[i], {i,1,30}] + Sum[NumSymb[Unique[]], {i,1,30}];

testSum /. Verbatim[Plus][a___, Longest[b__NumSymb], c___] :> a + c + NumSymb[Unique[]]

a[1] + a[2] + a[3] + a[4] + a[5] + a[6] + a[7] + a[8] + a[9] + a[10] + a[11] + a[12] + a[13] + a[14] + a[15] + a[16] + a[17] + a[18] + a[19] + a[20] + a[21] + a[22] + a[23] + a[24] + a[25] + a[26] + a[27] + a[28] + a[29] + a[30] + NumSymb[\$551]

Another idea is to create a new wrapper:

plus[a___, _NumSymb, b___] := DeleteCases[a+b,_NumSymb] + NumSymb[Unique[]]
plus[a___] := Plus[a]

testSum /. Plus -> plus

a[1] + a[2] + a[3] + a[4] + a[5] + a[6] + a[7] + a[8] + a[9] + a[10] + a[11] + a[12] + a[13] + a[14] + a[15] + a[16] + a[17] + a[18] + a[19] + a[20] + a[21] + a[22] + a[23] + a[24] + a[25] + a[26] + a[27] + a[28] + a[29] + a[30] + NumSymb[\$552]

Improve this answer
$\endgroup$
1
  • $\begingroup$ This does solve the problem in the case of the example I gave, but I am not sure how to extend it to the case where there are also summands other than NumSymb. For example, applying it to the sum testSum = Sum[a[i],{i,1,30}]+Sum[NumSymb[Unique[]],{i,1,30}] still is extremely slow, and timings now increase with the number of non NumSymb terms. $\endgroup$
    – Hausdorff
    Jun 19, 2020 at 11:19
0
$\begingroup$

The question (130984) pointed out to me by Mr.Wizard in the comments was really helpful. The answer there mentions that matching against an explicit Head like f[_] can enable optimizations in the pattern matcher that would not apply when for example using _f.

This essentially solved the problem for me, as performing replacements with the pattern

HoldPattern@Plus[x:NumSymb[_],y:NumSymb[_]] :> NumSymb[Unique[]]

takes only milliseconds even on large expressions.

I still think Carl's solution is much better, since it can be used when not matching against an explicit Head. Also it does not rely on any special behaviour of the pattern matcher, which could change in the future.

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.