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