MathGroup Archive 2004

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

Search the Archive

Re: Re: pair sums applied to trignometry sums

  • To: mathgroup at smc.vnet.net
  • Subject: [mg52552] Re: [mg52505] Re: [mg52487] pair sums applied to trignometry sums
  • From: DrBob <drbob at bigfoot.com>
  • Date: Wed, 1 Dec 2004 05:59:11 -0500 (EST)
  • References: <200411290622.BAA27977@smc.vnet.net> <200411301024.FAA01331@smc.vnet.net>
  • Reply-to: drbob at bigfoot.com
  • Sender: owner-wri-mathgroup at wolfram.com

Just for grins.... :)

Here's a plot of the error from Pi to 36 Pi. "relative" returns $MachinePrecision whenever fsin == fsin2 to machine precision or when the computed precision would be Indeterminate.

fsin2[x_] = Together[-
     Sum[((1 + 2*k)*x^(3 + 4*k))/((
             2 + 2*k)*(3 + 4*k)!), {k,
                     0, Infinity}] + Sum[x^(1 + 4*k)/((1 + 2*k)*(
                   1 + 4*k)!), {k, 0, Infinity}]];
fs[x_, n_] =
     If[Mod[n, 2] ==
          1, (-1)^(n)*n*x^(2*
                   n + 1)/((n + 1)*(2*n + 1)!), (-1)^(n)*x^(2*n + 1)/((n + 1)*(
           2*n + 1)!)];
fsin[x_] := N[Sum[fs[x, n], {n, 0, 100}]];
relative[x_] :=
     Module[{f2 = fsin2[x], f = fsin[x]}, If[
       f2 == 0 || f2 == f, $MachinePrecision, -Re[Log[10, Abs[(f2 - f)/f2]]]]]
Plot[relative@x, {x, Pi, 36Pi}, PlotRange -> All]
data = Flatten[Cases[%, Line[a_] -> a, Infinity], 1]

{{3.1415972350790797, 15.954589770191003},
   {7.602166348219689, 15.954589770191003},
   {12.466807244518934, 15.954589770191003},
   {17.03553064863929, 15.954589770191003},
   {21.429256733925268, 15.954589770191003},
   {26.106134429025374, 15.954589770191003},
   {30.608014805291102, 15.954589770191003},
   {35.39304679137096, 15.954589770191003},
   {40.00308145861644, 15.954589770191003},
   {44.438118807027536, 15.954589770191003},
   {49.15630776525276, 15.954589770191003},
   {53.69949940464361, 15.954589770191003},
   {58.06769372520007, 15.954589770191003},
   {62.71903965557067, 15.954589770191003},
   {67.19538826710688, 15.954589770191003},
   {71.95488848845723, 15.954589770191003},
   {76.5393913909732, 15.954589770191003},
   {80.94889697465477, 15.954589770191003},
   {85.64155416815049, 15.954589770191003},
   {90.15921404281183, 15.954589770191003},
   {94.96002552728729, 15.954589770191003},
   {99.58583969292837, 15.954589770191003},
   {104.03665653973508, 15.954589770191003},
   {106.29344388909165, 15.954589770191003},
   {108.7706249963559, 15.954589770191003},
   {109.85057065751995, 15.954589770191003},
   {110.44508404208645, 15.954589770191003},
   {111.00828024416123, 15.954589770191003},
   {111.53167179744722, 15.954589770191003},
   {111.67506457856302, 15.954589770191003},
   {111.82740138112412, 15.954589770191003},
   {111.95745531629451, 13.830647317435913},
   {112.10100969273067, 13.774015253747038},
   {113.09733094774326, 13.422761176770164}}

fsin == fsin2 to $MachinePrecision (or relative precision would be Indeterminate) for x < 35.6 Pi, approximately.

Here's a detail from 35.6 Pi to 59 Pi, where precision drops to less than one digit:

Plot[relative@x, {x, 35.6Pi, 59Pi}, PlotRange -> All]
data = Flatten[Cases[%, Line[a_] -> a, Infinity], 1]

{{111.84070153084949, 15.954589770191003},
   {111.93144524257782, 15.954589770191003},
   {112.01400659892401, 13.814681804761431},
   {112.10930712101167, 13.784858379354139},
   {112.19939538276357, 13.738175075338768},
   {112.28270974211034, 13.697691853954574},
   {112.35962783140114, 13.681352311306712},
   {112.44405392616041, 13.651723425970497},
   {112.53355515172996, 13.623110566921143},
   {113.29245103946467, 13.35737265411109},
   {114.82291059506349, 12.838656285970202},
   {118.07527050858927, 11.783127184339914},
   {120.9957204257613, 10.892462794496971},
   {124.10547741920908, 9.999964393416649},
   {127.09823620520758, 9.192817934425467},
   {130.2803020674818, 8.387554124021328},
   {133.34536972230677, 7.6609988186866},
   {136.29343916968244, 7.005489683461993},
   {139.43081569333387, 6.352381579407274},
   {142.451194009536, 5.765009989587841},
   {145.6608794020139, 5.183271195912701},
   {148.7535665870425, 4.662242307292363},
   {151.72925556462184, 4.195890995272771},
   {154.89425161847691, 3.735847149213959},
   {157.9422494648827, 3.3263312946868275},
   {160.87324910383924, 2.9622066095079154},
   {163.9935558190715, 2.605145907944078},
   {166.99686432685448, 2.2899632140849886},
   {170.1894799109132, 1.9841665287753802},
   {173.26509728752265, 1.7167736020631528},
   {176.22371645668284, 1.483554180588469},
   {179.37164270211875, 1.2600052198559342},
   {182.40257074010538, 1.0675211814520018},
   {185.31650057064275, 0.9024102087396019},
   {185.35396349874495, 0.9004100875184318}}

Bobby

On Tue, 30 Nov 2004 05:24:10 -0500 (EST), Daniel Lichtblau <danl at wolfram.com> wrote:

> Roger Bagula wrote:
>> I had used the mechanism with Bailey type of sequences
>> and their sums in the work on b normalness in iteratives functions.
>>
>> It occurred to me that by adding the variable x , I could get
>> functiond that used the nonlinear Cantor pair {1/(n+1),n/(n+1)}
>> to split the sine and the cosine down the middle.
>> The result is entirely new trignometric sum functions that converge very
>> well.
>>
>> (* pair sums applied to trignometry sums: {1/(n+1),n/(n+1)} modulo 2
>> switched sums*)
>> (* these sums break the trignometry of a circle into four functions
>> instead of two*)
>> (* these are subharmonic functions of a nonlinear Rational Cantor type*)
>> fs[x_,n_]:=
>>   If[Mod[n,2]==1,(-1)^(n)*n*x^(2*n+1)/((n+1)*(2*n+1)!),(-1)^(n)*
>>       x^(2*n+1)/((n+1)*(2*n+1)!)]
>>
>>
>> gs[x_,n_]:=
>>   If[Mod[n,2]==1,(-1)^n*x^(2*n+1)/((n+1)*(2*n+1)!),(-1)^n*n*
>>       x^(2*n+1)/((n+1)*(2*n+1)!)]
>>
>>
>> fc[x_,n_]:=
>>   If[Mod[n,2]==1,(-1)^(n)*n*x^(2*n)/((n+1)*(2*n)!),(-1)^(n)*
>>       x^(2*n)/((n+1)*(2*n)!)]
>>
>>
>> gc[x_,n_]:=
>>   If[Mod[n,2]==1,(-1)^(n)*x^(2*n)/((n+1)*(2*n)!),(-1)^(n)*n*
>>       x^(2*n)/((n+1)*(2*n)!)]
>>
>> digits=100;
>>
>>
>> fsin[x_]:=N[Sum[fs[x,n],{n,0,digits}]];
>>
>>
>> gsin[x_]:=N[Sum[gs[x,n],{n,0,digits}]]
>>
>>
>> fcos[x_]:=N[Sum[fc[x,n],{n,0,digits}]]
>>
>>
>> gcos[x_]:=N[Sum[gc[x,n],{n,0,digits}]]
>>
>>
>> Plot[fsin[x],{x,-Pi,Pi}]
>>
>> Plot[fsin[x],{x,-Pi,Pi}]
>>
>>
>> Plot[gsin[x],{x,-Pi,Pi}]
>>
>>
>> Plot[fcos[x],{x,-Pi,Pi}]
>>
>>
>> Plot[gcos[x],{x,-Pi,Pi}]
>>
>>
>> Plot[(fsin[x]+gsin[x]),{x,-Pi,Pi},PlotRange->All]
>>
>>
>> Plot[(fcos[x]+gcos[x]),{x,-Pi,Pi}]
>>
>>
>> ParametricPlot[{fsin[x],gsin[x]},{x,-Pi,Pi}]
>>
>> ParametricPlot[{fcos[x],gcos[x]},{x,-Pi,Pi}]
>>
>> ParametricPlot[{fsin[x],fcos[x]},{x,-Pi,Pi}]
>>
>> ParametricPlot[{gsin[x],gcos[x]},{x,-Pi,Pi}]
>>
>> ParametricPlot[{fsin[x]+gsin[x],fcos[x]+gcos[x]},{x,-Pi,Pi},PlotRange->All]
>> Respectfully, Roger L. Bagula
>>
>> tftn at earthlink.net, 11759Waterhill Road, Lakeside,Ca 92040-2905,tel: 619-5610814 :
>> alternative email: rlbtftn at netscape.net
>> URL :  http://home.earthlink.net/~tftn
>
>
> It occurs to me that these functions might be simplified, as they are
> each themselves sums of pairs of functions with terms satisfying simple
> recurrences. For example, fs can be written as the sum of n-even + n-odd
> terms, and these are just the sums of terms 1/(2*k+1)*x^(4*k+1)/(4*k+1)!
> and (-1)*(2*k+1)/(2*k+2)*x^(4*k+3)/(4*k+3)! respectively.
>
> In more detail we get the function below.
>
> InputForm[fsin2[x_] = Together[-Sum[(2*k+1)/(2*k+2)*x^(4*k+3)/(4*k+3)!,
> {k,0,Infinity}] +
>    Sum[1/(2*k+1)*x^(4*k+1)/(4*k+1)!, {k,0,Infinity}]]]
>
> Out[10]//InputForm= (-4 + 4*Cosh[x] + x*Sin[x] - x*Sinh[x])/(2*x)
>
> (Isn't it great to have a symbolic math engine at ones fingertips?)
>
> As a quick check:
>
> In[11]:= InputForm[Max[Abs[Table[fsin2[x]-fsin[x], {x,-Pi,Pi,.1}]]]]
> Out[11]//InputForm= 3.372302437298913*^-15
>
> (Isn't it great to have a numeric math engine at ones fingertips?)
>
> The advantage to using the closed form is twofold. One is that numeric
> computations are better, and the other is that they are significantly
> faster. To see the latter:
>
> In[5]:= Timing[Plot[fsin[x],{x,-Pi,Pi}]]
> Out[5]= {0.3 Second, -Graphics-}
>
> In[6]:= Timing[Plot[fsin2[x],{x,-Pi,Pi}]]
> Out[6]= {0.01 Second, -Graphics-}
>
> For the former, just notice what happens when we get outside the range
> -Pi<x<Pi, for example the interval {15*Pi,16*Pi}.
>
>
> Daniel Lichtblau
> Wolfram Research
>
>
>
>
>



-- 
DrBob at bigfoot.com
www.eclecticdreams.net


  • Prev by Date: Re: New User - Programming
  • Next by Date: Boltzmann Exponent
  • Previous by thread: Re: pair sums applied to trignometry sums
  • Next by thread: Re: Re: Changing CellMargins?