Skip to main content

performance tuning - How to speed up calculation of this equation (FindRoot)


I have come up with the following functions, and I need to calculate a value, in order to have a condition valid. In my problem, all data are given, and I need to calculate variable l. I am using findroot, and I give an initial value of 25 (plausible assumption) in order to get what I need. Although my calculation is correct, it is really time consuming (I am using an i7 -3720 qm) and it takes almost 8-9 seconds. My question is, how can I speed up evaluation speed.


f1[x_, y_] := 
  PDF[NormalDistribution[l, 3.975], x]*

   PDF[NormalDistribution[53.559 - l, 3.975], y];
p = (1 - Sum[f1[i, i], {i, 0, 50}])/(1 - 
     Sum[f1[i, i], {i, 0, 50}]*1.4317884120211488); 



f2[x_, y_] := If[x == y, f1[x, y]*1.4317884120211488`,
   f1[x, y]/p];

A = SessionTime[];

sexpNEW = 
 FindRoot[Sum[f2[i, j], {i, 0, 50}, {j, 0, i - 6.5}] == 
   0.4605263157894738, {l, 25}]
B = SessionTime[];

My results:


{l->29.8104}

{ speed:,8.6508650,seconds}



consider the following example, which is based on my previous, but this time some variables are unknown, lets call them u1, u2, u3


f1[x_,y_]:=PDF[NormalDistribution[u1,2.1],x]*PDF[NormalDistribution[u2,2.05],y];

p=(1-Sum[f1[i,i],{i,0,20}])/(1-Sum[f1[i,i],{i,0,50}]*u3);

f2[x_,y_]:=If[x==y,f1[x,y]*u3,f1[x,y]/p];

   limit1=20.5;




 FindRoot[
  Sum[f2[i, j], {i, 0, limit1}, {j, 0, limit1 - i}] == 
    0.4285714285714286`
   && Sum[f2[i, j], {i, 1, 20}, {j, 0, i - 1}] == 0.47417677642980943`
   && Sum[f2[i, j], {j, 1, 20}, {i, 0, j - 1}] == 
    0.2558058925476603`, {u1, 12}, {u2, 12}, {u3, 
   1}] // AbsoluteTiming


{8.18311, {u1 -> 11.0489, u2 -> 10.0626, u3 -> 2.10168}}

How would I use compile as you did @xzczd, in order to use findroot for a 3*3 system?



edit: (26/2/2016)


I am studying compile and I have a question regarding its applications. Could I use it in recursive functions too? I am using memoization, but even though I gain in speed, I was thinking that compile could improve my speeds further. My question is, how could I define the following function with compile? I tried to do so, but when I call my function, it keeps running forever.


This is my original function


f[t_, d_] := 
 f[t, d] = 
  If[t > 80, 0, 

   If[d == A && t == B, 1, 
    p7h*f[t + 1, d - 7] + p5h*f[t + 1, d - 5] + 
     p3h*f[t + 1, d - 3] + p7a*f[t + 1, d + 7] + 
     p5a*f[t + 1, d + 5] + p3a*f[t + 1, d + 3] + 
     pns*f[t + 1, d]]]

and this is how i tried to rewrite it using Compile


fC=
 Compile[{t, d},
  If[t > 80, 0,

   If[d == A && t == B, 1, 
    p7h*fC[t + 1, d - 7] + p5h*fC[t + 1, d - 5] + 
     p3h*fC[t + 1, d - 3] + p7a*fC[t + 1, d + 7] + 
     p5a*fC[t + 1, d + 5] + p3a*fC[t + 1, d + 3] + 
     pns*fC[t + 1, d]]]
  ]

t,d are intenger variables, and so are A and B. Thank you in advance.



Answer



You need Compile, with option "EvaluateSymbolically" -> False:



cf = Compile[{l}, #, RuntimeOptions -> "EvaluateSymbolically" -> False] &@
   Sum[f2[i, j], {i, 0, 50}, {j, 0, i - 6.5}];

FindRoot[cf@l == 0.4605263157894738, {l, 25}] // AbsoluteTiming


{0.015624, {l -> 29.8104}}


Update:



The method I showed above is fully applicable to the new added sample:


cfgenerator = 
  Compile[{u1, u2, u3}, #, RuntimeOptions -> "EvaluateSymbolically" -> False] &;

{cf1, cf2, cf3} = cfgenerator /@ {Sum[f2[i, j], {i, 0, limit1}, {j, 0, limit1 - i}],
     Sum[f2[i, j], {i, 1, 20}, {j, 0, i - 1}],
     Sum[f2[i, j], {j, 1, 20}, {i, 0, j - 1}]}; 

FindRoot[cf1[u1, u2, u3] == 0.4285714285714286` && 
   cf2[u1, u2, u3] == 0.47417677642980943` && 

   cf3[u1, u2, u3] == 0.2558058925476603`, {u1, 12}, {u2, 12}, {u3, 1}] // AbsoluteTiming


{0.052929, {u1 -> 11.0489, u2 -> 10.0626, u3 -> 2.10168}}

Then I'd like to talk a little about why this method works. Simply speaking, your original code is slow because those Sums are very big, and Compile is a way to speed up the evaluation of big expressions that are formed by relatively low level functions.


Well, to be honest, before answering, I hesitate for a while, because Compile isn't really a easy-to-use function (see here for more information) and personaly I don't recommond not-that-experienced Mathematica user jumping into the world of compiling. However, your Sums can (luckily) evaluate to compilable algebraic expressions and are so suitable for Compile that I can't help posting this answer. If you want to learn more about Compile (as mentioned above, currently I don't recommend you to! ) , you can consider starting from here.


Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...
Post a Comment
Read more

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...
Post a Comment
Read more