Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

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[1] + 
       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[[1]] & ) /@ myvals;
> myyval = (#1[[2]] & ) /@ 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}}]
> 

• References:
  • Obtain smooth plot of free-hand contour
    • From: "Dominic" <miliotodc@rtconline.com>