Re: programming competition

*To*: mathgroup at smc.vnet.net*Subject*: [mg4866] Re: programming competition*From*: rhall2 at umbc.edu (hall robert)*Date*: Thu, 26 Sep 1996 22:42:21 -0400*Organization*: University of Maryland, Baltimore County*Sender*: owner-wri-mathgroup at wolfram.com

Xah wrote: >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. This was Xah's list of points: In[26]:= li = Join[ {{0,0},{1,1}}, Table[{i,1}, {i,1,2,1/5}], {{2,1}, {3,3}}]; Xah gave linearInterpolate[] as a solution. In[27]:= linearInterpolate[ li, .3] 1 Power::infy: Infinite expression - encountered. 0 Drop::drop: Cannot drop positions -1 through -1 in {}. Out[27]= 6 7 8 9 {{Drop[{}, -1], 0}, {0, 1}, {1, 1}, {1, -}, {1, -}, {1, -}, {1, -}, 5 5 5 5 {1, 2}, {1, 2.04348}, {1.08696, 2.08696}, {1.17391, 2.13043}, {1.26087, 2.17391}, {1.34783, 2.21739}, {1.43478, 2.26087}, {1.52174, 2.30435}, {1.6087, 2.34783}, {1.69565, 2.3913}, {1.78261, 2.43478}, {1.86957, 2.47826}, {1.95652, 2.52174}, {2.04348, 2.56522}, {2.13043, 2.6087}, {2.21739, 2.65217}, {2.30435, 2.69565}, {2.3913, 2.73913}, {2.47826, 2.78261}, {2.56522, 2.82609}, {2.65217, 2.86957}, {2.73913, 2.91304}, {2.82609, 2.95652}, {2.91304, 2}, {1, 3}} Making a few small changes in linearInterpolate[] gives In[33]:= linearInterpolate2[ 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 ] ]&, li, Reverse[positions] ] ], 2 ] ] In[34]:= linearInterpolate2[ li, .3] Out[34]= {{0.2, 0.2}, {0.4, 0.4}, {0.6, 0.6}, {0.8, 0.8}, {0, 0}, {1, 1}, 6 7 8 9 {1, 1}, {-, 1}, {-, 1}, {-, 1}, {-, 1}, {2, 1}, {2.125, 1.25}, 5 5 5 5 {2.25, 1.5}, {2.375, 1.75}, {2.5, 2.}, {2.625, 2.25}, {2.75, 2.5}, {2.875, 2.75}, {2, 1}, {3, 3}} This is better, but it still doesn't give the answer in the form Xah specified; the new points are not positioned in the list between the points they're being interpolated between, i. e. they are not {p1, p2, p3, newP1, newP2,..., newPm, p4, p5, ... , pn}. With Lichtblau's and Hayes' admonitions to use procedural programming to solve procedural problems ringing freshly in my ears, I offer the following: In[69]:= insertPoints[points_List, maxDistance_] := Module[ {vector, distance}, Append[ Flatten[ Table[ If[ vector = points[[pointIndex]] - points[[pointIndex + 1]] ; distance = N[Sqrt[vector . vector]]; distance > maxDistance, (points[[pointIndex]] - #)& /@ Table[ multiplier * vector / distance, { multiplier, 0, distance, maxDistance } ], {points[[pointIndex]]} ], {pointIndex, Length[points] - 1} ], 1 ], Last[points] ] ] In[70]:= insertPoints[li, .3] Out[70]= {{0, 0}, {0.212132, 0.212132}, {0.424264, 0.424264}, {0.636396, 0.636396}, {0.848528, 0.848528}, {1., 1.}, {1., 1.}, {1.2, 1.}, {1.4, 1.}, {1.6, 1.}, {1.8, 1.}, {2., 1.}, {2., 1.}, {2.13416, 1.26833}, {2.26833, 1.53666}, {2.40249, 1.80498}, {2.53666, 2.07331}, {2.67082, 2.34164}, {2.80498, 2.60997}, {2.93915, 2.8783}, {3., 3.}} Xah's description of the problem didn't say anything about having the points evenly spaced, so they're not. But it would be simple to modify one line of code so they were evenly spaced. As Lichtblau points out, repeated copying of lists makes the problem O(n^2). In[137]:= pointsList1 = Table[{Random[], Random[]}, {100}]; pointsList2 = Table[{Random[], Random[]}, {1000}]; In[139]:= linearInterpolate2[ pointsList1, .3]; // Timing linearInterpolate2[ pointsList2, .3]; // Timing Out[139]= {3.8 Second, Null} Out[140]= {15.75 Second, Null} Avoiding copying of lists keeps the problem to O(n) In[143]:= insertPoints[pointsList1, .3]; // Timing insertPoints[pointsList2, .3]; // Timing Out[143]= {2.4 Second, Null} Out[144]= {4.25 Second, Null} I periodically need to do fairly complicated operations on small lists. Using the list manipulation functions may make the problem O(n^2), but for small lists this doesn't really matter. Using Append[], Rest[], and similar functions simplifies the code and makes it easier to develop and debug, compared to using a procedural approach and trying to write the fastest code possible. In Xah's and Richard Gaylord's (actually, Don Piele's) problems it was easier to develop a solution using a procedural approach, but it is often easier to use an approach that results in slower code. What I ask from Mathematica is that the code be as clear and self-documenting as possible, the development process be as short and painless as possible, and the result be correct. If speed were that important to me I'd be writing in a compiled language. The problem with many blocks of code is not that they're slow, but that they're confusing. This makes it more difficult to debug and be sure of getting a correct result. Overall, I think top-down design and attention to formatting are more important that speed. Because of it's clarity, I liked Paul Abbott's pattern matching approach to the Gaylord-Piele problem. It worked fine on short lists and you could tell at a glance what the code was doing. -- Bob Hall | "Know thyself? Absurd direction! rhall2 at gl.umbc.edu | Bubbles bear no introspection." -Khushhal Khan Khatak ==== [MESSAGE SEPARATOR] ====