Re: Data fitting with Mathematica 3.0
- To: mathgroup at smc.vnet.net
- Subject: [mg15434] Re: Data fitting with Mathematica 3.0
- From: Paul Abbott <paul at physics.uwa.edu.au>
- Date: Mon, 18 Jan 1999 04:21:40 -0500
- Organization: University of Western Australia
- References: <77jkcv$2uq@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Sergio Luis dos Santos e Lucato wrote:
> Does anyone know how to tell Mathematica 3 that the resulting funktion f
> has to go trough a certain point? I can not change my function, since
> it is a physical modell. That is the coefficients have to be found the
> way, that my conditions are met even if it is not the best fit. I could
> not find any options in the manual.
>
> un = Function[{x, n}, (1-x/c)^(n+0.5)]; f = Fit[werte, Table[un[x, n],
> {n, 0, 2}], x];
Forcing a fitting function to go through a certain data point is often a
bad idea. Assuming that it is justified in your case, you could use it
to manually constrain your fitting function reducing the number of free
parameters from 3 to 2. Replacing 0.5 with 1/2 and factoring out
(1-x/c)^(1/2) simplifies the algebra considerably.
An alternative approach is to use NonlinearFit with specified Weights.
For your definition,
In[1]:= un = Function[{x, n}, (1 - x/d)^(n + 1/2)];
the model can be written as follows:
In[2]:= f[d_, a_:1, b_:2, c_:3][x_] = {a, b, c} .
Table[un[x, n], {n, 0, 2}]
x x 3/2 x 5/2
Out[2]= a Sqrt[1 - -] + b (1 - -) + c (1 - -)
d d d
Producing some dummy data in which the first point is fixed and all
others are randomly perturbed,
In[3]:= data = Table[{x, f[1.1][x] + If[x > 0.01,
Random[Real, {-0.1, 0.1}], 0]}, {x, 0, 1, 0.01}];
we visualize the data:
In[4]:= lp = ListPlot[data];
Here is the unconstrained NonlinearFit:
In[5]:= NonlinearFit[data, f[d, a, b, c][x], x,
{{a, 1}, {b, 2}, {c, 3}, {d, 1.2}}]
Out[5]=
0.864351 Sqrt[1 - 0.908744 x] +
3/2 5/2
2.40231 (1 - 0.908744 x) + 2.69718 (1 - 0.908744 x)
Now we give large weight (5000) to the first point:
In[6]:= NonlinearFit[data, f[d, a, b, c][x], x,
{{a, 1}, {b, 2}, {c, 3}, {d, 1.2}},
Weights -> Join[{5000}, Table[1, {Length[data] - 1}]]]
Out[6]=
1.0613 Sqrt[1 - 0.929956 x] +
3/2 5/2
2.10949 (1 - 0.929956 x) + 2.82915 (1 - 0.929956 x)
We plot this fit along with the original data.
In[7]:= Plot[%, {x, 0, 1}, Epilog -> {Hue[1], lp[[1]]}];
Cheers,
Paul
____________________________________________________________________
Paul Abbott Phone: +61-8-9380-2734
Department of Physics Fax: +61-8-9380-1014
The University of Western Australia Nedlands WA 6907
mailto:paul at physics.uwa.edu.au AUSTRALIA
http://www.physics.uwa.edu.au/~paul
God IS a weakly left-handed dice player
____________________________________________________________________