Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2009

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

Search the Archive

Finding a sine wave

  • To: mathgroup at smc.vnet.net
  • Subject: [mg95341] Finding a sine wave
  • From: Hugh Goyder <h.g.d.goyder at cranfield.ac.uk>
  • Date: Fri, 16 Jan 2009 06:07:49 -0500 (EST)

An experiment will give me three coordinates which lie on a sine wave.
I have to find the sine wave efficiently. There are three unknowns the
sine wave amplitude, A, the wavelength of the sine wave, L,  and the
phase, ph. I also know that the wavelength is larger than the interval
containing my measurement points. I think this condition removes
possible multiple solutions.

 Below I give two methods which need improving. The first method uses
FindRoot. This methods works about 60% of the time. I give six
examples where it fails. The failure may be due to poor initial
guesses. In the second method I use FindFit. This is not quite the
correct method because I have an equal number of equations and
unknowns. Some of the failures here, I think, are due to there being
no error for the algorithm to work with. I give examples of failures.
I have also tried FindInstance, Reduce and NSolve but I don't think
these are  appropriate.

Here are some questions

1. I would really like a symbolic solution rather than an iterative
one. Is such a solution possible?
2. Can anyone improve on the methods below to make them more robust?
3. I have some control over my x-locations. How can I work out best x
locations given an estimate of the wavelength L?

Many thanks for all answers.


xx = Sort[Join[{0}, RandomReal[{0, 10}, 2]]]

yy = RandomReal[{-25, 25}, 3]

sol = FindRoot[{yy[[1]] - A*Sin[ph],
   yy[[2]] - A*Sin[2*Pi*(xx[[2]]/L) + ph],
       yy[[3]] - A*Sin[2*Pi*(xx[[3]]/L) + ph]}, {{A,
    Max[Abs[yy]]}, {L, Max[xx]}, {ph, 0}}]

Plot[Evaluate[A*Sin[2*Pi*(x/L) + ph] /. sol], {x, 0, 10},
   Epilog -> {PointSize[0.02], (Point[#1] & ) /@
    Transpose[{xx, yy}]}, PlotRange -> {{0, 10}, {-25, 25}}]

FindRootFailures = {{{0, 3.781264462608982,
     3.797055100562352}, {-22.948348087068737, 1.4581744078038472,
           -14.242676740704574}}, {{0, 4.424069570670131,
     8.861716396743098}, {-6.444538773775843, -10.787309362608688,
           15.579334094330942}}, {{0, 4.424069570670131,
     8.861716396743098}, {-5.944536471563289, 10.627536107497393,
           -21.294232497202316}}, {{0, 1.3680556047878967,
     8.546115267250002}, {4.128528863849845, 2.9017293848933923,
           -22.51610539815371}}, {{0, 1.3738869718371616,
     5.689309423462079}, {20.553993773523437, -16.972841620064592,
           16.61185061676568}}, {{0, 1.0408828831133632,
     8.484645515699821}, {-3.7267589861478045, 4.1016610850387,
           -24.600635061804443}}};

(({xx, yy} = #1;
    sol = FindRoot[{yy[[1]] - A*Sin[ph],
       yy[[2]] - A*Sin[2*Pi*(xx[[2]]/L) + ph],

       yy[[3]] - A*Sin[2*Pi*(xx[[3]]/L) + ph]}, {{A,
        Max[Abs[yy]]}, {L, Max[xx]}, {ph, 0}}];
        Plot[Evaluate[A*Sin[2*Pi*(x/L) + ph] /. sol], {x, 0, 10},

     Epilog -> {PointSize[0.02], (Point[#1] & ) /@
        Transpose[{xx, yy}]},
     PlotRange -> {{0, 10}, {-25, 25}}]) & ) /@
   FindRootFailures

xx = Sort[Join[{0}, RandomReal[{0, 10}, 2]]]

yy = RandomReal[{-25, 25}, 3]

sol = FindFit[
  Transpose[{xx, yy}], {A*Sin[2*Pi*(x/L) + ph],
   Max[Abs[xx]] < L}, {A, L, ph}, x]

Plot[Evaluate[A*Sin[2*Pi*(x/L) + ph] /. sol], {x, 0, 10},
   Epilog -> {PointSize[0.02], (Point[#1] & ) /@
    Transpose[{xx, yy}]}, PlotRange -> {{0, 10}, {-25, 25}}]

FindFitFailures = {{{0, 2.463263668380835,
     4.3190892163093615}, {-1.8407827676541144, -8.736574079785198,
           12.661520984622932}}, {{0, 3.894521446091823,
     9.937403619870642}, {12.381369822165155, 15.840399165432128,
           -6.914634137727327}}, {{0, 8.087369725271945,
     8.343899312282815}, {24.73795103895976, -13.396248713970305,
           7.150470311065216}}, {{0, 1.5480031866178834,
     9.575255260205617}, {-8.163720246784278, 13.373468882892958,
           -18.018462091502098}}, {{0, 0.6152784485896601,
     0.818296772602134}, {-1.858698140836046, 3.695113783904491,
           -1.3186989232026658}}, {{0, 4.743093154057316,
     6.028314583406327}, {-16.60893277597446, -17.413392198343093,
           -18.54081837965986}}};

(({xx, yy} = #1;
    sol = FindFit[
      Transpose[{xx, yy}], {A*Sin[2*Pi*(x/L) + ph],
       Max[Abs[xx]] < L}, {A, L, ph}, x];
        Plot[Evaluate[A*Sin[2*Pi*(x/L) + ph] /. sol], {x, 0, 10},

     Epilog -> {PointSize[0.02], (Point[#1] & ) /@
        Transpose[{xx, yy}]},
     PlotRange -> {{0, 10}, {-25, 25}}]) & ) /@
   FindFitFailures





  • Prev by Date: Re: Problem in generating a DO cycle (mathematica 6.0)
  • Next by Date: webMathematica - comments, opinions, user group (?)
  • Previous by thread: Re: HowTo: Lookup Special Character names
  • Next by thread: Re: Finding a sine wave