TUdataNLinLSq TCL UTILITIES USER MANUAL TUdataNLinLSq
SYNOPSIS
Perform a non-linear 2D least squares fit of a set of data to a functional relationship.
PACKAGE
TCLUTILS
NAME
TUdataNLinLSq
USAGE
TUdataNLinSq  Y W nP Coef iCoef nC FunC oPs
INPUT DEFINITIONS
Y - Input array of measured Y values. The measured X array of values is used only in the procedure FunC and must be globally accessible to it.
W - Weighting factor associated with each Y value.
nP - The number of input (Y,W) data values
Coef - Function coefficients
iCoef - Coefficient Status
0 : Do not solve for coefficient
1 : Solve for coefficient
nC - Number of coefficients
FunC - Procedure which defines the function being fit. This is described in detail under the procedure description.
Ops - Input/output array. With the partial exception of Ops(0) all of the array elements are either used internal to the procedure or to pass information back outside the procedure. Ops(0) should be set to -1 for the first call to the procedure to all it to do the required internal initializations. Set Ops(0) to 0 for final call to the procedure to compute the covariance and curvature matrices. The procedure will set this variable during the middle iteration calls. It will contain the iteration step size. Ops(1) and Ops(2) hold the current and previous Χ2 values respectively. Ops(3) is the is the number of coefficients being fit (sum of iCoef). Ops(4) is the index of the current data value being processed. The next nC elements in the array hold the current iterated coefficients. The nC*nC elements a following these hold the covarience matrix which only exists if Ops(0) was set to 0 for the procedure call. Finally the next nC*nC elements contain the curvature matrix again which only exists if Ops(0) was set to 0 for the procedure call.
RETURN DEFINITION
Procedure returns no information
DESCRIPTION
TUdataNLinLSq fits a set of data to a functional form using the Levenberg-Marquart method. The routine attempts to reduce the Χ2 of the fit in a iterative fashion. Each call to the procedure completes one iterative step. It is the responsibility of the invoking program to actually make the iterative calls. These are generally terminated when either a maximum number of iterations have been made or when the search step size used in minimizing the Χ2 (Ops(4)) becomes excessively large. There must also be an initial call to the procedure to initialize it (Ops(0) = -1 and a final call (Ops(0) = 0 in which the covarience and curvature matrices are computed. There also needs to be an initial guess made to the coefficients being solved for in the functional fit.
The function to which the data is being fit is described in the input procedure FunC. The procedure must have the form
Y = FunC nA dYdA Ops
where nA is the number of coefficients being solved for in the function, dYdA is an array containing the derivitives of the function with respect each coefficient at a specific measured X value, and Ops is the same array described above under the TUdataNLinSq parameters. Y is the solution to the function at the measured X. NOTE: The measured X array of data must be globally accessible to FunC.
The value of X used by the procedure in solving for both the current value of the function and its derivitives is obtained from X($Ops(4)). The coefficients used in the solution are the current coefficient values found in the Ops array beginning at element 5.
ERRORS
None Generated
C BACKING
Yes
EXAMPLE(S)
EXAMPLE 1:
# FIT as set of data to the curve: Y = (A*X^2 + B*X - C) * exp(-D * X^2)

# THIS function returns Y, dY/dA, dY/dB, dY/dC, and dY/dD for any value X.

proc FunC { nA dYdA Ops } {
    global X

    upvar $dYdA dA
    upvar $Ops  oP

    set xV $X($oP(4))
    set xS [expr $xV * $xV]

# THE coefficients
    set A $oP(5)
    set B $oP(6)
    set C $oP(7)
    set D $oP(8)


    set ExP [expr exp(-$D * $xS)]
    set PolY [expr $A * $xS + $B * $xV - $C]

# THE value of the function

    set yV [expr $PolY * $ExP]

# Derivitive with respect to A [X^2 * exp(-D * X^2)]
    set dA(0) [expr $xS * $ExP]
# Derivitive with respect to B [X * exp(-D * X^2)]
    set dA(1) [expr $xV * $ExP]
# Derivitive with respect to C [-exp(-D * X^2)]
    set dA(2) [expr -$ExP]
# Derivitive with respect to D [X^2 * yV] 
    set dA(3) [expr -$xS * $PolY * $ExP]
    return $yV
}

# SET up synthetic data set with A = 3.3, B = 2.64, C = 0.9 and D = 0.5.
#    The data set used in the fit is (X,Y) which has a noise superimposed
#    on it.  The data set (Xp,Yp) is the noiseless data set which is used
#    in a graphical comparison

set nP 0
set A 3.3
set B 2.64
set C 0.9
set D 0.5
for { set I -5.0 } { $I <= 5.0 } { set I [expr $I + 0.1] } { 
   set Xsp [expr $I * $I]
   set X($nP) [expr $I + [TUdataRnd1 V 1 PN .05]] 
   set Xs [expr $X($nP) * $X($nP)]
   set Y($nP) [expr ($A * $Xs + $B * $X($nP) - $C) * exp(-$D * $Xs)]
   set Xp($nP) $I
   set Yp($nP) [expr ($A * $Xsp + $B * $Xp($nP) - $C) * exp(-$D * $Xsp)]
   set Y($nP) [expr $Y($nP) * (1.0 + [TUdataRnd1 V 1 PN .2])] 
   incr nP
}

# SET up first guess at coefficients (all set to 1.0).  iP indicated
#   that all coefficients are to be solved for.

for { set I 0 } { $I < 4 } { incr I } {
   set P($I) 1.0;
   set iP($I) 1;
}

# WEIGHTING is set to 1 for all data elements

for { set I 0 } { $I < $nP } { incr I } { set W($I) 1.0; }

# INITIALIZE the fit parameters

set oP(0) -1
TUdataNLinLSq Y W $nP P iP 4 FunC oP

# NOT perform the fit.  Stops after either 500 steps or when the search
#   step size gets overly large, in this case 10000.0

set MaxCnt 0
while { ($MaxCnt < 500) && ($oP(0) < 10000.0) } {
    TUdataNLinLSq Y W $nP P iP 4 FunC oP
    incr MaxCnt
}

# FINISH up by computing the covarience matrices

set oP(0) 0.0
TUdataNLinLSq Y W $nP P iP 4 FunC oP

# THIS is the data set as computed from the fit coefficients.

set nP 0
for { set I -5.0 } { $I <= 5.0 } { set I [expr $I + 0.1] } { 
   set x($nP) $I
   set xs [expr $I * $I]
   set y($nP) [expr ($P(0) * $xs + $P(1) * $I - $P(2)) * exp(-$P(3) * $xs)]
   incr nP
}

# PRINT some results

puts stderr "Parameter A is [format "%.2f" $P(0)], should be 3.30"
puts stderr "Parameter B is [format "%.2f" $P(1)], should be 2.64"
puts stderr "Parameter C is [format "%.2f" $P(2)], should be 0.90"
puts stderr "Parameter D is [format "%.2f" $P(3)], should be 0.50"

# PRINT some error results

puts stderr "Covarience for Parameter A is [format "%.4f" $oP(9)]"
puts stderr "Covarience for Parameter B is [format "%.4f" $oP(14)]"
puts stderr "Covarience for Parameter C is [format "%.4f" $oP(19)]"
puts stderr "Covarience for Parameter D is [format "%.4f" $oP(24)]"

# SHOW results graphically
 
GraphicsOn TK ETones SWAP
GenWindow 1 0.15 0.15 0.0 0.85 0.85 0.0  -5. -2.0 0. 5.0 4.0 0.
DefinePlot 1 1 -1 -1

# PLOT the noisey input data in white

set GoP [list $GphInfo(White) NONE]
Plot2D 1 Xb Yb X Y 0 [expr $nP -1] LINE $GoP 

# PLOT the noiseless data in green

set GoP [list $GphInfo(Green) NONE]
Plot2D 1 Xb Yb Xp Yp 0 [expr $nP -1] LINE $GoP 

# PLOT the fit data in red as a scatter plot

set GoP [list $GphInfo(Red) <= -1.0e8 HOLD 8 "*"]
Plot2D 1 Xb Yb x y 0 [expr $nP -1] SCATTER $GoP 

PlotOutlines 1 [list "X" 1.0 "Y" 1.0] [list BOT BOT BOTH BOTH]

WinClip 1 0
TextProp 12 HOLD HOLD
TexT 1 0.0 4.85 0.0 center "ORIGINAL w/ ADDED NOISE" $GphInfo(White)
TexT 1 0.0 4.55 0.0 center "ORIGINAL w/ NO NOISE" $GphInfo(Green)
TexT 1 0.0 4.25 0.0 center "FIT" $GphInfo(Red)

update


> Parameter A is 3.17, should be 3.30
> Parameter B is 2.49, should be 2.64
> Parameter C is 0.94, should be 0.90
> Parameter D is 0.48, should be 0.50
> Covarience for Parameter A is 0.3024
> Covarience for Parameter B is 0.1410
> Covarience for Parameter C is 0.0997
> Covarience for Parameter D is 0.0025

      
Sept 19, 2006