programming competition

• To: mathgroup at smc.vnet.net
• Subject: [mg4847] programming competition
• From: Xah Lee <xah at best.com>
• Date: Thu, 26 Sep 1996 22:42:11 -0400
• Organization: Best Internet Communications
• Sender: owner-wri-mathgroup at wolfram.com

```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 at t, Sin at 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 at best.com; 74631.731 at compuserve.com
http://www.best.com/~xah/SpecialPlaneCurves_dir/specialPlaneCurves.html
Mountain View, CA, USA

==== [MESSAGE SEPARATOR] ====

```

• Prev by Date: Re: Importing gif, tiff... (etc) as an array
• Next by Date: Re: Plotting functions
• Previous by thread: Scaling a 2-D graph to a 8.5*11 inches page
• Next by thread: Re: programming competition