Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Topic: programming competition
Replies: 1   Last Post: Sep 26, 1996 4:51 PM

 Messages: [ Previous | Next ]
 Xah Lee Posts: 171 Registered: 12/4/04
programming competition
Posted: Sep 23, 1996 10:16 AM

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.

linearInterpolate::usage = "
linearInterpolate[{p1,p2,...}, maxLength ] returns
{P1,P2,...} such that the length between neighboring points
P[i], P[i+1] is less or equal to maxLength.
Newly created points lies on a line between old points";

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
]
]&,
li,
Reverse@ positions]), 2]
]

-----------------------

Example,

li = Join[ {{0,0},{1,1}},
Table[{i,1}, {i,1,2,1/5}],
{{2,1}, {3,3}}
];

Show[
Graphics[{
Hue[0], PointSize[.02], Point/@ li
}],
AspectRatio->Automatic,
Axes->True,
PlotRange->All
];0;

Show[
Graphics[{
Hue[0], PointSize[.02],
Point /@ linearInterpolate[ li, .3]
}],
AspectRatio->Automatic,
Axes->True,
PlotRange->All
];0;

----------------------

More example

In[15]:=
gp = First@ ParametricPlot[
t {Cos@t, Sin@t}, {t,0, 4 Pi},
PlotPoints->10,
MaxBend->10,
PlotDivision->5,
DisplayFunction->Identity
];0;

In[17]:=
Show[
Graphics[{ Point /@ gp[[1,1,1]]
}],
AspectRatio->Automatic,
Axes->True
];0;

In[18]:=
Show[
Graphics[{ Point /@ linearInterpolate[ gp[[1,1,1]], 1 ]
}],
AspectRatio->Automatic,
Axes->True
];0;

This program is used to increase resolution of arbitrary user generated graphics.
This gives me better resolution control of transformations applies to the original
image.

Xah
xah@best.com; 74631.731@compuserve.com
http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html
Mountain View, CA, USA

Date Subject Author
9/23/96 Xah Lee
9/26/96 hall robert