MathGroup Archive 2006

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

Search the Archive

How to evaluate the following expression in Mathematica?

  • To: mathgroup at smc.vnet.net
  • Subject: [mg64105] How to evaluate the following expression in Mathematica?
  • From: "comtech" <comtech.usa at gmail.com>
  • Date: Wed, 1 Feb 2006 04:34:56 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

It had been running on my PC for 1 day now, and it still did not get
any results...

What's wrong?

Cell[BoxData[
    RowBox[{"N", "[",
      RowBox[{
        SubsuperscriptBox["\[Integral]",
          RowBox[{"-", "\[Infinity]"}], "\[Infinity]"],
        RowBox[{
          SubsuperscriptBox["\[Integral]",
            RowBox[{"-", "\[Infinity]"}], "\[Infinity]"],
          RowBox[{
            FractionBox["1",
              SqrtBox[
                RowBox[{"2", "\[Pi]"}]]],
            RowBox[{"Exp", "[",
              RowBox[{"-",
                FractionBox[
                  RowBox[{
                    SuperscriptBox["u", "2"], "+",
                    SuperscriptBox[
                      RowBox[{"(",
                        RowBox[{"v", "-", "1"}], ")"}], "2"]}],
                  "2"]}], "]"}],
            RowBox[{"N", "[",
              RowBox[{
                FractionBox[
                  SqrtBox["5"],
                  SqrtBox[
                    RowBox[{"2", "\[Pi]"}]]],
                RowBox[{
                  SubsuperscriptBox["\[Integral]",
                    RowBox[{"-", "\[Infinity]"}],
                    RowBox[{"+", "\[Infinity]"}]],
                  RowBox[{
                    SubsuperscriptBox["\[Integral]",
                      RowBox[{
                        FractionBox[
                          SqrtBox["2"], "2"],
                        RowBox[{"Abs", "[",
                          RowBox[{"u", "-", "v"}], "]"}]}],
                      "\[Infinity]"],
                    RowBox[{
                      RowBox[{"Exp", "[",
                        RowBox[{"-",
                          FractionBox[
                            RowBox[{"(",
                              RowBox[{
                                SuperscriptBox["x", "2"], "+",
                                SuperscriptBox["y", "2"]}], ")"}],
                            RowBox[{"2", "/", "5"}]]}], "]"}],
                      RowBox[{"\[DifferentialD]", "x"}],
                      RowBox[{"\[DifferentialD]", "y"}]}]}]}]}],
              "]"}],
            RowBox[{"\[DifferentialD]", "u"}],
            RowBox[{"\[DifferentialD]", "v"}]}]}]}], "]"}]], "Input"]







Notebook[{
Cell[BoxData[
    \(N[\[Integral]\_\(-\[Infinity]\)\%\[Infinity]\(\[Integral]\_\(-\
\[Infinity]\)\%\[Infinity]\( 1\/\@\(2  \[Pi]\)\)
            Exp[\(-\(\(u\^2 + \((v - 1)\)\^2\)\/2\)\)]
            N[\(\@5\/\@\(2  \[Pi]\)\) \(\[Integral]\_\(-\[Infinity]\)\
\%\(+\[Infinity]\)\(\[Integral]\_\(\(\@2\/2\) Abs[u - v]\)\%\
\[Infinity] Exp[\(-\(\((x\^2 + y\^2)\)\/\(2/
                                5\)\)\)] \[DifferentialD]x \
\[DifferentialD]y\)\)] \[DifferentialD]u \[DifferentialD]v\)]\)], \
"Input"]
},
FrontEndVersion->"5.2 for Microsoft Windows",
ScreenRectangle->{{0, 800}, {0, 543}},
WindowSize->{665, 494},
WindowMargins->{{0, Automatic}, {Automatic, 0}}
]

From news at enyo.uwa.edu.au  Wed Feb  1 03:04:33 2006
	by smc.vnet.net (8.8.8+Sun/8.8.8) with ESMTP id DAA21583
	for <mathgroup at smc.vnet.net>; Wed, 1 Feb 2006 03:04:32 -0500 (EST)
	by mailbox8.ucsd.edu (8.13.5/8.13.5) with ESMTP id k1180p4E057703
	for <comp-soft-sys-math-mathematica at moderators.isc.org>; Wed, 1 Feb 2006 00:00:52 -0800 (PST)
	by asclepius.uwa.edu.au (Postfix) with SMTP id E760C184BA5
	for <comp-soft-sys-math-mathematica at moderators.isc.org>; Wed,  1 Feb 2006 16:00:38 +0800 (WST)
	by asclepius.prekas (Postfix) with SMTP id D479C184935
	for <comp-soft-sys-math-mathematica at moderators.isc.org>; Wed,  1 Feb 2006 16:00:38 +0800 (WST)
X-UWA-Client-IP: 130.95.128.9 (UWA)
	by asclepius.extinput (Postfix) with ESMTP id C67DD183519
	for <comp-soft-sys-math-mathematica at moderators.isc.org>; Wed,  1 Feb 2006 16:00:38 +0800 (WST)
	id 440F6281E8; Wed,  1 Feb 2006 16:00:36 +0800 (WST)
From: Paul Abbott <paul at physics.uwa.edu.au>
To: mathgroup at smc.vnet.net
Subject: [mg64105] FindFit and NormFunction
Organization: The University of Western Australia
X-SpamTest-Status: Not detected
X-SpamTest-Version: SMTP-Filter Version 2.0.0 [0125], KAS/Release
	processed by UCSD_GL-v2.1 on mailbox8.ucsd.edu;
	Wed, 01 February 2006 00:00:53 -0800 (PST)

I am having difficulty using the NormFunction option to FindFit. Let me 
give a concrete example. Abramowitz and Stegun Section 17.3.35 gives a 
nonlinear approximant to the complete elliptic integral. See

 www.convertit.com/Go/ConvertIt/Reference/AMS55.ASP?Res=150&Page=592

This approximant to EllipticE[1-m] can be implemented as

 f[a_, b_, c_, d_][m_] = a m + b m^2 - (c m + d m^2) Log[m] + 1; 

After sampling EllipticE[1-m],

 data = N[Table[{m, EllipticE[1-m]}, {m, 10^-8, 1 - 10^-8, 10^-3}]];

using FindFit gives quite a decent approximant:

 FindFit[data, f[a, b, c, d][m], {a,b,c,d}, m]

 best[m_] =f[a, b, c, d][m] /. %

The maximal absolute fractional error is ~6 x 10^-5 as seen from

 Plot[10^5 (1 - best[m]/EllipticE[1 - m]), {m, 0, 1}, PlotRange -> All]

However, the Abramowitz and Stegun approximant has error ~4 x 10^-5.

 AS[m_] =f[0.4630151, 0.1077812, 0.2452727, 0.0412496][m];

 Plot[10^5 (1 - AS[m]/EllipticE[1 - m]), {m, 0, 1}, PlotRange -> All]

Essentially, one needs to fit with respect to the L-Infinity-Norm, see

 http://mathworld.wolfram.com/L-Infinity-Norm.html

as the NormFunction in FindFit. However, when I try

  FindFit[data, f[a, b, c, d][m], {a,b,c,d}, m, 
     NormFunction :> (Norm[#, Infinity]&)]

I get a FindFit::"lmnl" message (which is reasonable and informative) 
and also a FindFit::"lstol" message:

 "The line search decreased the step size to within tolerance specified 
  by AccuracyGoal and PrecisionGoal but was unable to find a sufficient 
  decrease in the norm of the residual. You may need more than 
  MachinePrecision digits of working precision to meet these tolerances."

I can see (by monitoring the Norm of the residual) that the algorithm 
gets trapped a long way from the minimum -- but I don't see why more 
digits of working precision are required. 

As an aside, is there an easy way (a handle?) to monitor the norm of the 
residuals at each step? One way is to write a function to compute the 
residuals,

 r[a_, b_, c_, d_] = 
  Norm[(f[a, b, c, d] /@ data[[All,1]]) - data[[All,2]], Infinity];

and then track them using StepMonitor or EvaluationMonitor

  Reap[FindFit[data, f[a, b, c, d][m], {a,b,c,d}, m, 
    NormFunction :> (Norm[#,Infinity]&),
    EvaluationMonitor :> Sow[r[a,b,c,d]]]]

but is there a _direct_ way of accessing the residuals which are 
computed by FindFit anyway?

Cheers,
Paul

_______________________________________________________________________
Paul Abbott                                      Phone:  61 8 6488 2734
School of Physics, M013                            Fax: +61 8 6488 1014
The University of Western Australia         (CRICOS Provider No 00126G)    
AUSTRALIA                               http://physics.uwa.edu.au/~paul


  • Prev by Date: How to fit complex valued data?
  • Next by Date: Re: Recommended learning exercises for beginners?
  • Previous by thread: Re: How to fit complex valued data?
  • Next by thread: Re: How to evaluate the following expression in Mathematica?