Commit ece261cd authored by Emmanuel Bertin's avatar Emmanuel Bertin
Browse files

merged with SExFIGI branch

parent 5ae55cd0
#
# Windows Makefile for MATLAB interface to levmar
#
MEX=mex
MEXCFLAGS=-I.. -O #-g
# WHEN USING LAPACK, CHANGE THE NEXT TWO LINES TO WHERE YOUR COMPILED LAPACK/BLAS & F2C LIBS ARE!
LAPACKBLASLIBS_PATH=C:\src\lib
F2CLIBS_PATH=$(LAPACKBLASLIBS_PATH) # define appropriately if not identical to LAPACKBLASLIBS_PATH
INTFACESRCS=levmar.c
LAPACKLIBS=$(LAPACKBLASLIBS_PATH)/clapack.lib $(LAPACKBLASLIBS_PATH)/blas.lib $(F2CLIBS_PATH)/libF77.lib $(F2CLIBS_PATH)/libI77.lib
LIBS=$(LAPACKLIBS)
dummy: $(INTFACESRCS)
$(MEX) $(MEXCFLAGS) $(INTFACESRCS) ../levmar.lib $(LIBS)
clean:
-del levmar.mexw32
depend:
makedepend -f Makefile $(INTFACESRCS)
# DO NOT DELETE THIS LINE -- make depend depends on it.
This directory contains a matlab MEX interface to levmar. This interface
has been tested with Matlab v. 6.5 R13 under linux and v. 7.4 R2007 under Windows.
FILES
The following files are included:
levmar.c: C MEX-file for levmar
Makefile: UNIX makefile for compiling levmar.c using mex
Makefile.w32: Windows makefile for compiling levmar.c using mex
levmar.m: Documentation for the MEX interface
lmdemo.m: Demonstration of using the MEX interface; run as matlab < lmdemo.m
*.m: Matlab functions implementing various objective functions and their Jacobians.
For instance, meyer.m implements the objective function for Meyer's (reformulated)
problem and jacmeyer.m implements its Jacobian.
COMPILING
Use the provided Makefile or Makefile.w32, depending on your platform.
Alternatively, levmar.c can be compiled from matlab's prompt with a
command like
mex -DHAVE_LAPACK -I.. -O -L<levmar library dir> -L<blas/lapack libraries dir> levmar.c -llevmar -lclapack -lblas -lf2c
Make sure that you substitute the angle brackets with the correct paths to
the levmar and the blas/lapack directories. Also, on certain systems,
-lf2c should be changed to -llibF77 -llibI77
If your mex compiler has not been configured, the following command should be run first:
mex -setup
TESTING
After compiling, execute lmdemo.m with matlab < lmdemo.m
function x = bt3(p, adata)
n=5;
t1=p(1)-p(2);
t2=p(2)+p(3)-2.0;
t3=p(4)-1.0;
t4=p(5)-1.0;
for i=1:n
x(i)=t1*t1 + t2*t2 + t3*t3 + t4*t4;
end
function x = expfit(p, data)
n=data;
% data1, data2 are actually unused
for i=1:n
x(i)=p(1)*exp(-p(2)*i) + p(3);
end
function x = hs01(p)
n=2;
t=p(1)*p(1);
x(1)=10.0*(p(2)-t);
x(2)=1.0-p(1);
function jac = bt3_jac(p, adata)
n=5;
m=5;
t1=p(1)-p(2);
t2=p(2)+p(3)-2.0;
t3=p(4)-1.0;
t4=p(5)-1.0;
for i=1:n
jac(i, 1:m)=[2.0*t1, 2.0*(t2-t1), 2.0*t2, 2.0*t3, 2.0*t4];
end
function jac = expfit_jac(p, data)
n=data;
m=max(size(p));
for i=1:n
jac(i, 1:m)=[exp(-p(2)*i), -p(1)*i*exp(-p(2)*i), 1.0];
end
function jac = hs01_jac(p)
m=2;
jac(1, 1:m)=[-20.0*p(1), 10.0];
jac(2, 1:m)=[-1.0, 0.0];
function jac = meyer_jac(p, data1, data2)
n=16;
m=3;
for i=1:n
ui=0.45+0.05*i;
tmp=exp(10.0*p(2)/(ui+p(3)) - 13.0);
jac(i, 1:m)=[tmp, 10.0*p(1)*tmp/(ui+p(3)), -10.0*p(1)*p(2)*tmp/((ui+p(3))*(ui+p(3)))];
end
function jac = modhs52_jac(p)
m=5;
jac(1, 1:m)=[4.0, -1.0, 0.0, 0.0, 0.0];
jac(2, 1:m)=[0.0, 1.0, 1.0, 0.0, 0.0];
jac(3, 1:m)=[0.0, 0.0, 0.0, 1.0, 0.0];
jac(4, 1:m)=[0.0, 0.0, 0.0, 0.0, 1.0];
/* ////////////////////////////////////////////////////////////////////////////////
//
// Matlab MEX file for the Levenberg - Marquardt minimization algorithm
// Copyright (C) 2007 Manolis Lourakis (lourakis at ics forth gr)
// Institute of Computer Science, Foundation for Research & Technology - Hellas
// Heraklion, Crete, Greece.
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
//////////////////////////////////////////////////////////////////////////////// */
#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <math.h>
#include <string.h>
#include <ctype.h>
#include <lm.h>
#include <mex.h>
/**
#define DEBUG
**/
#ifndef HAVE_LAPACK
#ifdef _MSC_VER
#pragma message("LAPACK not available, certain functionalities cannot be compiled!")
#else
#warning LAPACK not available, certain functionalities cannot be compiled
#endif /* _MSC_VER */
#endif /* HAVE_LAPACK */
#define __MAX__(A, B) ((A)>=(B)? (A) : (B))
#define MIN_UNCONSTRAINED 0
#define MIN_CONSTRAINED_BC 1
#define MIN_CONSTRAINED_LEC 2
#define MIN_CONSTRAINED_BLEC 3
struct mexdata {
/* matlab names of the fitting function & its Jacobian */
char *fname, *jacname;
/* binary flags specifying if input p0 is a row or column vector */
int isrow_p0;
/* rhs args to be passed to matlab. rhs[0] is reserved for
* passing the parameter vector. If present, problem-specific
* data are passed in rhs[1], rhs[2], etc
*/
mxArray **rhs;
int nrhs; /* >= 1 */
};
/* display printf-style error messages in matlab */
static void matlabFmtdErrMsgTxt(char *fmt, ...)
{
char buf[256];
va_list args;
va_start(args, fmt);
vsprintf(buf, fmt, args);
va_end(args);
mexErrMsgTxt(buf);
}
/* display printf-style warning messages in matlab */
static void matlabFmtdWarnMsgTxt(char *fmt, ...)
{
char buf[256];
va_list args;
va_start(args, fmt);
vsprintf(buf, fmt, args);
va_end(args);
mexWarnMsgTxt(buf);
}
static void func(double *p, double *hx, int m, int n, void *adata)
{
mxArray *lhs[1];
double *mp, *mx;
register int i;
struct mexdata *dat=(struct mexdata *)adata;
/* prepare to call matlab */
mp=mxGetPr(dat->rhs[0]);
for(i=0; i<m; ++i)
mp[i]=p[i];
/* invoke matlab */
mexCallMATLAB(1, lhs, dat->nrhs, dat->rhs, dat->fname);
/* copy back results & cleanup */
mx=mxGetPr(lhs[0]);
for(i=0; i<n; ++i)
hx[i]=mx[i];
/* delete the matrix created by matlab */
mxDestroyArray(lhs[0]);
}
static void jacfunc(double *p, double *j, int m, int n, void *adata)
{
mxArray *lhs[1];
double *mp;
double *mj;
register int i, k;
struct mexdata *dat=(struct mexdata *)adata;
/* prepare to call matlab */
mp=mxGetPr(dat->rhs[0]);
for(i=0; i<m; ++i)
mp[i]=p[i];
/* invoke matlab */
mexCallMATLAB(1, lhs, dat->nrhs, dat->rhs, dat->jacname);
/* copy back results & cleanup. Note that the nxm Jacobian
* computed by matlab should be transposed so that
* levmar gets it in row major, as expected
*/
mj=mxGetPr(lhs[0]);
for(i=0; i<n; ++i)
for(k=0; k<m; ++k)
j[i*m+k]=mj[i+k*n];
/* delete the matrix created by matlab */
mxDestroyArray(lhs[0]);
}
/* matlab matrices are in column-major, this routine converts them to row major for levmar */
static double *getTranspose(mxArray *Am)
{
int m, n;
double *At, *A;
register int i, j;
m=mxGetM(Am);
n=mxGetN(Am);
A=mxGetPr(Am);
At=mxMalloc(m*n*sizeof(double));
for(i=0; i<m; i++)
for(j=0; j<n; j++)
At[i*n+j]=A[i+j*m];
return At;
}
/* check the supplied matlab function and its Jacobian. Returns 1 on error, 0 otherwise */
static int checkFuncAndJacobian(double *p, int m, int n, int havejac, struct mexdata *dat)
{
mxArray *lhs[1];
register int i;
int ret=0;
double *mp;
mexSetTrapFlag(1); /* handle errors in the MEX-file */
mp=mxGetPr(dat->rhs[0]);
for(i=0; i<m; ++i)
mp[i]=p[i];
/* attempt to call the supplied func */
i=mexCallMATLAB(1, lhs, dat->nrhs, dat->rhs, dat->fname);
if(i){
fprintf(stderr, "levmar: error calling '%s'.\n", dat->fname);
ret=1;
}
else if(!mxIsDouble(lhs[0]) || mxIsComplex(lhs[0]) || !(mxGetM(lhs[0])==1 || mxGetN(lhs[0])==1) ||
__MAX__(mxGetM(lhs[0]), mxGetN(lhs[0]))!=n){
fprintf(stderr, "levmar: '%s' should produce a real vector with %d elements (got %d).\n",
dat->fname, m, __MAX__(mxGetM(lhs[0]), mxGetN(lhs[0])));
ret=1;
}
/* delete the matrix created by matlab */
mxDestroyArray(lhs[0]);
if(havejac){
/* attempt to call the supplied jac */
i=mexCallMATLAB(1, lhs, dat->nrhs, dat->rhs, dat->jacname);
if(i){
fprintf(stderr, "levmar: error calling '%s'.\n", dat->jacname);
ret=1;
}
else if(!mxIsDouble(lhs[0]) || mxIsComplex(lhs[0]) || mxGetM(lhs[0])!=n || mxGetN(lhs[0])!=m){
fprintf(stderr, "levmar: '%s' should produce a real %dx%d matrix (got %dx%d).\n",
dat->jacname, n, m, mxGetM(lhs[0]), mxGetN(lhs[0]));
ret=1;
}
else if(mxIsSparse(lhs[0])){
fprintf(stderr, "levmar: '%s' should produce a real dense matrix (got a sparse one).\n", dat->jacname);
ret=1;
}
/* delete the matrix created by matlab */
mxDestroyArray(lhs[0]);
}
mexSetTrapFlag(0); /* on error terminate the MEX-file and return control to the MATLAB prompt */
return ret;
}
/*
[ret, p, info, covar]=levmar_der (f, j, p0, x, itmax, opts, 'unc' ...)
[ret, p, info, covar]=levmar_bc (f, j, p0, x, itmax, opts, 'bc', lb, ub, ...)
[ret, p, info, covar]=levmar_lec (f, j, p0, x, itmax, opts, 'lec', A, b, ...)
[ret, p, info, covar]=levmar_blec(f, j, p0, x, itmax, opts, 'blec', lb, ub, A, b, wghts, ...)
*/
void mexFunction(int nlhs, mxArray *plhs[], int nrhs, const mxArray *Prhs[])
{
register int i;
register double *pdbl;
mxArray **prhs=(mxArray **)&Prhs[0], *At;
struct mexdata mdata;
int len, status;
double *p, *p0, *ret, *x;
int m, n, havejac, Arows, itmax, nopts, mintype, nextra;
double opts[LM_OPTS_SZ]={LM_INIT_MU, LM_STOP_THRESH, LM_STOP_THRESH, LM_STOP_THRESH, LM_DIFF_DELTA};
double info[LM_INFO_SZ];
double *lb=NULL, *ub=NULL, *A=NULL, *b=NULL, *wghts=NULL, *covar=NULL;
/* parse input args; start by checking their number */
if((nrhs<5))
matlabFmtdErrMsgTxt("levmar: at least 5 input arguments required (got %d).", nrhs);
if(nlhs>4)
matlabFmtdErrMsgTxt("levmar: too many output arguments (max. 4, got %d).", nlhs);
else if(nlhs<2)
matlabFmtdErrMsgTxt("levmar: too few output arguments (min. 2, got %d).", nlhs);
/* note that in order to accommodate optional args, prhs & nrhs are adjusted accordingly below */
/** func **/
/* first argument must be a string , i.e. a char row vector */
if(mxIsChar(prhs[0])!=1)
mexErrMsgTxt("levmar: first argument must be a string.");
if(mxGetM(prhs[0])!=1)
mexErrMsgTxt("levmar: first argument must be a string (i.e. char row vector).");
/* store supplied name */
len=mxGetN(prhs[0])+1;
mdata.fname=mxCalloc(len, sizeof(char));
status=mxGetString(prhs[0], mdata.fname, len);
if(status!=0)
mexErrMsgTxt("levmar: not enough space. String is truncated.");
/** jac (optional) **/
/* check whether second argument is a string */
if(mxIsChar(prhs[1])==1){
if(mxGetM(prhs[1])!=1)
mexErrMsgTxt("levmar: second argument must be a string (i.e. row vector).");
/* store supplied name */
len=mxGetN(prhs[1])+1;
mdata.jacname=mxCalloc(len, sizeof(char));
status=mxGetString(prhs[1], mdata.jacname, len);
if(status!=0)
mexErrMsgTxt("levmar: not enough space. String is truncated.");
havejac=1;
++prhs;
--nrhs;
}
else{
mdata.jacname=NULL;
havejac=0;
}
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: %s analytic Jacobian\n", havejac? "with" : "no");
#endif /* DEBUG */
/* CHECK
if(!mxIsDouble(prhs[1]) || mxIsComplex(prhs[1]) || !(mxGetM(prhs[1])==1 && mxGetN(prhs[1])==1))
*/
/** p0 **/
/* the second required argument must be a real row or column vector */
if(!mxIsDouble(prhs[1]) || mxIsComplex(prhs[1]) || !(mxGetM(prhs[1])==1 || mxGetN(prhs[1])==1))
mexErrMsgTxt("levmar: p0 must be a real vector.");
p0=mxGetPr(prhs[1]);
/* determine if we have a row or column vector and retrieve its
* size, i.e. the number of parameters
*/
if(mxGetM(prhs[1])==1){
m=mxGetN(prhs[1]);
mdata.isrow_p0=1;
}
else{
m=mxGetM(prhs[1]);
mdata.isrow_p0=0;
}
/* copy input parameter vector to avoid destroying it */
p=mxMalloc(m*sizeof(double));
for(i=0; i<m; ++i)
p[i]=p0[i];
/** x **/
/* the third required argument must be a real row or column vector */
if(!mxIsDouble(prhs[2]) || mxIsComplex(prhs[2]) || !(mxGetM(prhs[2])==1 || mxGetN(prhs[2])==1))
mexErrMsgTxt("levmar: x must be a real vector.");
x=mxGetPr(prhs[2]);
n=__MAX__(mxGetM(prhs[2]), mxGetN(prhs[2]));
/** itmax **/
/* the fourth required argument must be a scalar */
if(!mxIsDouble(prhs[3]) || mxIsComplex(prhs[3]) || mxGetM(prhs[3])!=1 || mxGetN(prhs[3])!=1)
mexErrMsgTxt("levmar: itmax must be a scalar.");
itmax=(int)mxGetScalar(prhs[3]);
/** opts **/
/* the fifth required argument must be a real row or column vector */
if(!mxIsDouble(prhs[4]) || mxIsComplex(prhs[4]) || (!(mxGetM(prhs[4])==1 || mxGetN(prhs[4])==1) &&
!(mxGetM(prhs[4])==0 && mxGetN(prhs[4])==0)))
mexErrMsgTxt("levmar: opts must be a real vector.");
pdbl=mxGetPr(prhs[4]);
nopts=__MAX__(mxGetM(prhs[4]), mxGetN(prhs[4]));
if(nopts!=0){ /* if opts==[], nothing needs to be done and the defaults are used */
if(nopts>LM_OPTS_SZ)
matlabFmtdErrMsgTxt("levmar: opts must have at most %d elements, got %d.", LM_OPTS_SZ, nopts);
else if(nopts<((havejac)? LM_OPTS_SZ-1 : LM_OPTS_SZ))
matlabFmtdWarnMsgTxt("levmar: only the %d first elements of opts specified, remaining set to defaults.", nopts);
for(i=0; i<nopts; ++i)
opts[i]=pdbl[i];
}
#ifdef DEBUG
else{
fflush(stderr);
fprintf(stderr, "LEVMAR: empty options vector, using defaults\n");
}
#endif /* DEBUG */
/** mintype (optional) **/
/* check whether sixth argument is a string */
if(nrhs>=6 && mxIsChar(prhs[5])==1 && mxGetM(prhs[5])==1){
char *minhowto;
/* examine supplied name */
len=mxGetN(prhs[5])+1;
minhowto=mxCalloc(len, sizeof(char));
status=mxGetString(prhs[5], minhowto, len);
if(status!=0)
mexErrMsgTxt("levmar: not enough space. String is truncated.");
for(i=0; minhowto[i]; ++i)
minhowto[i]=tolower(minhowto[i]);
if(!strncmp(minhowto, "unc", 3)) mintype=MIN_UNCONSTRAINED;
else if(!strncmp(minhowto, "bc", 2)) mintype=MIN_CONSTRAINED_BC;
else if(!strncmp(minhowto, "lec", 3)) mintype=MIN_CONSTRAINED_LEC;
else if(!strncmp(minhowto, "blec", 4)) mintype=MIN_CONSTRAINED_BLEC;
else matlabFmtdErrMsgTxt("levmar: unknown minimization type '%s'.", minhowto);
mxFree(minhowto);
++prhs;
--nrhs;
}
else
mintype=MIN_UNCONSTRAINED;
if(mintype==MIN_UNCONSTRAINED) goto extraargs;
/* arguments below this point are optional and their presence depends
* upon the minimization type determined above
*/
/** lb, ub **/
if(nrhs>=7 && (mintype==MIN_CONSTRAINED_BC || mintype==MIN_CONSTRAINED_BLEC)){
/* check if the next two arguments are real row or column vectors */
if(mxIsDouble(prhs[5]) && !mxIsComplex(prhs[5]) && (mxGetM(prhs[5])==1 || mxGetN(prhs[5])==1)){
if(mxIsDouble(prhs[6]) && !mxIsComplex(prhs[6]) && (mxGetM(prhs[6])==1 || mxGetN(prhs[6])==1)){
if((i=__MAX__(mxGetM(prhs[5]), mxGetN(prhs[5])))!=m)
matlabFmtdErrMsgTxt("levmar: lb must have %d elements, got %d.", m, i);
if((i=__MAX__(mxGetM(prhs[6]), mxGetN(prhs[6])))!=m)
matlabFmtdErrMsgTxt("levmar: ub must have %d elements, got %d.", m, i);
lb=mxGetPr(prhs[5]);
ub=mxGetPr(prhs[6]);
prhs+=2;
nrhs-=2;
}
}
}
/** A, b **/
if(nrhs>=7 && (mintype==MIN_CONSTRAINED_LEC || mintype==MIN_CONSTRAINED_BLEC)){
/* check if the next two arguments are a real matrix and a real row or column vector */
if(mxIsDouble(prhs[5]) && !mxIsComplex(prhs[5]) && mxGetM(prhs[5])>=1 && mxGetN(prhs[5])>=1){
if(mxIsDouble(prhs[6]) && !mxIsComplex(prhs[6]) && (mxGetM(prhs[6])==1 || mxGetN(prhs[6])==1)){
if((i=mxGetN(prhs[5]))!=m)
matlabFmtdErrMsgTxt("levmar: A must have %d columns, got %d.", m, i);
if((i=__MAX__(mxGetM(prhs[6]), mxGetN(prhs[6])))!=(Arows=mxGetM(prhs[5])))
matlabFmtdErrMsgTxt("levmar: b must have %d elements, got %d.", Arows, i);
At=prhs[5];
b=mxGetPr(prhs[6]);
A=getTranspose(At);
prhs+=2;
nrhs-=2;
}
}
}
/* wghts */
/* check if we have a weights vector */
if(nrhs>=6 && mintype==MIN_CONSTRAINED_BLEC){ /* only check if we have seen both box & linear constraints */
if(mxIsDouble(prhs[5]) && !mxIsComplex(prhs[5]) && (mxGetM(prhs[5])==1 || mxGetN(prhs[5])==1)){
if(__MAX__(mxGetM(prhs[5]), mxGetN(prhs[5]))==m){
wghts=mxGetPr(prhs[5]);
++prhs;
--nrhs;
}
}
}
/* arguments below this point are assumed to be extra arguments passed
* to every invocation of the fitting function and its Jacobian
*/
extraargs:
/* handle any extra args and allocate memory for
* passing the current parameter estimate to matlab
*/
nextra=nrhs-5;
mdata.nrhs=nextra+1;
mdata.rhs=(mxArray **)mxMalloc(mdata.nrhs*sizeof(mxArray *));
for(i=0; i<nextra; ++i)
mdata.rhs[i+1]=(mxArray *)prhs[nrhs-nextra+i]; /* discard 'const' modifier */
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: %d extra args\n", nextra);
#endif /* DEBUG */
if(mdata.isrow_p0){ /* row vector */
mdata.rhs[0]=mxCreateDoubleMatrix(1, m, mxREAL);
/*
mxSetM(mdata.rhs[0], 1);
mxSetN(mdata.rhs[0], m);
*/
}
else{ /* column vector */
mdata.rhs[0]=mxCreateDoubleMatrix(m, 1, mxREAL);
/*
mxSetM(mdata.rhs[0], m);
mxSetN(mdata.rhs[0], 1);
*/
}
/* ensure that the supplied function & Jacobian are as expected */
if(checkFuncAndJacobian(p, m, n, havejac, &mdata)){
status=LM_ERROR;
goto cleanup;
}
if(nlhs>3) /* covariance output required */
covar=mxMalloc(m*m*sizeof(double));
/* invoke levmar */
if(!lb && !ub){
if(!A && !b){ /* no constraints */
if(havejac)
status=dlevmar_der(func, jacfunc, p, x, m, n, itmax, opts, info, NULL, covar, (void *)&mdata);
else
status=dlevmar_dif(func, p, x, m, n, itmax, opts, info, NULL, covar, (void *)&mdata);
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: calling dlevmar_der()/dlevmar_dif()\n");
#endif /* DEBUG */
}
else{ /* linear constraints */
#ifdef HAVE_LAPACK
if(havejac)
status=dlevmar_lec_der(func, jacfunc, p, x, m, n, A, b, Arows, itmax, opts, info, NULL, covar, (void *)&mdata);
else
status=dlevmar_lec_dif(func, p, x, m, n, A, b, Arows, itmax, opts, info, NULL, covar, (void *)&mdata);
#else
mexErrMsgTxt("levmar: no linear constraints support, HAVE_LAPACK was not defined during MEX-file compilation.");
#endif /* HAVE_LAPACK */
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: calling dlevmar_lec_der()/dlevmar_lec_dif()\n");
#endif /* DEBUG */
}
}
else{
if(!A && !b){ /* box constraints */
if(havejac)
status=dlevmar_bc_der(func, jacfunc, p, x, m, n, lb, ub, itmax, opts, info, NULL, covar, (void *)&mdata);
else
status=dlevmar_bc_dif(func, p, x, m, n, lb, ub, itmax, opts, info, NULL, covar, (void *)&mdata);
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: calling dlevmar_bc_der()/dlevmar_bc_dif()\n");
#endif /* DEBUG */
}
else{ /* box & linear constraints */
#ifdef HAVE_LAPACK
if(havejac)
status=dlevmar_blec_der(func, jacfunc, p, x, m, n, lb, ub, A, b, Arows, wghts, itmax, opts, info, NULL, covar, (void *)&mdata);
else
status=dlevmar_blec_dif(func, p, x, m, n, lb, ub, A, b, Arows, wghts, itmax, opts, info, NULL, covar, (void *)&mdata);
#else
mexErrMsgTxt("levmar: no box & linear constraints support, HAVE_LAPACK was not defined during MEX-file compilation.");
#endif /* HAVE_LAPACK */
#ifdef DEBUG
fflush(stderr);
fprintf(stderr, "LEVMAR: calling dlevmar_blec_der()/dlevmar_blec_dif()\n");
#endif /* DEBUG */
}
}
#ifdef DEBUG
fflush(stderr);
printf("LEVMAR: minimization returned %d in %g iter, reason %g\n\tSolution: ", status, info[5], info[6]);
for(i=0; i<m; ++i)
printf("%.7g ", p[i]);
printf("\n\n\tMinimization info:\n\t");
for(i=0; i<LM_INFO_SZ; ++i)
printf("%g ", info[i]);
printf("\n");
#endif /* DEBUG */
/* copy back return results */
/** ret **/
plhs[0]=mxCreateDoubleMatrix(1, 1, mxREAL);
ret=mxGetPr(plhs[0]);
ret[0]=(double)status;
/** popt **/
plhs[1]=(mdata.isrow_p0==1)? mxCreateDoubleMatrix(1, m, mxREAL) : mxCreateDoubleMatrix(m, 1, mxREAL);
pdbl=mxGetPr(plhs[1]);
for(i=0; i<m; ++i)
pdbl[i]=p[i];
/** info **/
if(nlhs>2){
plhs[2]=mxCreateDoubleMatrix(1, LM_INFO_SZ, mxREAL);
pdbl=mxGetPr(plhs[2]);
for(i=0; i<LM_INFO_SZ; ++i)
pdbl[i]=info[i];
}
/** covar **/
if(nlhs>3){
plhs[3]=mxCreateDoubleMatrix(m, m, mxREAL);
pdbl=mxGetPr(plhs[3]);
for(i=0; i<m*m; ++i) /* covariance matrices are symmetric, thus no need to transpose! */
pdbl[i]=covar[i];
}
cleanup:
/* cleanup */
mxDestroyArray(mdata.rhs[0]);
if(A) mxFree(A);
mxFree(mdata.fname);
if(havejac) mxFree(mdata.jacname);
mxFree(p);
mxFree(mdata.rhs);
if(covar) mxFree(covar);
if(status==LM_ERROR)
mexWarnMsgTxt("levmar: optimization returned with an error!");
}
function [ret, popt, info, covar]=levmar(fname, jacname, p0, x, itmax, opts, type)
% LEVMAR matlab MEX interface to the levmar non-linear least squares minimization
% library available from http://www.ics.forth.gr/~lourakis/levmar/
%
% levmar can be used in any of the 4 following ways:
% [ret, popt, info, covar]=levmar(fname, jacname, p0, x, itmax, opts, 'unc', ...)
% [ret, popt, info, covar]=levmar(fname, jacname, p0, x, itmax, opts, 'bc', lb, ub, ...)
% [ret, popt, info, covar]=levmar(fname, jacname, p0, x, itmax, opts, 'lec', A, b, ...)
% [ret, popt, info, covar]=levmar(fname, jacname, p0, x, itmax, opts, 'blec', lb, ub, A, b, wghts, ...)
%
% The dots at the end denote any additional, problem specific data that are passed uniterpreted to
% all invocations of fname and jacname, see below for details.
%
% In the following, the word "vector" is meant to imply either a row or a column vector.
%
% required input arguments:
% - fname: String defining the name of a matlab function implementing the function to be minimized.
% fname will be called as fname(p, ...), where p denotes the parameter vector and the dots any
% additional data passed as extra arguments during the invocation of levmar (refer to Meyer's
% problem in lmdemo.m for an example).
%
% - p0: vector of doubles holding the initial parameters estimates.
%
% - x: vector of doubles holding the measurements vector.
%
% - itmax: maximum number of iterations.
%
% - opts: vector of doubles specifying the minimization parameters, as follows:
% opts(1) scale factor for the initial damping factor
% opts(2) stopping threshold for ||J^T e||_inf
% opts(3) stopping threshold for ||Dp||_2
% opts(4) stopping threshold for ||e||_2
% opts(5) step used in finite difference approximation to the Jacobian.
% If an empty vector (i.e. []) is specified, defaults are used.
%
% optional input arguments:
% - jacname: String defining the name of matlab function implementing the Jacobian of function fname.
% jacname will be called as jacname(p, ...) where p is again the parameter vector and the dots
% denote any additional data passed as extra arguments to the invocation of levmar. If omitted,
% the Jacobian is approximated with finite differences through repeated invocations of fname.
%
% - type: String defining the minimization type. It should be one of the following:
% 'unc' specifies unconstrained minimization.
% 'bc' specifies minimization subject to box constraints.
% 'lec' specifies minimization subject to linear equation constraints.
% 'blec' specifies minimization subject to box and linear equation constraints.
% If omitted, a default of 'unc' is assumed. Depending on the minimization type, the MEX
% interface will invoke one of dlevmar_XXX, dlevmar_bc_XXX, dlevmar_lec_XXX or dlevmar_blec_XXX
%
% - lb, ub: vectors of doubles specifying lower and upper bounds for p, respectively
%
% - A, b: k x m matrix and k vector specifying linear equation constraints for p, i.e. A*p=b
% A should have full rank.
%
% - wghts: vector of doubles specifying the weights for the penalty terms corresponding to
% the box constraints, see lmblec_core.c for more details. If omitted and a 'blec' type
% minimization is to be carried out, default weights are used.
%
%
% output arguments
% - ret: return value of levmar, corresponding to the number of iterations if successful, -1 otherwise.
%
% - popt: estimated minimizer, i.e. minimized parameters vector.
%
% - info: optional array of doubles, which upon return provides information regarding the minimization.
% See lm_core.c for more details.
%
% - covar: optional covariance matrix corresponding to the estimated minimizer.
%
error('levmar.m is used only for providing documentation to levmar; make sure that levmar.c has been compiled using mex');
% Unconstrained minimization
% fitting the exponential model x_i=p(1)*exp(-p(2)*i)+p(3) of expfit.c to noisy measurements obtained with (5.0 0.1 1.0)
p0=[1.0, 0.0, 0.0];
x=[5.8728, 5.4948, 5.0081, 4.5929, 4.3574, 4.1198, 3.6843, 3.3642, 2.9742, 3.0237, 2.7002, 2.8781,...
2.5144, 2.4432, 2.2894, 2.0938, 1.9265, 2.1271, 1.8387, 1.7791, 1.6686, 1.6232, 1.571, 1.6057,...
1.3825, 1.5087, 1.3624, 1.4206, 1.2097, 1.3129, 1.131, 1.306, 1.2008, 1.3469, 1.1837, 1.2102,...
0.96518, 1.2129, 1.2003, 1.0743];
options=[1E-03, 1E-15, 1E-15, 1E-20, 1E-06];
% arg demonstrates additional data passing to expfit/jacexpfit
arg=[40];
[ret, popt, info]=levmar('expfit', 'jacexpfit', p0, x, 200, options, arg);
disp('Exponential model fitting (see also ../expfit.c)');
popt
% Meyer's (reformulated) problem
p0=[8.85, 4.0, 2.5];
x=[];
x(1:4)=[34.780, 28.610, 23.650, 19.630];
x(5:8)=[16.370, 13.720, 11.540, 9.744];
x(9:12)=[8.261, 7.030, 6.005, 5.147];
x(13:16)=[4.427, 3.820, 3.307, 2.872];
options=[1E-03, 1E-15, 1E-15, 1E-20, 1E-06];
% arg1, arg2 demonstrate additional dummy data passing to meyer/jacmeyer
arg1=[17];
arg2=[27];
%[ret, popt, info]=levmar('meyer', 'jacmeyer', p0, x, 200, options, arg1, arg2);
%[ret, popt, info, covar]=levmar('meyer', 'jacmeyer', p0, x, 200, options, arg1, arg2);
[ret, popt, info, covar]=levmar('meyer', p0, x, 200, options, 'unc', arg1, arg2);
disp('Meyer''s (reformulated) problem');
popt
% Linear constraints
% Boggs-Tolle problem 3
p0=[2.0, 2.0, 2.0, 2.0, 2.0];
x=[0.0, 0.0, 0.0, 0.0, 0.0];
options=[1E-03, 1E-15, 1E-15, 1E-20];
adata=[];
A=[1.0, 3.0, 0.0, 0.0, 0.0;
0.0, 0.0, 1.0, 1.0, -2.0;
0.0, 1.0, 0.0, 0.0, -1.0];
b=[0.0, 0.0, 0.0]';
[ret, popt, info, covar]=levmar('bt3', 'jacbt3', p0, x, 200, options, 'lec', A, b, adata);
disp('Boggs-Tolle problem 3');
popt
% Box constraints
% Hock-Schittkowski problem 01
p0=[-2.0, 1.0];
x=[0.0, 0.0];
lb=[-realmax, -1.5];
ub=[realmax, realmax];
options=[1E-03, 1E-15, 1E-15, 1E-20];
[ret, popt, info, covar]=levmar('hs01', 'jachs01', p0, x, 200, options, 'bc', lb, ub);
disp('Hock-Schittkowski problem 01');
popt
% Box and linear constraints
% Hock-Schittkowski modified problem 52
p0=[2.0, 2.0, 2.0, 2.0, 2.0];
x=[0.0, 0.0, 0.0, 0.0];
lb=[-0.09, 0.0, -realmax, -0.2, 0.0];
ub=[realmax, 0.3, 0.25, 0.3, 0.3];
A=[1.0, 3.0, 0.0, 0.0, 0.0;
0.0, 0.0, 1.0, 1.0, -2.0;
0.0, 1.0, 0.0, 0.0, -1.0];
b=[0.0, 0.0, 0.0]';
options=[1E-03, 1E-15, 1E-15, 1E-20];
[ret, popt, info, covar]=levmar('modhs52', 'jacmodhs52', p0, x, 200, options, 'blec', lb, ub, A, b);
disp('Hock-Schittkowski modified problem 52');
popt
% Hock-Schittkowski modified problem 235
p0=[-2.0, 3.0, 1.0];
x=[0.0, 0.0];
lb=[-realmax, 0.1, 0.7];
ub=[realmax, 2.9, realmax];
A=[1.0, 0.0, 1.0;
0.0, 1.0, -4.0];
b=[-1.0, 0.0]';
options=[1E-03, 1E-15, 1E-15, 1E-20];
[ret, popt, info, covar]=levmar('mods235', p0, x, 200, options, 'blec', lb, ub, A, b);
disp('Hock-Schittkowski modified problem 235');
popt
function x = meyer(p, data1, data2)
n=16;
% data1, data2 are actually unused
for i=1:n
ui=0.45+0.05*i;
x(i)=p(1)*exp(10.0*p(2)/(ui+p(3)) - 13.0);
end
function x = modhs52(p)
n=4;
x(1)=4.0*p(1)-p(2);
x(2)=p(2)+p(3)-2.0;
x(3)=p(4)-1.0;
x(4)=p(5)-1.0;
function x = mods235(p)
n=2;
x(1)=0.1*(p(1)-1.0);
x(2)=p(2)-p(1)*p(1);
/////////////////////////////////////////////////////////////////////////////////
//
// Levenberg - Marquardt non-linear minimization algorithm
// Copyright (C) 2004-05 Manolis Lourakis (lourakis at ics forth gr)
// Institute of Computer Science, Foundation for Research & Technology - Hellas
// Heraklion, Crete, Greece.
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
/////////////////////////////////////////////////////////////////////////////////
/********************************************************************************
* Miscelaneous functions for Levenberg-Marquardt nonlinear minimization. The
* same core code is used with appropriate #defines to derive single and double
* precision versions, see also misc_core.c
********************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <float.h>
#include "lm.h"
#include "misc.h"
#if !defined(LM_DBL_PREC) && !defined(LM_SNGL_PREC)
#error At least one of LM_DBL_PREC, LM_SNGL_PREC should be defined!
#endif
#ifdef LM_SNGL_PREC
/* single precision (float) definitions */
#define LM_REAL float
#define LM_PREFIX s
#define LM_REAL_EPSILON FLT_EPSILON
#define __SUBCNST(x) x##F
#define LM_CNST(x) __SUBCNST(x) // force substitution
#include "misc_core.c" // read in core code
#undef LM_REAL
#undef LM_PREFIX
#undef LM_REAL_EPSILON
#undef __SUBCNST
#undef LM_CNST
#endif /* LM_SNGL_PREC */
#ifdef LM_DBL_PREC
/* double precision definitions */
#define LM_REAL double
#define LM_PREFIX d
#define LM_REAL_EPSILON DBL_EPSILON
#define LM_CNST(x) (x)
#include "misc_core.c" // read in core code
#undef LM_REAL
#undef LM_PREFIX
#undef LM_REAL_EPSILON
#undef LM_CNST
#endif /* LM_DBL_PREC */
/////////////////////////////////////////////////////////////////////////////////
//
// Levenberg - Marquardt non-linear minimization algorithm
// Copyright (C) 2004 Manolis Lourakis (lourakis at ics forth gr)
// Institute of Computer Science, Foundation for Research & Technology - Hellas
// Heraklion, Crete, Greece.
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
/////////////////////////////////////////////////////////////////////////////////
#ifndef _MISC_H_
#define _MISC_H_
/* common prefix for BLAS subroutines. Leave undefined in case of no prefix. You might also need to modify LM_BLAS_PREFIX below */
/* f2c'd BLAS */
//#define LM_BLAS_PREFIX f2c_
/* C BLAS */
//#define LM_BLAS_PREFIX cblas_
/* common suffix for BLAS subroutines */
//#define LM_BLAS_SUFFIX // define empty if a f2c_ or cblas_ prefix was defined for LM_BLAS_PREFIX above
#define LM_BLAS_SUFFIX _ // use this in case of no BLAS prefix
#define LCAT_(a, b) #a b
#define LCAT(a, b) LCAT_(a, b) // force substitution
#define RCAT_(a, b) a #b
#define RCAT(a, b) RCAT_(a, b) // force substitution
#define __BLOCKSZ__ 32 /* block size for cache-friendly matrix-matrix multiply. It should be
* such that __BLOCKSZ__^2*sizeof(LM_REAL) is smaller than the CPU (L1)
* data cache size. Notice that a value of 32 when LM_REAL=double assumes
* an 8Kb L1 data cache (32*32*8=8K). This is a concervative choice since
* newer Pentium 4s have a L1 data cache of size 16K, capable of holding
* up to 45x45 double blocks.
*/
#define __BLOCKSZ__SQ (__BLOCKSZ__)*(__BLOCKSZ__)
/* add a prefix in front of a token */
#define LM_CAT__(a, b) a ## b
#define LM_CAT_(a, b) LM_CAT__(a, b) // force substitution
#define LM_ADD_PREFIX(s) LM_CAT_(LM_PREFIX, s)
#ifdef __cplusplus
extern "C" {
#endif
/* blocking-based matrix multiply */
extern void slevmar_trans_mat_mat_mult(float *a, float *b, int n, int m);
extern void dlevmar_trans_mat_mat_mult(double *a, double *b, int n, int m);
/* forward finite differences */
extern void slevmar_fdif_forw_jac_approx(void (*func)(float *p, float *hx, int m, int n, void *adata),
float *p, float *hx, float *hxx, float delta,
float *jac, int m, int n, void *adata);
extern void dlevmar_fdif_forw_jac_approx(void (*func)(double *p, double *hx, int m, int n, void *adata),
double *p, double *hx, double *hxx, double delta,
double *jac, int m, int n, void *adata);
/* central finite differences */
extern void slevmar_fdif_cent_jac_approx(void (*func)(float *p, float *hx, int m, int n, void *adata),
float *p, float *hxm, float *hxp, float delta,
float *jac, int m, int n, void *adata);
extern void dlevmar_fdif_cent_jac_approx(void (*func)(double *p, double *hx, int m, int n, void *adata),
double *p, double *hxm, double *hxp, double delta,
double *jac, int m, int n, void *adata);
/* e=x-y and ||e|| */
extern float slevmar_L2nrmxmy(float *e, float *x, float *y, int n);
extern double dlevmar_L2nrmxmy(double *e, double *x, double *y, int n);
/* covariance of LS fit */
extern int slevmar_covar(float *JtJ, float *C, float sumsq, int m, int n);
extern int dlevmar_covar(double *JtJ, double *C, double sumsq, int m, int n);
/* box constraints consistency check */
extern int slevmar_box_check(float *lb, float *ub, int m);
extern int dlevmar_box_check(double *lb, double *ub, int m);
/* Cholesky */
extern int slevmar_chol(float *C, float *W, int m);
extern int dlevmar_chol(double *C, double *W, int m);
#ifdef __cplusplus
}
#endif
#endif /* _MISC_H_ */
/////////////////////////////////////////////////////////////////////////////////
//
// Levenberg - Marquardt non-linear minimization algorithm
// Copyright (C) 2004-05 Manolis Lourakis (lourakis at ics forth gr)
// Institute of Computer Science, Foundation for Research & Technology - Hellas
// Heraklion, Crete, Greece.
//
// This program is free software; you can redistribute it and/or modify
// it under the terms of the GNU General Public License as published by
// the Free Software Foundation; either version 2 of the License, or
// (at your option) any later version.
//
// This program is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU General Public License for more details.
//
/////////////////////////////////////////////////////////////////////////////////
#ifndef LM_REAL // not included by misc.c
#error This file should not be compiled directly!
#endif
/* precision-specific definitions */
#define LEVMAR_CHKJAC LM_ADD_PREFIX(levmar_chkjac)
#define LEVMAR_FDIF_FORW_JAC_APPROX LM_ADD_PREFIX(levmar_fdif_forw_jac_approx)
#define LEVMAR_FDIF_CENT_JAC_APPROX LM_ADD_PREFIX(levmar_fdif_cent_jac_approx)
#define LEVMAR_TRANS_MAT_MAT_MULT LM_ADD_PREFIX(levmar_trans_mat_mat_mult)
#define LEVMAR_COVAR LM_ADD_PREFIX(levmar_covar)
#define LEVMAR_STDDEV LM_ADD_PREFIX(levmar_stddev)
#define LEVMAR_CORCOEF LM_ADD_PREFIX(levmar_corcoef)
#define LEVMAR_BOX_CHECK LM_ADD_PREFIX(levmar_box_check)
#define LEVMAR_L2NRMXMY LM_ADD_PREFIX(levmar_L2nrmxmy)
#ifdef HAVE_LAPACK
#define LEVMAR_PSEUDOINVERSE LM_ADD_PREFIX(levmar_pseudoinverse)
static int LEVMAR_PSEUDOINVERSE(LM_REAL *A, LM_REAL *B, int m);
/* BLAS matrix multiplication & LAPACK SVD routines */
#ifdef LM_BLAS_PREFIX
#define GEMM LM_CAT_(LM_BLAS_PREFIX, LM_ADD_PREFIX(LM_CAT_(gemm, LM_BLAS_SUFFIX)))
#else
#define GEMM LM_ADD_PREFIX(LM_CAT_(gemm, LM_BLAS_SUFFIX))
#endif
/* C := alpha*op( A )*op( B ) + beta*C */
extern void GEMM(char *transa, char *transb, int *m, int *n, int *k,
LM_REAL *alpha, LM_REAL *a, int *lda, LM_REAL *b, int *ldb, LM_REAL *beta, LM_REAL *c, int *ldc);
#define GESVD LM_ADD_PREFIX(gesvd_)
#define GESDD LM_ADD_PREFIX(gesdd_)
extern int GESVD(char *jobu, char *jobvt, int *m, int *n, LM_REAL *a, int *lda, LM_REAL *s, LM_REAL *u, int *ldu,
LM_REAL *vt, int *ldvt, LM_REAL *work, int *lwork, int *info);
/* lapack 3.0 new SVD routine, faster than xgesvd() */
extern int GESDD(char *jobz, int *m, int *n, LM_REAL *a, int *lda, LM_REAL *s, LM_REAL *u, int *ldu, LM_REAL *vt, int *ldvt,
LM_REAL *work, int *lwork, int *iwork, int *info);
/* cholesky decomposition */
#define POTF2 LM_ADD_PREFIX(potf2_)
extern int POTF2(char *uplo, int *n, LM_REAL *a, int *lda, int *info);
#define LEVMAR_CHOLESKY LM_ADD_PREFIX(levmar_chol)
#else
#define LEVMAR_LUINVERSE LM_ADD_PREFIX(levmar_LUinverse_noLapack)
static int LEVMAR_LUINVERSE(LM_REAL *A, LM_REAL *B, int m);
#endif /* HAVE_LAPACK */
/* blocked multiplication of the transpose of the nxm matrix a with itself (i.e. a^T a)
* using a block size of bsize. The product is returned in b.
* Since a^T a is symmetric, its computation can be speeded up by computing only its
* upper triangular part and copying it to the lower part.
*
* More details on blocking can be found at
* http://www-2.cs.cmu.edu/afs/cs/academic/class/15213-f02/www/R07/section_a/Recitation07-SectionA.pdf
*/
void LEVMAR_TRANS_MAT_MAT_MULT(LM_REAL *a, LM_REAL *b, int n, int m)
{
#ifdef HAVE_LAPACK /* use BLAS matrix multiply */
LM_REAL alpha=LM_CNST(1.0), beta=LM_CNST(0.0);
/* Fool BLAS to compute a^T*a avoiding transposing a: a is equivalent to a^T in column major,
* therefore BLAS computes a*a^T with a and a*a^T in column major, which is equivalent to
* computing a^T*a in row major!
*/
GEMM("N", "T", &m, &m, &n, &alpha, a, &m, a, &m, &beta, b, &m);
#else /* no LAPACK, use blocking-based multiply */
register int i, j, k, jj, kk;
register LM_REAL sum, *bim, *akm;
const int bsize=__BLOCKSZ__;
#define __MIN__(x, y) (((x)<=(y))? (x) : (y))
#define __MAX__(x, y) (((x)>=(y))? (x) : (y))
/* compute upper triangular part using blocking */
for(jj=0; jj<m; jj+=bsize){
for(i=0; i<m; ++i){
bim=b+i*m;
for(j=__MAX__(jj, i); j<__MIN__(jj+bsize, m); ++j)
bim[j]=0.0; //b[i*m+j]=0.0;
}
for(kk=0; kk<n; kk+=bsize){
for(i=0; i<m; ++i){
bim=b+i*m;
for(j=__MAX__(jj, i); j<__MIN__(jj+bsize, m); ++j){
sum=0.0;
for(k=kk; k<__MIN__(kk+bsize, n); ++k){
akm=a+k*m;
sum+=akm[i]*akm[j]; //a[k*m+i]*a[k*m+j];
}
bim[j]+=sum; //b[i*m+j]+=sum;
}
}
}
}
/* copy upper triangular part to the lower one */
for(i=0; i<m; ++i)
for(j=0; j<i; ++j)
b[i*m+j]=b[j*m+i];
#undef __MIN__
#undef __MAX__
#endif /* HAVE_LAPACK */
}
/* forward finite difference approximation to the Jacobian of func */
void LEVMAR_FDIF_FORW_JAC_APPROX(
void (*func)(LM_REAL *p, LM_REAL *hx, int m, int n, void *adata),
/* function to differentiate */
LM_REAL *p, /* I: current parameter estimate, mx1 */
LM_REAL *hx, /* I: func evaluated at p, i.e. hx=func(p), nx1 */
LM_REAL *hxx, /* W/O: work array for evaluating func(p+delta), nx1 */
LM_REAL delta, /* increment for computing the Jacobian */
LM_REAL *jac, /* O: array for storing approximated Jacobian, nxm */
int m,
int n,
void *adata)
{
register int i, j;
LM_REAL tmp;
register LM_REAL d;
for(j=0; j<m; ++j){
/* determine d=max(1E-04*|p[j]|, delta), see HZ */
d=LM_CNST(1E-04)*p[j]; // force evaluation
d=FABS(d);
if(d<delta)
d=delta;
tmp=p[j];
p[j]+=d;
(*func)(p, hxx, m, n, adata);
p[j]=tmp; /* restore */
d=LM_CNST(1.0)/d; /* invert so that divisions can be carried out faster as multiplications */
for(i=0; i<n; ++i){
jac[i*m+j]=(hxx[i]-hx[i])*d;
}
}
}
/* central finite difference approximation to the Jacobian of func */
void LEVMAR_FDIF_CENT_JAC_APPROX(
void (*func)(LM_REAL *p, LM_REAL *hx, int m, int n, void *adata),
/* function to differentiate */
LM_REAL *p, /* I: current parameter estimate, mx1 */
LM_REAL *hxm, /* W/O: work array for evaluating func(p-delta), nx1 */
LM_REAL *hxp, /* W/O: work array for evaluating func(p+delta), nx1 */
LM_REAL delta, /* increment for computing the Jacobian */
LM_REAL *jac, /* O: array for storing approximated Jacobian, nxm */
int m,
int n,
void *adata)
{
register int i, j;
LM_REAL tmp;
register LM_REAL d;
for(j=0; j<m; ++j){
/* determine d=max(1E-04*|p[j]|, delta), see HZ */
d=LM_CNST(1E-04)*p[j]; // force evaluation
d=FABS(d);
if(d<delta)
d=delta;
tmp=p[j];
p[j]-=d;
(*func)(p, hxm, m, n, adata);
p[j]=tmp+d;
(*func)(p, hxp, m, n, adata);
p[j]=tmp; /* restore */
d=LM_CNST(0.5)/d; /* invert so that divisions can be carried out faster as multiplications */
for(i=0; i<n; ++i){
jac[i*m+j]=(hxp[i]-hxm[i])*d;
}
}
}
/*
* Check the Jacobian of a n-valued nonlinear function in m variables
* evaluated at a point p, for consistency with the function itself.
*
* Based on fortran77 subroutine CHKDER by
* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More
* Argonne National Laboratory. MINPACK project. March 1980.
*
*
* func points to a function from R^m --> R^n: Given a p in R^m it yields hx in R^n
* jacf points to a function implementing the Jacobian of func, whose correctness
* is to be tested. Given a p in R^m, jacf computes into the nxm matrix j the
* Jacobian of func at p. Note that row i of j corresponds to the gradient of
* the i-th component of func, evaluated at p.
* p is an input array of length m containing the point of evaluation.
* m is the number of variables
* n is the number of functions
* adata points to possible additional data and is passed uninterpreted
* to func, jacf.
* err is an array of length n. On output, err contains measures
* of correctness of the respective gradients. if there is
* no severe loss of significance, then if err[i] is 1.0 the
* i-th gradient is correct, while if err[i] is 0.0 the i-th
* gradient is incorrect. For values of err between 0.0 and 1.0,
* the categorization is less certain. In general, a value of
* err[i] greater than 0.5 indicates that the i-th gradient is
* probably correct, while a value of err[i] less than 0.5
* indicates that the i-th gradient is probably incorrect.
*
*
* The function does not perform reliably if cancellation or
* rounding errors cause a severe loss of significance in the
* evaluation of a function. therefore, none of the components
* of p should be unusually small (in particular, zero) or any
* other value which may cause loss of significance.
*/
void LEVMAR_CHKJAC(
void (*func)(LM_REAL *p, LM_REAL *hx, int m, int n, void *adata),
void (*jacf)(LM_REAL *p, LM_REAL *j, int m, int n, void *adata),
LM_REAL *p, int m, int n, void *adata, LM_REAL *err)
{
LM_REAL factor=LM_CNST(100.0);
LM_REAL one=LM_CNST(1.0);
LM_REAL zero=LM_CNST(0.0);
LM_REAL *fvec, *fjac, *pp, *fvecp, *buf;
register int i, j;
LM_REAL eps, epsf, temp, epsmch;
LM_REAL epslog;
int fvec_sz=n, fjac_sz=n*m, pp_sz=m, fvecp_sz=n;
epsmch=LM_REAL_EPSILON;
eps=(LM_REAL)sqrt(epsmch);
buf=(LM_REAL *)malloc((fvec_sz + fjac_sz + pp_sz + fvecp_sz)*sizeof(LM_REAL));
if(!buf){
fprintf(stderr, LCAT(LEVMAR_CHKJAC, "(): memory allocation request failed\n"));
exit(1);
}
fvec=buf;
fjac=fvec+fvec_sz;
pp=fjac+fjac_sz;
fvecp=pp+pp_sz;
/* compute fvec=func(p) */
(*func)(p, fvec, m, n, adata);
/* compute the Jacobian at p */
(*jacf)(p, fjac, m, n, adata);
/* compute pp */
for(j=0; j<m; ++j){
temp=eps*FABS(p[j]);
if(temp==zero) temp=eps;
pp[j]=p[j]+temp;
}
/* compute fvecp=func(pp) */
(*func)(pp, fvecp, m, n, adata);
epsf=factor*epsmch;
epslog=(LM_REAL)log10(eps);
for(i=0; i<n; ++i)
err[i]=zero;
for(j=0; j<m; ++j){
temp=FABS(p[j]);
if(temp==zero) temp=one;
for(i=0; i<n; ++i)
err[i]+=temp*fjac[i*m+j];
}
for(i=0; i<n; ++i){
temp=one;
if(fvec[i]!=zero && fvecp[i]!=zero && FABS(fvecp[i]-fvec[i])>=epsf*FABS(fvec[i]))
temp=eps*FABS((fvecp[i]-fvec[i])/eps - err[i])/(FABS(fvec[i])+FABS(fvecp[i]));
err[i]=one;
if(temp>epsmch && temp<eps)
err[i]=((LM_REAL)log10(temp) - epslog)/epslog;
if(temp>=eps) err[i]=zero;
}
free(buf);
return;
}
#ifdef HAVE_LAPACK
/*
* This function computes the pseudoinverse of a square matrix A
* into B using SVD. A and B can coincide
*
* The function returns 0 in case of error (e.g. A is singular),
* the rank of A if successfull
*
* A, B are mxm
*
*/
static int LEVMAR_PSEUDOINVERSE(LM_REAL *A, LM_REAL *B, int m)
{
LM_REAL *buf=NULL;
int buf_sz=0;
static LM_REAL eps=LM_CNST(-1.0);
register int i, j;
LM_REAL *a, *u, *s, *vt, *work;
int a_sz, u_sz, s_sz, vt_sz, tot_sz;
LM_REAL thresh, one_over_denom;
int info, rank, worksz, *iwork, iworksz;
/* calculate required memory size */
worksz=16*m; /* more than needed */
iworksz=8*m;
a_sz=m*m;
u_sz=m*m; s_sz=m; vt_sz=m*m;
tot_sz=iworksz*sizeof(int) + (a_sz + u_sz + s_sz + vt_sz + worksz)*sizeof(LM_REAL);
buf_sz=tot_sz;
buf=(LM_REAL *)malloc(buf_sz);
if(!buf){
fprintf(stderr, RCAT("memory allocation in ", LEVMAR_PSEUDOINVERSE) "() failed!\n");
exit(1);
}
iwork=(int *)buf;
a=(LM_REAL *)(iwork+iworksz);
/* store A (column major!) into a */
for(i=0; i<m; i++)
for(j=0; j<m; j++)
a[i+j*m]=A[i*m+j];
u=a + a_sz;
s=u+u_sz;
vt=s+s_sz;
work=vt+vt_sz;
/* SVD decomposition of A */
GESVD("A", "A", (int *)&m, (int *)&m, a, (int *)&m, s, u, (int *)&m, vt, (int *)&m, work, (int *)&worksz, &info);
//GESDD("A", (int *)&m, (int *)&m, a, (int *)&m, s, u, (int *)&m, vt, (int *)&m, work, (int *)&worksz, iwork, &info);
/* error treatment */
if(info!=0){
if(info<0){
fprintf(stderr, RCAT(RCAT(RCAT("LAPACK error: illegal value for argument %d of ", GESVD), "/" GESDD) " in ", LEVMAR_PSEUDOINVERSE) "()\n", -info);
exit(1);
}
else{
fprintf(stderr, RCAT("LAPACK error: dgesdd (dbdsdc)/dgesvd (dbdsqr) failed to converge in ", LEVMAR_PSEUDOINVERSE) "() [info=%d]\n", info);
free(buf);
return 0;
}
}
if(eps<0.0){
LM_REAL aux;
/* compute machine epsilon */
for(eps=LM_CNST(1.0); aux=eps+LM_CNST(1.0), aux-LM_CNST(1.0)>0.0; eps*=LM_CNST(0.5))
;
eps*=LM_CNST(2.0);
}
/* compute the pseudoinverse in B */
for(i=0; i<a_sz; i++) B[i]=0.0; /* initialize to zero */
for(rank=0, thresh=eps*s[0]; rank<m && s[rank]>thresh; rank++){
one_over_denom=LM_CNST(1.0)/s[rank];
for(j=0; j<m; j++)
for(i=0; i<m; i++)
B[i*m+j]+=vt[rank+i*m]*u[j+rank*m]*one_over_denom;
}
free(buf);
return rank;
}
#else // no LAPACK
#define SVDINV LM_ADD_PREFIX(svdinv)
static int SVDINV(LM_REAL *a, LM_REAL *b, int m);
/*
* This function computes the inverse of A in B. A and B can coincide
*
* The function employs LAPACK-free LU decomposition of A to solve m linear
* systems A*B_i=I_i, where B_i and I_i are the i-th columns of B and I.
*
* A and B are mxm
*
* The function returns 0 in case of error,
* 1 if successfull
*
*/
static int LEVMAR_LUINVERSE(LM_REAL *A, LM_REAL *B, int m)
{
void *buf=NULL;
int buf_sz=0;
register int i, j, k, l;
int *idx, maxi=-1, idx_sz, a_sz, x_sz, work_sz, tot_sz;
LM_REAL *a, *x, *work, max, sum, tmp;
/* calculate required memory size */
idx_sz=m;
a_sz=m*m;
x_sz=m;
work_sz=m;
tot_sz=idx_sz*sizeof(int) + (a_sz+x_sz+work_sz)*sizeof(LM_REAL);
buf_sz=tot_sz;
buf=(void *)malloc(tot_sz);
if(!buf){
fprintf(stderr, RCAT("memory allocation in ", LEVMAR_LUINVERSE) "() failed!\n");
exit(1);
}
idx=(int *)buf;
a=(LM_REAL *)(idx + idx_sz);
x=a + a_sz;
work=x + x_sz;
/* avoid destroying A by copying it to a */
for(i=0; i<a_sz; ++i) a[i]=A[i];
/* compute the LU decomposition of a row permutation of matrix a; the permutation itself is saved in idx[] */
for(i=0; i<m; ++i){
max=0.0;
for(j=0; j<m; ++j)
if((tmp=FABS(a[i*m+j]))>max)
max=tmp;
if(max==0.0){
fprintf(stderr, RCAT("Singular matrix A in ", LEVMAR_LUINVERSE) "()!\n");
free(buf);
return 0;
}
work[i]=LM_CNST(1.0)/max;
}
for(j=0; j<m; ++j){
for(i=0; i<j; ++i){
sum=a[i*m+j];
for(k=0; k<i; ++k)
sum-=a[i*m+k]*a[k*m+j];
a[i*m+j]=sum;
}
max=0.0;
for(i=j; i<m; ++i){
sum=a[i*m+j];
for(k=0; k<j; ++k)
sum-=a[i*m+k]*a[k*m+j];
a[i*m+j]=sum;
if((tmp=work[i]*FABS(sum))>=max){
max=tmp;
maxi=i;
}
}
if(j!=maxi){
for(k=0; k<m; ++k){
tmp=a[maxi*m+k];
a[maxi*m+k]=a[j*m+k];
a[j*m+k]=tmp;
}
work[maxi]=work[j];
}
idx[j]=maxi;
if(a[j*m+j]==0.0)
a[j*m+j]=LM_REAL_EPSILON;
if(j!=m-1){
tmp=LM_CNST(1.0)/(a[j*m+j]);
for(i=j+1; i<m; ++i)
a[i*m+j]*=tmp;
}
}
/* The decomposition has now replaced a. Solve the m linear systems using
* forward and back substitution
*/
for(l=0; l<m; ++l){
for(i=0; i<m; ++i) x[i]=0.0;
x[l]=LM_CNST(1.0);
for(i=k=0; i<m; ++i){
j=idx[i];
sum=x[j];
x[j]=x[i];
if(k!=0)
for(j=k-1; j<i; ++j)
sum-=a[i*m+j]*x[j];
else
if(sum!=0.0)
k=i+1;
x[i]=sum;
}
for(i=m-1; i>=0; --i){
sum=x[i];
for(j=i+1; j<m; ++j)
sum-=a[i*m+j]*x[j];
x[i]=sum/a[i*m+i];
}
for(i=0; i<m; ++i)
B[i*m+l]=x[i];
}
free(buf);
return 1;
}
#endif /* HAVE_LAPACK */
/*
* This function computes in C the covariance matrix corresponding to a least
* squares fit. JtJ is the approximate Hessian at the solution (i.e. J^T*J, where
* J is the Jacobian at the solution), sumsq is the sum of squared residuals
* (i.e. goodnes of fit) at the solution, m is the number of parameters (variables)
* and n the number of observations. JtJ can coincide with C.
*
* if JtJ is of full rank, C is computed as sumsq/(n-m)*(JtJ)^-1
* otherwise and if LAPACK is available, C=sumsq/(n-r)*(JtJ)^+
* where r is JtJ's rank and ^+ denotes the pseudoinverse
* The diagonal of C is made up from the estimates of the variances
* of the estimated regression coefficients.
* See the documentation of routine E04YCF from the NAG fortran lib
*
* The function returns the rank of JtJ if successful, 0 on error
*
* A and C are mxm
*
*/
int LEVMAR_COVAR(LM_REAL *JtJ, LM_REAL *C, LM_REAL sumsq, int m, int n)
{
register int i;
int rnk;
LM_REAL fact;
#ifdef HAVE_LAPACK
rnk=LEVMAR_PSEUDOINVERSE(JtJ, C, m);
if(!rnk) return 0;
#else
#ifdef _MSC_VER
#pragma message("LAPACK not available, LU will be used for matrix inversion when computing the covariance; this might be unstable at times")
/*
#else
#warning LAPACK not available, LU will be used for matrix inversion when computing the covariance; this might be unstable at times
*/
#endif // _MSC_VER
// rnk=LEVMAR_LUINVERSE(JtJ, C, m);
rnk = SVDINV(JtJ, C, m);
if(!rnk) return 0;
// rnk=m; /* assume full rank */
#endif /* HAVE_LAPACK */
// fact=sumsq/(LM_REAL)(n-rnk);
// for(i=0; i<m*m; ++i)
// C[i]*=fact;
fact=(LM_REAL)n/(LM_REAL)(n-rnk);
for(i=0; i<m*m; ++i)
C[i]*=fact;
for(i=0; i<m; ++i)
if (C[i*(m+1)]<0.0)
C[i*(m+1)] = 0.0;
return rnk;
}
/* standard deviation of the best-fit parameter i.
* covar is the mxm covariance matrix of the best-fit parameters (see also LEVMAR_COVAR()).
*
* The standard deviation is computed as \sigma_{i} = \sqrt{C_{ii}}
*/
LM_REAL LEVMAR_STDDEV(LM_REAL *covar, int m, int i)
{
return (LM_REAL)sqrt(covar[i*m+i]);
}
/* Pearson's correlation coefficient of the best-fit parameters i and j.
* covar is the mxm covariance matrix of the best-fit parameters (see also LEVMAR_COVAR()).
*
* The coefficient is computed as \rho_{ij} = C_{ij} / sqrt(C_{ii} C_{jj})
*/
LM_REAL LEVMAR_CORCOEF(LM_REAL *covar, int m, int i, int j)
{
return (LM_REAL)(covar[i*m+j]/sqrt(covar[i*m+i]*covar[j*m+j]));
}
/* check box constraints for consistency */
int LEVMAR_BOX_CHECK(LM_REAL *lb, LM_REAL *ub, int m)
{
register int i;
if(!lb || !ub) return 1;
for(i=0; i<m; ++i)
if(lb[i]>ub[i]) return 0;
return 1;
}
#ifdef HAVE_LAPACK
/* compute the Cholesky decompostion of C in W, s.t. C=W^t W and W is upper triangular */
int LEVMAR_CHOLESKY(LM_REAL *C, LM_REAL *W, int m)
{
register int i, j;
int info;
/* copy weights array C to W (in column-major order!) so that LAPACK won't destroy it */
for(i=0; i<m; i++)
for(j=0; j<m; j++)
W[i+j*m]=C[i*m+j];
/* cholesky decomposition */
POTF2("U", (int *)&m, W, (int *)&m, (int *)&info);
/* error treatment */
if(info!=0){
if(info<0){
fprintf(stderr, "LAPACK error: illegal value for argument %d of dpotf2 in %s\n", -info, LCAT(LEVMAR_DER, "()"));
exit(1);
}
else{
fprintf(stderr, "LAPACK error: the leading minor of order %d is not positive definite,\n%s()\n", info,
RCAT("and the cholesky factorization could not be completed in ", LEVMAR_CHOLESKY));
return LM_ERROR;
}
}
/* the decomposition is in the upper part of W (in column-major order!).
* copying it to the lower part and zeroing the upper transposes
* W in row-major order
*/
for(i=0; i<m; i++)
for(j=0; j<i; j++){
W[i+j*m]=W[j+i*m];
W[j+i*m]=0.0;
}
return 0;
}
#endif /* HAVE_LAPACK */
/* Compute e=x-y for two n-vectors x and y and return the squared L2 norm of e.
* e can coincide with either x or y; x can be NULL, in which case it is assumed
* to be equal to the zero vector.
* Uses loop unrolling and blocking to reduce bookkeeping overhead & pipeline
* stalls and increase instruction-level parallelism; see http://www.abarnett.demon.co.uk/tutorial.html
*/
LM_REAL LEVMAR_L2NRMXMY(LM_REAL *e, LM_REAL *x, LM_REAL *y, int n)
{
const int blocksize=8, bpwr=3; /* 8=2^3 */
register int i;
int j1, j2, j3, j4, j5, j6, j7;
int blockn;
register LM_REAL sum0=0.0, sum1=0.0, sum2=0.0, sum3=0.0;
/* n may not be divisible by blocksize,
* go as near as we can first, then tidy up.
*/
blockn = (n>>bpwr)<<bpwr; /* (n / blocksize) * blocksize; */
if(x){
/* unroll the loop in blocks of `blocksize' */
for(i=0; i<blockn; i+=blocksize){
e[i ]=x[i ]-y[i ]; sum0+=e[i ]*e[i ];
j1=i+1; e[j1]=x[j1]-y[j1]; sum1+=e[j1]*e[j1];
j2=i+2; e[j2]=x[j2]-y[j2]; sum2+=e[j2]*e[j2];
j3=i+3; e[j3]=x[j3]-y[j3]; sum3+=e[j3]*e[j3];
j4=i+4; e[j4]=x[j4]-y[j4]; sum0+=e[j4]*e[j4];
j5=i+5; e[j5]=x[j5]-y[j5]; sum1+=e[j5]*e[j5];
j6=i+6; e[j6]=x[j6]-y[j6]; sum2+=e[j6]*e[j6];
j7=i+7; e[j7]=x[j7]-y[j7]; sum3+=e[j7]*e[j7];
}
/*
* There may be some left to do.
* This could be done as a simple for() loop,
* but a switch is faster (and more interesting)
*/
if(i<n){
/* Jump into the case at the place that will allow
* us to finish off the appropriate number of items.
*/
switch(n - i){
case 7 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 6 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 5 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 4 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 3 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 2 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
case 1 : e[i]=x[i]-y[i]; sum0+=e[i]*e[i]; ++i;
}
}
}
else{ /* x==0 */
/* unroll the loop in blocks of `blocksize' */
for(i=0; i<blockn; i+=blocksize){
e[i ]=-y[i ]; sum0+=e[i ]*e[i ];
j1=i+1; e[j1]=-y[j1]; sum1+=e[j1]*e[j1];
j2=i+2; e[j2]=-y[j2]; sum2+=e[j2]*e[j2];
j3=i+3; e[j3]=-y[j3]; sum3+=e[j3]*e[j3];
j4=i+4; e[j4]=-y[j4]; sum0+=e[j4]*e[j4];
j5=i+5; e[j5]=-y[j5]; sum1+=e[j5]*e[j5];
j6=i+6; e[j6]=-y[j6]; sum2+=e[j6]*e[j6];
j7=i+7; e[j7]=-y[j7]; sum3+=e[j7]*e[j7];
}
/*
* There may be some left to do.
* This could be done as a simple for() loop,
* but a switch is faster (and more interesting)
*/
if(i<n){
/* Jump into the case at the place that will allow
* us to finish off the appropriate number of items.
*/
switch(n - i){
case 7 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 6 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 5 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 4 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 3 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 2 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
case 1 : e[i]=-y[i]; sum0+=e[i]*e[i]; ++i;
}
}
}
return sum0+sum1+sum2+sum3;
}
/****** svdinv *************************************************************
PROTO int svdinv(double *a, double *b, int m)
PURPOSE Matrix inversion based on Singular Value Decomposition (SVD).
INPUT Pointer to the matrix to invert,
Pointer to the inverted matrix,
Matrix size.
OUTPUT Matrix rank.
NOTES Loosely adapted from Numerical Recipes in C, 2nd Ed. (p. 671). The a
and v matrices are transposed with respect to the N.R. convention.
AUTHOR E. Bertin (IAP)
VERSION 30/05/2008
***/
static int SVDINV(LM_REAL *a, LM_REAL *b, int m)
{
#define MAX(a,b) (maxarg1=(a),maxarg2=(b),(maxarg1) > (maxarg2) ?\
(maxarg1) : (maxarg2))
#define PYTHAG(a,b) ((at=fabs(a)) > (bt=fabs(b)) ? \
(ct=bt/at,at*sqrt(1.0+ct*ct)) \
: (bt ? (ct=at/bt,bt*sqrt(1.0+ct*ct)): 0.0))
#define SIGN(a,b) ((b) >= 0.0 ? fabs(a) : -fabs(a))
#define TOL 1.0e-11
int flag,i,its,j,jj,k,l,mmi,nm, nml, rank;
LM_REAL *vmat,*wmat,
*w,*ap,*ap0,*ap1,*ap10,*rv1p,*vp,*vp0,*vp1,*vp10,
*rv1,*tmp,
c,f,h,s,x,y,z,
anorm, g, scale,
at,bt,ct,maxarg1,maxarg2,
thresh, wmax;
anorm = g = scale = 0.0;
rv1=(LM_REAL *)malloc(m*sizeof(LM_REAL));
tmp=(LM_REAL *)malloc(m*sizeof(LM_REAL));
vmat=(LM_REAL *)malloc(m*m*sizeof(LM_REAL));
wmat=(LM_REAL *)malloc(m*sizeof(LM_REAL));
l = nm = nml = 0; /* To avoid gcc -Wall warnings */
for (i=0;i<m;i++)
{
l = i+1;
nml = m-l;
rv1[i] = scale*g;
g = s = scale = 0.0;
mmi = m - i;
ap = ap0 = a+i*(m+1);
for (k=mmi;k--;)
scale += fabs(*(ap++));
if (scale)
{
for (ap=ap0,k=mmi; k--; ap++)
{
*ap /= scale;
s += *ap**ap;
}
f = *ap0;
g = -SIGN(sqrt(s),f);
h = f*g-s;
*ap0 = f-g;
ap10 = a+l*m+i;
for (j=nml;j--; ap10+=m)
{
s = 0.0;
for (ap=ap0,ap1=ap10,k=mmi; k--;)
s += *(ap1++)**(ap++);
f = s/h;
for (ap=ap0,ap1=ap10,k=mmi; k--;)
*(ap1++) += f**(ap++);
}
for (ap=ap0,k=mmi; k--;)
*(ap++) *= scale;
}
wmat[i] = scale*g;
g = s = scale = 0.0;
if (i+1 != m)
{
ap = ap0 = a+i+m*l;
for (k=nml;k--; ap+=m)
scale += fabs(*ap);
if (scale)
{
for (ap=ap0,k=nml;k--; ap+=m)
{
*ap /= scale;
s += *ap**ap;
}
f=*ap0;
g = -SIGN(sqrt(s),f);
h=f*g-s;
*ap0=f-g;
rv1p = rv1+l;
for (ap=ap0,k=nml;k--; ap+=m)
*(rv1p++) = *ap/h;
ap10 = a+l+m*l;
for (j=m-l; j--; ap10++)
{
for (s=0.0,ap=ap0,ap1=ap10,k=nml; k--; ap+=m,ap1+=m)
s += *ap1**ap;
rv1p = rv1+l;
for (ap1=ap10,k=nml;k--; ap1+=m)
*ap1 += s**(rv1p++);
}
for (ap=ap0,k=nml;k--; ap+=m)
*ap *= scale;
}
}
anorm=MAX(anorm,(fabs(wmat[i])+fabs(rv1[i])));
}
for (i=m-1;i>=0;i--)
{
if (i < m-1)
{
if (g)
{
ap0 = a+l*m+i;
vp0 = vmat+i*m+l;
vp10 = vmat+l*m+l;
g *= *ap0;
for (ap=ap0,vp=vp0,j=nml; j--; ap+=m)
*(vp++) = *ap/g;
for (j=nml; j--; vp10+=m)
{
for (s=0.0,ap=ap0,vp1=vp10,k=nml; k--; ap+=m)
s += *ap**(vp1++);
for (vp=vp0,vp1=vp10,k=nml; k--;)
*(vp1++) += s**(vp++);
}
}
vp = vmat+l*m+i;
vp1 = vmat+i*m+l;
for (j=nml; j--; vp+=m)
*vp = *(vp1++) = 0.0;
}
vmat[i*m+i]=1.0;
g=rv1[i];
l=i;
nml = m-l;
}
for (i=m; --i>=0;)
{
l=i+1;
nml = m-l;
mmi=m-i;
g=wmat[i];
ap0 = a+i*m+i;
ap10 = ap0 + m;
for (ap=ap10,j=nml;j--;ap+=m)
*ap=0.0;
if (g)
{
g=1.0/g;
for (j=nml;j--; ap10+=m)
{
for (s=0.0,ap=ap0,ap1=ap10,k=mmi; --k;)
s += *(++ap)**(++ap1);
f = (s/(*ap0))*g;
for (ap=ap0,ap1=ap10,k=mmi;k--;)
*(ap1++) += f**(ap++);
}
for (ap=ap0,j=mmi;j--;)
*(ap++) *= g;
}
else
for (ap=ap0,j=mmi;j--;)
*(ap++)=0.0;
++(*ap0);
}
for (k=m; --k>=0;)
{
for (its=0;its<100;its++)
{
flag=1;
for (l=k;l>=0;l--)
{
nm=l-1;
if (fabs(rv1[l]) <= anorm*TOL)
{
flag=0;
break;
}
if (fabs(wmat[nm]) <= anorm*TOL)
break;
}
if (flag)
{
c=0.0;
s=1.0;
ap0 = a+nm*m;
ap10 = a+l*m;
for (i=l; i<=k; i++,ap10+=m)
{
f=s*rv1[i];
if (fabs(f) <= anorm*TOL)
break;
g=wmat[i];
h=PYTHAG(f,g);
wmat[i]=h;
h=1.0/h;
c=g*h;
s=(-f*h);
for (ap=ap0,ap1=ap10,j=m; j--;)
{
z = *ap1;
y = *ap;
*(ap++) = y*c+z*s;
*(ap1++) = z*c-y*s;
}
}
}
z=wmat[k];
if (l == k)
{
if (z < 0.0)
{
wmat[k] = -z;
vp = vmat+k*m;
for (j=m; j--; vp++)
*vp = (-*vp);
}
break;
}
x=wmat[l];
nm=k-1;
y=wmat[nm];
g=rv1[nm];
h=rv1[k];
f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
g=PYTHAG(f,1.0);
f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
c=s=1.0;
ap10 = a+l*m;
vp10 = vmat+l*m;
for (j=l;j<=nm;j++,ap10+=m,vp10+=m)
{
i=j+1;
g=rv1[i];
y=wmat[i];
h=s*g;
g=c*g;
z=PYTHAG(f,h);
rv1[j]=z;
c=f/z;
s=h/z;
f=x*c+g*s;
g=g*c-x*s;
h=y*s;
y=y*c;
for (vp=(vp1=vp10)+m,jj=m; jj--;)
{
z = *vp;
x = *vp1;
*(vp1++) = x*c+z*s;
*(vp++) = z*c-x*s;
}
z=PYTHAG(f,h);
wmat[j]=z;
if (z)
{
z=1.0/z;
c=f*z;
s=h*z;
}
f=c*g+s*y;
x=c*y-s*g;
for (ap=(ap1=ap10)+m,jj=m; jj--;)
{
z = *ap;
y = *ap1;
*(ap1++) = y*c+z*s;
*(ap++) = z*c-y*s;
}
}
rv1[l]=0.0;
rv1[k]=f;
wmat[k]=x;
}
}
wmax=0.0;
w = wmat;
for (j=m;j--; w++)
if (*w > wmax)
wmax=*w;
thresh=TOL*wmax;
rank = 0;
w = wmat;
for (j=m;j--; w++)
if (*w <= thresh)
*w = 0.0;
else
{
rank++;
*w = 1.0 / *w;
}
for (j=0; j<m; j++)
for (i=0; i<m; i++)
{
s = 0.0;
for (k=0; k<m; k++)
s += vmat[j+k*m]*a[i+k*m]*wmat[k];
b[j+i*m] = s;
}
/* Free temporary arrays */
free(tmp);
free(rv1);
free(vmat);
free(wmat);
return rank;
}
#undef SIGN
#undef MAX
#undef PYTHAG
#undef TOL
/* undefine everything. THIS MUST REMAIN AT THE END OF THE FILE */
#undef LEVMAR_PSEUDOINVERSE
#undef LEVMAR_LUINVERSE
#undef LEVMAR_BOX_CHECK
#undef LEVMAR_CHOLESKY
#undef LEVMAR_COVAR
#undef LEVMAR_STDDEV
#undef LEVMAR_CORCOEF
#undef LEVMAR_CHKJAC
#undef LEVMAR_FDIF_FORW_JAC_APPROX
#undef LEVMAR_FDIF_CENT_JAC_APPROX
#undef LEVMAR_TRANS_MAT_MAT_MULT
#undef LEVMAR_L2NRMXMY
......@@ -9,7 +9,7 @@
*
* Contents: Command-line parsing.
*
* Last modify: 07/07/2006
* Last modify: 12/11/2008
*
*%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*/
......@@ -26,13 +26,15 @@
#include "define.h"
#include "globals.h"
#include "prefs.h"
#include "pattern.h"
#define SYNTAX \
EXECUTABLE " <image> [<image2>][-c <configuration_file>][-<keyword> <value>]\n" \
"> to dump a default configuration file: " EXECUTABLE " -d \n" \
"> to dump a default extended configuration file: " EXECUTABLE " -dd \n"
"> to dump a default configuration file: " EXECUTABLE " -d \n" \
"> to dump a default extended configuration file: " EXECUTABLE " -dd \n" \
"> to dump a full list of measurement parameters: " EXECUTABLE " -dp \n"
extern const char notokstr[];
extern keystruct objkey[];
/********************************** main ************************************/
int main(int argc, char *argv[])
......@@ -80,7 +82,12 @@ int main(int argc, char *argv[])
strcpy(prefs.prefs_name, argv[++a]);
break;
case 'd':
dumpprefs(opt2=='d' ? 1 : 0);
if (opt2=='d')
dumpprefs(1);
else if (opt2=='p')
dumpparams();
else
dumpprefs(0);
exit(EXIT_SUCCESS);
break;
case 'v':
......@@ -114,12 +121,14 @@ int main(int argc, char *argv[])
}
readprefs(prefs.prefs_name, argkey, argval, narg);
preprefs();
free(argkey);
free(argval);
makeit();
endprefs();
NFPRINTF(OUTPUT, "");
NPRINTF(OUTPUT, "> All done (in %.0f s)\n", prefs.time_diff);
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment