Application Center - Maplesoft

App Preview:

Logistic Cost Curve by the Levenberg-Marquardt Method

You can switch back to the summary page by clicking here.

Learn about Maple
Download Application


 

LM Cost 2.mws

Logistic Cost Curve by the Levenberg-Marquardt Method

By J.M. R edwood

Synopsis

Procedure mnlfit , based on the Levenberg-Marquardt method, is used to fit a Logistic function to a project's cost data and provide a means for estimating cash flows in similar projects.

Copyright

The procedure used in this worksheet is an adaptation of Dr. D.E. Holmgren's procedure mnlfit 2000. His permission to reproduce and adapt the procedure is gratefully acknowledged.

Procedure mnlfit

Original Procedure

This worksheet implements the Levenberg-Marquardt method of fitting a non-linear function to a set of data. The general form of the fitting function is:

y = f(a[0] ...a[n] ;x[0] ...x[m] )

i.e., it is possible to have more than one independent variable. The user must supply a Maple routine to compute the function
f (see example below). The procedure mnlfit will then compute the required derivatives. The user must also supply the data in the form of vectors of x and y values (or a matrix of x values in the case of more than one independent variable), as well as weights for the data points. The weights are usually the reciprocals of the standard deviations for each of the observed data points, but if not known, they may be set to unity. The routine below will iterate the solution either until the tolerance tol is reached or until the maximum number of iterations (50) is reached.

If the procedure requires a full 50 iterations, the data and formulation of the problem should be re-examined. In any case, the best way of learning how to use mnlfit is to run through the example below.

If there is sufficient interest and/or demand, a future version of this code will include automatic differentiation for more complicated model functions.

All of the usual qualifications concerning free software apply here (i.e., no claims of suitability for any particular application). Responsibility lies with the user to ensure that correct results are obtained!

Any questions about
mnlfit should be addressed to D.E. Holmgren, together with any suggestions for modifications.

This procedure was developed jointly by:

D.E. Holmgren (holmgren@brandonu.ca) Brandon University, Brandon, MB, Canada
J.F. Ogilvie (ogilvie@munkebo.chem.ou.dk)
M. Monagan (monagan@cecm.sfu.ca) Center for Experimental and Constructive Mathematics, Simon Fraser University, Vancouver BC, Canada.

Adaptations of Original Procedure

Dr. D.E. Holmgren's original worksheet was downloaded from www.maplesoft.com/apps/categories/data_analysis_stats/data/html/genfit_6.html, and was adapted with Maple V Release 5.1. It can be used with both Maple V R5.1 and Maple 6.

The adaptations were:

(a) Removal of the redundant procedure fitstats .

(b) Removal of statements that attempted to calculate the covariance ratio, F (referred to as fstat in the original).

(c) Removal of all commands preceded by the # sign.

(d) Removal of the square root from weighting operations.

(e) Provision of means to control the output.

(f) Provision of an analysis of covariance and tests of the regression.

(g) Improved presentation of output.

Tests of the regression include G.W. Snedecor's test of the covariance ratio, F . This test is only valid for data drawn from a (multi-variable) Normal distribution. Users must satisfy themselves that this is the case, before placing any credence in this test. Naturally, the same applies to any other tests based, like Snedecor's, on Sir Ronald Fisher's z distribution and his transforms of z .

Definitions

mnlfit := proc(f, X, x::array, y::vector, wt::vector, P::{name,list(name)},p::vector,tol,Prin,digi::integer)

f is the name of the function to be fitted to the data,

X is the name of the independent variable appearing in this function,

x is the array of observed values of X ,

y is the array of observed values of the dependent variable or function,

wt is an array of weights (usually the inverses of the standard deviation of each value of dependent variable, but can be set to unity if weights are not known),

P is the name of the parameters of X as a vectorial quantity,

p is a vector of initial estimates of values of the parameters of X (rough guesses are usually good enough - the Levenberg-Marquardt method is not very sensitive to the initial estimates),

tol is a tolerance that serves as a criterion of convergence of the solution,
Prin controls the output of supplementary information - insert:

S in place of Prin if the fit statistics are required,

R if a table of residuals is required,

B if both statistics and residuals are required,

It if the residuals after each iteration are required,

All causes all the above items to be printed,

Inserting any other name, or leaving it as Prin , prevents their output,

digi is an integer that controls the number of digits printed by mnlfit .

mnlfit prints the number of iterations, the Std Deviation of Residuals (Goodness of Fit) statistic, the supplementary information required, and returns f .

Procedure mnlfit

> restart: Digits := 40:

> mnlfit := proc(f, X, x::array, y::vector, wt::vector, P::{name,list(name)},p::vector,
tol,Prin,digi::integer)
local gradf,nobs,npar,k,yck,xk,r,a,drv,niter,j,n,corr,corrprint,alpha,beta,cvm,b,p1,errors,dp,
res,nu,res1,sigma1,reso,nxvar,yc,finals,hdg,ssr,ssyc,ssy,cf,msr,msyc,msy,F,pF,Rsq,Tests, anova,resi,rout;
# Initialize.
if type(P,name) then
RETURN(mnlfit(f,X,x,y,wt,[seq(P[k],k=1..linalg[vectdim](p))],p,tol,Prin,digi));
fi;
gradf := linalg[grad](f,P);
reso := 1.0*10^9;
nobs := linalg[vectdim](y);
npar := linalg[vectdim](p);
nxvar := linalg[coldim](x);
xk := vector(nxvar);
r := vector(nobs);
a := matrix(nobs,npar,0.0);
corr := matrix(npar,npar,0.0);
drv := vector(npar);
p1 := vector(npar);
errors := vector(npar);
niter := 50;
nu := 1000;
# Begin iterations.
for n from 1 to niter do
# Compute initial fit and residuals ( = observed - calculated).
for k from 1 to nobs do
for j from 1 to nxvar do xk[j] := x[k,j]
od; yck,drv := gry(f,gradf,X,P,npar,xk,p);
r[k] := evalf(wt[k]*(y[k] - yck));
for j from 1 to npar do
a[k,j] := wt[k]*drv[j];
od:
od:
# Sum of squares of residuals
res1 := evalf(linalg[dotprod](r,r));
if Prin = It or Prin = All then print(` Iteration No `, n ,` initial SSR = `, evalf(res1,digi));
fi; # Compute matrix alpha of normal equations.
alpha := evalf(evalm(linalg[transpose](a) &* a));
# Compute vector beta for right sides of normal equations.
beta := evalf(evalm(linalg[transpose](a) &* r));
# Note use of factor nu in this next loop; this increases as one approaches solution.
for j from 1 to npar do
alpha[j,j] := evalf(alpha[j,j]*(1. + 1./nu));
od:
# Solve a system of normal equations to correct parameters.
dp := evalf(linalg[linsolve](alpha, beta));
# Compute sum of squares of residuals at new point p1 = p + dp.
p1 := evalf(evalm(p + dp));
for k from 1 to nobs do
for j from 1 to nxvar do xk[j] := x[k,j] od;
yck,drv := gry(f,gradf,X,P,npar,xk,p1);
r[k] := evalf(wt[k]*(y[k]-yck));
# Store yc[k] ie calculated y.
yc[k] := yck;
od:
res := evalf(linalg[dotprod](r,r));
if Prin = It or Prin = All then print(` new SSR = `, evalf(res,digi));
fi; # Modify nu according to whether the sum of squares increases or decreases after this correction. # For the wrong direction, elements are not corrected.
if res1 <= res then
nu := nu/10.;
else
# For the right direction, correct the elements.
nu := nu*10.;
p := evalf(evalm(p + dp));
fi:
# Test for convergence.
if abs(res - reso) <= tol then
break
fi;
reso := res;
od:
# Covariance matrix
cvm := evalf(linalg[inverse](alpha));
# Standard deviation of residuals
sigma1 := sqrt(res/(nobs - npar));
# Errors of parameters
for j from 1 to npar do
errors[j] := evalf(sigma1*sqrt(cvm[j,j]));
od:
for j from 1 to npar do
for k from 1 to npar do
corr[j,k] := cvm[j,k]/sqrt(cvm[j,j]*cvm[k,k])
od:
od: # Print results.
print (array([[`No of Iterations`,`Std Deviation of Residuals`],[n,evalf(sigma1, digi)]]));
print();
if Prin = S or Prin = B or Prin = All then
print();
# Calculate Sums of Squares, Covariances & Tests.
cf := (add(wt[j]*y[j],j=1..nobs))^2/nobs;
ssyc := add((wt[j]*yc[j])^2,j=1..nobs) - cf;
ssr := add(wt[j]^2*(yc[j] - y[j])^2,j=1..nobs);
ssy := add((wt[j]*y[j])^2,j=1..nobs) - cf;
msyc := ssyc/(npar-1);
msy := ssy/(nobs - 1);
msr := ssr/(nobs - npar);
Rsq := ssyc/ssy;
pF := 1 - stats[statevalf,cdf,fratio[(npar - 1),(nobs - npar)]](msyc/msr);
anova := array([[`Source`,Sigma(`Squares`),`DF`,`Mean Square`], [`Regression`,trunc(ssyc),(npar-1),evalf(msyc,digi)], [`Residuals`,trunc(ssr),(nobs-npar),evalf(msr,digi)],[`Total`,trunc(ssy),(nobs - 1),` `]]);
Tests := array([[R^2,`F`,`Prob of F by chance`],[` `,` `,`for Normal data`],
[evalf(Rsq,3),evalf(msyc/msr,3),evalf(pF,3)]]);
# Print Anova and Tests
print(`Analysis of Covariance`);
print();
print(anova);
print();
print(`Tests of Covariance`);
print();
print(Tests);
print();
print (`Final values of parameters`); hdg := array([`Parameter`,`Value`,`Standard Error`]); finals := linalg[augment]([seq(j,j=1..npar)], convert(p,list), [seq(errors[j],j=1..npar)]); finals := evalf(evalm(finals),digi):
finals := linalg[stackmatrix](hdg,finals);
print(finals);
print();
corr := evalf(evalm(corr),digi):
cvm := evalf(evalm(cvm),digi):
print(`Matrix of Covariances`);
print();
print(cvm);
print();
print(` Matrix of Correlation Coefficients `);
print();
print(corr);
print();
fi;
if Prin =R or Prin = B or Prin = All then print(` Table of residuals `);
print();
resi := convert([seq([(seq(evalf(x[j,k],digi),k=1..nxvar),evalf(y[j],digi),evalf(yc[j],digi),
evalf(y[j]-yc[j],digi), evalf(wt[j]*(y[j]-yc[j])/sigma1, digi))],j=1..nobs)],matrix);
hdg := array([(seq(`x obs`[k],k=1..nxvar),` y obs `,` y calc `,` difference `,`wt*difference / sd of residuals`)]);
resi := linalg[stackmatrix](hdg,resi);
print(resi);
print();
fi;
RETURN(subs(seq(P[j]=evalf(p[j],digi),j=1..npar),f));
end:

gry := proc(f,G,x,a,n,xval,p::vector)
# Procedure to evaluate derivatives and formula
local k,y,i,drv,point;
point := {x=xval, seq(a[i]=p[i], i=1..n)};
drv := vector(n);
for k from 1 to n do
drv[k] := evalf(eval(G[k],point))
od:
y := evalf(eval(f,point));
RETURN(y,drv);
end:

Logistic Cost Curve

Problem

A method was needed for estimating the cash flows of engineering development projects undertaken by a certain company. One such project took 27 months to complete and the cumulative cost returns were collected throughout the life of the project. The accounts were closed 3 months after completion of the project, when the last bills were brought to account.

The cumulative costs were collected at the end of each month up to the final fixed price of 1,000,000. The data therefore comprises 30 pairs of (end) of month numbers and the cumulative costs in k.

The cumulative logistic distribution function often fits data from growth situations that are limited by a finite resource. In this case, the costs are limited by the fixed price for the job. They grow slowly at first as just a few, then more and more people on the development team become involved. They then increase more rapidly as parts are bought in and manufacturing, assembly and test proceed, and then taper off as the manufacturing and development teams reduce with final evaluation and delivery to the customer, followed by settlement of the last bills from suppliers.

Data

The data recorded was

> cost := [[1,2],[2,7],[3,11],[4,20],[5,36],[6,58],[7,87],[8,106],[9,138],[10,186],[11,234], [12,268],[13,352],[14,396],[15,489],[16,545],[17,643],[18,672],[19,750],[20,819], [21,854],[22,875],[23,924],[24,938],[25,948],[26,968],[27,975],[28,982],[29,995],[30,1000]]:

n := nops(cost):

As a first step, the data is plotted.

> with(plots):
pointplot(cost,view=[0..30,0..1000],labels=[`Months`,`Cost k`],title=`An Engineering Development Project`);

Warning, the name changecoords has been redefined

[Maple Plot]

The shape of the plot is typical of the cumulative expenditure for a fixed price project, and the sigmoidal form suggests that the logistic equation should fit the data. (Note the familiar slow start because engineers and draughtsmen were still involved with a different project!)

The (cumulative) logistic distribution function is given by f(t) = a[1]/(1+exp(a[2]-a[3]*t)) where a[1], a[2], a[3] are constants, and t is the independent variable.

Fitting the Logistic Equation to the Data

Starting values for p = [a[1], a[2], a[3]] are chosen from previous experience, and all weights are set to unity.

> p := vector(3,[1000,5,1]);
w := vector(n,1):

p := vector([1000, 5, 1])

> f := a[1]/(1+exp(a[2]-a[3]*t[1]));

f := a[1]/(1+exp(a[2]-a[3]*t[1]))

Choosing Prin = B and Digi = 6 , mnlfit is run.

> costv := linalg[col](cost,2):
month := matrix(n,1,linalg[col](cost,1)):
f1 := mnlfit(f,t,month,costv,w,a,p,10^(-20),B,6);

matrix([[`No of Iterations`, `Std Deviation of Resi...

`Analysis of Covariance`

matrix([[Source, Sigma(Squares), DF, `Mean Square`]...

`Tests of Covariance`

matrix([[R^2, F, `Prob of F by chance`], [` `, ` `,...

`Final values of parameters`

matrix([[Parameter, Value, `Standard Error`], [1., ...

`Matrix of Covariances`

matrix([[.256498, -.162752e-2, -.154989e-3], [-.162...

` Matrix of Correlation Coefficients `

matrix([[1.00000, -.509655, -.665013], [-.509655, 1...

` Table of residuals `

matrix([[`x obs`[1], ` y obs `, ` y calc `, ` diffe...

f1 := 1009.24*1/(1+exp(4.50362-.294132*t[1]))

> F1:=unapply(subs(t[1]=t,f1),t);

F1 := proc (t) options operator, arrow; 1009.24*1/(...

F1 is the desired logistic function that fits the data. It is now plotted against the data from which it was obtained.

> aa := pointplot(cost,view=[0..30,0..1000],labels=[`Months`,`Cost k`],title=`An Engineering Development Project`): bb := plot(F1(x),x=0..n):
display(aa,bb);

[Maple Plot]

Checks

By eye, the fit appears very good and this is supported by the relatively small Std Deviation of Residuals statistic.

However, one should plot the residuals to check that there is no clear trend,

> pts := zip((x,y)->[x,y],[seq(j,j=1..n)],[seq(cost[i,2]-F1(i),i=1..n)]):
pointplot(pts,labels=["Month","Actual - Est Cost k"]);

[Maple Plot]

The above plot shows the residuals are scattered at random, and the Table of Residuals shows they are all less than about twice the Std Deviation of Residuals . There is no reason to believe that the cost data, or the residuals, should be Normally distributed. Snedecor's test of F produced by mnlfit is therefore meaningless. However, the R^2 test shows that the regression accounts for 99.9% of the total covariance and F is very large. These reinforce the impression obtained by eye, and that given by the small Std Deviation of Residuals , that the fit is very good.

Standardised Logistic Cost Curve

By standardising the data as percentages of the total time and cost of the project, the resulting function would be more useful to accountants estimating the cash flow of other similar, planned projects.

The usual financial health warnings about past performance being no guide to future performance apply with a vengeance!!

Standardised Data and Fitting the Curve

> costvpc := evalm(100*costv/costv[n]):

> timepc := evalm(100*month/month[n,1]):

> costpc := zip((x,y)->[x,y],convert(timepc,vector),evalm(costvpc)):

> f100 := mnlfit(f,t,timepc,costvpc,w,a,p,10^(-20),S,6);

matrix([[`No of Iterations`, `Std Deviation of Resi...

`Analysis of Covariance`

matrix([[Source, Sigma(Squares), DF, `Mean Square`]...

`Tests of Covariance`

matrix([[R^2, F, `Prob of F by chance`], [` `, ` `,...

`Final values of parameters`

matrix([[Parameter, Value, `Standard Error`], [1., ...

`Matrix of Covariances`

matrix([[.256498, -.162752e-1, -.464966e-3], [-.162...

` Matrix of Correlation Coefficients `

matrix([[1.00000, -.509655, -.665013], [-.509655, 1...

f100 := 100.924*1/(1+exp(4.50362-.882396e-1*t[1]))

> F100:=unapply(subs(t[1]=t,f100),t);

F100 := proc (t) options operator, arrow; 100.924*1...

> aa := pointplot(costpc,labels=[`% Total Time`,`% Total Cost`],title=`Fixed Price Engineering Development Project Estimates`):
bb := plot(F100(x),x=0..100):
with(plots): display(aa,bb);

[Maple Plot]

Checking the Standardised Logistic Curve

Checking, as before, that there is no clear trend in the residuals,

> pts := zip((x,y)->[x,y],[seq(j,j=1..30)],[seq((costvpc[i]-F100(i*100/30)),i=1..30)]): pointplot(pts,labels=["%Total Time x 30/100","%Actual - %Est Cost "]);

[Maple Plot]

As expected, the plot of errors is identical to the previous one.

Finally, a sample spreadsheet is produced for the benefit of the accountants who have to estimate the cash flows of similar projects in future.

Spreadsheet

`Project Length Months = ` 24 `Total Cost  =` 850000




`Months to Date` `% Total Time` `% Total Cost` `Est Spent to Date`
m 25/6*m 100.924*1/(1+exp(4.50362-.3676650000*m)) 857854.0000*1/(1+exp(4.50362-.3676650000*m))
857854.0000*1/(1+exp(4.50362-.3676650000*m))
3 25/2 3.257416727842701073958592972489750742382
3.257416727842701073958592972489750742382
27688.04218666295912864804026616288131025
27688.04218666295912864804026616288131025
6 25 9.216322525352026585681020815072530008132
9.216322525352026585681020815072530008132
78338.74146549222597828867692811650506912
78338.74146549222597828867692811650506912
9 75/2 23.45786572027002537999492131089918939978
23.45786572027002537999492131089918939978
199391.8586222952157299568311426431098981
199391.8586222952157299568311426431098981
12 50 48.15144791383612336724759845795158600668
48.15144791383612336724759845795158600668
409287.3072676070486216045868925884810568
409287.3072676070486216045868925884810568
15 125/2 74.00607968076699699032961167852069512152
74.00607968076699699032961167852069512152
629051.6772865194744178016992674259085329
629051.6772865194744178016992674259085329
18 75 90.05348797314453551359768108047423313936
90.05348797314453551359768108047423313936
765454.6477717285518655802891840309816846
765454.6477717285518655802891840309816846
21 175/2 97.03659000837981409356296925462741962578
97.03659000837981409356296925462741962578
824811.0150712284197952852386643330668191
824811.0150712284197952852386643330668191
24 100 99.59978477141376701967840849295729720139
99.59978477141376701967840849295729720139
846598.1705570170196672664721901370262118
846598.1705570170196672664721901370262118

The missing 3402 from the Spent to Date after 24 months is reserved for the Project Manager's celebrations...hic, haec, hoc!

>

>

Observations

a. Fitting the very non-linear logistic (cumulative) distribution curve to a set of data is widely acknowledged to be extremely demanding. Nevertheless, Maple and Dr. D.E. Holmgren's procedure mnlfit produced an excellent fit to the cost data in this example. The author has obtained similarly good results with other sets of data, e.g. population of the USA.

b. It is quite remarkable that a procedure based on user-programmable symbolic logic should be able to perform the kind of computations normally done with specially coded numerical programs.

c. The very ease with which mnlfit produces results should warn us that care is essential when interpreting, or using, the results. In this example, applying the time-cost function to projects that are not very similar to the one from which the data was obtained, is a recipe for disaster.

d. The R^2 test of covariance shows that the regression accounts for 99.9% of the total covariation, indicating an excellent fit, and the value of F indicates the same. These reinforce the goodness of fit indicated by the Std Deviation of Residuals .

Disclaimer : While every effort has been made to validate the solutions in this worksheet, Waterloo Maple Inc. and the contributors are not responsible for any errors contained and are not liable for any damages resulting from the use of this material.