       Re: Obtain smooth plot of free-hand contour

• To: mathgroup at smc.vnet.net
• Subject: [mg107234] Re: [mg107174] Obtain smooth plot of free-hand contour
• From: Patrick Scheibe <pscheibe at trm.uni-leipzig.de>
• Date: Sat, 6 Feb 2010 03:24:26 -0500 (EST)
• References: <201002050818.DAA06447@smc.vnet.net>

```Hi,

from your drawn contour you get a Graphics[Line[pts_],___] object.
If you take only the x values of pts, then you have time-series x[t] of
x-positions you have drawn (same with y[t]).
Now you could make an Fourier-transform and cut some high frequencies.
>From the remaining frequencies you make a fourier series providing three
things:

- a smoothed version of what you have drawn
- a continuous function which is
- periodic and therefore your contour will be closed

FourierSmooth[Graphics[Line[pts_], ___], numFourCoeff_Integer] :=
Module[{wx, wy, ftsum, w, nn},
If[numFourCoeff < 1 || numFourCoeff > nn/2,
Return[\$Failed]
];
nn = Length[pts];
{wx, wy} = Fourier /@ Transpose[pts];
ftsum[t_] :=
Evaluate[
1/Sqrt[nn] (w +
Sum[2 w[i + 1]*Exp[-2 Pi I t i/nn], {i, 1, numFourCoeff}])];
Show[{
Graphics[{Gray, Dashed, Line[pts]}],
ParametricPlot[
Re[ftsum[t]] /. w[i__] :> {wx[[i]], wy[[i]]}, {t, 0, nn},
PlotStyle -> {Magenta}, Axes -> False, Frame -> True]
}]
]

Copy and paste a contour-graphics in some variable gr (must be of the
above mentioned pattern) and call

FourierSmooth[gr, 8]

Cheers
Patrick

On Fri, 2010-02-05 at 03:18 -0500, Dominic wrote:
> Hi,
>
> I'm working on a contour integral over a contour I'd like to draw
> free-hand via the graphics tools, then obtain a smooth plot of the
> curve.  So first I do a
> Show[mypoint,Axes-True,PlotRange->{{-2,2},{-2,2}}] to just get the
> graphics box of a single point.  Then I use the graphics tools to draw
> in the contour, then I select the contour and assign it to
> myfreehandcontour to obtain the x and y points.  Then I extract the
> points and then do a FindFit on the x and y values.  However, I cannot
> get the end-points to meet so the contour is not even close to closed.
> Here is the code I use once I have pasted the plot to myfreehandcontour
> and I don't know if it's ok to post JPEG images to the group but I'll
> try below of the points and resulting FindFit curve. Note the start and
> end points are not closing the contour in the contour of the resulting
> ParametricPlot[{xcod[t],{ycod[t]},{t,1,1100}].  I don't know, maybe this
> is too much..
>
> Can you guys suggest a way to input a free-hand closed contour into
> Mathematica and obtain a nice smooth {x(t),y(t)} representation of it?
>
> Thanks!
>
> Dominic
>
> lns = Cases[Normal[First[myfreehandcontour]], Line[pts_] -> pts,
> {0, Infinity}];
>
> lplot1 = ListPlot[lns]
>
> myvals = First[lns];
> myxval = (#1[] & ) /@ myvals;
> myyval = (#1[] & ) /@ myvals;
> nmax = 100;
> myfun = Sum[Subscript[a, n]*t^n, {n, 0, nmax}];
> mycoef = Table[Subscript[a, n], {n, 0, nmax}]
> clist = FindFit[myxval, myfun, mycoef, t];
> xcod[t_] = myfun /. clist
> myyfun = Sum[Subscript[b, n]*t^n, {n, 0, nmax}];
> myycoef = Table[Subscript[b, n], {n, 0, nmax}];
> cylist = FindFit[myyval, myyfun, myycoef, t];
> ycod[t_] = myyfun /. cylist
>
> pp1 = ParametricPlot[{xcod[t], ycod[t]}, {t, 1, 1100}]
>
> GraphicsGrid[{{lplot1, pp1}}]
>

```

• Prev by Date: Re: Extra Data and Data structures
• Next by Date: Re: arrows disappear in exported 3D graphic
• Previous by thread: Obtain smooth plot of free-hand contour
• Next by thread: Re: Obtain smooth plot of free-hand contour