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] ====