ArcLengthPartition/plane curve segments
- To: mathgroup at christensen.cybernetics.net
- Subject: [mg335] ArcLengthPartition/plane curve segments
- From: Xah Y Lee <xyl10060 at fhda.edu>
- Date: Fri, 16 Dec 1994 08:58:12 -0800 (PST)
Dear MathGroupers,
What is the best way to write a program that will return a list of t(s)
of a parametric curve such that these points will cut the curve into
equal-length segments? Here's my best shot
ArcLengthPartition::usage = "
ArcLengthPartition[{xf,yf},{tmin,tmax}, n] returns a list
of t parameters {tmin, t1, t2,..., tmax}, such that the points
{xf[ti],yf[ti]} cut the parametric curve into n seqments of equal
length.
For example, to cut the Sine curve from 0 to 2 Pi into 6 segments,
do ArcLengthPartition[ { #&, Sin}, {0, 2 Pi}, 6].
Note: ArcLengthPartition may take a long time if n is large.";
ArcLengthPartition[{f_, g_}, {tmin_, tmax_}, n_ ] :=
Module[{ x, integrand, s},
integrand = Compile[{t}, Evaluate[ Sqrt[ f'[t]^2 + g'[t]^2 ] ] ];
s = Compile[ {t}, NIntegrate[ integrand[x], {x, tmin, t}] ];
x = x /. (FindRoot[ s[x] == #, {x, #}]&/@
Range[ 0, s[tmax] , s[tmax]/n]);
x
]
To test ArcLengthPartition, we can do the following
ptsGP =
Point[{#^2 Cos[#], #^2 Sin[#]}]& /@
ArcLengthPartition[ {#^2 Cos[#]&, #^2 Sin[#]&} , {0, 8 Pi}, 6]
ParametricPlot[ {t^2 Cos[t], t^2 Sin[t]},
{ t, 0, 4 2 Pi},
PlotStyle->{Hue[0],Hue[.7],Hue[.8]},
AspectRatio->Automatic,
Epilog->{Hue[.7], PointSize[.02],ptsGP}
]
It works all-right, but it's very clumsy and slow. Is there a better way?
I know there is a theorem that says every parametric curve can be
re-parametrized to form a unit-parametrization such that the parameter t
represents the length of the curve directly. But the problem is how to go
about finding the re-parametrization for arbitrary curve?
Thank all for helping.
Xah Lee Quote of the day:
xyl10060 at tiptoe.fhda.edu | Top spies all, inside override.
74631.731 at compuserve.com | NothingGP none, empty braces fine.
Mathematician of WasaMata U. | If conflic arise, latter take place.
Mountain View, CA., US & A. | --mnemonic of mma graphics syntax.