Group Abstract

Message Boards

WOLFRAM COMMUNITY

13K Views

4 Replies

0 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

What is wrong with my Mathematica code, why is it so slow?

Joe Gilray

Posted 10 years ago

I've been programming in Mathematica for a couple years. I realize that For[] loops are not idiomatic and can be rather slow, but I don't see why the code below (the equivalent of which runs in 4 minutes in Racket - scheme - lisp) takes 43 hours (!!!) in Mathematica: ClearAll[blumblumshub, makelines, vectorXprod, euler165] blumblumshub[n_] := Block[{s = {290797}}, For[i = 1, i <= n, i++, AppendTo[s, Mod[Last@sLast@s, 50515093]]]; Return[Map[Mod[#, 500] &, Rest@s]]] makelines[n_] := Block[{raw = blumblumshub[4 n]}, Map[{{raw[[#]], raw[[# + 1]]}, {raw[[# + 2]] - raw[[#]], raw[[# + 3]] - raw[[# + 1]]}} &, Range[1, 4 n, 4]]] vectorXprod[{a_, b_}, {c_, d_}] := ad - bc euler165[n_] := Block[{l = makelines[n], l1, l2, i, j, fl1, ll1, fl2mfl1, ll2, rxs, t, u, hits = {}}, For[i = 1, i < n, i++, l1 = l[[i]]; fl1 = First@l1; ll1 = Last@l1; For[j = i + 1, j <= n, j++, l2 = l[[j]]; fl2mfl1 = First@l2 - fl1; ll2 = Last@l2; rxs = vectorXprod[ll1, ll2]; If[rxs != 0, t = vectorXprod[fl2mfl1, ll2/rxs]; If[t > 0 && t < 1, u = vectorXprod[fl2mfl1, ll1/rxs]; If[u > 0 && u < 1, AppendTo[hits, fl1 + tll1]]]]]]; Length[DeleteDuplicates[hits]]] euler165[5000] // Timing If you change the 5000 to 1000 it still takes over 3 minutes. What am I doing wrong? I replaced the For[] loops with While[] loops but that didn't help, unsurprisingly. Thanks! -Joe

I've been programming in Mathematica for a couple years. I realize that For[] loops are not idiomatic and can be rather slow, but I don't see why the code below (the equivalent of which runs in 4 minutes in Racket - scheme - lisp) takes 43 hours (!!!) in Mathematica:

ClearAll[blumblumshub, makelines, vectorXprod, euler165] 
blumblumshub[n_] := 
 Block[{s = {290797}}, 
  For[i = 1, i <= n, i++, AppendTo[s, Mod[Last@s*Last@s, 50515093]]]; 
  Return[Map[Mod[#, 500] &, Rest@s]]]
makelines[n_] := 
 Block[{raw = blumblumshub[4 n]}, 
  Map[{{raw[[#]], raw[[# + 1]]}, {raw[[# + 2]] - raw[[#]], 
      raw[[# + 3]] - raw[[# + 1]]}} &, Range[1, 4 n, 4]]]
vectorXprod[{a_, b_}, {c_, d_}] := a*d - b*c
euler165[n_] := 
 Block[{l = makelines[n], l1, l2, i, j, fl1, ll1, fl2mfl1, ll2, rxs, 
   t, u, hits = {}},
  For[i = 1, i < n, i++, l1 = l[[i]]; fl1 = First@l1; ll1 = Last@l1;
   For[j = i + 1, j <= n, j++, l2 = l[[j]]; fl2mfl1 = First@l2 - fl1; 
    ll2 = Last@l2;
    rxs = vectorXprod[ll1, ll2];
    If[rxs != 0, t = vectorXprod[fl2mfl1, ll2/rxs];
     If[t > 0 && t < 1, u = vectorXprod[fl2mfl1, ll1/rxs];
      If[u > 0 && u < 1, AppendTo[hits, fl1 + t*ll1]]]]]];
  Length[DeleteDuplicates[hits]]]
euler165[5000] // Timing

If you change the 5000 to 1000 it still takes over 3 minutes.

What am I doing wrong? I replaced the For[] loops with While[] loops but that didn't help, unsurprisingly.

Thanks! -Joe

POSTED BY: Joe Gilray

4 Replies

Sort By:

Joe Gilray

Posted 10 years ago

Very nice. Thanks for the education. It still didn't speed up the performance, but looks so much more idiomatic! -Joe

POSTED BY: Joe Gilray

Gianluca Gorni

Gianluca Gorni, University of Udine

Posted 10 years ago

Your `blumblumshub` seems a good opportunity to try `NestList`: Mod[Rest@NestList[Mod[#^2, 50515093] &, 290797, n], 500]

POSTED BY: Gianluca Gorni

Frank Kampas

Frank Kampas, Physicist at Large Consulting

Posted 10 years ago

I suspect that the problem is your use of AppendTo, which is quite slow. It's better to generate an array of zeros of the correct size for the final result and then put in the results one at a time.

POSTED BY: Frank Kampas

Joe Gilray

Posted 10 years ago

Removing AppendTo did speed it up! The following code completed in just under 6 minutes... thanks Frank! ClearAll[blumblumshub, makelines, vectorXprod, euler165] blumblumshub[n_] := Mod[Rest@NestList[Mod[#^2, 50515093] &, 290797, n], 500] makelines[n_] := Block[{raw = blumblumshub[4 n]}, Map[{{raw[[#]], raw[[# + 1]]}, {raw[[# + 2]] - raw[[#]], raw[[# + 3]] - raw[[# + 1]]}} &, Range[1, 4 n, 4]]] vectorXprod[{a_, b_}, {c_, d_}] := ad - bc euler165[n_] := Block[{l = makelines[n], l1, l2, i, j, fl1, ll1, fl2mfl1, ll2, rxs, t, u, hits = ConstantArray[0, 3000000], next = 1}, For[i = 1, i < n, i++, l1 = l[[i]]; fl1 = First@l1; ll1 = Last@l1; For[j = i + 1, j <= n, j++, l2 = l[[j]]; fl2mfl1 = First@l2 - fl1; ll2 = Last@l2; rxs = vectorXprod[ll1, ll2]; If[rxs != 0, t = vectorXprod[fl2mfl1, ll2/rxs]; If[t > 0 && t < 1, u = vectorXprod[fl2mfl1, ll1/rxs]; If[u > 0 && u < 1, hits[[next++]] = fl1 + t*ll1]]]]]; Length[DeleteDuplicates[hits]] - 1] euler165[5000] // Timing

Removing AppendTo did speed it up! The following code completed in just under 6 minutes... thanks Frank!

ClearAll[blumblumshub, makelines, vectorXprod, euler165] 
blumblumshub[n_] := 
 Mod[Rest@NestList[Mod[#^2, 50515093] &, 290797, n], 500]
makelines[n_] := 
 Block[{raw = blumblumshub[4 n]}, 
  Map[{{raw[[#]], raw[[# + 1]]}, {raw[[# + 2]] - raw[[#]], 
      raw[[# + 3]] - raw[[# + 1]]}} &, Range[1, 4 n, 4]]]
vectorXprod[{a_, b_}, {c_, d_}] := a*d - b*c
euler165[n_] := 
 Block[{l = makelines[n], l1, l2, i, j, fl1, ll1, fl2mfl1, ll2, rxs, 
   t, u, hits = ConstantArray[0, 3000000], next = 1},
  For[i = 1, i < n, i++, l1 = l[[i]]; fl1 = First@l1; ll1 = Last@l1;
   For[j = i + 1, j <= n, j++, l2 = l[[j]]; fl2mfl1 = First@l2 - fl1; 
    ll2 = Last@l2;
    rxs = vectorXprod[ll1, ll2];
    If[rxs != 0, t = vectorXprod[fl2mfl1, ll2/rxs];
     If[t > 0 && t < 1, u = vectorXprod[fl2mfl1, ll1/rxs];
      If[u > 0 && u < 1, hits[[next++]] = fl1 + t*ll1]]]]];
  Length[DeleteDuplicates[hits]] - 1]
euler165[5000] // Timing

POSTED BY: Joe Gilray

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Feedback