Re: programming competition

*To*: mathgroup at smc.vnet.net*Subject*: [mg4900] Re: programming competition*From*: Xah Lee <xah at best.com>*Date*: Fri, 4 Oct 1996 00:17:38 -0400*Organization*: Best Internet Communications*Sender*: owner-wri-mathgroup at wolfram.com

At 10:42 PM 96/9/26, Xah Lee wrote: >This is a programming problem I recently encountered. The problem has the >attraction of being a programming competition type. I post the problem and my >solution here and hope someone will enjoy and maybe come out with other solutions. > >Problem: >Suppose you have a ordered list {p1, p2, ... , pn} where points has the form >{x,y}. You want to modify the list so any neighboring points will have a distance >less or equal to a given value maxLength. You do this by adding points in between >points. For example, suppose p3 and p4 has length greater than maxLength. Your new >list should then be >{p1, p2, p3, newP1, newP2,..., newPm, p4, p5, ... , pn} where >newP1, ...newPm lies on the line p3 p4. A few people have responded. Attached below are the codes and a timing result. Clear[linearInterpolate, insertPoints, linearInterpolateEH1, linearInterpolateEH2] (* by Xah Lee xah at best.com *) linearInterpolate[ li_List, maxLength_ ]:= Module[{positions}, positions = Flatten@ Position[ N@ Sqrt[#.#]& /@ Rest[ li-RotateRight[li] ], x_/; (x > maxLength), {1} ]; Partition[ Flatten@ (Fold[ Module[{p1 = li[[#2]], p2 = li[[#2+1]]}, Insert[ #1, Drop[ Rest@ Table[ (p2-p1) i + p1, {i, 0, 1, 1./Ceiling@ N[Sqrt[Plus@@((p2-p1)^2)]/maxLength] } ],-1 ], #2 +1 ] ]&, li, Reverse@ positions]), 2] ] (* by rhall2 at umbc.edu (hall robert), (modified a bit) *) insertPoints[li_List, maxLength_] := Module[ {v, dist}, Append[ Flatten[ Table[ If[ v = li[[i]] - li[[i + 1]]; dist = N[Sqrt[v.v]]; dist > maxLength, (li[[i]] - #)& /@ Table[ v*j/dist, {j, 0, dist -dist/Ceiling@ N[dist/maxLength], dist/Ceiling@ N[dist/maxLength] } ], {li[[i]]} ], {i, Length@ li - 1} ] ,1 ], Last@ li ] ] (* by espen.haslund at fys.uio.no (Espen Haslund) *) linearInterpolateEH1[ li_List, maxLength_ ]:= Module[{res={}, p1, p2, n}, Do[ {p1, p2} = li[[{i, i+1}]]; n = Max[Ceiling[Sqrt[#.#]&[N[p2-p1]]/maxLength],1]; res = {res,Table[p1+(p2-p1)j,{j,0,1-.5/n,1./n}]}, {i, 1, Length[li]-1}]; Partition[Flatten[{res, Last[li]}],2] ] (* by espen.haslund at fys.uio.no (Espen Haslund) *) linearInterpolateEH2[ li_List, maxLength_ ]:= Module[{p1, p2, n}, Append[Join @@ Table[{p1, p2} = li[[{i, i+1}]]; n = Max[Ceiling[Sqrt[#.#]&[N[p2-p1]]/maxLength],1]; Table[p1+(p2-p1)j,{j,0,1-.5/n,1./n}], {i,1,Length[li]-1}], Last[li] ] ] (*-----------timing results -------------*) li = Table[{Random[], Random[]}, {1000}]; maxLength = .1; a1 = Timing@ linearInterpolate[ li, maxLength]; a2 = Timing@ insertPoints[ li, maxLength]; a3 = Timing@ linearInterpolateEH1[ li, maxLength]; a4 = Timing@ linearInterpolateEH2[ li, maxLength]; First /@ {a1,a2,a3,a4} (* {20. Second, 9.36667 Second, 8.81667 Second, 7.9 Second} *) SameQ@@ Last /@ SetPrecision[{a1,a2,a3,a4},5] (* True *) Except that my functional approach is the slowest by an order, Robert Hall and Espen Haslund's sequential approach are similar. Now perhaps someone can give a pattern matching approach? Xah xah at best.com; 74631.731 at compuserve.com http://www.best.com/~xah/PageTwo_dir/MathGraphicsGallery_dir/mathGraphicsGallery.html Mountain View, CA, USA ==== [MESSAGE SEPARATOR] ====