Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

The following code takes over 4 seconds to run. Any one has suggestions to make the expressions for qf, phi, qr, and k more efficient?

Can someone suggest ways I can useNestWhile in the place of While and Compile[] on the four expressions (qf, phi, qr, and k) to enable Parallelization?

demand[n_, k_] := Min[k Vf, n capacity];
supply[n_, k_] := Min[(n Kj - k) w, n capacity];
flo[n_, ku_, kd_] := Min[demand[n, ku], supply[n, kd]];
gamma[ku_, kd_] := Min[1, supply[L, kd]/demand[L, ku]];
inflow [phi_, FQin_] := (phi - \[Beta] FQin) dx;
density[qin_, qout_, qr_] := (qin - qout + qr)/Vf;

L = 1; \[Beta] = 0.1; dx = 1/6; capacity = 7500; Kj = 150.; w = 100.; Vf = 100.;TT=0; RML = 2
k0 = Table[1, {i1, 1, 10}];
kr = Table[Table[1, {i1, 1, 4}], {i2, 1, 10}];
While[TT < 200000,
   qf = Map[flo[L, #[[1]], #[[2]]] &, Partition[k0, 2, 1]];
   phi = Flatten[Map[demand[1, #] &, Take[kr, All, -1]]][[2 ;; -2]]*Map[gamma[#[[1]], #[[2]]] &, Partition[k0[[2 ;; -1]], 2, 1]];
   qr = (inflow @@ #) & /@ Transpose[{phi, qf[[1 ;; -2]]}];
   k = (Plus @@ #) & /@ Transpose[{Insert[Map[density[#[[1]], #[[2]], #[[3]]] &, Flatten /@ Transpose[{Partition[qf, 2, 1], qr}]], 0, {{1}, {-1}}], k0}];
   k0 = k;
   TT += Plus @@ k0;
]; // Timing

Edit:

I also have the following piece of code that will go right below the k0=k in the above code

RMori = Table[100 (i1 dx)^2 + 50 (i1 dx) + 1000, {i1, 1, n - 2}];
RM = MapThread[Min[#1, #2] &, {RMori, flo[1, #[[RML]], #[[RML + 1]]] & /@ kr}];
qr = MapThread[Join[#1, {#2}, #3, {#4}] &, {flo[L, ##] & @@@ Partition[#[[;; RML]], 2, 1] & /@ kr, RM, flo[L, ##] & @@@ Partition[#[[RML + 1 ;;]], 2, 1] & /@ kr, \[Phi]}];
kr = MapThread[(#1 + #2) &, {Join[{0}, #] & /@ (density[Most@#,Rest@#, 0] & /@ qr), kr}];

in line of the suggestions made by SimonWoods, Can some one suggest ways to improve this piece of code?

Also, I need some guidance on using NestWhile in place of While.

share|improve this question
    
The initial value for TT is missing –  belisarius Mar 11 at 19:37
    
@belisarius Fixed it. Thank you. –  brama Mar 11 at 19:46

1 Answer 1

up vote 4 down vote accepted

One thing you should do is take advantage of Listable functions where possible. For example your inflow and density functions are composed of Listable functions and are therefore themselves Listable. Also make sure you are not computing the same constant over and over again in a loop (for example the first term in phi).

The following is the same calculation as your loop but runs about twice as fast:

phi1 = demand[1, #] & /@ kr[[2 ;; -2, -1]];

While[TT < 200000,
   qf = MapThread[flo[L, ##] &, {Most@k0, Rest@k0}];
   phi = phi1 MapThread[gamma, {k0[[2 ;; -2]], k0[[3 ;;]]}];
   qr = inflow[phi, Most@qf];
   k0 += Join[{0}, density[Most@qf, Rest@qf, qr], {0}];
   TT += Total@k0;]; // Timing

For a significant speed up you probably need to use Compile or significantly restructure the algorithm.

share|improve this answer
    
Excellent points. Listable functions is a great idea. I want to use compile, but do not know how to do it. Can you please give me some hints.Moreover, I think Total is not a CompilerFunction and hence need to use Plus. –  brama Mar 12 at 0:01
1  
Some tips here: Making Mathematica faster with Compile –  Chris Degnen Mar 12 at 0:23

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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