开始集成AddTree 功能
parent
349df169b4
commit
41339c6461
|
|
@ -0,0 +1,13 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
add_subdirectory("glew")
|
||||
add_subdirectory("glfw")
|
||||
add_subdirectory("tetgen")
|
||||
add_subdirectory("kd_tree")
|
||||
add_subdirectory("cminpack")
|
||||
add_subdirectory("optimizer_lm")
|
||||
add_subdirectory("easy3d")
|
||||
add_subdirectory("imgui")
|
||||
add_subdirectory("tinyfiledialogs")
|
||||
add_subdirectory("rply")
|
||||
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
|
||||
set(PROJECT_NAME 3rd_${MODULE_NAME})
|
||||
project(${PROJECT_NAME})
|
||||
|
||||
|
||||
|
||||
add_library(${PROJECT_NAME} STATIC
|
||||
chkder.c
|
||||
chkder_.c
|
||||
covar.c
|
||||
covar1.c
|
||||
covar_.c
|
||||
dogleg.c
|
||||
dogleg_.c
|
||||
dpmpar.c
|
||||
dpmpar_.c
|
||||
enorm.c
|
||||
enorm_.c
|
||||
fdjac1.c
|
||||
fdjac1_.c
|
||||
fdjac2.c
|
||||
fdjac2_.c
|
||||
hybrd.c
|
||||
hybrd1.c
|
||||
hybrd1_.c
|
||||
hybrd_.c
|
||||
hybrj.c
|
||||
hybrj1.c
|
||||
hybrj1_.c
|
||||
hybrj_.c
|
||||
lmder.c
|
||||
lmder1.c
|
||||
lmder1_.c
|
||||
lmder_.c
|
||||
lmdif.c
|
||||
lmdif1.c
|
||||
lmdif1_.c
|
||||
lmdif_.c
|
||||
lmpar.c
|
||||
lmpar_.c
|
||||
lmstr.c
|
||||
lmstr1.c
|
||||
lmstr1_.c
|
||||
lmstr_.c
|
||||
qform.c
|
||||
qform_.c
|
||||
qrfac.c
|
||||
qrfac_.c
|
||||
qrsolv.c
|
||||
qrsolv_.c
|
||||
r1mpyq.c
|
||||
r1mpyq_.c
|
||||
r1updt.c
|
||||
r1updt_.c
|
||||
rwupdt.c
|
||||
rwupdt_.c
|
||||
cminpack.h
|
||||
cminpackP.h
|
||||
minpack.h
|
||||
minpackP.h
|
||||
)
|
||||
|
||||
set_target_properties(${PROJECT_NAME} PROPERTIES
|
||||
FOLDER "3rd_party")
|
||||
|
||||
|
||||
target_include_directories(${PROJECT_NAME} PRIVATE ${EASY3D_cminpack_INCLUDE_DIR})
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
Minpack Copyright Notice (1999) University of Chicago. All rights reserved
|
||||
|
||||
Redistribution and use in source and binary forms, with or
|
||||
without modification, are permitted provided that the
|
||||
following conditions are met:
|
||||
|
||||
1. Redistributions of source code must retain the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials
|
||||
provided with the distribution.
|
||||
|
||||
3. The end-user documentation included with the
|
||||
redistribution, if any, must include the following
|
||||
acknowledgment:
|
||||
|
||||
"This product includes software developed by the
|
||||
University of Chicago, as Operator of Argonne National
|
||||
Laboratory.
|
||||
|
||||
Alternately, this acknowledgment may appear in the software
|
||||
itself, if and wherever such third-party acknowledgments
|
||||
normally appear.
|
||||
|
||||
4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
|
||||
WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
|
||||
UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
|
||||
THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
|
||||
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
|
||||
OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
|
||||
OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
|
||||
USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
|
||||
THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
|
||||
DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
|
||||
UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
|
||||
BE CORRECTED.
|
||||
|
||||
5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
|
||||
HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
|
||||
ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
|
||||
INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
|
||||
ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
|
||||
PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
|
||||
SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
|
||||
(INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
|
||||
EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
|
||||
POSSIBILITY OF SUCH LOSS OR DAMAGES.
|
||||
|
||||
|
|
@ -0,0 +1,159 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
#define log10e 0.43429448190325182765
|
||||
#define factor 100.
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(chkder)(int m, int n, const real *x,
|
||||
real *fvec, real *fjac, int ldfjac, real *xp,
|
||||
real *fvecp, int mode, real *err)
|
||||
{
|
||||
/* Local variables */
|
||||
int i, j;
|
||||
real eps, epsf, temp, epsmch;
|
||||
real epslog;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine chkder */
|
||||
|
||||
/* this subroutine checks the gradients of m nonlinear functions */
|
||||
/* in n variables, evaluated at a point x, for consistency with */
|
||||
/* the functions themselves. the user must call chkder twice, */
|
||||
/* first with mode = 1 and then with mode = 2. */
|
||||
|
||||
/* mode = 1. on input, x must contain the point of evaluation. */
|
||||
/* on output, xp is set to a neighboring point. */
|
||||
|
||||
/* mode = 2. on input, fvec must contain the functions and the */
|
||||
/* rows of fjac must contain the gradients */
|
||||
/* of the respective functions each evaluated */
|
||||
/* at x, and fvecp must contain the functions */
|
||||
/* evaluated at xp. */
|
||||
/* on output, err contains measures of correctness of */
|
||||
/* the respective gradients. */
|
||||
|
||||
/* the subroutine 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 x should be unusually small (in particular, zero) or any */
|
||||
/* other value which may cause loss of significance. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine chkder(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an array of length m. on input when mode = 2, */
|
||||
/* fvec must contain the functions evaluated at x. */
|
||||
|
||||
/* fjac is an m by n array. on input when mode = 2, */
|
||||
/* the rows of fjac must contain the gradients of */
|
||||
/* the respective functions evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input parameter not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* xp is an array of length n. on output when mode = 1, */
|
||||
/* xp is set to a neighboring point of x. */
|
||||
|
||||
/* fvecp is an array of length m. on input when mode = 2, */
|
||||
/* fvecp must contain the functions evaluated at xp. */
|
||||
|
||||
/* mode is an integer input variable set to 1 on the first call */
|
||||
/* and 2 on the second. other values of mode are equivalent */
|
||||
/* to mode = 1. */
|
||||
|
||||
/* err is an array of length m. on output when mode = 2, */
|
||||
/* 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. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack supplied ... dpmpar */
|
||||
|
||||
/* fortran supplied ... dabs,dlog10,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
eps = sqrt(epsmch);
|
||||
|
||||
if (mode != 2) {
|
||||
|
||||
/* mode = 1. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
temp = eps * fabs(x[j]);
|
||||
if (temp == 0.) {
|
||||
temp = eps;
|
||||
}
|
||||
xp[j] = x[j] + temp;
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
/* mode = 2. */
|
||||
|
||||
epsf = factor * epsmch;
|
||||
epslog = log10e * log(eps);
|
||||
for (i = 0; i < m; ++i) {
|
||||
err[i] = 0.;
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
temp = fabs(x[j]);
|
||||
if (temp == 0.) {
|
||||
temp = 1.;
|
||||
}
|
||||
for (i = 0; i < m; ++i) {
|
||||
err[i] += temp * fjac[i + j * ldfjac];
|
||||
}
|
||||
}
|
||||
for (i = 0; i < m; ++i) {
|
||||
temp = 1.;
|
||||
if (fvec[i] != 0. && fvecp[i] != 0. &&
|
||||
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] = 1.;
|
||||
if (temp > epsmch && temp < eps) {
|
||||
err[i] = (log10e * log(temp) - epslog) / epslog;
|
||||
}
|
||||
if (temp >= eps) {
|
||||
err[i] = 0.;
|
||||
}
|
||||
}
|
||||
|
||||
/* last card of subroutine chkder. */
|
||||
|
||||
} /* chkder_ */
|
||||
|
||||
|
|
@ -0,0 +1,198 @@
|
|||
/* chkder.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
#define log10e 0.43429448190325182765
|
||||
#define factor 100.
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(chkder)(const int *m, const int *n, const real *x,
|
||||
real *fvec, real *fjac, const int *ldfjac, real *xp,
|
||||
real *fvecp, const int *mode, real *err)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const int c__1 = 1;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j;
|
||||
real eps, epsf, temp, epsmch;
|
||||
real epslog;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine chkder */
|
||||
|
||||
/* this subroutine checks the gradients of m nonlinear functions */
|
||||
/* in n variables, evaluated at a point x, for consistency with */
|
||||
/* the functions themselves. the user must call chkder twice, */
|
||||
/* first with mode = 1 and then with mode = 2. */
|
||||
|
||||
/* mode = 1. on input, x must contain the point of evaluation. */
|
||||
/* on output, xp is set to a neighboring point. */
|
||||
|
||||
/* mode = 2. on input, fvec must contain the functions and the */
|
||||
/* rows of fjac must contain the gradients */
|
||||
/* of the respective functions each evaluated */
|
||||
/* at x, and fvecp must contain the functions */
|
||||
/* evaluated at xp. */
|
||||
/* on output, err contains measures of correctness of */
|
||||
/* the respective gradients. */
|
||||
|
||||
/* the subroutine 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 x should be unusually small (in particular, zero) or any */
|
||||
/* other value which may cause loss of significance. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine chkder(m,n,x,fvec,fjac,ldfjac,xp,fvecp,mode,err) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an array of length m. on input when mode = 2, */
|
||||
/* fvec must contain the functions evaluated at x. */
|
||||
|
||||
/* fjac is an m by n array. on input when mode = 2, */
|
||||
/* the rows of fjac must contain the gradients of */
|
||||
/* the respective functions evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input parameter not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* xp is an array of length n. on output when mode = 1, */
|
||||
/* xp is set to a neighboring point of x. */
|
||||
|
||||
/* fvecp is an array of length m. on input when mode = 2, */
|
||||
/* fvecp must contain the functions evaluated at xp. */
|
||||
|
||||
/* mode is an integer input variable set to 1 on the first call */
|
||||
/* and 2 on the second. other values of mode are equivalent */
|
||||
/* to mode = 1. */
|
||||
|
||||
/* err is an array of length m. on output when mode = 2, */
|
||||
/* 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. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack supplied ... dpmpar */
|
||||
|
||||
/* fortran supplied ... dabs,dlog10,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--err;
|
||||
--fvecp;
|
||||
--fvec;
|
||||
--xp;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
eps = sqrt(epsmch);
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L20;
|
||||
}
|
||||
|
||||
/* mode = 1. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
temp = eps * fabs(x[j]);
|
||||
if (temp == 0.) {
|
||||
temp = eps;
|
||||
}
|
||||
xp[j] = x[j] + temp;
|
||||
/* L10: */
|
||||
}
|
||||
/* goto L70; */
|
||||
return;
|
||||
L20:
|
||||
|
||||
/* mode = 2. */
|
||||
|
||||
epsf = factor * epsmch;
|
||||
epslog = log10e * log(eps);
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
err[i__] = 0.;
|
||||
/* L30: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
temp = fabs(x[j]);
|
||||
if (temp == 0.) {
|
||||
temp = 1.;
|
||||
}
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
err[i__] += temp * fjac[i__ + j * fjac_dim1];
|
||||
/* L40: */
|
||||
}
|
||||
/* L50: */
|
||||
}
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
temp = 1.;
|
||||
if (fvec[i__] != 0. && fvecp[i__] != 0. && 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__] = 1.;
|
||||
if (temp > epsmch && temp < eps) {
|
||||
err[i__] = (log10e * log(temp) - epslog) / epslog;
|
||||
}
|
||||
if (temp >= eps) {
|
||||
err[i__] = 0.;
|
||||
}
|
||||
/* L60: */
|
||||
}
|
||||
/* L70: */
|
||||
|
||||
/* return 0; */
|
||||
|
||||
/* last card of subroutine chkder. */
|
||||
|
||||
} /* chkder_ */
|
||||
|
||||
|
|
@ -0,0 +1,379 @@
|
|||
/* Header file for cminpack, by Frederic Devernay.
|
||||
The documentation for all functions can be found in the file
|
||||
minpack-documentation.txt from the distribution, or in the source
|
||||
code of each function. */
|
||||
|
||||
#ifndef __CMINPACK_H__
|
||||
#define __CMINPACK_H__
|
||||
|
||||
/* The default floating-point type is "double" for C/C++ and "float" for CUDA,
|
||||
but you can change this by defining one of the following symbols when
|
||||
compiling the library, and before including cminpack.h when using it:
|
||||
__cminpack_long_double__ for long double (requires compiler support)
|
||||
__cminpack_double__ for double
|
||||
__cminpack_float__ for float
|
||||
__cminpack_half__ for half from the OpenEXR library (in this case, you must
|
||||
compile cminpack with a C++ compiler)
|
||||
*/
|
||||
#ifdef __cminpack_long_double__
|
||||
#define __cminpack_real__ long double
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_double__
|
||||
#define __cminpack_real__ double
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_float__
|
||||
#define __cminpack_real__ float
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_half__
|
||||
#include <OpenEXR/half.h>
|
||||
#define __cminpack_real__ half
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif /* __cplusplus */
|
||||
|
||||
/* Cmake will define cminpack_EXPORTS on Windows when it
|
||||
configures to build a shared library. If you are going to use
|
||||
another build system on windows or create the visual studio
|
||||
projects by hand you need to define cminpack_EXPORTS when
|
||||
building a DLL on windows.
|
||||
*/
|
||||
#if defined (__GNUC__)
|
||||
#define CMINPACK_DECLSPEC_EXPORT __declspec(__dllexport__)
|
||||
#define CMINPACK_DECLSPEC_IMPORT __declspec(__dllimport__)
|
||||
#endif
|
||||
#if defined (_MSC_VER) || defined (__BORLANDC__)
|
||||
#define CMINPACK_DECLSPEC_EXPORT __declspec(dllexport)
|
||||
#define CMINPACK_DECLSPEC_IMPORT __declspec(dllimport)
|
||||
#endif
|
||||
#ifdef __WATCOMC__
|
||||
#define CMINPACK_DECLSPEC_EXPORT __export
|
||||
#define CMINPACK_DECLSPEC_IMPORT __import
|
||||
#endif
|
||||
#ifdef __IBMC__
|
||||
#define CMINPACK_DECLSPEC_EXPORT _Export
|
||||
#define CMINPACK_DECLSPEC_IMPORT _Import
|
||||
#endif
|
||||
|
||||
#if !defined(CMINPACK_NO_DLL) && (defined(__WIN32__) || defined(WIN32) || defined (_WIN32))
|
||||
#if defined(cminpack_EXPORTS) || defined(CMINPACK_EXPORTS) || defined(CMINPACK_DLL_EXPORTS)
|
||||
#define CMINPACK_EXPORT //CMINPACK_DECLSPEC_EXPORT
|
||||
#else
|
||||
#define CMINPACK_EXPORT //CMINPACK_DECLSPEC_IMPORT
|
||||
#endif /* cminpack_EXPORTS */
|
||||
#else /* defined (_WIN32) */
|
||||
#define CMINPACK_EXPORT
|
||||
#endif
|
||||
|
||||
#if defined(__CUDA_ARCH__) || defined(__CUDACC__)
|
||||
#define __cminpack_attr__ __device__
|
||||
#ifndef __cminpack_real__
|
||||
#define __cminpack_float__
|
||||
#define __cminpack_real__ float
|
||||
#endif
|
||||
#define __cminpack_type_fcn_nn__ __cminpack_attr__ int fcn_nn
|
||||
#define __cminpack_type_fcnder_nn__ __cminpack_attr__ int fcnder_nn
|
||||
#define __cminpack_type_fcn_mn__ __cminpack_attr__ int fcn_mn
|
||||
#define __cminpack_type_fcnder_mn__ __cminpack_attr__ int fcnder_mn
|
||||
#define __cminpack_type_fcnderstr_mn__ __cminpack_attr__ int fcnderstr_mn
|
||||
#define __cminpack_decl_fcn_nn__
|
||||
#define __cminpack_decl_fcnder_nn__
|
||||
#define __cminpack_decl_fcn_mn__
|
||||
#define __cminpack_decl_fcnder_mn__
|
||||
#define __cminpack_decl_fcnderstr_mn__
|
||||
#define __cminpack_param_fcn_nn__
|
||||
#define __cminpack_param_fcnder_nn__
|
||||
#define __cminpack_param_fcn_mn__
|
||||
#define __cminpack_param_fcnder_mn__
|
||||
#define __cminpack_param_fcnderstr_mn__
|
||||
#else
|
||||
#define __cminpack_attr__
|
||||
#ifndef __cminpack_real__
|
||||
#define __cminpack_double__
|
||||
#define __cminpack_real__ double
|
||||
#endif
|
||||
#define __cminpack_type_fcn_nn__ typedef int (*cminpack_func_nn)
|
||||
#define __cminpack_type_fcnder_nn__ typedef int (*cminpack_funcder_nn)
|
||||
#define __cminpack_type_fcn_mn__ typedef int (*cminpack_func_mn)
|
||||
#define __cminpack_type_fcnder_mn__ typedef int (*cminpack_funcder_mn)
|
||||
#define __cminpack_type_fcnderstr_mn__ typedef int (*cminpack_funcderstr_mn)
|
||||
#define __cminpack_decl_fcn_nn__ cminpack_func_nn fcn_nn,
|
||||
#define __cminpack_decl_fcnder_nn__ cminpack_funcder_nn fcnder_nn,
|
||||
#define __cminpack_decl_fcn_mn__ cminpack_func_mn fcn_mn,
|
||||
#define __cminpack_decl_fcnder_mn__ cminpack_funcder_mn fcnder_mn,
|
||||
#define __cminpack_decl_fcnderstr_mn__ cminpack_funcderstr_mn fcnderstr_mn,
|
||||
#define __cminpack_param_fcn_nn__ fcn_nn,
|
||||
#define __cminpack_param_fcnder_nn__ fcnder_nn,
|
||||
#define __cminpack_param_fcn_mn__ fcn_mn,
|
||||
#define __cminpack_param_fcnder_mn__ fcnder_mn,
|
||||
#define __cminpack_param_fcnderstr_mn__ fcnderstr_mn,
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_double__
|
||||
#define __cminpack_func__(func) func
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_long_double__
|
||||
#define __cminpack_func__(func) ld ## func
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_float__
|
||||
#define __cminpack_func__(func) s ## func
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_half__
|
||||
#define __cminpack_func__(func) h ## func
|
||||
#endif
|
||||
|
||||
/* Declarations for minpack */
|
||||
|
||||
/* Function types: */
|
||||
/* The first argument can be used to store extra function parameters, thus */
|
||||
/* avoiding the use of global variables. */
|
||||
/* the iflag parameter is input-only (with respect to the FORTRAN */
|
||||
/* version), the output iflag value is the return value of the function. */
|
||||
/* If iflag=0, the function shoulkd just print the current values (see */
|
||||
/* the nprint parameters below). */
|
||||
|
||||
/* for hybrd1 and hybrd: */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* return a negative value to terminate hybrd1/hybrd */
|
||||
__cminpack_type_fcn_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, int iflag );
|
||||
|
||||
/* for hybrj1 and hybrj */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* return a negative value to terminate hybrj1/hybrj */
|
||||
__cminpack_type_fcnder_nn__(void *p, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, int iflag );
|
||||
|
||||
/* for lmdif1 and lmdif */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = 1 the result is used to compute the residuals. */
|
||||
/* if iflag = 2 the result is used to compute the Jacobian by finite differences. */
|
||||
/* Jacobian computation requires exactly n function calls with iflag = 2. */
|
||||
/* return a negative value to terminate lmdif1/lmdif */
|
||||
__cminpack_type_fcn_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
|
||||
int iflag );
|
||||
|
||||
/* for lmder1 and lmder */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* return a negative value to terminate lmder1/lmder */
|
||||
__cminpack_type_fcnder_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
|
||||
__cminpack_real__ *fjac, int ldfjac, int iflag );
|
||||
|
||||
/* for lmstr1 and lmstr */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* return a negative value to terminate lmstr1/lmstr */
|
||||
__cminpack_type_fcnderstr_mn__(void *p, int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec,
|
||||
__cminpack_real__ *fjrow, int iflag );
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/* MINPACK functions: */
|
||||
/* the info parameter was removed from most functions: the return */
|
||||
/* value of the function is used instead. */
|
||||
/* The argument 'p' can be used to store extra function parameters, thus */
|
||||
/* avoiding the use of global variables. You can also think of it as a */
|
||||
/* 'this' pointer a la C++. */
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (Jacobian calculated by
|
||||
a forward-difference approximation) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(hybrd1)( __cminpack_decl_fcn_nn__
|
||||
void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
|
||||
__cminpack_real__ *wa, int lwa );
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (Jacobian calculated by
|
||||
a forward-difference approximation, more general). */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(hybrd)( __cminpack_decl_fcn_nn__
|
||||
void *p, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ xtol, int maxfev,
|
||||
int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *diag, int mode,
|
||||
__cminpack_real__ factor, int nprint, int *nfev,
|
||||
__cminpack_real__ *fjac, int ldfjac, __cminpack_real__ *r, int lr, __cminpack_real__ *qtf,
|
||||
__cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3, __cminpack_real__ *wa4);
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (user-supplied Jacobian) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(hybrj1)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
|
||||
__cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ tol,
|
||||
__cminpack_real__ *wa, int lwa );
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (user-supplied Jacobian,
|
||||
more general) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(hybrj)( __cminpack_decl_fcnder_nn__ void *p, int n, __cminpack_real__ *x,
|
||||
__cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac, __cminpack_real__ xtol,
|
||||
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
|
||||
int nprint, int *nfev, int *njev, __cminpack_real__ *r,
|
||||
int lr, __cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2,
|
||||
__cminpack_real__ *wa3, __cminpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(Jacobian calculated by a forward-difference approximation) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmdif1)( __cminpack_decl_fcn_mn__
|
||||
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ tol,
|
||||
int *iwa, __cminpack_real__ *wa, int lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(Jacobian calculated by a forward-difference approximation, more
|
||||
general) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmdif)( __cminpack_decl_fcn_mn__
|
||||
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ ftol,
|
||||
__cminpack_real__ xtol, __cminpack_real__ gtol, int maxfev, __cminpack_real__ epsfcn,
|
||||
__cminpack_real__ *diag, int mode, __cminpack_real__ factor, int nprint,
|
||||
int *nfev, __cminpack_real__ *fjac, int ldfjac, int *ipvt,
|
||||
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
|
||||
__cminpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmder1)( __cminpack_decl_fcnder_mn__
|
||||
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, __cminpack_real__ tol, int *ipvt,
|
||||
__cminpack_real__ *wa, int lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, more general) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmder)( __cminpack_decl_fcnder_mn__
|
||||
void *p, int m, int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
|
||||
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
|
||||
int nprint, int *nfev, int *njev, int *ipvt,
|
||||
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
|
||||
__cminpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, minimal storage) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmstr1)( __cminpack_decl_fcnderstr_mn__ void *p, int m, int n,
|
||||
__cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
|
||||
__cminpack_real__ tol, int *ipvt, __cminpack_real__ *wa, int lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, minimal storage, more general) */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(lmstr)( __cminpack_decl_fcnderstr_mn__ void *p, int m,
|
||||
int n, __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, __cminpack_real__ ftol, __cminpack_real__ xtol, __cminpack_real__ gtol,
|
||||
int maxfev, __cminpack_real__ *diag, int mode, __cminpack_real__ factor,
|
||||
int nprint, int *nfev, int *njev, int *ipvt,
|
||||
__cminpack_real__ *qtf, __cminpack_real__ *wa1, __cminpack_real__ *wa2, __cminpack_real__ *wa3,
|
||||
__cminpack_real__ *wa4 );
|
||||
|
||||
__cminpack_attr__
|
||||
void CMINPACK_EXPORT __cminpack_func__(chkder)( int m, int n, const __cminpack_real__ *x, __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, __cminpack_real__ *xp, __cminpack_real__ *fvecp, int mode,
|
||||
__cminpack_real__ *err );
|
||||
|
||||
__cminpack_attr__
|
||||
__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(dpmpar)( int i );
|
||||
|
||||
__cminpack_attr__
|
||||
__cminpack_real__ CMINPACK_EXPORT __cminpack_func__(enorm)( int n, const __cminpack_real__ *x );
|
||||
|
||||
/* compute a forward-difference approximation to the m by n jacobian
|
||||
matrix associated with a specified problem of m functions in n
|
||||
variables. */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(fdjac2)(__cminpack_decl_fcn_mn__
|
||||
void *p, int m, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac,
|
||||
int ldfjac, __cminpack_real__ epsfcn, __cminpack_real__ *wa);
|
||||
|
||||
/* compute a forward-difference approximation to the n by n jacobian
|
||||
matrix associated with a specified problem of n functions in n
|
||||
variables. if the jacobian has a banded form, then function
|
||||
evaluations are saved by only approximating the nonzero terms. */
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(fdjac1)(__cminpack_decl_fcn_nn__
|
||||
void *p, int n, __cminpack_real__ *x, const __cminpack_real__ *fvec, __cminpack_real__ *fjac, int ldfjac,
|
||||
int ml, int mu, __cminpack_real__ epsfcn, __cminpack_real__ *wa1,
|
||||
__cminpack_real__ *wa2);
|
||||
|
||||
/* compute inverse(JtJ) after a run of lmdif or lmder. The covariance matrix is obtained
|
||||
by scaling the result by enorm(y)**2/(m-n). If JtJ is singular and k = rank(J), the
|
||||
pseudo-inverse is computed, and the result has to be scaled by enorm(y)**2/(m-k). */
|
||||
__cminpack_attr__
|
||||
void CMINPACK_EXPORT __cminpack_func__(covar)(int n, __cminpack_real__ *r, int ldr,
|
||||
const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
|
||||
|
||||
/* covar1 estimates the variance-covariance matrix:
|
||||
C = sigma**2 (JtJ)**+
|
||||
where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
|
||||
and sigma**2 = fsumsq / (m - k)
|
||||
where fsumsq is the residual sum of squares and k is the rank of J.
|
||||
The function returns 0 if J has full rank, else the rank of J.
|
||||
*/
|
||||
__cminpack_attr__
|
||||
int CMINPACK_EXPORT __cminpack_func__(covar1)(int m, int n, __cminpack_real__ fsumsq, __cminpack_real__ *r, int ldr,
|
||||
const int *ipvt, __cminpack_real__ tol, __cminpack_real__ *wa);
|
||||
|
||||
/* internal MINPACK subroutines */
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(dogleg)(int n, const __cminpack_real__ *r, int lr,
|
||||
const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta, __cminpack_real__ *x,
|
||||
__cminpack_real__ *wa1, __cminpack_real__ *wa2);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qrfac)(int m, int n, __cminpack_real__ *a, int
|
||||
lda, int pivot, int *ipvt, int lipvt, __cminpack_real__ *rdiag,
|
||||
__cminpack_real__ *acnorm, __cminpack_real__ *wa);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qrsolv)(int n, __cminpack_real__ *r, int ldr,
|
||||
const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ *x,
|
||||
__cminpack_real__ *sdiag, __cminpack_real__ *wa);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qform)(int m, int n, __cminpack_real__ *q, int
|
||||
ldq, __cminpack_real__ *wa);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(r1updt)(int m, int n, __cminpack_real__ *s, int
|
||||
ls, const __cminpack_real__ *u, __cminpack_real__ *v, __cminpack_real__ *w, int *sing);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(r1mpyq)(int m, int n, __cminpack_real__ *a, int
|
||||
lda, const __cminpack_real__ *v, const __cminpack_real__ *w);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(lmpar)(int n, __cminpack_real__ *r, int ldr,
|
||||
const int *ipvt, const __cminpack_real__ *diag, const __cminpack_real__ *qtb, __cminpack_real__ delta,
|
||||
__cminpack_real__ *par, __cminpack_real__ *x, __cminpack_real__ *sdiag, __cminpack_real__ *wa1,
|
||||
__cminpack_real__ *wa2);
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(rwupdt)(int n, __cminpack_real__ *r, int ldr,
|
||||
const __cminpack_real__ *w, __cminpack_real__ *b, __cminpack_real__ *alpha, __cminpack_real__ *cos,
|
||||
__cminpack_real__ *sin);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
|
||||
#endif /* __CMINPACK_H__ */
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
/* Internal header file for cminpack, by Frederic Devernay. */
|
||||
#ifndef __CMINPACKP_H__
|
||||
#define __CMINPACKP_H__
|
||||
|
||||
#ifndef __CMINPACK_H__
|
||||
#error "cminpackP.h in an internal cminpack header, and must be included after all other headers (including cminpack.h)"
|
||||
#endif
|
||||
|
||||
#if (defined (USE_CBLAS) || defined (USE_LAPACK)) && !defined (__cminpack_double__)
|
||||
#error "cminpack can use cblas and lapack only in double precision mode"
|
||||
#endif
|
||||
|
||||
#ifdef USE_CBLAS
|
||||
#ifdef __APPLE__
|
||||
#include <Accelerate/Accelerate.h>
|
||||
#else
|
||||
#include <cblas.h>
|
||||
#endif
|
||||
#define __cminpack_enorm__(n,x) cblas_dnrm2(n,x,1)
|
||||
#else
|
||||
#define __cminpack_enorm__(n,x) __cminpack_func__(enorm)(n,x)
|
||||
#endif
|
||||
|
||||
#ifdef USE_LAPACK
|
||||
#ifdef __APPLE__
|
||||
#include <Accelerate/Accelerate.h>
|
||||
#else
|
||||
#if defined(__LP64__) /* In LP64 match sizes with the 32 bit ABI */
|
||||
typedef int __CLPK_integer;
|
||||
typedef int __CLPK_logical;
|
||||
typedef float __CLPK_real;
|
||||
typedef double __CLPK_doublereal;
|
||||
typedef __CLPK_logical (*__CLPK_L_fp)();
|
||||
typedef int __CLPK_ftnlen;
|
||||
#else
|
||||
typedef long int __CLPK_integer;
|
||||
typedef long int __CLPK_logical;
|
||||
typedef float __CLPK_real;
|
||||
typedef double __CLPK_doublereal;
|
||||
typedef __CLPK_logical (*__CLPK_L_fp)();
|
||||
typedef long int __CLPK_ftnlen;
|
||||
#endif
|
||||
//extern void dlartg_(double *f, double *g, double *cs, double *sn, double *r__);
|
||||
int dlartg_(__CLPK_doublereal *f, __CLPK_doublereal *g, __CLPK_doublereal *cs,
|
||||
__CLPK_doublereal *sn, __CLPK_doublereal *r__);
|
||||
//extern void dgeqp3_(int *m, int *n, double *a, int *lda, int *jpvt, double *tau, double *work, int *lwork, int *info);
|
||||
int dgeqp3_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
|
||||
lda, __CLPK_integer *jpvt, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork,
|
||||
__CLPK_integer *info);
|
||||
//extern void dgeqrf_(int *m, int *n, double *a, int *lda, double *tau, double *work, int *lwork, int *info);
|
||||
int dgeqrf_(__CLPK_integer *m, __CLPK_integer *n, __CLPK_doublereal *a, __CLPK_integer *
|
||||
lda, __CLPK_doublereal *tau, __CLPK_doublereal *work, __CLPK_integer *lwork, __CLPK_integer *info);
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#include "minpackP.h"
|
||||
|
||||
#endif /* !__CMINPACKP_H__ */
|
||||
|
|
@ -0,0 +1,155 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(covar)(int n, real *r, int ldr,
|
||||
const int *ipvt, real tol, real *wa)
|
||||
{
|
||||
/* Local variables */
|
||||
int i, j, k, l, ii, jj;
|
||||
int sing;
|
||||
real temp, tolr;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine covar */
|
||||
|
||||
/* given an m by n matrix a, the problem is to determine */
|
||||
/* the covariance matrix corresponding to a, defined as */
|
||||
|
||||
/* t */
|
||||
/* inverse(a *a) . */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then covar expects */
|
||||
/* the full upper triangle of r and the permutation matrix p. */
|
||||
/* the covariance matrix is then computed as */
|
||||
|
||||
/* t t */
|
||||
/* p*inverse(r *r)*p . */
|
||||
|
||||
/* if a is nearly rank deficient, it may be desirable to compute */
|
||||
/* the covariance matrix corresponding to the linearly independent */
|
||||
/* columns of a. to define the numerical rank of a, covar uses */
|
||||
/* the tolerance tol. if l is the largest integer such that */
|
||||
|
||||
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
|
||||
|
||||
/* then covar computes the covariance matrix corresponding to */
|
||||
/* the first l columns of r. for k greater than l, column */
|
||||
/* and row ipvt(k) of the covariance matrix are set to zero. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine covar(n,r,ldr,ipvt,tol,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle must */
|
||||
/* contain the full upper triangle of the matrix r. on output */
|
||||
/* r contains the square symmetric covariance matrix. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* tol is a nonnegative input variable used to define the */
|
||||
/* numerical rank of a in the manner described above. */
|
||||
|
||||
/* wa is a work array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs */
|
||||
|
||||
/* argonne national laboratory. minpack project. august 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
tolr = tol * fabs(r[0]);
|
||||
|
||||
/* form the inverse of r in the full upper triangle of r. */
|
||||
|
||||
l = -1;
|
||||
for (k = 0; k < n; ++k) {
|
||||
if (fabs(r[k + k * ldr]) <= tolr) {
|
||||
break;
|
||||
}
|
||||
r[k + k * ldr] = 1. / r[k + k * ldr];
|
||||
if (k > 0) {
|
||||
for (j = 0; j < k; ++j) {
|
||||
// coverity[copy_paste_error]
|
||||
temp = r[k + k * ldr] * r[j + k * ldr];
|
||||
r[j + k * ldr] = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
r[i + k * ldr] -= temp * r[i + j * ldr];
|
||||
}
|
||||
}
|
||||
}
|
||||
l = k;
|
||||
}
|
||||
|
||||
/* form the full upper triangle of the inverse of (r transpose)*r */
|
||||
/* in the full upper triangle of r. */
|
||||
|
||||
if (l >= 0) {
|
||||
for (k = 0; k <= l; ++k) {
|
||||
if (k > 0) {
|
||||
for (j = 0; j < k; ++j) {
|
||||
temp = r[j + k * ldr];
|
||||
for (i = 0; i <= j; ++i) {
|
||||
r[i + j * ldr] += temp * r[i + k * ldr];
|
||||
}
|
||||
}
|
||||
}
|
||||
temp = r[k + k * ldr];
|
||||
for (i = 0; i <= k; ++i) {
|
||||
r[i + k * ldr] *= temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* form the full lower triangle of the covariance matrix */
|
||||
/* in the strict lower triangle of r and in wa. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
jj = ipvt[j]-1;
|
||||
sing = j > l;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
if (sing) {
|
||||
r[i + j * ldr] = 0.;
|
||||
}
|
||||
ii = ipvt[i]-1;
|
||||
if (ii > jj) {
|
||||
r[ii + jj * ldr] = r[i + j * ldr];
|
||||
}
|
||||
else if (ii < jj) {
|
||||
r[jj + ii * ldr] = r[i + j * ldr];
|
||||
}
|
||||
}
|
||||
wa[jj] = r[j + j * ldr];
|
||||
}
|
||||
|
||||
/* symmetrize the covariance matrix in r. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
for (i = 0; i < j; ++i) {
|
||||
r[i + j * ldr] = r[j + i * ldr];
|
||||
}
|
||||
r[j + j * ldr] = wa[j];
|
||||
}
|
||||
|
||||
/* last card of subroutine covar. */
|
||||
|
||||
} /* covar_ */
|
||||
|
||||
|
|
@ -0,0 +1,166 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
/* covar1 estimates the variance-covariance matrix:
|
||||
C = sigma**2 (JtJ)**+
|
||||
where (JtJ)**+ is the inverse of JtJ or the pseudo-inverse of JtJ (in case J does not have full rank),
|
||||
and sigma**2 = fsumsq / (m - k)
|
||||
where fsumsq is the residual sum of squares and k is the rank of J.
|
||||
*/
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(covar1)(int m, int n, real fsumsq, real *r, int ldr,
|
||||
const int *ipvt, real tol, real *wa)
|
||||
{
|
||||
/* Local variables */
|
||||
int i, j, k, l, ii, jj;
|
||||
int sing;
|
||||
real temp, tolr;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine covar */
|
||||
|
||||
/* given an m by n matrix a, the problem is to determine */
|
||||
/* the covariance matrix corresponding to a, defined as */
|
||||
|
||||
/* t */
|
||||
/* inverse(a *a) . */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then covar expects */
|
||||
/* the full upper triangle of r and the permutation matrix p. */
|
||||
/* the covariance matrix is then computed as */
|
||||
|
||||
/* t t */
|
||||
/* p*inverse(r *r)*p . */
|
||||
|
||||
/* if a is nearly rank deficient, it may be desirable to compute */
|
||||
/* the covariance matrix corresponding to the linearly independent */
|
||||
/* columns of a. to define the numerical rank of a, covar uses */
|
||||
/* the tolerance tol. if l is the largest integer such that */
|
||||
|
||||
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
|
||||
|
||||
/* then covar computes the covariance matrix corresponding to */
|
||||
/* the first l columns of r. for k greater than l, column */
|
||||
/* and row ipvt(k) of the covariance matrix are set to zero. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine covar(n,r,ldr,ipvt,tol,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle must */
|
||||
/* contain the full upper triangle of the matrix r. on output */
|
||||
/* r contains the square symmetric covariance matrix. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* tol is a nonnegative input variable used to define the */
|
||||
/* numerical rank of a in the manner described above. */
|
||||
|
||||
/* wa is a work array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs */
|
||||
|
||||
/* argonne national laboratory. minpack project. august 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
tolr = tol * fabs(r[0]);
|
||||
|
||||
/* form the inverse of r in the full upper triangle of r. */
|
||||
|
||||
l = -1;
|
||||
for (k = 0; k < n; ++k) {
|
||||
if (fabs(r[k + k * ldr]) <= tolr) {
|
||||
break;
|
||||
}
|
||||
r[k + k * ldr] = 1. / r[k + k * ldr];
|
||||
if (k > 0) {
|
||||
for (j = 0; j < k; ++j) {
|
||||
// coverity[copy_paste_error]
|
||||
temp = r[k + k * ldr] * r[j + k * ldr];
|
||||
r[j + k * ldr] = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
r[i + k * ldr] -= temp * r[i + j * ldr];
|
||||
}
|
||||
}
|
||||
}
|
||||
l = k;
|
||||
}
|
||||
|
||||
/* form the full upper triangle of the inverse of (r transpose)*r */
|
||||
/* in the full upper triangle of r. */
|
||||
|
||||
if (l >= 0) {
|
||||
for (k = 0; k <= l; ++k) {
|
||||
if (k > 0) {
|
||||
for (j = 0; j < k; ++j) {
|
||||
temp = r[j + k * ldr];
|
||||
for (i = 0; i <= j; ++i) {
|
||||
r[i + j * ldr] += temp * r[i + k * ldr];
|
||||
}
|
||||
}
|
||||
}
|
||||
temp = r[k + k * ldr];
|
||||
for (i = 0; i <= k; ++i) {
|
||||
r[i + k * ldr] *= temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* form the full lower triangle of the covariance matrix */
|
||||
/* in the strict lower triangle of r and in wa. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
jj = ipvt[j]-1;
|
||||
sing = j > l;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
if (sing) {
|
||||
r[i + j * ldr] = 0.;
|
||||
}
|
||||
ii = ipvt[i]-1;
|
||||
if (ii > jj) {
|
||||
r[ii + jj * ldr] = r[i + j * ldr];
|
||||
}
|
||||
else if (ii < jj) {
|
||||
r[jj + ii * ldr] = r[i + j * ldr];
|
||||
}
|
||||
}
|
||||
wa[jj] = r[j + j * ldr];
|
||||
}
|
||||
|
||||
/* symmetrize the covariance matrix in r. */
|
||||
|
||||
temp = fsumsq / (m - (l + 1));
|
||||
for (j = 0; j < n; ++j) {
|
||||
for (i = 0; i < j; ++i) {
|
||||
r[j + i * ldr] *= temp;
|
||||
r[i + j * ldr] = r[j + i * ldr];
|
||||
}
|
||||
r[j + j * ldr] = temp * wa[j];
|
||||
}
|
||||
|
||||
/* last card of subroutine covar. */
|
||||
if (l == (n - 1)) {
|
||||
return 0;
|
||||
}
|
||||
return l + 1;
|
||||
} /* covar_ */
|
||||
|
||||
|
|
@ -0,0 +1,210 @@
|
|||
/* covar.f -- translated by f2c (version 20100827).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(covar)(const int *n, real *r__, const int *ldr,
|
||||
const int *ipvt, const real *tol, real *wa)
|
||||
{
|
||||
/* System generated locals */
|
||||
int r_dim1, r_offset, i__1, i__2, i__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, l, ii, jj, km1;
|
||||
int sing;
|
||||
real temp, tolr;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine covar */
|
||||
|
||||
/* given an m by n matrix a, the problem is to determine */
|
||||
/* the covariance matrix corresponding to a, defined as */
|
||||
|
||||
/* t */
|
||||
/* inverse(a *a) . */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then covar expects */
|
||||
/* the full upper triangle of r and the permutation matrix p. */
|
||||
/* the covariance matrix is then computed as */
|
||||
|
||||
/* t t */
|
||||
/* p*inverse(r *r)*p . */
|
||||
|
||||
/* if a is nearly rank deficient, it may be desirable to compute */
|
||||
/* the covariance matrix corresponding to the linearly independent */
|
||||
/* columns of a. to define the numerical rank of a, covar uses */
|
||||
/* the tolerance tol. if l is the largest integer such that */
|
||||
|
||||
/* abs(r(l,l)) .gt. tol*abs(r(1,1)) , */
|
||||
|
||||
/* then covar computes the covariance matrix corresponding to */
|
||||
/* the first l columns of r. for k greater than l, column */
|
||||
/* and row ipvt(k) of the covariance matrix are set to zero. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine covar(n,r,ldr,ipvt,tol,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle must */
|
||||
/* contain the full upper triangle of the matrix r. on output */
|
||||
/* r contains the square symmetric covariance matrix. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* tol is a nonnegative input variable used to define the */
|
||||
/* numerical rank of a in the manner described above. */
|
||||
|
||||
/* wa is a work array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs */
|
||||
|
||||
/* argonne national laboratory. minpack project. august 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
--ipvt;
|
||||
tolr = *tol * fabs(r__[0]);
|
||||
r_dim1 = *ldr;
|
||||
r_offset = 1 + r_dim1;
|
||||
r__ -= r_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* form the inverse of r in the full upper triangle of r. */
|
||||
|
||||
l = 0;
|
||||
i__1 = *n;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
if (fabs(r__[k + k * r_dim1]) <= tolr) {
|
||||
goto L50;
|
||||
}
|
||||
r__[k + k * r_dim1] = 1. / r__[k + k * r_dim1];
|
||||
km1 = k - 1;
|
||||
if (km1 < 1) {
|
||||
goto L30;
|
||||
}
|
||||
i__2 = km1;
|
||||
for (j = 1; j <= i__2; ++j) {
|
||||
// coverity[copy_paste_error]
|
||||
temp = r__[k + k * r_dim1] * r__[j + k * r_dim1];
|
||||
r__[j + k * r_dim1] = 0.;
|
||||
i__3 = j;
|
||||
for (i__ = 1; i__ <= i__3; ++i__) {
|
||||
r__[i__ + k * r_dim1] -= temp * r__[i__ + j * r_dim1];
|
||||
/* L10: */
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
L30:
|
||||
l = k;
|
||||
/* L40: */
|
||||
}
|
||||
L50:
|
||||
|
||||
/* form the full upper triangle of the inverse of (r transpose)*r */
|
||||
/* in the full upper triangle of r. */
|
||||
|
||||
if (l < 1) {
|
||||
goto L110;
|
||||
}
|
||||
i__1 = l;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
km1 = k - 1;
|
||||
if (km1 < 1) {
|
||||
goto L80;
|
||||
}
|
||||
i__2 = km1;
|
||||
for (j = 1; j <= i__2; ++j) {
|
||||
temp = r__[j + k * r_dim1];
|
||||
i__3 = j;
|
||||
for (i__ = 1; i__ <= i__3; ++i__) {
|
||||
r__[i__ + j * r_dim1] += temp * r__[i__ + k * r_dim1];
|
||||
/* L60: */
|
||||
}
|
||||
/* L70: */
|
||||
}
|
||||
L80:
|
||||
temp = r__[k + k * r_dim1];
|
||||
i__2 = k;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
r__[i__ + k * r_dim1] = temp * r__[i__ + k * r_dim1];
|
||||
/* L90: */
|
||||
}
|
||||
/* L100: */
|
||||
}
|
||||
L110:
|
||||
|
||||
/* form the full lower triangle of the covariance matrix */
|
||||
/* in the strict lower triangle of r and in wa. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
jj = ipvt[j];
|
||||
sing = j > l;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
if (sing) {
|
||||
r__[i__ + j * r_dim1] = 0.;
|
||||
}
|
||||
ii = ipvt[i__];
|
||||
if (ii > jj) {
|
||||
r__[ii + jj * r_dim1] = r__[i__ + j * r_dim1];
|
||||
}
|
||||
if (ii < jj) {
|
||||
r__[jj + ii * r_dim1] = r__[i__ + j * r_dim1];
|
||||
}
|
||||
/* L120: */
|
||||
}
|
||||
wa[jj] = r__[j + j * r_dim1];
|
||||
/* L130: */
|
||||
}
|
||||
|
||||
/* symmetrize the covariance matrix in r. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
r__[i__ + j * r_dim1] = r__[j + i__ * r_dim1];
|
||||
/* L140: */
|
||||
}
|
||||
r__[j + j * r_dim1] = wa[j];
|
||||
/* L150: */
|
||||
}
|
||||
/*return 0;*/
|
||||
|
||||
/* last card of subroutine covar. */
|
||||
|
||||
} /* covar_ */
|
||||
|
||||
|
|
@ -0,0 +1,219 @@
|
|||
/* dogleg.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(dogleg)(int n, const real *r, int lr,
|
||||
const real *diag, const real *qtb, real delta, real *x,
|
||||
real *wa1, real *wa2)
|
||||
{
|
||||
/* System generated locals */
|
||||
real d1, d2, d3, d4;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, k, l, jj, jp1;
|
||||
real sum, temp, alpha, bnorm;
|
||||
real gnorm, qnorm, epsmch;
|
||||
real sgnorm;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine dogleg */
|
||||
|
||||
/* given an m by n matrix a, an n by n nonsingular diagonal */
|
||||
/* matrix d, an m-vector b, and a positive number delta, the */
|
||||
/* problem is to determine the convex combination x of the */
|
||||
/* gauss-newton and scaled gradient directions that minimizes */
|
||||
/* (a*x - b) in the least squares sense, subject to the */
|
||||
/* restriction that the euclidean norm of d*x be at most delta. */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization of a. that is, if a = q*r, where q has */
|
||||
/* orthogonal columns and r is an upper triangular matrix, */
|
||||
/* then dogleg expects the full upper triangle of r and */
|
||||
/* the first n components of (q transpose)*b. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an input array of length lr which must contain the upper */
|
||||
/* triangular matrix r stored by rows. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* delta is a positive input variable which specifies an upper */
|
||||
/* bound on the euclidean norm of d*x. */
|
||||
|
||||
/* x is an output array of length n which contains the desired */
|
||||
/* convex combination of the gauss-newton direction and the */
|
||||
/* scaled gradient direction. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa2;
|
||||
--wa1;
|
||||
--x;
|
||||
--qtb;
|
||||
--diag;
|
||||
--r;
|
||||
(void)lr;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
/* first, calculate the gauss-newton direction. */
|
||||
|
||||
jj = n * (n + 1) / 2 + 1;
|
||||
for (k = 1; k <= n; ++k) {
|
||||
j = n - k + 1;
|
||||
jp1 = j + 1;
|
||||
jj -= k;
|
||||
l = jj + 1;
|
||||
sum = 0.;
|
||||
if (n >= jp1) {
|
||||
for (i = jp1; i <= n; ++i) {
|
||||
sum += r[l] * x[i];
|
||||
++l;
|
||||
}
|
||||
}
|
||||
temp = r[jj];
|
||||
if (temp == 0.) {
|
||||
l = j;
|
||||
for (i = 1; i <= j; ++i) {
|
||||
/* Computing MAX */
|
||||
d2 = fabs(r[l]);
|
||||
temp = max(temp,d2);
|
||||
l = l + n - i;
|
||||
}
|
||||
temp = epsmch * temp;
|
||||
if (temp == 0.) {
|
||||
temp = epsmch;
|
||||
}
|
||||
}
|
||||
x[j] = (qtb[j] - sum) / temp;
|
||||
}
|
||||
|
||||
/* test whether the gauss-newton direction is acceptable. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa1[j] = 0.;
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
qnorm = __cminpack_enorm__(n, &wa2[1]);
|
||||
if (qnorm <= delta) {
|
||||
return;
|
||||
}
|
||||
|
||||
/* the gauss-newton direction is not acceptable. */
|
||||
/* next, calculate the scaled gradient direction. */
|
||||
|
||||
l = 1;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
temp = qtb[j];
|
||||
for (i = j; i <= n; ++i) {
|
||||
wa1[i] += r[l] * temp;
|
||||
++l;
|
||||
}
|
||||
wa1[j] /= diag[j];
|
||||
}
|
||||
|
||||
/* calculate the norm of the scaled gradient and test for */
|
||||
/* the special case in which the scaled gradient is zero. */
|
||||
|
||||
gnorm = __cminpack_enorm__(n, &wa1[1]);
|
||||
sgnorm = 0.;
|
||||
alpha = delta / qnorm;
|
||||
if (gnorm != 0.) {
|
||||
|
||||
/* calculate the point along the scaled gradient */
|
||||
/* at which the quadratic is minimized. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa1[j] = wa1[j] / gnorm / diag[j];
|
||||
}
|
||||
l = 1;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
sum = 0.;
|
||||
for (i = j; i <= n; ++i) {
|
||||
sum += r[l] * wa1[i];
|
||||
++l;
|
||||
}
|
||||
wa2[j] = sum;
|
||||
}
|
||||
temp = __cminpack_enorm__(n, &wa2[1]);
|
||||
sgnorm = gnorm / temp / temp;
|
||||
|
||||
/* test whether the scaled gradient direction is acceptable. */
|
||||
|
||||
alpha = 0.;
|
||||
if (sgnorm < delta) {
|
||||
|
||||
/* the scaled gradient direction is not acceptable. */
|
||||
/* finally, calculate the point along the dogleg */
|
||||
/* at which the quadratic is minimized. */
|
||||
|
||||
bnorm = __cminpack_enorm__(n, &qtb[1]);
|
||||
temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / delta);
|
||||
/* Computing 2nd power */
|
||||
d1 = sgnorm / delta;
|
||||
/* Computing 2nd power */
|
||||
d2 = temp - delta / qnorm;
|
||||
/* Computing 2nd power */
|
||||
d3 = delta / qnorm;
|
||||
/* Computing 2nd power */
|
||||
d4 = sgnorm / delta;
|
||||
temp = temp - delta / qnorm * (d1 * d1)
|
||||
+ sqrt(d2 * d2
|
||||
+ (1. - d3 * d3) * (1. - d4 * d4));
|
||||
/* Computing 2nd power */
|
||||
d1 = sgnorm / delta;
|
||||
alpha = delta / qnorm * (1. - d1 * d1) / temp;
|
||||
}
|
||||
}
|
||||
|
||||
/* form appropriate convex combination of the gauss-newton */
|
||||
/* direction and the scaled gradient direction. */
|
||||
|
||||
temp = (1. - alpha) * min(sgnorm,delta);
|
||||
for (j = 1; j <= n; ++j) {
|
||||
x[j] = temp * wa1[j] + alpha * x[j];
|
||||
}
|
||||
|
||||
/* last card of subroutine dogleg. */
|
||||
|
||||
} /* dogleg_ */
|
||||
|
||||
|
|
@ -0,0 +1,250 @@
|
|||
/* dogleg.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
/* Table of constant values */
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(dogleg)(const int *n, const real *r__, const int *lr,
|
||||
const real *diag, const real *qtb, const real *delta, real *x,
|
||||
real *wa1, real *wa2)
|
||||
{
|
||||
/* System generated locals */
|
||||
int i__1, i__2;
|
||||
real d__1, d__2, d__3, d__4;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, l, jj, jp1;
|
||||
real sum, temp, alpha, bnorm;
|
||||
real gnorm, qnorm, epsmch;
|
||||
real sgnorm;
|
||||
const int c__1 = 1;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine dogleg */
|
||||
|
||||
/* given an m by n matrix a, an n by n nonsingular diagonal */
|
||||
/* matrix d, an m-vector b, and a positive number delta, the */
|
||||
/* problem is to determine the convex combination x of the */
|
||||
/* gauss-newton and scaled gradient directions that minimizes */
|
||||
/* (a*x - b) in the least squares sense, subject to the */
|
||||
/* restriction that the euclidean norm of d*x be at most delta. */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization of a. that is, if a = q*r, where q has */
|
||||
/* orthogonal columns and r is an upper triangular matrix, */
|
||||
/* then dogleg expects the full upper triangle of r and */
|
||||
/* the first n components of (q transpose)*b. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine dogleg(n,r,lr,diag,qtb,delta,x,wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an input array of length lr which must contain the upper */
|
||||
/* triangular matrix r stored by rows. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* delta is a positive input variable which specifies an upper */
|
||||
/* bound on the euclidean norm of d*x. */
|
||||
|
||||
/* x is an output array of length n which contains the desired */
|
||||
/* convex combination of the gauss-newton direction and the */
|
||||
/* scaled gradient direction. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa2;
|
||||
--wa1;
|
||||
--x;
|
||||
--qtb;
|
||||
--diag;
|
||||
--r__;
|
||||
(void)lr;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
/* first, calculate the gauss-newton direction. */
|
||||
|
||||
jj = *n * (*n + 1) / 2 + 1;
|
||||
i__1 = *n;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
j = *n - k + 1;
|
||||
jp1 = j + 1;
|
||||
jj -= k;
|
||||
l = jj + 1;
|
||||
sum = 0.;
|
||||
if (*n < jp1) {
|
||||
goto L20;
|
||||
}
|
||||
i__2 = *n;
|
||||
for (i__ = jp1; i__ <= i__2; ++i__) {
|
||||
sum += r__[l] * x[i__];
|
||||
++l;
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
temp = r__[jj];
|
||||
if (temp != 0.) {
|
||||
goto L40;
|
||||
}
|
||||
l = j;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
/* Computing MAX */
|
||||
d__2 = temp, d__3 = fabs(r__[l]);
|
||||
temp = max(d__2,d__3);
|
||||
l = l + *n - i__;
|
||||
/* L30: */
|
||||
}
|
||||
temp = epsmch * temp;
|
||||
if (temp == 0.) {
|
||||
temp = epsmch;
|
||||
}
|
||||
L40:
|
||||
x[j] = (qtb[j] - sum) / temp;
|
||||
/* L50: */
|
||||
}
|
||||
|
||||
/* test whether the gauss-newton direction is acceptable. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = 0.;
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L60: */
|
||||
}
|
||||
qnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
if (qnorm <= *delta) {
|
||||
/* goto L140; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* the gauss-newton direction is not acceptable. */
|
||||
/* next, calculate the scaled gradient direction. */
|
||||
|
||||
l = 1;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
temp = qtb[j];
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
wa1[i__] += r__[l] * temp;
|
||||
++l;
|
||||
/* L70: */
|
||||
}
|
||||
wa1[j] /= diag[j];
|
||||
/* L80: */
|
||||
}
|
||||
|
||||
/* calculate the norm of the scaled gradient and test for */
|
||||
/* the special case in which the scaled gradient is zero. */
|
||||
|
||||
gnorm = __minpack_func__(enorm)(n, &wa1[1]);
|
||||
sgnorm = 0.;
|
||||
alpha = *delta / qnorm;
|
||||
if (gnorm == 0.) {
|
||||
goto L120;
|
||||
}
|
||||
|
||||
/* calculate the point along the scaled gradient */
|
||||
/* at which the quadratic is minimized. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = wa1[j] / gnorm / diag[j];
|
||||
/* L90: */
|
||||
}
|
||||
l = 1;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += r__[l] * wa1[i__];
|
||||
++l;
|
||||
/* L100: */
|
||||
}
|
||||
wa2[j] = sum;
|
||||
/* L110: */
|
||||
}
|
||||
temp = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
sgnorm = gnorm / temp / temp;
|
||||
|
||||
/* test whether the scaled gradient direction is acceptable. */
|
||||
|
||||
alpha = 0.;
|
||||
if (sgnorm >= *delta) {
|
||||
goto L120;
|
||||
}
|
||||
|
||||
/* the scaled gradient direction is not acceptable. */
|
||||
/* finally, calculate the point along the dogleg */
|
||||
/* at which the quadratic is minimized. */
|
||||
|
||||
bnorm = __minpack_func__(enorm)(n, &qtb[1]);
|
||||
temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / *delta);
|
||||
/* Computing 2nd power */
|
||||
d__1 = sgnorm / *delta;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp - *delta / qnorm;
|
||||
/* Computing 2nd power */
|
||||
d__3 = *delta / qnorm;
|
||||
/* Computing 2nd power */
|
||||
d__4 = sgnorm / *delta;
|
||||
temp = temp - *delta / qnorm * (d__1 * d__1) + sqrt(d__2 * d__2 + (1. -
|
||||
d__3 * d__3) * (1. - d__4 * d__4));
|
||||
/* Computing 2nd power */
|
||||
d__1 = sgnorm / *delta;
|
||||
alpha = *delta / qnorm * (1. - d__1 * d__1) / temp;
|
||||
L120:
|
||||
|
||||
/* form appropriate convex combination of the gauss-newton */
|
||||
/* direction and the scaled gradient direction. */
|
||||
|
||||
temp = (1. - alpha) * min(sgnorm,*delta);
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = temp * wa1[j] + alpha * x[j];
|
||||
/* L130: */
|
||||
}
|
||||
/* L140: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine dogleg. */
|
||||
|
||||
} /* dogleg_ */
|
||||
|
||||
|
|
@ -0,0 +1,191 @@
|
|||
#include "cminpack.h"
|
||||
#include <float.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
#define DPMPAR(type,X) _DPMPAR(type,X)
|
||||
#define _DPMPAR(type,X) type ## _ ## X
|
||||
|
||||
__cminpack_attr__
|
||||
real __cminpack_func__(dpmpar)(int i)
|
||||
{
|
||||
/* ********** */
|
||||
|
||||
/* Function dpmpar */
|
||||
|
||||
/* This function provides double precision machine parameters */
|
||||
/* when the appropriate set of data statements is activated (by */
|
||||
/* removing the c from column 1) and all other data statements are */
|
||||
/* rendered inactive. Most of the parameter values were obtained */
|
||||
/* from the corresponding Bell Laboratories Port Library function. */
|
||||
|
||||
/* The function statement is */
|
||||
|
||||
/* double precision function dpmpar(i) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* i is an integer input variable set to 1, 2, or 3 which */
|
||||
/* selects the desired machine parameter. If the machine has */
|
||||
/* t base b digits and its smallest and largest exponents are */
|
||||
/* emin and emax, respectively, then these parameters are */
|
||||
|
||||
/* dpmpar(1) = b**(1 - t), the machine precision, */
|
||||
|
||||
/* dpmpar(2) = b**(emin - 1), the smallest magnitude, */
|
||||
|
||||
/* dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. */
|
||||
|
||||
/* Argonne National Laboratory. MINPACK Project. November 1996. */
|
||||
/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* Machine constants for the IBM 360/370 series, */
|
||||
/* the Amdahl 470/V6, the ICL 2900, the Itel AS/6, */
|
||||
/* the Xerox Sigma 5/7/9 and the Sel systems 85/86. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / z34100000, z00000000 / */
|
||||
/* data minmag(1),minmag(2) / z00100000, z00000000 / */
|
||||
/* data maxmag(1),maxmag(2) / z7fffffff, zffffffff / */
|
||||
|
||||
/* Machine constants for the Honeywell 600/6000 series. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / o606400000000, o000000000000 / */
|
||||
/* data minmag(1),minmag(2) / o402400000000, o000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / o376777777777, o777777777777 / */
|
||||
|
||||
/* Machine constants for the CDC 6000/7000 series. */
|
||||
|
||||
/* data mcheps(1) / 15614000000000000000b / */
|
||||
/* data mcheps(2) / 15010000000000000000b / */
|
||||
|
||||
/* data minmag(1) / 00604000000000000000b / */
|
||||
/* data minmag(2) / 00000000000000000000b / */
|
||||
|
||||
/* data maxmag(1) / 37767777777777777777b / */
|
||||
/* data maxmag(2) / 37167777777777777777b / */
|
||||
|
||||
/* Machine constants for the PDP-10 (KA processor). */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / "114400000000, "000000000000 / */
|
||||
/* data minmag(1),minmag(2) / "033400000000, "000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / "377777777777, "344777777777 / */
|
||||
|
||||
/* Machine constants for the PDP-10 (KI processor). */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / "104400000000, "000000000000 / */
|
||||
/* data minmag(1),minmag(2) / "000400000000, "000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / "377777777777, "377777777777 / */
|
||||
|
||||
/* Machine constants for the PDP-11. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / 9472, 0 / */
|
||||
/* data mcheps(3),mcheps(4) / 0, 0 / */
|
||||
|
||||
/* data minmag(1),minmag(2) / 128, 0 / */
|
||||
/* data minmag(3),minmag(4) / 0, 0 / */
|
||||
|
||||
/* data maxmag(1),maxmag(2) / 32767, -1 / */
|
||||
/* data maxmag(3),maxmag(4) / -1, -1 / */
|
||||
|
||||
/* Machine constants for the Burroughs 6700/7700 systems. */
|
||||
|
||||
/* data mcheps(1) / o1451000000000000 / */
|
||||
/* data mcheps(2) / o0000000000000000 / */
|
||||
|
||||
/* data minmag(1) / o1771000000000000 / */
|
||||
/* data minmag(2) / o7770000000000000 / */
|
||||
|
||||
/* data maxmag(1) / o0777777777777777 / */
|
||||
/* data maxmag(2) / o7777777777777777 / */
|
||||
|
||||
/* Machine constants for the Burroughs 5700 system. */
|
||||
|
||||
/* data mcheps(1) / o1451000000000000 / */
|
||||
/* data mcheps(2) / o0000000000000000 / */
|
||||
|
||||
/* data minmag(1) / o1771000000000000 / */
|
||||
/* data minmag(2) / o0000000000000000 / */
|
||||
|
||||
/* data maxmag(1) / o0777777777777777 / */
|
||||
/* data maxmag(2) / o0007777777777777 / */
|
||||
|
||||
/* Machine constants for the Burroughs 1700 system. */
|
||||
|
||||
/* data mcheps(1) / zcc6800000 / */
|
||||
/* data mcheps(2) / z000000000 / */
|
||||
|
||||
/* data minmag(1) / zc00800000 / */
|
||||
/* data minmag(2) / z000000000 / */
|
||||
|
||||
/* data maxmag(1) / zdffffffff / */
|
||||
/* data maxmag(2) / zfffffffff / */
|
||||
|
||||
/* Machine constants for the Univac 1100 series. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / o170640000000, o000000000000 / */
|
||||
/* data minmag(1),minmag(2) / o000040000000, o000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / o377777777777, o777777777777 / */
|
||||
|
||||
/* Machine constants for the Data General Eclipse S/200. */
|
||||
|
||||
/* Note - it may be appropriate to include the following card - */
|
||||
/* static dmach(3) */
|
||||
|
||||
/* data minmag/20k,3*0/,maxmag/77777k,3*177777k/ */
|
||||
/* data mcheps/32020k,3*0/ */
|
||||
|
||||
/* Machine constants for the Harris 220. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / '20000000, '00000334 / */
|
||||
/* data minmag(1),minmag(2) / '20000000, '00000201 / */
|
||||
/* data maxmag(1),maxmag(2) / '37777777, '37777577 / */
|
||||
|
||||
/* Machine constants for the Cray-1. */
|
||||
|
||||
/* data mcheps(1) / 0376424000000000000000b / */
|
||||
/* data mcheps(2) / 0000000000000000000000b / */
|
||||
|
||||
/* data minmag(1) / 0200034000000000000000b / */
|
||||
/* data minmag(2) / 0000000000000000000000b / */
|
||||
|
||||
/* data maxmag(1) / 0577777777777777777777b / */
|
||||
/* data maxmag(2) / 0000007777777777777776b / */
|
||||
|
||||
/* Machine constants for the Prime 400. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / :10000000000, :00000000123 / */
|
||||
/* data minmag(1),minmag(2) / :10000000000, :00000100000 / */
|
||||
/* data maxmag(1),maxmag(2) / :17777777777, :37777677776 / */
|
||||
|
||||
/* Machine constants for the VAX-11. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / 9472, 0 / */
|
||||
/* data minmag(1),minmag(2) / 128, 0 / */
|
||||
/* data maxmag(1),maxmag(2) / -32769, -1 / */
|
||||
|
||||
/* Machine constants for IEEE machines. */
|
||||
|
||||
/* data dmach(1) /2.22044604926d-16/ */
|
||||
/* data dmach(2) /2.22507385852d-308/ */
|
||||
/* data dmach(3) /1.79769313485d+308/ */
|
||||
|
||||
switch(i) {
|
||||
case 1:
|
||||
return DPMPAR(realm,EPSILON); /* 2.2204460492503131e-16 | 1.19209290e-07F */
|
||||
case 2:
|
||||
return DPMPAR(realm,MIN); /* 2.2250738585072014e-308 | 1.17549435e-38F */
|
||||
default:
|
||||
return DPMPAR(realm,MAX); /* 1.7976931348623157e+308 | 3.40282347e+38F */
|
||||
}
|
||||
|
||||
/* Last card of function dpmpar. */
|
||||
|
||||
} /* dpmpar_ */
|
||||
|
||||
#undef mcheps
|
||||
#undef maxmag
|
||||
#undef minmag
|
||||
#undef dmach
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,196 @@
|
|||
/* dpmpar.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include "minpackP.h"
|
||||
|
||||
#define DPMPAR(type,X) _DPMPAR(type,X)
|
||||
#define _DPMPAR(type,X) type ## _ ## X
|
||||
|
||||
__minpack_attr__
|
||||
real __minpack_func__(dpmpar)(const int *i)
|
||||
{
|
||||
/* ********** */
|
||||
|
||||
/* Function dpmpar */
|
||||
|
||||
/* This function provides double precision machine parameters */
|
||||
/* when the appropriate set of data statements is activated (by */
|
||||
/* removing the c from column 1) and all other data statements are */
|
||||
/* rendered inactive. Most of the parameter values were obtained */
|
||||
/* from the corresponding Bell Laboratories Port Library function. */
|
||||
|
||||
/* The function statement is */
|
||||
|
||||
/* double precision function dpmpar(i) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* i is an integer input variable set to 1, 2, or 3 which */
|
||||
/* selects the desired machine parameter. If the machine has */
|
||||
/* t base b digits and its smallest and largest exponents are */
|
||||
/* emin and emax, respectively, then these parameters are */
|
||||
|
||||
/* dpmpar(1) = b**(1 - t), the machine precision, */
|
||||
|
||||
/* dpmpar(2) = b**(emin - 1), the smallest magnitude, */
|
||||
|
||||
/* dpmpar(3) = b**emax*(1 - b**(-t)), the largest magnitude. */
|
||||
|
||||
/* Argonne National Laboratory. MINPACK Project. November 1996. */
|
||||
/* Burton S. Garbow, Kenneth E. Hillstrom, Jorge J. More' */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* Machine constants for the IBM 360/370 series, */
|
||||
/* the Amdahl 470/V6, the ICL 2900, the Itel AS/6, */
|
||||
/* the Xerox Sigma 5/7/9 and the Sel systems 85/86. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / z34100000, z00000000 / */
|
||||
/* data minmag(1),minmag(2) / z00100000, z00000000 / */
|
||||
/* data maxmag(1),maxmag(2) / z7fffffff, zffffffff / */
|
||||
|
||||
/* Machine constants for the Honeywell 600/6000 series. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / o606400000000, o000000000000 / */
|
||||
/* data minmag(1),minmag(2) / o402400000000, o000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / o376777777777, o777777777777 / */
|
||||
|
||||
/* Machine constants for the CDC 6000/7000 series. */
|
||||
|
||||
/* data mcheps(1) / 15614000000000000000b / */
|
||||
/* data mcheps(2) / 15010000000000000000b / */
|
||||
|
||||
/* data minmag(1) / 00604000000000000000b / */
|
||||
/* data minmag(2) / 00000000000000000000b / */
|
||||
|
||||
/* data maxmag(1) / 37767777777777777777b / */
|
||||
/* data maxmag(2) / 37167777777777777777b / */
|
||||
|
||||
/* Machine constants for the PDP-10 (KA processor). */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / "114400000000, "000000000000 / */
|
||||
/* data minmag(1),minmag(2) / "033400000000, "000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / "377777777777, "344777777777 / */
|
||||
|
||||
/* Machine constants for the PDP-10 (KI processor). */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / "104400000000, "000000000000 / */
|
||||
/* data minmag(1),minmag(2) / "000400000000, "000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / "377777777777, "377777777777 / */
|
||||
|
||||
/* Machine constants for the PDP-11. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / 9472, 0 / */
|
||||
/* data mcheps(3),mcheps(4) / 0, 0 / */
|
||||
|
||||
/* data minmag(1),minmag(2) / 128, 0 / */
|
||||
/* data minmag(3),minmag(4) / 0, 0 / */
|
||||
|
||||
/* data maxmag(1),maxmag(2) / 32767, -1 / */
|
||||
/* data maxmag(3),maxmag(4) / -1, -1 / */
|
||||
|
||||
/* Machine constants for the Burroughs 6700/7700 systems. */
|
||||
|
||||
/* data mcheps(1) / o1451000000000000 / */
|
||||
/* data mcheps(2) / o0000000000000000 / */
|
||||
|
||||
/* data minmag(1) / o1771000000000000 / */
|
||||
/* data minmag(2) / o7770000000000000 / */
|
||||
|
||||
/* data maxmag(1) / o0777777777777777 / */
|
||||
/* data maxmag(2) / o7777777777777777 / */
|
||||
|
||||
/* Machine constants for the Burroughs 5700 system. */
|
||||
|
||||
/* data mcheps(1) / o1451000000000000 / */
|
||||
/* data mcheps(2) / o0000000000000000 / */
|
||||
|
||||
/* data minmag(1) / o1771000000000000 / */
|
||||
/* data minmag(2) / o0000000000000000 / */
|
||||
|
||||
/* data maxmag(1) / o0777777777777777 / */
|
||||
/* data maxmag(2) / o0007777777777777 / */
|
||||
|
||||
/* Machine constants for the Burroughs 1700 system. */
|
||||
|
||||
/* data mcheps(1) / zcc6800000 / */
|
||||
/* data mcheps(2) / z000000000 / */
|
||||
|
||||
/* data minmag(1) / zc00800000 / */
|
||||
/* data minmag(2) / z000000000 / */
|
||||
|
||||
/* data maxmag(1) / zdffffffff / */
|
||||
/* data maxmag(2) / zfffffffff / */
|
||||
|
||||
/* Machine constants for the Univac 1100 series. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / o170640000000, o000000000000 / */
|
||||
/* data minmag(1),minmag(2) / o000040000000, o000000000000 / */
|
||||
/* data maxmag(1),maxmag(2) / o377777777777, o777777777777 / */
|
||||
|
||||
/* Machine constants for the Data General Eclipse S/200. */
|
||||
|
||||
/* Note - it may be appropriate to include the following card - */
|
||||
/* static dmach(3) */
|
||||
|
||||
/* data minmag/20k,3*0/,maxmag/77777k,3*177777k/ */
|
||||
/* data mcheps/32020k,3*0/ */
|
||||
|
||||
/* Machine constants for the Harris 220. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / '20000000, '00000334 / */
|
||||
/* data minmag(1),minmag(2) / '20000000, '00000201 / */
|
||||
/* data maxmag(1),maxmag(2) / '37777777, '37777577 / */
|
||||
|
||||
/* Machine constants for the Cray-1. */
|
||||
|
||||
/* data mcheps(1) / 0376424000000000000000b / */
|
||||
/* data mcheps(2) / 0000000000000000000000b / */
|
||||
|
||||
/* data minmag(1) / 0200034000000000000000b / */
|
||||
/* data minmag(2) / 0000000000000000000000b / */
|
||||
|
||||
/* data maxmag(1) / 0577777777777777777777b / */
|
||||
/* data maxmag(2) / 0000007777777777777776b / */
|
||||
|
||||
/* Machine constants for the Prime 400. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / :10000000000, :00000000123 / */
|
||||
/* data minmag(1),minmag(2) / :10000000000, :00000100000 / */
|
||||
/* data maxmag(1),maxmag(2) / :17777777777, :37777677776 / */
|
||||
|
||||
/* Machine constants for the VAX-11. */
|
||||
|
||||
/* data mcheps(1),mcheps(2) / 9472, 0 / */
|
||||
/* data minmag(1),minmag(2) / 128, 0 / */
|
||||
/* data maxmag(1),maxmag(2) / -32769, -1 / */
|
||||
|
||||
/* Machine constants for IEEE machines. */
|
||||
|
||||
/* data dmach(1) /2.22044604926d-16/ */
|
||||
/* data dmach(2) /2.22507385852d-308/ */
|
||||
/* data dmach(3) /1.79769313485d+308/ */
|
||||
|
||||
|
||||
switch(*i) {
|
||||
case 1:
|
||||
return DPMPAR(realm,EPSILON); /* 2.2204460492503131e-16 | 1.19209290e-07F */
|
||||
case 2:
|
||||
return DPMPAR(realm,MIN); /* 2.2250738585072014e-308 | 1.17549435e-38F */
|
||||
default:
|
||||
return DPMPAR(realm,MAX); /* 1.7976931348623157e+308 | 3.40282347e+38F */
|
||||
}
|
||||
|
||||
/* Last card of function dpmpar. */
|
||||
|
||||
} /* dpmpar_ */
|
||||
|
||||
#undef mcheps
|
||||
#undef maxmag
|
||||
#undef minmag
|
||||
#undef dmach
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
/*
|
||||
About the values for rdwarf and rgiant.
|
||||
|
||||
The original values, both in single-precision FORTRAN source code and in double-precision code were:
|
||||
#define rdwarf 3.834e-20
|
||||
#define rgiant 1.304e19
|
||||
See for example:
|
||||
http://www.netlib.org/slatec/src/denorm.f
|
||||
http://www.netlib.org/slatec/src/enorm.f
|
||||
However, rdwarf is smaller than sqrt(FLT_MIN) = 1.0842021724855044e-19, so that rdwarf**2 will
|
||||
underflow. This contradicts the constraints expressed in the comments below.
|
||||
|
||||
We changed these constants to those proposed by the
|
||||
implementation found in MPFIT http://cow.physics.wisc.edu/~craigm/idl/fitting.html
|
||||
|
||||
cmpfit-1.2 proposes the following definitions:
|
||||
rdwarf = sqrt(dpmpar(2)*1.5) * 10
|
||||
rgiant = sqrt(dpmpar(3)) * 0.1
|
||||
|
||||
The half version does not really worked that way, so we use for half:
|
||||
rdwarf = sqrt(dpmpar(2)) * 2
|
||||
rgiant = sqrt(dpmpar(3)) * 0.5
|
||||
Any suggestion is welcome. Half CMINPACK is really only a
|
||||
proof-of-concept anyway.
|
||||
|
||||
See the example/tenorm*c, which computes these values
|
||||
*/
|
||||
#define double_dwarf (1.82691291192569e-153)
|
||||
#define double_giant (1.34078079299426e+153)
|
||||
#define long_double_dwarf (2.245696932951581572e-2465l)
|
||||
#define long_double_giant (1.090748135619415929e+2465l)
|
||||
#define float_dwarf (1.327871072777421e-18f)
|
||||
#define float_giant (1.844674297419792e+18f)
|
||||
#define half_dwarf (0.015625f)
|
||||
#define half_giant (127.9375f)
|
||||
|
||||
#define dwarf(type) _dwarf(type)
|
||||
#define _dwarf(type) type ## _dwarf
|
||||
#define giant(type) _giant(type)
|
||||
#define _giant(type) type ## _giant
|
||||
|
||||
#define rdwarf dwarf(realm)
|
||||
#define rgiant giant(realm)
|
||||
|
||||
__cminpack_attr__
|
||||
real __cminpack_func__(enorm)(int n, const real *x)
|
||||
{
|
||||
#ifdef USE_CBLAS
|
||||
return cblas_dnrm2(n, x, 1);
|
||||
#else /* !USE_CBLAS */
|
||||
/* System generated locals */
|
||||
real ret_val, d1;
|
||||
|
||||
/* Local variables */
|
||||
int i;
|
||||
real s1, s2, s3, xabs, x1max, x3max, agiant;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* function enorm */
|
||||
|
||||
/* given an n-vector x, this function calculates the */
|
||||
/* euclidean norm of x. */
|
||||
|
||||
/* the euclidean norm is computed by accumulating the sum of */
|
||||
/* squares in three different sums. the sums of squares for the */
|
||||
/* small and large components are scaled so that no overflows */
|
||||
/* occur. non-destructive underflows are permitted. underflows */
|
||||
/* and overflows do not occur in the computation of the unscaled */
|
||||
/* sum of squares for the intermediate components. */
|
||||
/* the definitions of small, intermediate and large components */
|
||||
/* depend on two constants, rdwarf and rgiant. the main */
|
||||
/* restrictions on these constants are that rdwarf**2 not */
|
||||
/* underflow and rgiant**2 not overflow. the constants */
|
||||
/* given here are suitable for every known computer. */
|
||||
|
||||
/* the function statement is */
|
||||
|
||||
/* double precision function enorm(n,x) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
s1 = 0.;
|
||||
s2 = 0.;
|
||||
s3 = 0.;
|
||||
x1max = 0.;
|
||||
x3max = 0.;
|
||||
agiant = rgiant / (real)n;
|
||||
for (i = 0; i < n; ++i) {
|
||||
xabs = fabs(x[i]);
|
||||
if (xabs >= agiant) {
|
||||
/* sum for large components. */
|
||||
if (xabs > x1max) {
|
||||
/* Computing 2nd power */
|
||||
d1 = x1max / xabs;
|
||||
s1 = 1. + s1 * (d1 * d1);
|
||||
x1max = xabs;
|
||||
} else {
|
||||
/* Computing 2nd power */
|
||||
d1 = xabs / x1max;
|
||||
s1 += d1 * d1;
|
||||
}
|
||||
} else if (xabs <= rdwarf) {
|
||||
/* sum for small components. */
|
||||
if (xabs > x3max) {
|
||||
/* Computing 2nd power */
|
||||
d1 = x3max / xabs;
|
||||
s3 = 1. + s3 * (d1 * d1);
|
||||
x3max = xabs;
|
||||
} else if (xabs != 0.) {
|
||||
/* Computing 2nd power */
|
||||
d1 = xabs / x3max;
|
||||
s3 += d1 * d1;
|
||||
}
|
||||
} else {
|
||||
/* sum for intermediate components. */
|
||||
/* Computing 2nd power */
|
||||
s2 += xabs * xabs;
|
||||
}
|
||||
}
|
||||
|
||||
/* calculation of norm. */
|
||||
|
||||
if (s1 != 0.) {
|
||||
ret_val = x1max * sqrt(s1 + (s2 / x1max) / x1max);
|
||||
} else if (s2 != 0.) {
|
||||
if (s2 >= x3max) {
|
||||
ret_val = sqrt(s2 * (1. + (x3max / s2) * (x3max * s3)));
|
||||
} else {
|
||||
ret_val = sqrt(x3max * ((s2 / x3max) + (x3max * s3)));
|
||||
}
|
||||
} else {
|
||||
ret_val = x3max * sqrt(s3);
|
||||
}
|
||||
return ret_val;
|
||||
|
||||
/* last card of function enorm. */
|
||||
#endif /* !USE_CBLAS */
|
||||
} /* enorm_ */
|
||||
|
||||
|
|
@ -0,0 +1,199 @@
|
|||
/* enorm.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
|
||||
#include "minpackP.h"
|
||||
|
||||
/*
|
||||
About the values for rdwarf and rgiant.
|
||||
|
||||
The original values, both in single-precision FORTRAN source code and in double-precision code were:
|
||||
#define rdwarf 3.834e-20
|
||||
#define rgiant 1.304e19
|
||||
See for example:
|
||||
http://www.netlib.org/slatec/src/denorm.f
|
||||
http://www.netlib.org/slatec/src/enorm.f
|
||||
However, rdwarf is smaller than sqrt(FLT_MIN) = 1.0842021724855044e-19, so that rdwarf**2 will
|
||||
underflow. This contradicts the constraints expressed in the comments below.
|
||||
|
||||
We changed these constants to those proposed by the
|
||||
implementation found in MPFIT http://cow.physics.wisc.edu/~craigm/idl/fitting.html
|
||||
|
||||
cmpfit-1.2 proposes the following definitions:
|
||||
rdwarf = sqrt(dpmpar(2)*1.5) * 10
|
||||
rgiant = sqrt(dpmpar(3)) * 0.1
|
||||
|
||||
The half version does not really worked that way, so we use for half:
|
||||
rdwarf = sqrt(dpmpar(2)) * 2
|
||||
rgiant = sqrt(dpmpar(3)) * 0.5
|
||||
Any suggestion is welcome. Half CMINPACK is really only a
|
||||
proof-of-concept anyway.
|
||||
|
||||
See the example/tenorm*c, which computes these values
|
||||
*/
|
||||
#define double_dwarf (1.82691291192569e-153)
|
||||
#define double_giant (1.34078079299426e+153)
|
||||
#define long_double_dwarf (2.245696932951581572e-2465l)
|
||||
#define long_double_giant (1.090748135619415929e+2465l)
|
||||
#define float_dwarf (1.327871072777421e-18f)
|
||||
#define float_giant (1.844674297419792e+18f)
|
||||
#define half_dwarf (0.015625f)
|
||||
#define half_giant (127.9375f)
|
||||
|
||||
#define dwarf(type) _dwarf(type)
|
||||
#define _dwarf(type) type ## _dwarf
|
||||
#define giant(type) _giant(type)
|
||||
#define _giant(type) type ## _giant
|
||||
|
||||
#define rdwarf dwarf(realm)
|
||||
#define rgiant giant(realm)
|
||||
|
||||
__minpack_attr__
|
||||
real __minpack_func__(enorm)(const int *n, const real *x)
|
||||
{
|
||||
/* System generated locals */
|
||||
int i__1;
|
||||
real ret_val, d__1;
|
||||
|
||||
/* Local variables */
|
||||
int i__;
|
||||
real s1, s2, s3, xabs, x1max, x3max, agiant, floatn;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* function enorm */
|
||||
|
||||
/* given an n-vector x, this function calculates the */
|
||||
/* euclidean norm of x. */
|
||||
|
||||
/* the euclidean norm is computed by accumulating the sum of */
|
||||
/* squares in three different sums. the sums of squares for the */
|
||||
/* small and large components are scaled so that no overflows */
|
||||
/* occur. non-destructive underflows are permitted. underflows */
|
||||
/* and overflows do not occur in the computation of the unscaled */
|
||||
/* sum of squares for the intermediate components. */
|
||||
/* the definitions of small, intermediate and large components */
|
||||
/* depend on two constants, rdwarf and rgiant. the main */
|
||||
/* restrictions on these constants are that rdwarf**2 not */
|
||||
/* underflow and rgiant**2 not overflow. the constants */
|
||||
/* given here are suitable for every known computer. */
|
||||
|
||||
/* the function statement is */
|
||||
|
||||
/* double precision function enorm(n,x) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--x;
|
||||
|
||||
/* Function Body */
|
||||
s1 = 0.;
|
||||
s2 = 0.;
|
||||
s3 = 0.;
|
||||
x1max = 0.;
|
||||
x3max = 0.;
|
||||
floatn = (real) (*n);
|
||||
agiant = rgiant / floatn;
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
xabs = fabs(x[i__]);
|
||||
if (xabs > rdwarf && xabs < agiant) {
|
||||
goto L70;
|
||||
}
|
||||
if (xabs <= rdwarf) {
|
||||
goto L30;
|
||||
}
|
||||
|
||||
/* sum for large components. */
|
||||
|
||||
if (xabs <= x1max) {
|
||||
goto L10;
|
||||
}
|
||||
/* Computing 2nd power */
|
||||
d__1 = x1max / xabs;
|
||||
s1 = 1. + s1 * (d__1 * d__1);
|
||||
x1max = xabs;
|
||||
goto L20;
|
||||
L10:
|
||||
/* Computing 2nd power */
|
||||
d__1 = xabs / x1max;
|
||||
s1 += d__1 * d__1;
|
||||
L20:
|
||||
goto L60;
|
||||
L30:
|
||||
|
||||
/* sum for small components. */
|
||||
|
||||
if (xabs <= x3max) {
|
||||
goto L40;
|
||||
}
|
||||
/* Computing 2nd power */
|
||||
d__1 = x3max / xabs;
|
||||
s3 = 1. + s3 * (d__1 * d__1);
|
||||
x3max = xabs;
|
||||
goto L50;
|
||||
L40:
|
||||
if (xabs != 0.) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = xabs / x3max;
|
||||
s3 += d__1 * d__1;
|
||||
}
|
||||
L50:
|
||||
L60:
|
||||
goto L80;
|
||||
L70:
|
||||
|
||||
/* sum for intermediate components. */
|
||||
|
||||
/* Computing 2nd power */
|
||||
d__1 = xabs;
|
||||
s2 += d__1 * d__1;
|
||||
L80:
|
||||
/* L90: */
|
||||
;
|
||||
}
|
||||
|
||||
/* calculation of norm. */
|
||||
|
||||
if (s1 == 0.) {
|
||||
goto L100;
|
||||
}
|
||||
ret_val = x1max * sqrt(s1 + s2 / x1max / x1max);
|
||||
goto L130;
|
||||
L100:
|
||||
if (s2 == 0.) {
|
||||
goto L110;
|
||||
}
|
||||
if (s2 >= x3max) {
|
||||
ret_val = sqrt(s2 * (1. + x3max / s2 * (x3max * s3)));
|
||||
} else {
|
||||
ret_val = sqrt(x3max * (s2 / x3max + x3max * s3));
|
||||
}
|
||||
goto L120;
|
||||
L110:
|
||||
ret_val = x3max * sqrt(s3);
|
||||
L120:
|
||||
L130:
|
||||
return ret_val;
|
||||
|
||||
/* last card of function enorm. */
|
||||
|
||||
} /* enorm_ */
|
||||
|
||||
|
|
@ -0,0 +1,189 @@
|
|||
/* fdjac1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(fdjac1)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, const real *
|
||||
fvec, real *fjac, int ldfjac, int ml,
|
||||
int mu, real epsfcn, real *wa1, real *wa2)
|
||||
{
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset;
|
||||
|
||||
/* Local variables */
|
||||
real h;
|
||||
int i, j, k;
|
||||
real eps, temp;
|
||||
int msum;
|
||||
real epsmch;
|
||||
int iflag = 0;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine fdjac1 */
|
||||
|
||||
/* this subroutine computes a forward-difference approximation */
|
||||
/* to the n by n jacobian matrix associated with a specified */
|
||||
/* problem of n functions in n variables. if the jacobian has */
|
||||
/* a banded form, then function evaluations are saved by only */
|
||||
/* approximating the nonzero terms. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, */
|
||||
/* wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of fdjac1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an input array of length n which must contain the */
|
||||
/* functions evaluated at x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* approximation to the jacobian matrix evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* iflag is an integer variable which can be used to terminate */
|
||||
/* the execution of fdjac1. see description of fcn. */
|
||||
|
||||
/* ml is a nonnegative integer input variable which specifies */
|
||||
/* the number of subdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* ml to at least n - 1. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* mu is a nonnegative integer input variable which specifies */
|
||||
/* the number of superdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* mu to at least n - 1. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at */
|
||||
/* least n, then the jacobian is considered dense, and wa2 is */
|
||||
/* not referenced. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa2;
|
||||
--wa1;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
eps = sqrt((max(epsfcn,epsmch)));
|
||||
msum = ml + mu + 1;
|
||||
if (msum >= n) {
|
||||
|
||||
/* computation of dense approximate jacobian. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
temp = x[j];
|
||||
h = eps * fabs(temp);
|
||||
if (h == 0.) {
|
||||
h = eps;
|
||||
}
|
||||
x[j] = temp + h;
|
||||
/* the last parameter of fcn_nn() is set to 2 to differentiate
|
||||
calls made to compute the function from calls made to compute
|
||||
the Jacobian (see fcn() in examples/hybdrv.c, and how njev
|
||||
is used to compute the number of Jacobian evaluations) */
|
||||
iflag = fcn_nn(p, n, &x[1], &wa1[1], 2);
|
||||
if (iflag < 0) {
|
||||
return iflag;
|
||||
}
|
||||
x[j] = temp;
|
||||
for (i = 1; i <= n; ++i) {
|
||||
fjac[i + j * fjac_dim1] = (wa1[i] - fvec[i]) / h;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* computation of banded approximate jacobian. */
|
||||
|
||||
for (k = 1; k <= msum; ++k) {
|
||||
for (j = k; j <= n; j += msum) {
|
||||
wa2[j] = x[j];
|
||||
h = eps * fabs(wa2[j]);
|
||||
if (h == 0.) {
|
||||
h = eps;
|
||||
}
|
||||
x[j] = wa2[j] + h;
|
||||
}
|
||||
iflag = fcn_nn(p, n, &x[1], &wa1[1], 1);
|
||||
if (iflag < 0) {
|
||||
return iflag;
|
||||
}
|
||||
for (j = k; j <= n; j += msum) {
|
||||
x[j] = wa2[j];
|
||||
h = eps * fabs(wa2[j]);
|
||||
if (h == 0.) {
|
||||
h = eps;
|
||||
}
|
||||
for (i = 1; i <= n; ++i) {
|
||||
fjac[i + j * fjac_dim1] = 0.;
|
||||
if (i >= j - mu && i <= j + ml) {
|
||||
fjac[i + j * fjac_dim1] = (wa1[i] - fvec[i]) / h;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
/* last card of subroutine fdjac1. */
|
||||
|
||||
} /* fdjac1_ */
|
||||
|
||||
|
|
@ -0,0 +1,209 @@
|
|||
/* fdjac1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(fdjac1)(__minpack_decl_fcn_nn__ const int *n, real *x, const real *
|
||||
fvec, real *fjac, const int *ldfjac, int *iflag, const int *ml,
|
||||
const int *mu, const real *epsfcn, real *wa1, real *wa2)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2, i__3, i__4;
|
||||
|
||||
/* Local variables */
|
||||
real h__;
|
||||
int i__, j, k;
|
||||
real eps, temp;
|
||||
int msum;
|
||||
real epsmch;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine fdjac1 */
|
||||
|
||||
/* this subroutine computes a forward-difference approximation */
|
||||
/* to the n by n jacobian matrix associated with a specified */
|
||||
/* problem of n functions in n variables. if the jacobian has */
|
||||
/* a banded form, then function evaluations are saved by only */
|
||||
/* approximating the nonzero terms. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine fdjac1(fcn,n,x,fvec,fjac,ldfjac,iflag,ml,mu,epsfcn, */
|
||||
/* wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of fdjac1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an input array of length n which must contain the */
|
||||
/* functions evaluated at x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* approximation to the jacobian matrix evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* iflag is an integer variable which can be used to terminate */
|
||||
/* the execution of fdjac1. see description of fcn. */
|
||||
|
||||
/* ml is a nonnegative integer input variable which specifies */
|
||||
/* the number of subdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* ml to at least n - 1. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* mu is a nonnegative integer input variable which specifies */
|
||||
/* the number of superdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* mu to at least n - 1. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. if ml + mu + 1 is at */
|
||||
/* least n, then the jacobian is considered dense, and wa2 is */
|
||||
/* not referenced. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa2;
|
||||
--wa1;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
eps = sqrt((max(*epsfcn,epsmch)));
|
||||
msum = *ml + *mu + 1;
|
||||
if (msum < *n) {
|
||||
goto L40;
|
||||
}
|
||||
|
||||
/* computation of dense approximate jacobian. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
temp = x[j];
|
||||
h__ = eps * fabs(temp);
|
||||
if (h__ == 0.) {
|
||||
h__ = eps;
|
||||
}
|
||||
x[j] = temp + h__;
|
||||
fcn_nn(n, &x[1], &wa1[1], iflag);
|
||||
if (*iflag < 0) {
|
||||
goto L30;
|
||||
}
|
||||
x[j] = temp;
|
||||
i__2 = *n;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
fjac[i__ + j * fjac_dim1] = (wa1[i__] - fvec[i__]) / h__;
|
||||
/* L10: */
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
L30:
|
||||
/* goto L110; */
|
||||
return;
|
||||
L40:
|
||||
|
||||
/* computation of banded approximate jacobian. */
|
||||
|
||||
i__1 = msum;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
i__2 = *n;
|
||||
i__3 = msum;
|
||||
for (j = k; j <= i__2; j += i__3) {
|
||||
wa2[j] = x[j];
|
||||
h__ = eps * fabs(wa2[j]);
|
||||
if (h__ == 0.) {
|
||||
h__ = eps;
|
||||
}
|
||||
x[j] = wa2[j] + h__;
|
||||
/* L60: */
|
||||
}
|
||||
fcn_nn(n, &x[1], &wa1[1], iflag);
|
||||
if (*iflag < 0) {
|
||||
/* goto L100; */
|
||||
return;
|
||||
}
|
||||
i__3 = *n;
|
||||
i__2 = msum;
|
||||
for (j = k; j <= i__3; j += i__2) {
|
||||
x[j] = wa2[j];
|
||||
h__ = eps * fabs(wa2[j]);
|
||||
if (h__ == 0.) {
|
||||
h__ = eps;
|
||||
}
|
||||
i__4 = *n;
|
||||
for (i__ = 1; i__ <= i__4; ++i__) {
|
||||
fjac[i__ + j * fjac_dim1] = 0.;
|
||||
if (i__ >= j - *mu && i__ <= j + *ml) {
|
||||
fjac[i__ + j * fjac_dim1] = (wa1[i__] - fvec[i__]) / h__;
|
||||
}
|
||||
/* L70: */
|
||||
}
|
||||
/* L80: */
|
||||
}
|
||||
/* L90: */
|
||||
}
|
||||
/* L100: */
|
||||
/* L110: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine fdjac1. */
|
||||
|
||||
} /* fdjac1_ */
|
||||
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(fdjac2)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
|
||||
const real *fvec, real *fjac, int ldfjac,
|
||||
real epsfcn, real *wa)
|
||||
{
|
||||
/* Local variables */
|
||||
real h;
|
||||
int i, j;
|
||||
real eps, temp, epsmch;
|
||||
int iflag;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine fdjac2 */
|
||||
|
||||
/* this subroutine computes a forward-difference approximation */
|
||||
/* to the m by n jacobian matrix associated with a specified */
|
||||
/* problem of m functions in n variables. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of fdjac2. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an input array of length m which must contain the */
|
||||
/* functions evaluated at x. */
|
||||
|
||||
/* fjac is an output m by n array which contains the */
|
||||
/* approximation to the jacobian matrix evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* iflag is an integer variable which can be used to terminate */
|
||||
/* the execution of fdjac2. see description of fcn. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* wa is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
eps = sqrt((max(epsfcn,epsmch)));
|
||||
for (j = 0; j < n; ++j) {
|
||||
temp = x[j];
|
||||
h = eps * fabs(temp);
|
||||
if (h == 0.) {
|
||||
h = eps;
|
||||
}
|
||||
x[j] = temp + h;
|
||||
/* the last parameter of fcn_mn() is set to 2 to differentiate
|
||||
calls made to compute the function from calls made to compute
|
||||
the Jacobian (see fcn() in examples/lmfdrv.c, and how njev
|
||||
is used to compute the number of Jacobian evaluations) */
|
||||
iflag = fcn_mn(p, m, n, x, wa, 2);
|
||||
if (iflag < 0) {
|
||||
return iflag;
|
||||
}
|
||||
x[j] = temp;
|
||||
for (i = 0; i < m; ++i) {
|
||||
fjac[i + j * ldfjac] = (wa[i] - fvec[i]) / h;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
||||
/* last card of subroutine fdjac2. */
|
||||
|
||||
} /* fdjac2_ */
|
||||
|
||||
|
|
@ -0,0 +1,144 @@
|
|||
/* fdjac2.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(fdjac2)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
|
||||
const real *fvec, real *fjac, const int *ldfjac, int *iflag,
|
||||
const real *epsfcn, real *wa)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
|
||||
/* Local variables */
|
||||
real h__;
|
||||
int i__, j;
|
||||
real eps, temp, epsmch;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine fdjac2 */
|
||||
|
||||
/* this subroutine computes a forward-difference approximation */
|
||||
/* to the m by n jacobian matrix associated with a specified */
|
||||
/* problem of m functions in n variables. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine fdjac2(fcn,m,n,x,fvec,fjac,ldfjac,iflag,epsfcn,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of fdjac2. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an input array of length n. */
|
||||
|
||||
/* fvec is an input array of length m which must contain the */
|
||||
/* functions evaluated at x. */
|
||||
|
||||
/* fjac is an output m by n array which contains the */
|
||||
/* approximation to the jacobian matrix evaluated at x. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* iflag is an integer variable which can be used to terminate */
|
||||
/* the execution of fdjac2. see description of fcn. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* wa is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
eps = sqrt((max(*epsfcn,epsmch)));
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
temp = x[j];
|
||||
h__ = eps * fabs(temp);
|
||||
if (h__ == 0.) {
|
||||
h__ = eps;
|
||||
}
|
||||
x[j] = temp + h__;
|
||||
fcn_mn(m, n, &x[1], &wa[1], iflag);
|
||||
if (*iflag < 0) {
|
||||
/* goto L30; */
|
||||
return;
|
||||
}
|
||||
x[j] = temp;
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
fjac[i__ + j * fjac_dim1] = (wa[i__] - fvec[i__]) / h__;
|
||||
/* L10: */
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
/* L30: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine fdjac2. */
|
||||
|
||||
} /* fdjac2_ */
|
||||
|
||||
|
|
@ -0,0 +1,570 @@
|
|||
/* hybrd.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(hybrd)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, real *
|
||||
fvec, real xtol, int maxfev, int ml, int mu,
|
||||
real epsfcn, real *diag, int mode, real
|
||||
factor, int nprint, int *nfev, real *
|
||||
fjac, int ldfjac, real *r, int lr, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p001 .001
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i1;
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l, jm1, iwa[1];
|
||||
real sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp;
|
||||
int msum, iflag;
|
||||
real delta = 0.;
|
||||
int jeval;
|
||||
int ncsuc;
|
||||
real ratio;
|
||||
real fnorm;
|
||||
real pnorm, xnorm = 0., fnorm1;
|
||||
int nslow1, nslow2;
|
||||
int ncfail;
|
||||
real actred, epsmch, prered;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrd */
|
||||
|
||||
/* the purpose of hybrd is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn, */
|
||||
/* diag,mode,factor,nprint,info,nfev,fjac, */
|
||||
/* ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrd. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn is at least maxfev */
|
||||
/* by the end of an iteration. */
|
||||
|
||||
/* ml is a nonnegative integer input variable which specifies */
|
||||
/* the number of subdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* ml to at least n - 1. */
|
||||
|
||||
/* mu is a nonnegative integer input variable which specifies */
|
||||
/* the number of superdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* mu to at least n - 1. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 2 number of calls to fcn has reached or exceeded */
|
||||
/* maxfev. */
|
||||
|
||||
/* info = 3 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* five jacobian evaluations. */
|
||||
|
||||
/* info = 5 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* ten iterations. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* r is an output array of length lr which contains the */
|
||||
/* upper triangular matrix produced by the qr factorization */
|
||||
/* of the final approximate jacobian, stored rowwise. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dogleg,dpmpar,enorm,fdjac1, */
|
||||
/* qform,qrfac,r1mpyq,r1updt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,min0,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--diag;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--r;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || xtol < 0. || maxfev <= 0 || ml < 0 || mu < 0 ||
|
||||
factor <= 0. || ldfjac < n || lr < n * (n + 1) / 2) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
if (mode == 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = fcn_nn(p, n, &x[1], &fvec[1], 1);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm = __cminpack_enorm__(n, &fvec[1]);
|
||||
|
||||
/* determine the number of calls to fcn needed to compute */
|
||||
/* the jacobian matrix. */
|
||||
|
||||
/* Computing MIN */
|
||||
i1 = ml + mu + 1;
|
||||
msum = min(i1,n);
|
||||
|
||||
/* initialize iteration counter and monitors. */
|
||||
|
||||
iter = 1;
|
||||
ncsuc = 0;
|
||||
ncfail = 0;
|
||||
nslow1 = 0;
|
||||
nslow2 = 0;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
for (;;) {
|
||||
jeval = TRUE_;
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = __cminpack_func__(fdjac1)(__cminpack_param_fcn_nn__ p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac,
|
||||
ml, mu, epsfcn, &wa1[1], &wa2[1]);
|
||||
*nfev += msum;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__cminpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, FALSE_, iwa, 1,
|
||||
&wa1[1], &wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter == 1) {
|
||||
if (mode != 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, &wa3[1]);
|
||||
delta = factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = factor;
|
||||
}
|
||||
}
|
||||
|
||||
/* form (q transpose)*fvec and store in qtf. */
|
||||
|
||||
for (i = 1; i <= n; ++i) {
|
||||
qtf[i] = fvec[i];
|
||||
}
|
||||
for (j = 1; j <= n; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = j; i <= n; ++i) {
|
||||
sum += fjac[i + j * fjac_dim1] * qtf[i];
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
for (i = j; i <= n; ++i) {
|
||||
qtf[i] += fjac[i + j * fjac_dim1] * temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* copy the triangular factor of the qr factorization into r. */
|
||||
|
||||
sing = FALSE_;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
l = j;
|
||||
jm1 = j - 1;
|
||||
if (jm1 >= 1) {
|
||||
for (i = 1; i <= jm1; ++i) {
|
||||
r[l] = fjac[i + j * fjac_dim1];
|
||||
l = l + n - i;
|
||||
}
|
||||
}
|
||||
r[l] = wa1[j];
|
||||
if (wa1[j] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
}
|
||||
|
||||
/* accumulate the orthogonal factor in fjac. */
|
||||
|
||||
__cminpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (mode != 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
/* Computing MAX */
|
||||
d1 = diag[j], d2 = wa2[j];
|
||||
diag[j] = max(d1,d2);
|
||||
}
|
||||
}
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (nprint > 0) {
|
||||
iflag = 0;
|
||||
if ((iter - 1) % nprint == 0) {
|
||||
iflag = fcn_nn(p, n, &x[1], &fvec[1], 0);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
|
||||
/* determine the direction p. */
|
||||
|
||||
__cminpack_func__(dogleg)(n, &r[1], lr, &diag[1], &qtf[1], delta, &wa1[1], &wa2[1], &wa3[1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
}
|
||||
pnorm = __cminpack_enorm__(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = fcn_nn(p, n, &wa2[1], &wa4[1], 1);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm1 = __cminpack_enorm__(n, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = fnorm1 / fnorm;
|
||||
actred = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction. */
|
||||
|
||||
l = 1;
|
||||
for (i = 1; i <= n; ++i) {
|
||||
sum = 0.;
|
||||
for (j = i; j <= n; ++j) {
|
||||
sum += r[l] * wa1[j];
|
||||
++l;
|
||||
}
|
||||
wa3[i] = qtf[i] + sum;
|
||||
}
|
||||
temp = __cminpack_enorm__(n, &wa3[1]);
|
||||
prered = 0.;
|
||||
if (temp < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = temp / fnorm;
|
||||
prered = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered > 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio < p1) {
|
||||
ncsuc = 0;
|
||||
++ncfail;
|
||||
delta = p5 * delta;
|
||||
} else {
|
||||
ncfail = 0;
|
||||
++ncsuc;
|
||||
if (ratio >= p5 || ncsuc > 1) {
|
||||
/* Computing MAX */
|
||||
d1 = pnorm / p5;
|
||||
delta = max(delta,d1);
|
||||
}
|
||||
if (fabs(ratio - 1.) <= p1) {
|
||||
delta = pnorm / p5;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio >= p0001) {
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
fvec[j] = wa4[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
}
|
||||
|
||||
/* determine the progress of the iteration. */
|
||||
|
||||
++nslow1;
|
||||
if (actred >= p001) {
|
||||
nslow1 = 0;
|
||||
}
|
||||
if (jeval) {
|
||||
++nslow2;
|
||||
}
|
||||
if (actred >= p1) {
|
||||
nslow2 = 0;
|
||||
}
|
||||
|
||||
/* test for convergence. */
|
||||
|
||||
if (delta <= xtol * xnorm || fnorm == 0.) {
|
||||
info = 1;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= maxfev) {
|
||||
info = 2;
|
||||
}
|
||||
/* Computing MAX */
|
||||
d1 = p1 * delta;
|
||||
if (p1 * max(d1,pnorm) <= epsmch * xnorm) {
|
||||
info = 3;
|
||||
}
|
||||
if (nslow2 == 5) {
|
||||
info = 4;
|
||||
}
|
||||
if (nslow1 == 10) {
|
||||
info = 5;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* criterion for recalculating jacobian approximation */
|
||||
/* by forward differences. */
|
||||
|
||||
if (ncfail == 2) {
|
||||
goto TERMINATE_INNER_LOOP;
|
||||
}
|
||||
|
||||
/* calculate the rank one modification to the jacobian */
|
||||
/* and update qtf if necessary. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
sum = 0.;
|
||||
for (i = 1; i <= n; ++i) {
|
||||
sum += fjac[i + j * fjac_dim1] * wa4[i];
|
||||
}
|
||||
wa2[j] = (sum - wa3[j]) / pnorm;
|
||||
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
|
||||
if (ratio >= p0001) {
|
||||
qtf[j] = sum;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the updated jacobian. */
|
||||
|
||||
__cminpack_func__(r1updt)(n, n, &r[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
|
||||
__cminpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
|
||||
__cminpack_func__(r1mpyq)(1, n, &qtf[1], 1, &wa2[1], &wa3[1]);
|
||||
|
||||
/* end of the inner loop. */
|
||||
|
||||
jeval = FALSE_;
|
||||
}
|
||||
TERMINATE_INNER_LOOP:
|
||||
;
|
||||
/* end of the outer loop. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
info = iflag;
|
||||
}
|
||||
if (nprint > 0) {
|
||||
fcn_nn(p, n, &x[1], &fvec[1], 0);
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine hybrd. */
|
||||
|
||||
} /* hybrd_ */
|
||||
|
||||
|
|
@ -0,0 +1,148 @@
|
|||
/* hybrd1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(hybrd1)(__cminpack_decl_fcn_nn__ void *p, int n, real *x, real *
|
||||
fvec, real tol, real *wa, int lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* Local variables */
|
||||
int j, ml, lr, mu, mode, nfev;
|
||||
real xtol;
|
||||
int index;
|
||||
real epsfcn;
|
||||
int maxfev, nprint;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrd1 */
|
||||
|
||||
/* the purpose of hybrd1 is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. this is done by using the */
|
||||
/* more general nonlinear equation solver hybrd. the user */
|
||||
/* must provide a subroutine which calculates the functions. */
|
||||
/* the jacobian is then calculated by a forward-difference */
|
||||
/* approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrd1(fcn,n,x,fvec,tol,info,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrd1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 2 number of calls to fcn has reached or exceeded */
|
||||
/* 200*(n+1). */
|
||||
|
||||
/* info = 3 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* (n*(3*n+13))/2. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... hybrd */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--x;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || tol < 0. || lwa < n * (n * 3 + 13) / 2) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* call hybrd. */
|
||||
|
||||
maxfev = (n + 1) * 200;
|
||||
xtol = tol;
|
||||
ml = n - 1;
|
||||
mu = n - 1;
|
||||
epsfcn = 0.;
|
||||
mode = 2;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa[j] = 1.;
|
||||
}
|
||||
nprint = 0;
|
||||
lr = n * (n + 1) / 2;
|
||||
index = n * 6 + lr;
|
||||
info = __cminpack_func__(hybrd)(__cminpack_param_fcn_nn__ p, n, &x[1], &fvec[1], xtol, maxfev, ml, mu, epsfcn, &
|
||||
wa[1], mode, factor, nprint, &nfev, &wa[index + 1], n, &
|
||||
wa[n * 6 + 1], lr, &wa[n + 1], &wa[(n << 1) + 1], &wa[n * 3
|
||||
+ 1], &wa[(n << 2) + 1], &wa[n * 5 + 1]);
|
||||
if (info == 5) {
|
||||
info = 4;
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine hybrd1. */
|
||||
|
||||
} /* hybrd1_ */
|
||||
|
||||
|
|
@ -0,0 +1,156 @@
|
|||
/* hybrd1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(hybrd1)(__minpack_decl_fcn_nn__ const int *n, real *x, real *
|
||||
fvec, const real *tol, int *info, real *wa, const int *lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* System generated locals */
|
||||
int i__1;
|
||||
|
||||
/* Local variables */
|
||||
int j, ml, lr, mu, mode, nfev;
|
||||
real xtol;
|
||||
int index;
|
||||
real epsfcn;
|
||||
int maxfev, nprint;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrd1 */
|
||||
|
||||
/* the purpose of hybrd1 is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. this is done by using the */
|
||||
/* more general nonlinear equation solver hybrd. the user */
|
||||
/* must provide a subroutine which calculates the functions. */
|
||||
/* the jacobian is then calculated by a forward-difference */
|
||||
/* approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrd1(fcn,n,x,fvec,tol,info,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrd1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 2 number of calls to fcn has reached or exceeded */
|
||||
/* 200*(n+1). */
|
||||
|
||||
/* info = 3 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* (n*(3*n+13))/2. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... hybrd */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--x;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
*info = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *tol < 0. || *lwa < *n * (*n * 3 + 13) / 2) {
|
||||
/* goto L20; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* call hybrd. */
|
||||
|
||||
maxfev = (*n + 1) * 200;
|
||||
xtol = *tol;
|
||||
ml = *n - 1;
|
||||
mu = *n - 1;
|
||||
epsfcn = 0.;
|
||||
mode = 2;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa[j] = 1.;
|
||||
/* L10: */
|
||||
}
|
||||
nprint = 0;
|
||||
lr = *n * (*n + 1) / 2;
|
||||
index = *n * 6 + lr;
|
||||
__minpack_func__(hybrd)(__minpack_param_fcn_nn__ n, &x[1], &fvec[1], &xtol, &maxfev, &ml, &mu, &epsfcn, &
|
||||
wa[1], &mode, &factor, &nprint, info, &nfev, &wa[index + 1], n, &
|
||||
wa[*n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3
|
||||
+ 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
|
||||
if (*info == 5) {
|
||||
*info = 4;
|
||||
}
|
||||
/* L20: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine hybrd1. */
|
||||
|
||||
} /* hybrd1_ */
|
||||
|
||||
|
|
@ -0,0 +1,631 @@
|
|||
/* hybrd.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(hybrd)(__minpack_decl_fcn_nn__ const int *n, real *x, real *
|
||||
fvec, const real *xtol, const int *maxfev, const int *ml, const int *mu,
|
||||
const real *epsfcn, real *diag, const int *mode, const real *
|
||||
factor, const int *nprint, int *info, int *nfev, real *
|
||||
fjac, const int *ldfjac, real *r__, const int *lr, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
const int c_false = FALSE_;
|
||||
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p001 .001
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l, jm1, iwa[1];
|
||||
real sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp;
|
||||
int msum, iflag;
|
||||
real delta;
|
||||
int jeval;
|
||||
int ncsuc;
|
||||
real ratio;
|
||||
real fnorm;
|
||||
real pnorm, xnorm = 0, fnorm1;
|
||||
int nslow1, nslow2;
|
||||
int ncfail;
|
||||
real actred, epsmch, prered;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrd */
|
||||
|
||||
/* the purpose of hybrd is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrd(fcn,n,x,fvec,xtol,maxfev,ml,mu,epsfcn, */
|
||||
/* diag,mode,factor,nprint,info,nfev,fjac, */
|
||||
/* ldfjac,r,lr,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,iflag) */
|
||||
/* integer n,iflag */
|
||||
/* double precision x(n),fvec(n) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrd. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn is at least maxfev */
|
||||
/* by the end of an iteration. */
|
||||
|
||||
/* ml is a nonnegative integer input variable which specifies */
|
||||
/* the number of subdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* ml to at least n - 1. */
|
||||
|
||||
/* mu is a nonnegative integer input variable which specifies */
|
||||
/* the number of superdiagonals within the band of the */
|
||||
/* jacobian matrix. if the jacobian is not banded, set */
|
||||
/* mu to at least n - 1. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 2 number of calls to fcn has reached or exceeded */
|
||||
/* maxfev. */
|
||||
|
||||
/* info = 3 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* five jacobian evaluations. */
|
||||
|
||||
/* info = 5 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* ten iterations. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* r is an output array of length lr which contains the */
|
||||
/* upper triangular matrix produced by the qr factorization */
|
||||
/* of the final approximate jacobian, stored rowwise. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dogleg,dpmpar,enorm,fdjac1, */
|
||||
/* qform,qrfac,r1mpyq,r1updt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,min0,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--diag;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--r__;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
*info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *xtol < 0. || *maxfev <= 0 || *ml < 0 || *mu < 0 || *
|
||||
factor <= 0. || *ldfjac < *n || *lr < *n * (*n + 1) / 2) {
|
||||
goto L300;
|
||||
}
|
||||
if (*mode != 2) {
|
||||
goto L20;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcn_nn(n, &x[1], &fvec[1], &iflag);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm = __minpack_func__(enorm)(n, &fvec[1]);
|
||||
|
||||
/* determine the number of calls to fcn needed to compute */
|
||||
/* the jacobian matrix. */
|
||||
|
||||
/* Computing MIN */
|
||||
i__1 = *ml + *mu + 1;
|
||||
msum = min(i__1,*n);
|
||||
|
||||
/* initialize iteration counter and monitors. */
|
||||
|
||||
iter = 1;
|
||||
ncsuc = 0;
|
||||
ncfail = 0;
|
||||
nslow1 = 0;
|
||||
nslow2 = 0;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
L30:
|
||||
jeval = TRUE_;
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = 2;
|
||||
__minpack_func__(fdjac1)(__minpack_param_fcn_nn__ n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag,
|
||||
ml, mu, epsfcn, &wa1[1], &wa2[1]);
|
||||
*nfev += msum;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_false, iwa, &c__1, &wa1[1], &
|
||||
wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter != 1) {
|
||||
goto L70;
|
||||
}
|
||||
if (*mode == 2) {
|
||||
goto L50;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
/* L40: */
|
||||
}
|
||||
L50:
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
/* L60: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
delta = *factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = *factor;
|
||||
}
|
||||
L70:
|
||||
|
||||
/* form (q transpose)*fvec and store in qtf. */
|
||||
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
qtf[i__] = fvec[i__];
|
||||
/* L80: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
goto L110;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
|
||||
/* L90: */
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L100: */
|
||||
}
|
||||
L110:
|
||||
/* L120: */
|
||||
;
|
||||
}
|
||||
|
||||
/* copy the triangular factor of the qr factorization into r. */
|
||||
|
||||
sing = FALSE_;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = j;
|
||||
jm1 = j - 1;
|
||||
if (jm1 < 1) {
|
||||
goto L140;
|
||||
}
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
r__[l] = fjac[i__ + j * fjac_dim1];
|
||||
l = l + *n - i__;
|
||||
/* L130: */
|
||||
}
|
||||
L140:
|
||||
r__[l] = wa1[j];
|
||||
if (wa1[j] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
/* L150: */
|
||||
}
|
||||
|
||||
/* accumulate the orthogonal factor in fjac. */
|
||||
|
||||
__minpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L170;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
/* Computing MAX */
|
||||
d__1 = diag[j], d__2 = wa2[j];
|
||||
diag[j] = max(d__1,d__2);
|
||||
/* L160: */
|
||||
}
|
||||
L170:
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
L180:
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (*nprint <= 0) {
|
||||
goto L190;
|
||||
}
|
||||
iflag = 0;
|
||||
if ((iter - 1) % *nprint == 0) {
|
||||
fcn_nn(n, &x[1], &fvec[1], &iflag);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
L190:
|
||||
|
||||
/* determine the direction p. */
|
||||
|
||||
__minpack_func__(dogleg)(n, &r__[1], lr, &diag[1], &qtf[1], &delta, &wa1[1], &wa2[1], &wa3[
|
||||
1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
/* L200: */
|
||||
}
|
||||
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcn_nn(n, &wa2[1], &wa4[1], &iflag);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm1 = __minpack_func__(enorm)(n, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = fnorm1 / fnorm;
|
||||
actred = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction. */
|
||||
|
||||
l = 1;
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (j = i__; j <= i__2; ++j) {
|
||||
sum += r__[l] * wa1[j];
|
||||
++l;
|
||||
/* L210: */
|
||||
}
|
||||
wa3[i__] = qtf[i__] + sum;
|
||||
/* L220: */
|
||||
}
|
||||
temp = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
prered = 0.;
|
||||
if (temp < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp / fnorm;
|
||||
prered = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered > 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio >= p1) {
|
||||
goto L230;
|
||||
}
|
||||
ncsuc = 0;
|
||||
++ncfail;
|
||||
delta = p5 * delta;
|
||||
goto L240;
|
||||
L230:
|
||||
ncfail = 0;
|
||||
++ncsuc;
|
||||
if (ratio >= p5 || ncsuc > 1) {
|
||||
/* Computing MAX */
|
||||
d__1 = delta, d__2 = pnorm / p5;
|
||||
delta = max(d__1,d__2);
|
||||
}
|
||||
if (fabs(ratio - 1.) <= p1) {
|
||||
delta = pnorm / p5;
|
||||
}
|
||||
L240:
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L260;
|
||||
}
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
fvec[j] = wa4[j];
|
||||
/* L250: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
L260:
|
||||
|
||||
/* determine the progress of the iteration. */
|
||||
|
||||
++nslow1;
|
||||
if (actred >= p001) {
|
||||
nslow1 = 0;
|
||||
}
|
||||
if (jeval) {
|
||||
++nslow2;
|
||||
}
|
||||
if (actred >= p1) {
|
||||
nslow2 = 0;
|
||||
}
|
||||
|
||||
/* test for convergence. */
|
||||
|
||||
if (delta <= *xtol * xnorm || fnorm == 0.) {
|
||||
*info = 1;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= *maxfev) {
|
||||
*info = 2;
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__1 = p1 * delta;
|
||||
if (p1 * max(d__1,pnorm) <= epsmch * xnorm) {
|
||||
*info = 3;
|
||||
}
|
||||
if (nslow2 == 5) {
|
||||
*info = 4;
|
||||
}
|
||||
if (nslow1 == 10) {
|
||||
*info = 5;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* criterion for recalculating jacobian approximation */
|
||||
/* by forward differences. */
|
||||
|
||||
if (ncfail == 2) {
|
||||
goto L290;
|
||||
}
|
||||
|
||||
/* calculate the rank one modification to the jacobian */
|
||||
/* and update qtf if necessary. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
|
||||
/* L270: */
|
||||
}
|
||||
wa2[j] = (sum - wa3[j]) / pnorm;
|
||||
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
|
||||
if (ratio >= p0001) {
|
||||
qtf[j] = sum;
|
||||
}
|
||||
/* L280: */
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the updated jacobian. */
|
||||
|
||||
__minpack_func__(r1updt)(n, n, &r__[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
|
||||
__minpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
|
||||
__minpack_func__(r1mpyq)(&c__1, n, &qtf[1], &c__1, &wa2[1], &wa3[1]);
|
||||
|
||||
/* end of the inner loop. */
|
||||
|
||||
jeval = FALSE_;
|
||||
goto L180;
|
||||
L290:
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
goto L30;
|
||||
L300:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
*info = iflag;
|
||||
}
|
||||
iflag = 0;
|
||||
if (*nprint > 0) {
|
||||
fcn_nn(n, &x[1], &fvec[1], &iflag);
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine hybrd. */
|
||||
|
||||
} /* hybrd_ */
|
||||
|
||||
|
|
@ -0,0 +1,549 @@
|
|||
/* hybrj.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(hybrj)(__cminpack_decl_fcnder_nn__ void *p, int n, real *x, real *
|
||||
fvec, real *fjac, int ldfjac, real xtol, int
|
||||
maxfev, real *diag, int mode, real factor, int
|
||||
nprint, int *nfev, int *njev, real *r,
|
||||
int lr, real *qtf, real *wa1, real *wa2,
|
||||
real *wa3, real *wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p001 .001
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset;
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l, jm1, iwa[1];
|
||||
real sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp;
|
||||
int iflag;
|
||||
real delta = 0.;
|
||||
int jeval;
|
||||
int ncsuc;
|
||||
real ratio;
|
||||
real fnorm;
|
||||
real pnorm, xnorm = 0., fnorm1;
|
||||
int nslow1, nslow2;
|
||||
int ncfail;
|
||||
real actred, epsmch, prered;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrj */
|
||||
|
||||
/* the purpose of hybrj is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag, */
|
||||
/* mode,factor,nprint,info,nfev,njev,r,lr,qtf, */
|
||||
/* wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(n),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrj. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. fvec and fjac should not be altered. */
|
||||
/* if nprint is not positive, no special calls of fcn */
|
||||
/* with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 2 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 3 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* five jacobian evaluations. */
|
||||
|
||||
/* info = 5 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* ten iterations. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* r is an output array of length lr which contains the */
|
||||
/* upper triangular matrix produced by the qr factorization */
|
||||
/* of the final approximate jacobian, stored rowwise. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dogleg,dpmpar,enorm, */
|
||||
/* qform,qrfac,r1mpyq,r1updt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--diag;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--r;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || ldfjac < n || xtol < 0. || maxfev <= 0 || factor <=
|
||||
0. || lr < n * (n + 1) / 2) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
if (mode == 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 1);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm = __cminpack_enorm__(n, &fvec[1]);
|
||||
|
||||
/* initialize iteration counter and monitors. */
|
||||
|
||||
iter = 1;
|
||||
ncsuc = 0;
|
||||
ncfail = 0;
|
||||
nslow1 = 0;
|
||||
nslow2 = 0;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
for (;;) {
|
||||
jeval = TRUE_;
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 2);
|
||||
++(*njev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__cminpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, FALSE_, iwa, 1,
|
||||
&wa1[1], &wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter == 1) {
|
||||
if (mode != 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, &wa3[1]);
|
||||
delta = factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = factor;
|
||||
}
|
||||
}
|
||||
|
||||
/* form (q transpose)*fvec and store in qtf. */
|
||||
|
||||
for (i = 1; i <= n; ++i) {
|
||||
qtf[i] = fvec[i];
|
||||
}
|
||||
for (j = 1; j <= n; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = j; i <= n; ++i) {
|
||||
sum += fjac[i + j * fjac_dim1] * qtf[i];
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
for (i = j; i <= n; ++i) {
|
||||
qtf[i] += fjac[i + j * fjac_dim1] * temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* copy the triangular factor of the qr factorization into r. */
|
||||
|
||||
sing = FALSE_;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
l = j;
|
||||
jm1 = j - 1;
|
||||
if (jm1 >= 1) {
|
||||
for (i = 1; i <= jm1; ++i) {
|
||||
r[l] = fjac[i + j * fjac_dim1];
|
||||
l = l + n - i;
|
||||
}
|
||||
}
|
||||
r[l] = wa1[j];
|
||||
if (wa1[j] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
}
|
||||
|
||||
/* accumulate the orthogonal factor in fjac. */
|
||||
|
||||
__cminpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (mode != 2) {
|
||||
for (j = 1; j <= n; ++j) {
|
||||
/* Computing MAX */
|
||||
d1 = diag[j], d2 = wa2[j];
|
||||
diag[j] = max(d1,d2);
|
||||
}
|
||||
}
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (nprint > 0) {
|
||||
iflag = 0;
|
||||
if ((iter - 1) % nprint == 0) {
|
||||
iflag = fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 0);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
|
||||
/* determine the direction p. */
|
||||
|
||||
__cminpack_func__(dogleg)(n, &r[1], lr, &diag[1], &qtf[1], delta, &wa1[1], &wa2[1], &wa3[1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
}
|
||||
pnorm = __cminpack_enorm__(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = fcnder_nn(p, n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, 1);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm1 = __cminpack_enorm__(n, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = fnorm1 / fnorm;
|
||||
actred = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction. */
|
||||
|
||||
l = 1;
|
||||
for (i = 1; i <= n; ++i) {
|
||||
sum = 0.;
|
||||
for (j = i; j <= n; ++j) {
|
||||
sum += r[l] * wa1[j];
|
||||
++l;
|
||||
}
|
||||
wa3[i] = qtf[i] + sum;
|
||||
}
|
||||
temp = __cminpack_enorm__(n, &wa3[1]);
|
||||
prered = 0.;
|
||||
if (temp < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = temp / fnorm;
|
||||
prered = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered > 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio < p1) {
|
||||
ncsuc = 0;
|
||||
++ncfail;
|
||||
delta = p5 * delta;
|
||||
} else {
|
||||
ncfail = 0;
|
||||
++ncsuc;
|
||||
if (ratio >= p5 || ncsuc > 1) {
|
||||
/* Computing MAX */
|
||||
d1 = pnorm / p5;
|
||||
delta = max(delta,d1);
|
||||
}
|
||||
if (fabs(ratio - 1.) <= p1) {
|
||||
delta = pnorm / p5;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio >= p0001) {
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
fvec[j] = wa4[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
}
|
||||
|
||||
/* determine the progress of the iteration. */
|
||||
|
||||
++nslow1;
|
||||
if (actred >= p001) {
|
||||
nslow1 = 0;
|
||||
}
|
||||
if (jeval) {
|
||||
++nslow2;
|
||||
}
|
||||
if (actred >= p1) {
|
||||
nslow2 = 0;
|
||||
}
|
||||
|
||||
/* test for convergence. */
|
||||
|
||||
if (delta <= xtol * xnorm || fnorm == 0.) {
|
||||
info = 1;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= maxfev) {
|
||||
info = 2;
|
||||
}
|
||||
/* Computing MAX */
|
||||
d1 = p1 * delta;
|
||||
if (p1 * max(d1,pnorm) <= epsmch * xnorm) {
|
||||
info = 3;
|
||||
}
|
||||
if (nslow2 == 5) {
|
||||
info = 4;
|
||||
}
|
||||
if (nslow1 == 10) {
|
||||
info = 5;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* criterion for recalculating jacobian. */
|
||||
|
||||
if (ncfail == 2) {
|
||||
goto TERMINATE_INNER_LOOP;
|
||||
}
|
||||
|
||||
/* calculate the rank one modification to the jacobian */
|
||||
/* and update qtf if necessary. */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
sum = 0.;
|
||||
for (i = 1; i <= n; ++i) {
|
||||
sum += fjac[i + j * fjac_dim1] * wa4[i];
|
||||
}
|
||||
wa2[j] = (sum - wa3[j]) / pnorm;
|
||||
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
|
||||
if (ratio >= p0001) {
|
||||
qtf[j] = sum;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the updated jacobian. */
|
||||
|
||||
__cminpack_func__(r1updt)(n, n, &r[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
|
||||
__cminpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
|
||||
__cminpack_func__(r1mpyq)(1, n, &qtf[1], 1, &wa2[1], &wa3[1]);
|
||||
|
||||
/* end of the inner loop. */
|
||||
|
||||
jeval = FALSE_;
|
||||
}
|
||||
TERMINATE_INNER_LOOP:
|
||||
;
|
||||
/* end of the outer loop. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
info = iflag;
|
||||
}
|
||||
if (nprint > 0) {
|
||||
fcnder_nn(p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, 0);
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine hybrj. */
|
||||
|
||||
} /* hybrj_ */
|
||||
|
||||
|
|
@ -0,0 +1,158 @@
|
|||
/* hybrj1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(hybrj1)(__cminpack_decl_fcnder_nn__ void *p, int n, real *x, real *
|
||||
fvec, real *fjac, int ldfjac, real tol,
|
||||
real *wa, int lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset;
|
||||
|
||||
/* Local variables */
|
||||
int j, lr, mode, nfev, njev;
|
||||
real xtol;
|
||||
int maxfev, nprint;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrj1 */
|
||||
|
||||
/* the purpose of hybrj1 is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. this is done by using the */
|
||||
/* more general nonlinear equation solver hybrj. the user */
|
||||
/* must provide a subroutine which calculates the functions */
|
||||
/* and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(n),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrj1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 2 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 3 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* (n*(n+13))/2. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... hybrj */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || ldfjac < n || tol < 0. || lwa < n * (n + 13) / 2) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* call hybrj. */
|
||||
|
||||
maxfev = (n + 1) * 100;
|
||||
xtol = tol;
|
||||
mode = 2;
|
||||
for (j = 1; j <= n; ++j) {
|
||||
wa[j] = 1.;
|
||||
/* L10: */
|
||||
}
|
||||
nprint = 0;
|
||||
lr = n * (n + 1) / 2;
|
||||
info = __cminpack_func__(hybrj)(__cminpack_param_fcnder_nn__ p, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, xtol,
|
||||
maxfev, &wa[1], mode, factor, nprint, &nfev, &njev, &wa[
|
||||
n * 6 + 1], lr, &wa[n + 1], &wa[(n << 1) + 1], &wa[n * 3 + 1],
|
||||
&wa[(n << 2) + 1], &wa[n * 5 + 1]);
|
||||
if (info == 5) {
|
||||
info = 4;
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine hybrj1. */
|
||||
|
||||
} /* hybrj1_ */
|
||||
|
||||
|
|
@ -0,0 +1,163 @@
|
|||
/* hybrj1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(hybrj1)(__minpack_decl_fcnder_nn__ const int *n, real *x, real *
|
||||
fvec, real *fjac, const int *ldfjac, const real *tol, int *
|
||||
info, real *wa, const int *lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1;
|
||||
|
||||
/* Local variables */
|
||||
int j, lr, mode, nfev, njev;
|
||||
real xtol;
|
||||
int maxfev, nprint;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrj1 */
|
||||
|
||||
/* the purpose of hybrj1 is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. this is done by using the */
|
||||
/* more general nonlinear equation solver hybrj. the user */
|
||||
/* must provide a subroutine which calculates the functions */
|
||||
/* and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(n),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrj1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 2 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 3 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* (n*(n+13))/2. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... hybrj */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
*info = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *ldfjac < *n || *tol < 0. || *lwa < *n * (*n + 13) / 2) {
|
||||
/* goto L20; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* call hybrj. */
|
||||
|
||||
maxfev = (*n + 1) * 100;
|
||||
xtol = *tol;
|
||||
mode = 2;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa[j] = 1.;
|
||||
/* L10: */
|
||||
}
|
||||
nprint = 0;
|
||||
lr = *n * (*n + 1) / 2;
|
||||
__minpack_func__(hybrj)(__minpack_param_fcnder_nn__ n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &xtol, &
|
||||
maxfev, &wa[1], &mode, &factor, &nprint, info, &nfev, &njev, &wa[*
|
||||
n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1],
|
||||
&wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
|
||||
if (*info == 5) {
|
||||
*info = 4;
|
||||
}
|
||||
/* L20: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine hybrj1. */
|
||||
|
||||
} /* hybrj1_ */
|
||||
|
||||
|
|
@ -0,0 +1,608 @@
|
|||
/* hybrj.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(hybrj)(__minpack_decl_fcnder_nn__ const int *n, real *x, real *
|
||||
fvec, real *fjac, const int *ldfjac, const real *xtol, const int *
|
||||
maxfev, real *diag, const int *mode, const real *factor, const int *
|
||||
nprint, int *info, int *nfev, int *njev, real *r__,
|
||||
const int *lr, real *qtf, real *wa1, real *wa2,
|
||||
real *wa3, real *wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p001 .001
|
||||
#define p0001 1e-4
|
||||
const int c_false = FALSE_;
|
||||
const int c__1 = 1;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l, jm1, iwa[1];
|
||||
real sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp;
|
||||
int iflag;
|
||||
real delta;
|
||||
int jeval;
|
||||
int ncsuc;
|
||||
real ratio;
|
||||
real fnorm;
|
||||
real pnorm, xnorm = 0, fnorm1;
|
||||
int nslow1, nslow2;
|
||||
int ncfail;
|
||||
real actred, epsmch, prered;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine hybrj */
|
||||
|
||||
/* the purpose of hybrj is to find a zero of a system of */
|
||||
/* n nonlinear functions in n variables by a modification */
|
||||
/* of the powell hybrid method. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine hybrj(fcn,n,x,fvec,fjac,ldfjac,xtol,maxfev,diag, */
|
||||
/* mode,factor,nprint,info,nfev,njev,r,lr,qtf, */
|
||||
/* wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(n),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* --------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of hybrj. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of functions and variables. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length n which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array which contains the */
|
||||
/* orthogonal matrix q produced by the qr factorization */
|
||||
/* of the final approximate jacobian. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. fvec and fjac should not be altered. */
|
||||
/* if nprint is not positive, no special calls of fcn */
|
||||
/* with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 2 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 3 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 4 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* five jacobian evaluations. */
|
||||
|
||||
/* info = 5 iteration is not making good progress, as */
|
||||
/* measured by the improvement from the last */
|
||||
/* ten iterations. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* r is an output array of length lr which contains the */
|
||||
/* upper triangular matrix produced by the qr factorization */
|
||||
/* of the final approximate jacobian, stored rowwise. */
|
||||
|
||||
/* lr is a positive integer input variable not less than */
|
||||
/* (n*(n+1))/2. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, wa3, and wa4 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dogleg,dpmpar,enorm, */
|
||||
/* qform,qrfac,r1mpyq,r1updt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--diag;
|
||||
--fvec;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--r__;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
*info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *ldfjac < *n || *xtol < 0. || *maxfev <= 0 || *factor <=
|
||||
0. || *lr < *n * (*n + 1) / 2) {
|
||||
goto L300;
|
||||
}
|
||||
if (*mode != 2) {
|
||||
goto L20;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm = __minpack_func__(enorm)(n, &fvec[1]);
|
||||
|
||||
/* initialize iteration counter and monitors. */
|
||||
|
||||
iter = 1;
|
||||
ncsuc = 0;
|
||||
ncfail = 0;
|
||||
nslow1 = 0;
|
||||
nslow2 = 0;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
L30:
|
||||
jeval = TRUE_;
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = 2;
|
||||
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
++(*njev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_false, iwa, &c__1, &wa1[1], &
|
||||
wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter != 1) {
|
||||
goto L70;
|
||||
}
|
||||
if (*mode == 2) {
|
||||
goto L50;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
/* L40: */
|
||||
}
|
||||
L50:
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
/* L60: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
delta = *factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = *factor;
|
||||
}
|
||||
L70:
|
||||
|
||||
/* form (q transpose)*fvec and store in qtf. */
|
||||
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
qtf[i__] = fvec[i__];
|
||||
/* L80: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
goto L110;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
|
||||
/* L90: */
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L100: */
|
||||
}
|
||||
L110:
|
||||
/* L120: */
|
||||
;
|
||||
}
|
||||
|
||||
/* copy the triangular factor of the qr factorization into r. */
|
||||
|
||||
sing = FALSE_;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = j;
|
||||
jm1 = j - 1;
|
||||
if (jm1 < 1) {
|
||||
goto L140;
|
||||
}
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
r__[l] = fjac[i__ + j * fjac_dim1];
|
||||
l = l + *n - i__;
|
||||
/* L130: */
|
||||
}
|
||||
L140:
|
||||
r__[l] = wa1[j];
|
||||
if (wa1[j] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
/* L150: */
|
||||
}
|
||||
|
||||
/* accumulate the orthogonal factor in fjac. */
|
||||
|
||||
__minpack_func__(qform)(n, n, &fjac[fjac_offset], ldfjac, &wa1[1]);
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L170;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
/* Computing MAX */
|
||||
d__1 = diag[j], d__2 = wa2[j];
|
||||
diag[j] = max(d__1,d__2);
|
||||
/* L160: */
|
||||
}
|
||||
L170:
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
L180:
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (*nprint <= 0) {
|
||||
goto L190;
|
||||
}
|
||||
iflag = 0;
|
||||
if ((iter - 1) % *nprint == 0) {
|
||||
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
L190:
|
||||
|
||||
/* determine the direction p. */
|
||||
|
||||
__minpack_func__(dogleg)(n, &r__[1], lr, &diag[1], &qtf[1], &delta, &wa1[1], &wa2[1], &wa3[
|
||||
1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
/* L200: */
|
||||
}
|
||||
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnder_nn(n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm1 = __minpack_func__(enorm)(n, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = fnorm1 / fnorm;
|
||||
actred = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction. */
|
||||
|
||||
l = 1;
|
||||
i__1 = *n;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (j = i__; j <= i__2; ++j) {
|
||||
sum += r__[l] * wa1[j];
|
||||
++l;
|
||||
/* L210: */
|
||||
}
|
||||
wa3[i__] = qtf[i__] + sum;
|
||||
/* L220: */
|
||||
}
|
||||
temp = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
prered = 0.;
|
||||
if (temp < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp / fnorm;
|
||||
prered = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered > 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio >= p1) {
|
||||
goto L230;
|
||||
}
|
||||
ncsuc = 0;
|
||||
++ncfail;
|
||||
delta = p5 * delta;
|
||||
goto L240;
|
||||
L230:
|
||||
ncfail = 0;
|
||||
++ncsuc;
|
||||
if (ratio >= p5 || ncsuc > 1) {
|
||||
/* Computing MAX */
|
||||
d__1 = delta, d__2 = pnorm / p5;
|
||||
delta = max(d__1,d__2);
|
||||
}
|
||||
if (fabs(ratio - 1.) <= p1) {
|
||||
delta = pnorm / p5;
|
||||
}
|
||||
L240:
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L260;
|
||||
}
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
fvec[j] = wa4[j];
|
||||
/* L250: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
L260:
|
||||
|
||||
/* determine the progress of the iteration. */
|
||||
|
||||
++nslow1;
|
||||
if (actred >= p001) {
|
||||
nslow1 = 0;
|
||||
}
|
||||
if (jeval) {
|
||||
++nslow2;
|
||||
}
|
||||
if (actred >= p1) {
|
||||
nslow2 = 0;
|
||||
}
|
||||
|
||||
/* test for convergence. */
|
||||
|
||||
if (delta <= *xtol * xnorm || fnorm == 0.) {
|
||||
*info = 1;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= *maxfev) {
|
||||
*info = 2;
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__1 = p1 * delta;
|
||||
if (p1 * max(d__1,pnorm) <= epsmch * xnorm) {
|
||||
*info = 3;
|
||||
}
|
||||
if (nslow2 == 5) {
|
||||
*info = 4;
|
||||
}
|
||||
if (nslow1 == 10) {
|
||||
*info = 5;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* criterion for recalculating jacobian. */
|
||||
|
||||
if (ncfail == 2) {
|
||||
goto L290;
|
||||
}
|
||||
|
||||
/* calculate the rank one modification to the jacobian */
|
||||
/* and update qtf if necessary. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
|
||||
/* L270: */
|
||||
}
|
||||
wa2[j] = (sum - wa3[j]) / pnorm;
|
||||
wa1[j] = diag[j] * (diag[j] * wa1[j] / pnorm);
|
||||
if (ratio >= p0001) {
|
||||
qtf[j] = sum;
|
||||
}
|
||||
/* L280: */
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the updated jacobian. */
|
||||
|
||||
__minpack_func__(r1updt)(n, n, &r__[1], lr, &wa1[1], &wa2[1], &wa3[1], &sing);
|
||||
__minpack_func__(r1mpyq)(n, n, &fjac[fjac_offset], ldfjac, &wa2[1], &wa3[1]);
|
||||
__minpack_func__(r1mpyq)(&c__1, n, &qtf[1], &c__1, &wa2[1], &wa3[1]);
|
||||
|
||||
/* end of the inner loop. */
|
||||
|
||||
jeval = FALSE_;
|
||||
goto L180;
|
||||
L290:
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
goto L30;
|
||||
L300:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
*info = iflag;
|
||||
}
|
||||
iflag = 0;
|
||||
if (*nprint > 0) {
|
||||
fcnder_nn(n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine hybrj. */
|
||||
|
||||
} /* hybrj_ */
|
||||
|
||||
|
|
@ -0,0 +1,526 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmder)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real *fjac, int ldfjac, real ftol,
|
||||
real xtol, real gtol, int maxfev, real *
|
||||
diag, int mode, real factor, int nprint,
|
||||
int *nfev, int *njev, int *ipvt, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l;
|
||||
real par, sum;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta = 0.;
|
||||
real ratio;
|
||||
real fnorm, gnorm, pnorm, xnorm = 0., fnorm1, actred, dirder,
|
||||
epsmch, prered;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmder */
|
||||
|
||||
/* the purpose of lmder is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
|
||||
/* maxfev,diag,mode,factor,nprint,info,nfev, */
|
||||
/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer m,n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(m),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmder. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.).100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x, fvec, and fjac */
|
||||
/* available for printing. fvec and fjac should not be */
|
||||
/* altered. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || ldfjac < m || ftol < 0. || xtol < 0. ||
|
||||
gtol < 0. || maxfev <= 0 || factor <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
if (mode == 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 1);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm = __cminpack_enorm__(m, fvec);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 2);
|
||||
++(*njev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (nprint > 0) {
|
||||
iflag = 0;
|
||||
if ((iter - 1) % nprint == 0) {
|
||||
iflag = fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__cminpack_func__(qrfac)(m, n, fjac, ldfjac, TRUE_, ipvt, n,
|
||||
wa1, wa2, wa3);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter == 1) {
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa3);
|
||||
delta = factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = factor;
|
||||
}
|
||||
}
|
||||
|
||||
/* form (q transpose)*fvec and store the first n components in */
|
||||
/* qtf. */
|
||||
|
||||
for (i = 0; i < m; ++i) {
|
||||
wa4[i] = fvec[i];
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (fjac[j + j * ldfjac] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = j; i < m; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * wa4[i];
|
||||
}
|
||||
temp = -sum / fjac[j + j * ldfjac];
|
||||
for (i = j; i < m; ++i) {
|
||||
wa4[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
fjac[j + j * ldfjac] = wa1[j];
|
||||
qtf[j] = wa4[j];
|
||||
}
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm != 0.) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
if (wa2[l] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
|
||||
}
|
||||
/* Computing MAX */
|
||||
d1 = fabs(sum / wa2[l]);
|
||||
gnorm = max(gnorm,d1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= gtol) {
|
||||
info = 4;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
/* Computing MAX */
|
||||
d1 = diag[j], d2 = wa2[j];
|
||||
diag[j] = max(d1,d2);
|
||||
}
|
||||
}
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
do {
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__cminpack_func__(lmpar)(n, fjac, ldfjac, ipvt, diag, qtf, delta,
|
||||
&par, wa1, wa2, wa3, wa4);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
}
|
||||
pnorm = __cminpack_enorm__(n, wa3);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = fcnder_mn(p, m, n, wa2, wa4, fjac, ldfjac, 1);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm1 = __cminpack_enorm__(m, wa4);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = fnorm1 / fnorm;
|
||||
actred = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j]-1;
|
||||
temp = wa1[l];
|
||||
for (i = 0; i <= j; ++i) {
|
||||
wa3[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
temp1 = __cminpack_enorm__(n, wa3) / fnorm;
|
||||
temp2 = (sqrt(par) * pnorm) / fnorm;
|
||||
prered = temp1 * temp1 + temp2 * temp2 / p5;
|
||||
dirder = -(temp1 * temp1 + temp2 * temp2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio <= p25) {
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
} else {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d1 = pnorm / p1;
|
||||
delta = temp * min(delta,d1);
|
||||
par /= temp;
|
||||
} else {
|
||||
if (par == 0. || ratio >= p75) {
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio >= p0001) {
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
for (i = 0; i < m; ++i) {
|
||||
fvec[i] = wa4[i];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa2);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
}
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
|
||||
info = 1;
|
||||
}
|
||||
if (delta <= xtol * xnorm) {
|
||||
info = 2;
|
||||
}
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
|
||||
info = 3;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= maxfev) {
|
||||
info = 5;
|
||||
}
|
||||
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
info = 8;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
} while (ratio < p0001);
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
info = iflag;
|
||||
}
|
||||
if (nprint > 0) {
|
||||
fcnder_mn(p, m, n, x, fvec, fjac, ldfjac, 0);
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmder. */
|
||||
|
||||
} /* lmder_ */
|
||||
|
||||
|
|
@ -0,0 +1,167 @@
|
|||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmder1)(__cminpack_decl_fcnder_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real *fjac, int ldfjac, real tol,
|
||||
int *ipvt, real *wa, int lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* Local variables */
|
||||
int mode, nfev, njev;
|
||||
real ftol, gtol, xtol;
|
||||
int maxfev, nprint;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmder1 */
|
||||
|
||||
/* the purpose of lmder1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of the */
|
||||
/* levenberg-marquardt algorithm. this is done by using the more */
|
||||
/* general least-squares solver lmder. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
|
||||
/* ipvt,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer m,n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(m),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmder1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than 5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmder */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || ldfjac < m || tol < 0. || lwa < n * 5 + m) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* call lmder. */
|
||||
|
||||
maxfev = (n + 1) * 100;
|
||||
ftol = tol;
|
||||
xtol = tol;
|
||||
gtol = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
info = __cminpack_func__(lmder)(__cminpack_param_fcnder_mn__ p, m, n, x, fvec, fjac, ldfjac,
|
||||
ftol, xtol, gtol, maxfev, wa, mode, factor, nprint,
|
||||
&nfev, &njev, ipvt, &wa[n], &wa[(n << 1)], &
|
||||
wa[n * 3], &wa[(n << 2)], &wa[n * 5]);
|
||||
if (info == 8) {
|
||||
info = 4;
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmder1. */
|
||||
|
||||
} /* lmder1_ */
|
||||
|
||||
|
|
@ -0,0 +1,190 @@
|
|||
/* lmder1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmder1)(__minpack_decl_fcnder_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, real *fjac, const int *ldfjac, const real *tol,
|
||||
int *info, int *ipvt, real *wa, const int *lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset;
|
||||
|
||||
/* Local variables */
|
||||
int mode, nfev, njev;
|
||||
real ftol, gtol, xtol;
|
||||
int maxfev, nprint;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmder1 */
|
||||
|
||||
/* the purpose of lmder1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of the */
|
||||
/* levenberg-marquardt algorithm. this is done by using the more */
|
||||
/* general least-squares solver lmder. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
|
||||
/* ipvt,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer m,n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(m),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmder1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than 5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmder */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--ipvt;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
*info = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *ldfjac < *m || *tol < 0. || *lwa < *n * 5 + *
|
||||
m) {
|
||||
/* goto L10; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* call lmder. */
|
||||
|
||||
maxfev = (*n + 1) * 100;
|
||||
ftol = *tol;
|
||||
xtol = *tol;
|
||||
gtol = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
__minpack_func__(lmder)(__minpack_param_fcnder_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
|
||||
ftol, &xtol, >ol, &maxfev, &wa[1], &mode, &factor, &nprint,
|
||||
info, &nfev, &njev, &ipvt[1], &wa[*n + 1], &wa[(*n << 1) + 1], &
|
||||
wa[*n * 3 + 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
|
||||
if (*info == 8) {
|
||||
*info = 4;
|
||||
}
|
||||
/* L10: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmder1. */
|
||||
|
||||
} /* lmder1_ */
|
||||
|
||||
|
|
@ -0,0 +1,621 @@
|
|||
/* lmder.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmder)(__minpack_decl_fcnder_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, real *fjac, const int *ldfjac, const real *ftol,
|
||||
const real *xtol, const real *gtol, const int *maxfev, real *
|
||||
diag, const int *mode, const real *factor, const int *nprint, int *
|
||||
info, int *nfev, int *njev, int *ipvt, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
const int c_true = TRUE_;
|
||||
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
real d__1, d__2, d__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l;
|
||||
real par, sum;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta;
|
||||
real ratio;
|
||||
real fnorm, gnorm, pnorm, xnorm = 0, fnorm1, actred, dirder,
|
||||
epsmch, prered;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmder */
|
||||
|
||||
/* the purpose of lmder is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm. the user must provide a */
|
||||
/* subroutine which calculates the functions and the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmder(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
|
||||
/* maxfev,diag,mode,factor,nprint,info,nfev, */
|
||||
/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the jacobian. fcn must */
|
||||
/* be declared in an external statement in the user */
|
||||
/* calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
|
||||
/* integer m,n,ldfjac,iflag */
|
||||
/* double precision x(n),fvec(m),fjac(ldfjac,n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmder. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.).100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x, fvec, and fjac */
|
||||
/* available for printing. fvec and fjac should not be */
|
||||
/* altered. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--fvec;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--ipvt;
|
||||
--diag;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
*info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *ldfjac < *m || *ftol < 0. || *xtol < 0. ||
|
||||
*gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
if (*mode != 2) {
|
||||
goto L20;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
L30:
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = 2;
|
||||
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
++(*njev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (*nprint <= 0) {
|
||||
goto L40;
|
||||
}
|
||||
iflag = 0;
|
||||
if ((iter - 1) % *nprint == 0) {
|
||||
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
L40:
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__minpack_func__(qrfac)(m, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
|
||||
wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter != 1) {
|
||||
goto L80;
|
||||
}
|
||||
if (*mode == 2) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
/* L50: */
|
||||
}
|
||||
L60:
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
/* L70: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
delta = *factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = *factor;
|
||||
}
|
||||
L80:
|
||||
|
||||
/* form (q transpose)*fvec and store the first n components in */
|
||||
/* qtf. */
|
||||
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
wa4[i__] = fvec[i__];
|
||||
/* L90: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
goto L120;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
|
||||
/* L100: */
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
wa4[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L110: */
|
||||
}
|
||||
L120:
|
||||
fjac[j + j * fjac_dim1] = wa1[j];
|
||||
qtf[j] = wa4[j];
|
||||
/* L130: */
|
||||
}
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm == 0.) {
|
||||
goto L170;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
if (wa2[l] == 0.) {
|
||||
goto L150;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
|
||||
/* L140: */
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__2 = gnorm, d__3 = fabs(sum / wa2[l]);
|
||||
gnorm = max(d__2,d__3);
|
||||
L150:
|
||||
/* L160: */
|
||||
;
|
||||
}
|
||||
L170:
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= *gtol) {
|
||||
*info = 4;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L190;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
/* Computing MAX */
|
||||
d__1 = diag[j], d__2 = wa2[j];
|
||||
diag[j] = max(d__1,d__2);
|
||||
/* L180: */
|
||||
}
|
||||
L190:
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
L200:
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
|
||||
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
/* L210: */
|
||||
}
|
||||
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnder_mn(m, n, &wa2[1], &wa4[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = fnorm1 / fnorm;
|
||||
actred = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j];
|
||||
temp = wa1[l];
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L220: */
|
||||
}
|
||||
/* L230: */
|
||||
}
|
||||
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
|
||||
temp2 = sqrt(par) * pnorm / fnorm;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
prered = d__1 * d__1 + d__2 * d__2 / p5;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
dirder = -(d__1 * d__1 + d__2 * d__2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio > p25) {
|
||||
goto L240;
|
||||
}
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
} else {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d__1 = delta, d__2 = pnorm / p1;
|
||||
delta = temp * min(d__1,d__2);
|
||||
par /= temp;
|
||||
goto L260;
|
||||
L240:
|
||||
if (par != 0. && ratio < p75) {
|
||||
goto L250;
|
||||
}
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
L250:
|
||||
L260:
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L290;
|
||||
}
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L270: */
|
||||
}
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
fvec[i__] = wa4[i__];
|
||||
/* L280: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
L290:
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
|
||||
*info = 1;
|
||||
}
|
||||
if (delta <= *xtol * xnorm) {
|
||||
*info = 2;
|
||||
}
|
||||
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
|
||||
== 2) {
|
||||
*info = 3;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= *maxfev) {
|
||||
*info = 5;
|
||||
}
|
||||
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
*info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
*info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
*info = 8;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L200;
|
||||
}
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
goto L30;
|
||||
L300:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
*info = iflag;
|
||||
}
|
||||
iflag = 0;
|
||||
if (*nprint > 0) {
|
||||
fcnder_mn(m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &iflag);
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmder. */
|
||||
|
||||
} /* lmder_ */
|
||||
|
||||
|
|
@ -0,0 +1,530 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmdif)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real ftol, real xtol, real
|
||||
gtol, int maxfev, real epsfcn, real *diag, int
|
||||
mode, real factor, int nprint, int *
|
||||
nfev, real *fjac, int ldfjac, int *ipvt, real *
|
||||
qtf, real *wa1, real *wa2, real *wa3, real *
|
||||
wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l;
|
||||
real par, sum;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta = 0.;
|
||||
real ratio;
|
||||
real fnorm, gnorm;
|
||||
real pnorm, xnorm = 0., fnorm1, actred, dirder, epsmch, prered;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmdif */
|
||||
|
||||
/* the purpose of lmdif is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, */
|
||||
/* diag,mode,factor,nprint,info,nfev,fjac, */
|
||||
/* ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmdif. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn is at least */
|
||||
/* maxfev by the end of an iteration. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn has reached or */
|
||||
/* exceeded maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || ldfjac < m || ftol < 0. || xtol < 0. ||
|
||||
gtol < 0. || maxfev <= 0 || factor <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
if (mode == 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = fcn_mn(p, m, n, x, fvec, 1);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm = __cminpack_enorm__(m, fvec);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = __cminpack_func__(fdjac2)(__cminpack_param_fcn_mn__ p, m, n, x, fvec, fjac, ldfjac,
|
||||
epsfcn, wa4);
|
||||
*nfev += n;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (nprint > 0) {
|
||||
iflag = 0;
|
||||
if ((iter - 1) % nprint == 0) {
|
||||
iflag = fcn_mn(p, m, n, x, fvec, 0);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__cminpack_func__(qrfac)(m, n, fjac, ldfjac, TRUE_, ipvt, n,
|
||||
wa1, wa2, wa3);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter == 1) {
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa3);
|
||||
delta = factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = factor;
|
||||
}
|
||||
}
|
||||
|
||||
/* form (q transpose)*fvec and store the first n components in */
|
||||
/* qtf. */
|
||||
|
||||
for (i = 0; i < m; ++i) {
|
||||
wa4[i] = fvec[i];
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (fjac[j + j * ldfjac] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = j; i < m; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * wa4[i];
|
||||
}
|
||||
temp = -sum / fjac[j + j * ldfjac];
|
||||
for (i = j; i < m; ++i) {
|
||||
wa4[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
fjac[j + j * ldfjac] = wa1[j];
|
||||
qtf[j] = wa4[j];
|
||||
}
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm != 0.) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
if (wa2[l] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
|
||||
}
|
||||
/* Computing MAX */
|
||||
d1 = fabs(sum / wa2[l]);
|
||||
gnorm = max(gnorm,d1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= gtol) {
|
||||
info = 4;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
/* Computing MAX */
|
||||
d1 = diag[j], d2 = wa2[j];
|
||||
diag[j] = max(d1,d2);
|
||||
}
|
||||
}
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
do {
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__cminpack_func__(lmpar)(n, fjac, ldfjac, ipvt, diag, qtf, delta,
|
||||
&par, wa1, wa2, wa3, wa4);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
}
|
||||
pnorm = __cminpack_enorm__(n, wa3);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = fcn_mn(p, m, n, wa2, wa4, 1);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm1 = __cminpack_enorm__(m, wa4);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = fnorm1 / fnorm;
|
||||
actred = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j]-1;
|
||||
temp = wa1[l];
|
||||
for (i = 0; i <= j; ++i) {
|
||||
wa3[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
temp1 = __cminpack_enorm__(n, wa3) / fnorm;
|
||||
temp2 = (sqrt(par) * pnorm) / fnorm;
|
||||
prered = temp1 * temp1 + temp2 * temp2 / p5;
|
||||
dirder = -(temp1 * temp1 + temp2 * temp2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio <= p25) {
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
} else {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d1 = pnorm / p1;
|
||||
delta = temp * min(delta,d1);
|
||||
par /= temp;
|
||||
} else {
|
||||
if (par == 0. || ratio >= p75) {
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio >= p0001) {
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
for (i = 0; i < m; ++i) {
|
||||
fvec[i] = wa4[i];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa2);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
}
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
|
||||
info = 1;
|
||||
}
|
||||
if (delta <= xtol * xnorm) {
|
||||
info = 2;
|
||||
}
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
|
||||
info = 3;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= maxfev) {
|
||||
info = 5;
|
||||
}
|
||||
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
info = 8;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
} while (ratio < p0001);
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
info = iflag;
|
||||
}
|
||||
if (nprint > 0) {
|
||||
fcn_mn(p, m, n, x, fvec, 0);
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmdif. */
|
||||
|
||||
} /* lmdif_ */
|
||||
|
||||
|
|
@ -0,0 +1,147 @@
|
|||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmdif1)(__cminpack_decl_fcn_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real tol, int *iwa,
|
||||
real *wa, int lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
int mp5n, mode, nfev;
|
||||
real ftol, gtol, xtol;
|
||||
real epsfcn;
|
||||
int maxfev, nprint;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmdif1 */
|
||||
|
||||
/* the purpose of lmdif1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of the */
|
||||
/* levenberg-marquardt algorithm. this is done by using the more */
|
||||
/* general least-squares solver lmdif. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmdif1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn has reached or */
|
||||
/* exceeded 200*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* iwa is an integer work array of length n. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* m*n+5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmdif */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || tol < 0. || lwa < m * n + n * 5 + m) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* call lmdif. */
|
||||
|
||||
maxfev = (n + 1) * 200;
|
||||
ftol = tol;
|
||||
xtol = tol;
|
||||
gtol = 0.;
|
||||
epsfcn = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
mp5n = m + n * 5;
|
||||
info = __cminpack_func__(lmdif)(__cminpack_param_fcn_mn__ p, m, n, x, fvec, ftol, xtol, gtol, maxfev,
|
||||
epsfcn, wa, mode, factor, nprint, &nfev, &wa[mp5n],
|
||||
m, iwa, &wa[n], &wa[(n << 1)], &wa[n * 3],
|
||||
&wa[(n << 2)], &wa[n * 5]);
|
||||
if (info == 8) {
|
||||
info = 4;
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmdif1. */
|
||||
|
||||
} /* lmdif1_ */
|
||||
|
||||
|
|
@ -0,0 +1,163 @@
|
|||
/* lmdif1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmdif1)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, const real *tol, int *info, int *iwa,
|
||||
real *wa, const int *lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
int mp5n, mode, nfev;
|
||||
real ftol, gtol, xtol;
|
||||
real epsfcn;
|
||||
int maxfev, nprint;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmdif1 */
|
||||
|
||||
/* the purpose of lmdif1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of the */
|
||||
/* levenberg-marquardt algorithm. this is done by using the more */
|
||||
/* general least-squares solver lmdif. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmdif1(fcn,m,n,x,fvec,tol,info,iwa,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmdif1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn has reached or */
|
||||
/* exceeded 200*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* iwa is an integer work array of length n. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than */
|
||||
/* m*n+5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmdif */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--iwa;
|
||||
--x;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
*info = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *tol < 0. || *lwa < *m * *n + *n * 5 + *m) {
|
||||
/* goto L10; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* call lmdif. */
|
||||
|
||||
maxfev = (*n + 1) * 200;
|
||||
ftol = *tol;
|
||||
xtol = *tol;
|
||||
gtol = 0.;
|
||||
epsfcn = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
mp5n = *m + *n * 5;
|
||||
__minpack_func__(lmdif)(__minpack_param_fcn_mn__ m, n, &x[1], &fvec[1], &ftol, &xtol, >ol, &maxfev, &
|
||||
epsfcn, &wa[1], &mode, &factor, &nprint, info, &nfev, &wa[mp5n +
|
||||
1], m, &iwa[1], &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1],
|
||||
&wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
|
||||
if (*info == 8) {
|
||||
*info = 4;
|
||||
}
|
||||
/* L10: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmdif1. */
|
||||
|
||||
} /* lmdif1_ */
|
||||
|
||||
|
|
@ -0,0 +1,625 @@
|
|||
/* lmdif.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmdif)(__minpack_decl_fcn_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, const real *ftol, const real *xtol, const real *
|
||||
gtol, const int *maxfev, const real *epsfcn, real *diag, const int *
|
||||
mode, const real *factor, const int *nprint, int *info, int *
|
||||
nfev, real *fjac, const int *ldfjac, int *ipvt, real *
|
||||
qtf, real *wa1, real *wa2, real *wa3, real *
|
||||
wa4)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
const int c_true = TRUE_;
|
||||
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
real d__1, d__2, d__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l;
|
||||
real par, sum;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta;
|
||||
real ratio;
|
||||
real fnorm, gnorm;
|
||||
real pnorm, xnorm = 0, fnorm1, actred, dirder, epsmch, prered;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmdif */
|
||||
|
||||
/* the purpose of lmdif is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm. the user must provide a */
|
||||
/* subroutine which calculates the functions. the jacobian is */
|
||||
/* then calculated by a forward-difference approximation. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmdif(fcn,m,n,x,fvec,ftol,xtol,gtol,maxfev,epsfcn, */
|
||||
/* diag,mode,factor,nprint,info,nfev,fjac, */
|
||||
/* ldfjac,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions. fcn must be declared */
|
||||
/* in an external statement in the user calling */
|
||||
/* program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m) */
|
||||
/* ---------- */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmdif. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn is at least */
|
||||
/* maxfev by the end of an iteration. */
|
||||
|
||||
/* epsfcn is an input variable used in determining a suitable */
|
||||
/* step length for the forward-difference approximation. this */
|
||||
/* approximation assumes that the relative errors in the */
|
||||
/* functions are of the order of epsfcn. if epsfcn is less */
|
||||
/* than the machine precision, it is assumed that the relative */
|
||||
/* errors in the functions are of the order of the machine */
|
||||
/* precision. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn has reached or */
|
||||
/* exceeded maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn. */
|
||||
|
||||
/* fjac is an output m by n array. the upper n by n submatrix */
|
||||
/* of fjac contains an upper triangular matrix r with */
|
||||
/* diagonal elements of nonincreasing magnitude such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower trapezoidal */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular */
|
||||
/* with diagonal elements of nonincreasing magnitude. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,fdjac2,lmpar,qrfac */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--fvec;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--ipvt;
|
||||
--diag;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
*info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *ldfjac < *m || *ftol < 0. || *xtol < 0. ||
|
||||
*gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
if (*mode != 2) {
|
||||
goto L20;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto L300;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcn_mn(m, n, &x[1], &fvec[1], &iflag);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
L30:
|
||||
|
||||
/* calculate the jacobian matrix. */
|
||||
|
||||
iflag = 2;
|
||||
__minpack_func__(fdjac2)(__minpack_param_fcn_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
|
||||
iflag, epsfcn, &wa4[1]);
|
||||
*nfev += *n;
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (*nprint <= 0) {
|
||||
goto L40;
|
||||
}
|
||||
iflag = 0;
|
||||
if ((iter - 1) % *nprint == 0) {
|
||||
fcn_mn(m, n, &x[1], &fvec[1], &iflag);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
L40:
|
||||
|
||||
/* compute the qr factorization of the jacobian. */
|
||||
|
||||
__minpack_func__(qrfac)(m, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
|
||||
wa2[1], &wa3[1]);
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter != 1) {
|
||||
goto L80;
|
||||
}
|
||||
if (*mode == 2) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
/* L50: */
|
||||
}
|
||||
L60:
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
/* L70: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
delta = *factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = *factor;
|
||||
}
|
||||
L80:
|
||||
|
||||
/* form (q transpose)*fvec and store the first n components in */
|
||||
/* qtf. */
|
||||
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
wa4[i__] = fvec[i__];
|
||||
/* L90: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
goto L120;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * wa4[i__];
|
||||
/* L100: */
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
wa4[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L110: */
|
||||
}
|
||||
L120:
|
||||
fjac[j + j * fjac_dim1] = wa1[j];
|
||||
qtf[j] = wa4[j];
|
||||
/* L130: */
|
||||
}
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm == 0.) {
|
||||
goto L170;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
if (wa2[l] == 0.) {
|
||||
goto L150;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
|
||||
/* L140: */
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__2 = gnorm, d__3 = fabs(sum / wa2[l]);
|
||||
gnorm = max(d__2,d__3);
|
||||
L150:
|
||||
/* L160: */
|
||||
;
|
||||
}
|
||||
L170:
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= *gtol) {
|
||||
*info = 4;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L190;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
/* Computing MAX */
|
||||
d__1 = diag[j], d__2 = wa2[j];
|
||||
diag[j] = max(d__1,d__2);
|
||||
/* L180: */
|
||||
}
|
||||
L190:
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
L200:
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
|
||||
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
/* L210: */
|
||||
}
|
||||
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcn_mn(m, n, &wa2[1], &wa4[1], &iflag);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto L300;
|
||||
}
|
||||
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = fnorm1 / fnorm;
|
||||
actred = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j];
|
||||
temp = wa1[l];
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L220: */
|
||||
}
|
||||
/* L230: */
|
||||
}
|
||||
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
|
||||
temp2 = sqrt(par) * pnorm / fnorm;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
prered = d__1 * d__1 + d__2 * d__2 / p5;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
dirder = -(d__1 * d__1 + d__2 * d__2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio > p25) {
|
||||
goto L240;
|
||||
}
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
} else {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d__1 = delta, d__2 = pnorm / p1;
|
||||
delta = temp * min(d__1,d__2);
|
||||
par /= temp;
|
||||
goto L260;
|
||||
L240:
|
||||
if (par != 0. && ratio < p75) {
|
||||
goto L250;
|
||||
}
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
L250:
|
||||
L260:
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L290;
|
||||
}
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L270: */
|
||||
}
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
fvec[i__] = wa4[i__];
|
||||
/* L280: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
L290:
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
|
||||
*info = 1;
|
||||
}
|
||||
if (delta <= *xtol * xnorm) {
|
||||
*info = 2;
|
||||
}
|
||||
if (fabs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
|
||||
== 2) {
|
||||
*info = 3;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= *maxfev) {
|
||||
*info = 5;
|
||||
}
|
||||
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
*info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
*info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
*info = 8;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L300;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L200;
|
||||
}
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
goto L30;
|
||||
L300:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
*info = iflag;
|
||||
}
|
||||
iflag = 0;
|
||||
if (*nprint > 0) {
|
||||
fcn_mn(m, n, &x[1], &fvec[1], &iflag);
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmdif. */
|
||||
|
||||
} /* lmdif_ */
|
||||
|
||||
|
|
@ -0,0 +1,338 @@
|
|||
/* lmpar.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(lmpar)(int n, real *r, int ldr,
|
||||
const int *ipvt, const real *diag, const real *qtb, real delta,
|
||||
real *par, real *x, real *sdiag, real *wa1,
|
||||
real *wa2)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p001 .001
|
||||
|
||||
/* System generated locals */
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int j, l;
|
||||
real fp;
|
||||
real parc, parl;
|
||||
int iter;
|
||||
real temp, paru, dwarf;
|
||||
int nsing;
|
||||
real gnorm;
|
||||
real dxnorm;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmpar */
|
||||
|
||||
/* given an m by n matrix a, an n by n nonsingular diagonal */
|
||||
/* matrix d, an m-vector b, and a positive number delta, */
|
||||
/* the problem is to determine a value for the parameter */
|
||||
/* par such that if x solves the system */
|
||||
|
||||
/* a*x = b , sqrt(par)*d*x = 0 , */
|
||||
|
||||
/* in the least squares sense, and dxnorm is the euclidean */
|
||||
/* norm of d*x, then either par is zero and */
|
||||
|
||||
/* (dxnorm-delta) .le. 0.1*delta , */
|
||||
|
||||
/* or par is positive and */
|
||||
|
||||
/* abs(dxnorm-delta) .le. 0.1*delta . */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then lmpar expects */
|
||||
/* the full upper triangle of r, the permutation matrix p, */
|
||||
/* and the first n components of (q transpose)*b. on output */
|
||||
/* lmpar also provides an upper triangular matrix s such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(a *a + par*d*d)*p = s *s . */
|
||||
|
||||
/* s is employed within lmpar and may be of separate interest. */
|
||||
|
||||
/* only a few iterations are generally needed for convergence */
|
||||
/* of the algorithm. if, however, the limit of 10 iterations */
|
||||
/* is reached, then the output par will contain the best */
|
||||
/* value obtained so far. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, */
|
||||
/* wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle */
|
||||
/* must contain the full upper triangle of the matrix r. */
|
||||
/* on output the full upper triangle is unaltered, and the */
|
||||
/* strict lower triangle contains the strict upper triangle */
|
||||
/* (transposed) of the upper triangular matrix s. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* delta is a positive input variable which specifies an upper */
|
||||
/* bound on the euclidean norm of d*x. */
|
||||
|
||||
/* par is a nonnegative variable. on input par contains an */
|
||||
/* initial estimate of the levenberg-marquardt parameter. */
|
||||
/* on output par contains the final estimate. */
|
||||
|
||||
/* x is an output array of length n which contains the least */
|
||||
/* squares solution of the system a*x = b, sqrt(par)*d*x = 0, */
|
||||
/* for the output par. */
|
||||
|
||||
/* sdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of the upper triangular matrix s. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,qrsolv */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* dwarf is the smallest positive magnitude. */
|
||||
|
||||
dwarf = __cminpack_func__(dpmpar)(2);
|
||||
|
||||
/* compute and store in x the gauss-newton direction. if the */
|
||||
/* jacobian is rank-deficient, obtain a least squares solution. */
|
||||
|
||||
nsing = n;
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] = qtb[j];
|
||||
if (r[j + j * ldr] == 0. && nsing == n) {
|
||||
nsing = j;
|
||||
}
|
||||
if (nsing < n) {
|
||||
wa1[j] = 0.;
|
||||
}
|
||||
}
|
||||
# ifdef USE_CBLAS
|
||||
cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
|
||||
# else
|
||||
if (nsing >= 1) {
|
||||
int k;
|
||||
for (k = 1; k <= nsing; ++k) {
|
||||
j = nsing - k;
|
||||
wa1[j] /= r[j + j * ldr];
|
||||
temp = wa1[j];
|
||||
if (j >= 1) {
|
||||
int i;
|
||||
for (i = 0; i < j; ++i) {
|
||||
wa1[i] -= r[i + j * ldr] * temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# endif
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
x[l] = wa1[j];
|
||||
}
|
||||
|
||||
/* initialize the iteration counter. */
|
||||
/* evaluate the function at the origin, and test */
|
||||
/* for acceptance of the gauss-newton direction. */
|
||||
|
||||
iter = 0;
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
dxnorm = __cminpack_enorm__(n, wa2);
|
||||
fp = dxnorm - delta;
|
||||
if (fp <= p1 * delta) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* if the jacobian is not rank deficient, the newton */
|
||||
/* step provides a lower bound, parl, for the zero of */
|
||||
/* the function. otherwise set this bound to zero. */
|
||||
|
||||
parl = 0.;
|
||||
if (nsing >= n) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
wa1[j] = diag[l] * (wa2[l] / dxnorm);
|
||||
}
|
||||
# ifdef USE_CBLAS
|
||||
cblas_dtrsv(CblasColMajor, CblasUpper, CblasTrans, CblasNonUnit, n, r, ldr, wa1, 1);
|
||||
# else
|
||||
for (j = 0; j < n; ++j) {
|
||||
real sum = 0.;
|
||||
if (j >= 1) {
|
||||
int i;
|
||||
for (i = 0; i < j; ++i) {
|
||||
sum += r[i + j * ldr] * wa1[i];
|
||||
}
|
||||
}
|
||||
wa1[j] = (wa1[j] - sum) / r[j + j * ldr];
|
||||
}
|
||||
# endif
|
||||
temp = __cminpack_enorm__(n, wa1);
|
||||
parl = fp / delta / temp / temp;
|
||||
}
|
||||
|
||||
/* calculate an upper bound, paru, for the zero of the function. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
real sum;
|
||||
# ifdef USE_CBLAS
|
||||
sum = cblas_ddot(j+1, &r[j*ldr], 1, qtb, 1);
|
||||
# else
|
||||
int i;
|
||||
sum = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
sum += r[i + j * ldr] * qtb[i];
|
||||
}
|
||||
# endif
|
||||
l = ipvt[j]-1;
|
||||
wa1[j] = sum / diag[l];
|
||||
}
|
||||
gnorm = __cminpack_enorm__(n, wa1);
|
||||
paru = gnorm / delta;
|
||||
if (paru == 0.) {
|
||||
paru = dwarf / min(delta,(real)p1) /* / p001 ??? */;
|
||||
}
|
||||
|
||||
/* if the input par lies outside of the interval (parl,paru), */
|
||||
/* set par to the closer endpoint. */
|
||||
|
||||
*par = max(*par,parl);
|
||||
*par = min(*par,paru);
|
||||
if (*par == 0.) {
|
||||
*par = gnorm / dxnorm;
|
||||
}
|
||||
|
||||
/* beginning of an iteration. */
|
||||
|
||||
for (;;) {
|
||||
++iter;
|
||||
|
||||
/* evaluate the function at the current value of par. */
|
||||
|
||||
if (*par == 0.) {
|
||||
/* Computing MAX */
|
||||
d1 = dwarf, d2 = p001 * paru;
|
||||
*par = max(d1,d2);
|
||||
}
|
||||
temp = sqrt(*par);
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] = temp * diag[j];
|
||||
}
|
||||
__cminpack_func__(qrsolv)(n, r, ldr, ipvt, wa1, qtb, x, sdiag, wa2);
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
dxnorm = __cminpack_enorm__(n, wa2);
|
||||
temp = fp;
|
||||
fp = dxnorm - delta;
|
||||
|
||||
/* if the function is small enough, accept the current value */
|
||||
/* of par. also test for the exceptional cases where parl */
|
||||
/* is zero or the number of iterations has reached 10. */
|
||||
|
||||
if (fabs(fp) <= p1 * delta || (parl == 0. && fp <= temp && temp < 0.) || iter == 10) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* compute the newton correction. */
|
||||
|
||||
# ifdef USE_CBLAS
|
||||
for (j = 0; j < nsing; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
wa1[j] = diag[l] * (wa2[l] / dxnorm);
|
||||
}
|
||||
for (j = nsing; j < n; ++j) {
|
||||
wa1[j] = 0.;
|
||||
}
|
||||
/* exchange the diagonal of r with sdiag */
|
||||
cblas_dswap(n, r, ldr+1, sdiag, 1);
|
||||
/* solve lower(r).x = wa1, result id put in wa1 */
|
||||
cblas_dtrsv(CblasColMajor, CblasLower, CblasNoTrans, CblasNonUnit, nsing, r, ldr, wa1, 1);
|
||||
/* exchange the diagonal of r with sdiag */
|
||||
cblas_dswap( n, r, ldr+1, sdiag, 1);
|
||||
# else /* !USE_CBLAS */
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
wa1[j] = diag[l] * (wa2[l] / dxnorm);
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] /= sdiag[j];
|
||||
temp = wa1[j];
|
||||
if (n > j+1) {
|
||||
int i;
|
||||
for (i = j+1; i < n; ++i) {
|
||||
wa1[i] -= r[i + j * ldr] * temp;
|
||||
}
|
||||
}
|
||||
}
|
||||
# endif /* !USE_CBLAS */
|
||||
temp = __cminpack_enorm__(n, wa1);
|
||||
parc = fp / delta / temp / temp;
|
||||
|
||||
/* depending on the sign of the function, update parl or paru. */
|
||||
|
||||
if (fp > 0.) {
|
||||
parl = max(parl,*par);
|
||||
}
|
||||
if (fp < 0.) {
|
||||
paru = min(paru,*par);
|
||||
}
|
||||
|
||||
/* compute an improved estimate for par. */
|
||||
|
||||
/* Computing MAX */
|
||||
d1 = parl, d2 = *par + parc;
|
||||
*par = max(d1,d2);
|
||||
|
||||
/* end of an iteration. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination. */
|
||||
|
||||
if (iter == 0) {
|
||||
*par = 0.;
|
||||
}
|
||||
|
||||
/* last card of subroutine lmpar. */
|
||||
|
||||
} /* lmpar_ */
|
||||
|
||||
|
|
@ -0,0 +1,372 @@
|
|||
/* lmpar.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmpar)(const int *n, real *r__, const int *ldr,
|
||||
const int *ipvt, const real *diag, const real *qtb, const real *delta,
|
||||
real *par, real *x, real *sdiag, real *wa1,
|
||||
real *wa2)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__2 = 2;
|
||||
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p001 .001
|
||||
|
||||
/* System generated locals */
|
||||
int r_dim1, r_offset, i__1, i__2;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, l;
|
||||
real fp;
|
||||
int jm1, jp1;
|
||||
real sum, parc, parl;
|
||||
int iter;
|
||||
real temp, paru, dwarf;
|
||||
int nsing;
|
||||
real gnorm;
|
||||
real dxnorm;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmpar */
|
||||
|
||||
/* given an m by n matrix a, an n by n nonsingular diagonal */
|
||||
/* matrix d, an m-vector b, and a positive number delta, */
|
||||
/* the problem is to determine a value for the parameter */
|
||||
/* par such that if x solves the system */
|
||||
|
||||
/* a*x = b , sqrt(par)*d*x = 0 , */
|
||||
|
||||
/* in the least squares sense, and dxnorm is the euclidean */
|
||||
/* norm of d*x, then either par is zero and */
|
||||
|
||||
/* (dxnorm-delta) .le. 0.1*delta , */
|
||||
|
||||
/* or par is positive and */
|
||||
|
||||
/* abs(dxnorm-delta) .le. 0.1*delta . */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then lmpar expects */
|
||||
/* the full upper triangle of r, the permutation matrix p, */
|
||||
/* and the first n components of (q transpose)*b. on output */
|
||||
/* lmpar also provides an upper triangular matrix s such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(a *a + par*d*d)*p = s *s . */
|
||||
|
||||
/* s is employed within lmpar and may be of separate interest. */
|
||||
|
||||
/* only a few iterations are generally needed for convergence */
|
||||
/* of the algorithm. if, however, the limit of 10 iterations */
|
||||
/* is reached, then the output par will contain the best */
|
||||
/* value obtained so far. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmpar(n,r,ldr,ipvt,diag,qtb,delta,par,x,sdiag, */
|
||||
/* wa1,wa2) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle */
|
||||
/* must contain the full upper triangle of the matrix r. */
|
||||
/* on output the full upper triangle is unaltered, and the */
|
||||
/* strict lower triangle contains the strict upper triangle */
|
||||
/* (transposed) of the upper triangular matrix s. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* delta is a positive input variable which specifies an upper */
|
||||
/* bound on the euclidean norm of d*x. */
|
||||
|
||||
/* par is a nonnegative variable. on input par contains an */
|
||||
/* initial estimate of the levenberg-marquardt parameter. */
|
||||
/* on output par contains the final estimate. */
|
||||
|
||||
/* x is an output array of length n which contains the least */
|
||||
/* squares solution of the system a*x = b, sqrt(par)*d*x = 0, */
|
||||
/* for the output par. */
|
||||
|
||||
/* sdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of the upper triangular matrix s. */
|
||||
|
||||
/* wa1 and wa2 are work arrays of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,qrsolv */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa2;
|
||||
--wa1;
|
||||
--sdiag;
|
||||
--x;
|
||||
--qtb;
|
||||
--diag;
|
||||
--ipvt;
|
||||
r_dim1 = *ldr;
|
||||
r_offset = 1 + r_dim1 * 1;
|
||||
r__ -= r_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* dwarf is the smallest positive magnitude. */
|
||||
|
||||
dwarf = __minpack_func__(dpmpar)(&c__2);
|
||||
|
||||
/* compute and store in x the gauss-newton direction. if the */
|
||||
/* jacobian is rank-deficient, obtain a least squares solution. */
|
||||
|
||||
nsing = *n;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = qtb[j];
|
||||
if (r__[j + j * r_dim1] == 0. && nsing == *n) {
|
||||
nsing = j - 1;
|
||||
}
|
||||
if (nsing < *n) {
|
||||
wa1[j] = 0.;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
if (nsing < 1) {
|
||||
goto L50;
|
||||
}
|
||||
i__1 = nsing;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
j = nsing - k + 1;
|
||||
wa1[j] /= r__[j + j * r_dim1];
|
||||
temp = wa1[j];
|
||||
jm1 = j - 1;
|
||||
if (jm1 < 1) {
|
||||
goto L30;
|
||||
}
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
|
||||
/* L20: */
|
||||
}
|
||||
L30:
|
||||
/* L40: */
|
||||
;
|
||||
}
|
||||
L50:
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
x[l] = wa1[j];
|
||||
/* L60: */
|
||||
}
|
||||
|
||||
/* initialize the iteration counter. */
|
||||
/* evaluate the function at the origin, and test */
|
||||
/* for acceptance of the gauss-newton direction. */
|
||||
|
||||
iter = 0;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L70: */
|
||||
}
|
||||
dxnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fp = dxnorm - *delta;
|
||||
if (fp <= p1 * *delta) {
|
||||
goto L220;
|
||||
}
|
||||
|
||||
/* if the jacobian is not rank deficient, the newton */
|
||||
/* step provides a lower bound, parl, for the zero of */
|
||||
/* the function. otherwise set this bound to zero. */
|
||||
|
||||
parl = 0.;
|
||||
if (nsing < *n) {
|
||||
goto L120;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
wa1[j] = diag[l] * (wa2[l] / dxnorm);
|
||||
/* L80: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
sum = 0.;
|
||||
jm1 = j - 1;
|
||||
if (jm1 < 1) {
|
||||
goto L100;
|
||||
}
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += r__[i__ + j * r_dim1] * wa1[i__];
|
||||
/* L90: */
|
||||
}
|
||||
L100:
|
||||
wa1[j] = (wa1[j] - sum) / r__[j + j * r_dim1];
|
||||
/* L110: */
|
||||
}
|
||||
temp = __minpack_func__(enorm)(n, &wa1[1]);
|
||||
parl = fp / *delta / temp / temp;
|
||||
L120:
|
||||
|
||||
/* calculate an upper bound, paru, for the zero of the function. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
sum = 0.;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += r__[i__ + j * r_dim1] * qtb[i__];
|
||||
/* L130: */
|
||||
}
|
||||
l = ipvt[j];
|
||||
wa1[j] = sum / diag[l];
|
||||
/* L140: */
|
||||
}
|
||||
gnorm = __minpack_func__(enorm)(n, &wa1[1]);
|
||||
paru = gnorm / *delta;
|
||||
if (paru == 0.) {
|
||||
paru = dwarf / min(*delta,(real)p1);
|
||||
}
|
||||
|
||||
/* if the input par lies outside of the interval (parl,paru), */
|
||||
/* set par to the closer endpoint. */
|
||||
|
||||
*par = max(*par,parl);
|
||||
*par = min(*par,paru);
|
||||
if (*par == 0.) {
|
||||
*par = gnorm / dxnorm;
|
||||
}
|
||||
|
||||
/* beginning of an iteration. */
|
||||
|
||||
L150:
|
||||
++iter;
|
||||
|
||||
/* evaluate the function at the current value of par. */
|
||||
|
||||
if (*par == 0.) {
|
||||
/* Computing MAX */
|
||||
d__1 = dwarf, d__2 = p001 * paru;
|
||||
*par = max(d__1,d__2);
|
||||
}
|
||||
temp = sqrt(*par);
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = temp * diag[j];
|
||||
/* L160: */
|
||||
}
|
||||
__minpack_func__(qrsolv)(n, &r__[r_offset], ldr, &ipvt[1], &wa1[1], &qtb[1], &x[1], &sdiag[
|
||||
1], &wa2[1]);
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L170: */
|
||||
}
|
||||
dxnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
temp = fp;
|
||||
fp = dxnorm - *delta;
|
||||
|
||||
/* if the function is small enough, accept the current value */
|
||||
/* of par. also test for the exceptional cases where parl */
|
||||
/* is zero or the number of iterations has reached 10. */
|
||||
|
||||
if (abs(fp) <= p1 * *delta || (parl == 0. && fp <= temp && temp < 0.) ||
|
||||
iter == 10) {
|
||||
goto L220;
|
||||
}
|
||||
|
||||
/* compute the newton correction. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
wa1[j] = diag[l] * (wa2[l] / dxnorm);
|
||||
/* L180: */
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] /= sdiag[j];
|
||||
temp = wa1[j];
|
||||
jp1 = j + 1;
|
||||
if (*n < jp1) {
|
||||
goto L200;
|
||||
}
|
||||
i__2 = *n;
|
||||
for (i__ = jp1; i__ <= i__2; ++i__) {
|
||||
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
|
||||
/* L190: */
|
||||
}
|
||||
L200:
|
||||
/* L210: */
|
||||
;
|
||||
}
|
||||
temp = __minpack_func__(enorm)(n, &wa1[1]);
|
||||
parc = fp / *delta / temp / temp;
|
||||
|
||||
/* depending on the sign of the function, update parl or paru. */
|
||||
|
||||
if (fp > 0.) {
|
||||
parl = max(parl,*par);
|
||||
}
|
||||
if (fp < 0.) {
|
||||
paru = min(paru,*par);
|
||||
}
|
||||
|
||||
/* compute an improved estimate for par. */
|
||||
|
||||
/* Computing MAX */
|
||||
d__1 = parl, d__2 = *par + parc;
|
||||
*par = max(d__1,d__2);
|
||||
|
||||
/* end of an iteration. */
|
||||
|
||||
goto L150;
|
||||
L220:
|
||||
|
||||
/* termination. */
|
||||
|
||||
if (iter == 0) {
|
||||
*par = 0.;
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmpar. */
|
||||
|
||||
} /* lmpar_ */
|
||||
|
||||
|
|
@ -0,0 +1,544 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmstr)(__cminpack_decl_fcnderstr_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real *fjac, int ldfjac, real ftol,
|
||||
real xtol, real gtol, int maxfev, real *
|
||||
diag, int mode, real factor, int nprint,
|
||||
int *nfev, int *njev, int *ipvt, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
real d1, d2;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l;
|
||||
real par, sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta = 0.;
|
||||
real ratio;
|
||||
real fnorm, gnorm, pnorm, xnorm = 0., fnorm1, actred, dirder,
|
||||
epsmch, prered;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmstr */
|
||||
|
||||
/* the purpose of lmstr is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm which uses minimal storage. */
|
||||
/* the user must provide a subroutine which calculates the */
|
||||
/* functions and the rows of the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmstr(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
|
||||
/* maxfev,diag,mode,factor,nprint,info,nfev, */
|
||||
/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the rows of the jacobian. */
|
||||
/* fcn must be declared in an external statement in the */
|
||||
/* user calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjrow,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m),fjrow(n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmstr. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array. the upper triangle of fjac */
|
||||
/* contains an upper triangular matrix r such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower triangular */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac,rwupdt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || ldfjac < n || ftol < 0. || xtol < 0. ||
|
||||
gtol < 0. || maxfev <= 0 || factor <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
if (mode == 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = fcnderstr_mn(p, m, n, x, fvec, wa3, 1);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm = __cminpack_enorm__(m, fvec);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
for (;;) {
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (nprint > 0) {
|
||||
iflag = 0;
|
||||
if ((iter - 1) % nprint == 0) {
|
||||
iflag = fcnderstr_mn(p, m, n, x, fvec, wa3, 0);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the qr factorization of the jacobian matrix */
|
||||
/* calculated one row at a time, while simultaneously */
|
||||
/* forming (q transpose)*fvec and storing the first */
|
||||
/* n components in qtf. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
qtf[j] = 0.;
|
||||
for (i = 0; i < n; ++i) {
|
||||
fjac[i + j * ldfjac] = 0.;
|
||||
}
|
||||
}
|
||||
iflag = 2;
|
||||
for (i = 0; i < m; ++i) {
|
||||
if (fcnderstr_mn(p, m, n, x, fvec, wa3, iflag) < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
temp = fvec[i];
|
||||
__cminpack_func__(rwupdt)(n, fjac, ldfjac, wa3, qtf, &temp,
|
||||
wa1, wa2);
|
||||
++iflag;
|
||||
}
|
||||
++(*njev);
|
||||
|
||||
/* if the jacobian is rank deficient, call qrfac to */
|
||||
/* reorder its columns and update the components of qtf. */
|
||||
|
||||
sing = FALSE_;
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (fjac[j + j * ldfjac] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
ipvt[j] = j+1;
|
||||
wa2[j] = __cminpack_enorm__(j+1, &fjac[j * ldfjac + 0]);
|
||||
}
|
||||
if (sing) {
|
||||
__cminpack_func__(qrfac)(n, n, fjac, ldfjac, TRUE_, ipvt, n,
|
||||
wa1, wa2, wa3);
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (fjac[j + j * ldfjac] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = j; i < n; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * qtf[i];
|
||||
}
|
||||
temp = -sum / fjac[j + j * ldfjac];
|
||||
for (i = j; i < n; ++i) {
|
||||
qtf[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
fjac[j + j * ldfjac] = wa1[j];
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter == 1) {
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa3);
|
||||
delta = factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = factor;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm != 0.) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
if (wa2[l] != 0.) {
|
||||
sum = 0.;
|
||||
for (i = 0; i <= j; ++i) {
|
||||
sum += fjac[i + j * ldfjac] * (qtf[i] / fnorm);
|
||||
}
|
||||
/* Computing MAX */
|
||||
d1 = fabs(sum / wa2[l]);
|
||||
gnorm = max(gnorm,d1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= gtol) {
|
||||
info = 4;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (mode != 2) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
/* Computing MAX */
|
||||
d1 = diag[j], d2 = wa2[j];
|
||||
diag[j] = max(d1,d2);
|
||||
}
|
||||
}
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
do {
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__cminpack_func__(lmpar)(n, fjac, ldfjac, ipvt, diag, qtf, delta,
|
||||
&par, wa1, wa2, wa3, wa4);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
}
|
||||
pnorm = __cminpack_enorm__(n, wa3);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = fcnderstr_mn(p, m, n, wa2, wa4, wa3, 1);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
fnorm1 = __cminpack_enorm__(m, wa4);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d1 = fnorm1 / fnorm;
|
||||
actred = 1. - d1 * d1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j]-1;
|
||||
temp = wa1[l];
|
||||
for (i = 0; i <= j; ++i) {
|
||||
wa3[i] += fjac[i + j * ldfjac] * temp;
|
||||
}
|
||||
}
|
||||
temp1 = __cminpack_enorm__(n, wa3) / fnorm;
|
||||
temp2 = (sqrt(par) * pnorm) / fnorm;
|
||||
prered = temp1 * temp1 + temp2 * temp2 / p5;
|
||||
dirder = -(temp1 * temp1 + temp2 * temp2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio <= p25) {
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
} else {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d1 = pnorm / p1;
|
||||
delta = temp * min(delta,d1);
|
||||
par /= temp;
|
||||
} else {
|
||||
if (par == 0. || ratio >= p75) {
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
}
|
||||
}
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio >= p0001) {
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
}
|
||||
for (i = 0; i < m; ++i) {
|
||||
fvec[i] = wa4[i];
|
||||
}
|
||||
xnorm = __cminpack_enorm__(n, wa2);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
}
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1.) {
|
||||
info = 1;
|
||||
}
|
||||
if (delta <= xtol * xnorm) {
|
||||
info = 2;
|
||||
}
|
||||
if (fabs(actred) <= ftol && prered <= ftol && p5 * ratio <= 1. && info == 2) {
|
||||
info = 3;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= maxfev) {
|
||||
info = 5;
|
||||
}
|
||||
if (fabs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
info = 8;
|
||||
}
|
||||
if (info != 0) {
|
||||
goto TERMINATE;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
} while (ratio < p0001);
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
}
|
||||
TERMINATE:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
info = iflag;
|
||||
}
|
||||
if (nprint > 0) {
|
||||
fcnderstr_mn(p, m, n, x, fvec, wa3, 0);
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmstr. */
|
||||
|
||||
} /* lmstr_ */
|
||||
|
||||
|
|
@ -0,0 +1,167 @@
|
|||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
int __cminpack_func__(lmstr1)(__cminpack_decl_fcnderstr_mn__ void *p, int m, int n, real *x,
|
||||
real *fvec, real *fjac, int ldfjac, real tol,
|
||||
int *ipvt, real *wa, int lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* Local variables */
|
||||
int mode, nfev, njev;
|
||||
real ftol, gtol, xtol;
|
||||
int maxfev, nprint;
|
||||
int info;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmstr1 */
|
||||
|
||||
/* the purpose of lmstr1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm which uses minimal storage. */
|
||||
/* this is done by using the more general least-squares solver */
|
||||
/* lmstr. the user must provide a subroutine which calculates */
|
||||
/* the functions and the rows of the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmstr1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
|
||||
/* ipvt,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the rows of the jacobian. */
|
||||
/* fcn must be declared in an external statement in the */
|
||||
/* user calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjrow,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m),fjrow(n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmstr1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array. the upper triangle of fjac */
|
||||
/* contains an upper triangular matrix r such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower triangular */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than 5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmstr */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (n <= 0 || m < n || ldfjac < n || tol < 0. || lwa < n * 5 + m) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* call lmstr. */
|
||||
|
||||
maxfev = (n + 1) * 100;
|
||||
ftol = tol;
|
||||
xtol = tol;
|
||||
gtol = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
info = __cminpack_func__(lmstr)(__cminpack_param_fcnderstr_mn__ p, m, n, x, fvec, fjac, ldfjac,
|
||||
ftol, xtol, gtol, maxfev, wa, mode, factor, nprint,
|
||||
&nfev, &njev, ipvt, &wa[n], &wa[(n << 1)], &
|
||||
wa[n * 3], &wa[(n << 2)], &wa[n * 5]);
|
||||
if (info == 8) {
|
||||
info = 4;
|
||||
}
|
||||
return info;
|
||||
|
||||
/* last card of subroutine lmstr1. */
|
||||
|
||||
} /* lmstr1_ */
|
||||
|
||||
|
|
@ -0,0 +1,190 @@
|
|||
/* lmstr1.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmstr1)(__minpack_decl_fcnderstr_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, real *fjac, const int *ldfjac, const real *tol,
|
||||
int *info, int *ipvt, real *wa, const int *lwa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
const real factor = 100.;
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset;
|
||||
|
||||
/* Local variables */
|
||||
int mode, nfev, njev;
|
||||
real ftol, gtol, xtol;
|
||||
int maxfev, nprint;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmstr1 */
|
||||
|
||||
/* the purpose of lmstr1 is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm which uses minimal storage. */
|
||||
/* this is done by using the more general least-squares solver */
|
||||
/* lmstr. the user must provide a subroutine which calculates */
|
||||
/* the functions and the rows of the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmstr1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
|
||||
/* ipvt,wa,lwa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the rows of the jacobian. */
|
||||
/* fcn must be declared in an external statement in the */
|
||||
/* user calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjrow,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m),fjrow(n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmstr1. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array. the upper triangle of fjac */
|
||||
/* contains an upper triangular matrix r such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower triangular */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* tol is a nonnegative input variable. termination occurs */
|
||||
/* when the algorithm estimates either that the relative */
|
||||
/* error in the sum of squares is at most tol or that */
|
||||
/* the relative error between x and the solution is at */
|
||||
/* most tol. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 algorithm estimates that the relative error */
|
||||
/* in the sum of squares is at most tol. */
|
||||
|
||||
/* info = 2 algorithm estimates that the relative error */
|
||||
/* between x and the solution is at most tol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 fvec is orthogonal to the columns of the */
|
||||
/* jacobian to machine precision. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached 100*(n+1). */
|
||||
|
||||
/* info = 6 tol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 tol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* wa is a work array of length lwa. */
|
||||
|
||||
/* lwa is a positive integer input variable not less than 5*n+m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... lmstr */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--fvec;
|
||||
--ipvt;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
--wa;
|
||||
|
||||
/* Function Body */
|
||||
*info = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *ldfjac < *n || *tol < 0. || *lwa < *n * 5 + *
|
||||
m) {
|
||||
/* goto L10; */
|
||||
return;
|
||||
}
|
||||
|
||||
/* call lmstr. */
|
||||
|
||||
maxfev = (*n + 1) * 100;
|
||||
ftol = *tol;
|
||||
xtol = *tol;
|
||||
gtol = 0.;
|
||||
mode = 1;
|
||||
nprint = 0;
|
||||
__minpack_func__(lmstr)(__minpack_param_fcnderstr_mn__ m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &
|
||||
ftol, &xtol, >ol, &maxfev, &wa[1], &mode, &factor, &nprint,
|
||||
info, &nfev, &njev, &ipvt[1], &wa[*n + 1], &wa[(*n << 1) + 1], &
|
||||
wa[*n * 3 + 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]);
|
||||
if (*info == 8) {
|
||||
*info = 4;
|
||||
}
|
||||
/* L10: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmstr1. */
|
||||
|
||||
} /* lmstr1_ */
|
||||
|
||||
|
|
@ -0,0 +1,648 @@
|
|||
/* lmstr.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmstr)(__minpack_decl_fcnderstr_mn__ const int *m, const int *n, real *x,
|
||||
real *fvec, real *fjac, const int *ldfjac, const real *ftol,
|
||||
const real *xtol, const real *gtol, const int *maxfev, real *
|
||||
diag, const int *mode, const real *factor, const int *nprint, int *
|
||||
info, int *nfev, int *njev, int *ipvt, real *qtf,
|
||||
real *wa1, real *wa2, real *wa3, real *wa4)
|
||||
{
|
||||
/* Table of constant values */
|
||||
|
||||
const int c__1 = 1;
|
||||
const int c_true = TRUE_;
|
||||
|
||||
/* Initialized data */
|
||||
|
||||
#define p1 .1
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
#define p75 .75
|
||||
#define p0001 1e-4
|
||||
|
||||
/* System generated locals */
|
||||
int fjac_dim1, fjac_offset, i__1, i__2;
|
||||
real d__1, d__2, d__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l;
|
||||
real par, sum;
|
||||
int sing;
|
||||
int iter;
|
||||
real temp, temp1, temp2;
|
||||
int iflag;
|
||||
real delta;
|
||||
real ratio;
|
||||
real fnorm, gnorm, pnorm, xnorm = 0, fnorm1, actred, dirder,
|
||||
epsmch, prered;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine lmstr */
|
||||
|
||||
/* the purpose of lmstr is to minimize the sum of the squares of */
|
||||
/* m nonlinear functions in n variables by a modification of */
|
||||
/* the levenberg-marquardt algorithm which uses minimal storage. */
|
||||
/* the user must provide a subroutine which calculates the */
|
||||
/* functions and the rows of the jacobian. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine lmstr(fcn,m,n,x,fvec,fjac,ldfjac,ftol,xtol,gtol, */
|
||||
/* maxfev,diag,mode,factor,nprint,info,nfev, */
|
||||
/* njev,ipvt,qtf,wa1,wa2,wa3,wa4) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* fcn is the name of the user-supplied subroutine which */
|
||||
/* calculates the functions and the rows of the jacobian. */
|
||||
/* fcn must be declared in an external statement in the */
|
||||
/* user calling program, and should be written as follows. */
|
||||
|
||||
/* subroutine fcn(m,n,x,fvec,fjrow,iflag) */
|
||||
/* integer m,n,iflag */
|
||||
/* double precision x(n),fvec(m),fjrow(n) */
|
||||
/* ---------- */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* ---------- */
|
||||
/* return */
|
||||
/* end */
|
||||
|
||||
/* the value of iflag should not be changed by fcn unless */
|
||||
/* the user wants to terminate execution of lmstr. */
|
||||
/* in this case set iflag to a negative integer. */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of functions. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of variables. n must not exceed m. */
|
||||
|
||||
/* x is an array of length n. on input x must contain */
|
||||
/* an initial estimate of the solution vector. on output x */
|
||||
/* contains the final estimate of the solution vector. */
|
||||
|
||||
/* fvec is an output array of length m which contains */
|
||||
/* the functions evaluated at the output x. */
|
||||
|
||||
/* fjac is an output n by n array. the upper triangle of fjac */
|
||||
/* contains an upper triangular matrix r such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(jac *jac)*p = r *r, */
|
||||
|
||||
/* where p is a permutation matrix and jac is the final */
|
||||
/* calculated jacobian. column j of p is column ipvt(j) */
|
||||
/* (see below) of the identity matrix. the lower triangular */
|
||||
/* part of fjac contains information generated during */
|
||||
/* the computation of r. */
|
||||
|
||||
/* ldfjac is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array fjac. */
|
||||
|
||||
/* ftol is a nonnegative input variable. termination */
|
||||
/* occurs when both the actual and predicted relative */
|
||||
/* reductions in the sum of squares are at most ftol. */
|
||||
/* therefore, ftol measures the relative error desired */
|
||||
/* in the sum of squares. */
|
||||
|
||||
/* xtol is a nonnegative input variable. termination */
|
||||
/* occurs when the relative error between two consecutive */
|
||||
/* iterates is at most xtol. therefore, xtol measures the */
|
||||
/* relative error desired in the approximate solution. */
|
||||
|
||||
/* gtol is a nonnegative input variable. termination */
|
||||
/* occurs when the cosine of the angle between fvec and */
|
||||
/* any column of the jacobian is at most gtol in absolute */
|
||||
/* value. therefore, gtol measures the orthogonality */
|
||||
/* desired between the function vector and the columns */
|
||||
/* of the jacobian. */
|
||||
|
||||
/* maxfev is a positive integer input variable. termination */
|
||||
/* occurs when the number of calls to fcn with iflag = 1 */
|
||||
/* has reached maxfev. */
|
||||
|
||||
/* diag is an array of length n. if mode = 1 (see */
|
||||
/* below), diag is internally set. if mode = 2, diag */
|
||||
/* must contain positive entries that serve as */
|
||||
/* multiplicative scale factors for the variables. */
|
||||
|
||||
/* mode is an integer input variable. if mode = 1, the */
|
||||
/* variables will be scaled internally. if mode = 2, */
|
||||
/* the scaling is specified by the input diag. other */
|
||||
/* values of mode are equivalent to mode = 1. */
|
||||
|
||||
/* factor is a positive input variable used in determining the */
|
||||
/* initial step bound. this bound is set to the product of */
|
||||
/* factor and the euclidean norm of diag*x if nonzero, or else */
|
||||
/* to factor itself. in most cases factor should lie in the */
|
||||
/* interval (.1,100.). 100. is a generally recommended value. */
|
||||
|
||||
/* nprint is an integer input variable that enables controlled */
|
||||
/* printing of iterates if it is positive. in this case, */
|
||||
/* fcn is called with iflag = 0 at the beginning of the first */
|
||||
/* iteration and every nprint iterations thereafter and */
|
||||
/* immediately prior to return, with x and fvec available */
|
||||
/* for printing. if nprint is not positive, no special calls */
|
||||
/* of fcn with iflag = 0 are made. */
|
||||
|
||||
/* info is an integer output variable. if the user has */
|
||||
/* terminated execution, info is set to the (negative) */
|
||||
/* value of iflag. see description of fcn. otherwise, */
|
||||
/* info is set as follows. */
|
||||
|
||||
/* info = 0 improper input parameters. */
|
||||
|
||||
/* info = 1 both actual and predicted relative reductions */
|
||||
/* in the sum of squares are at most ftol. */
|
||||
|
||||
/* info = 2 relative error between two consecutive iterates */
|
||||
/* is at most xtol. */
|
||||
|
||||
/* info = 3 conditions for info = 1 and info = 2 both hold. */
|
||||
|
||||
/* info = 4 the cosine of the angle between fvec and any */
|
||||
/* column of the jacobian is at most gtol in */
|
||||
/* absolute value. */
|
||||
|
||||
/* info = 5 number of calls to fcn with iflag = 1 has */
|
||||
/* reached maxfev. */
|
||||
|
||||
/* info = 6 ftol is too small. no further reduction in */
|
||||
/* the sum of squares is possible. */
|
||||
|
||||
/* info = 7 xtol is too small. no further improvement in */
|
||||
/* the approximate solution x is possible. */
|
||||
|
||||
/* info = 8 gtol is too small. fvec is orthogonal to the */
|
||||
/* columns of the jacobian to machine precision. */
|
||||
|
||||
/* nfev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 1. */
|
||||
|
||||
/* njev is an integer output variable set to the number of */
|
||||
/* calls to fcn with iflag = 2. */
|
||||
|
||||
/* ipvt is an integer output array of length n. ipvt */
|
||||
/* defines a permutation matrix p such that jac*p = q*r, */
|
||||
/* where jac is the final calculated jacobian, q is */
|
||||
/* orthogonal (not stored), and r is upper triangular. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* qtf is an output array of length n which contains */
|
||||
/* the first n elements of the vector (q transpose)*fvec. */
|
||||
|
||||
/* wa1, wa2, and wa3 are work arrays of length n. */
|
||||
|
||||
/* wa4 is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* user-supplied ...... fcn */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm,lmpar,qrfac,rwupdt */
|
||||
|
||||
/* fortran-supplied ... dabs,dmax1,dmin1,dsqrt,mod */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa4;
|
||||
--fvec;
|
||||
--wa3;
|
||||
--wa2;
|
||||
--wa1;
|
||||
--qtf;
|
||||
--ipvt;
|
||||
--diag;
|
||||
--x;
|
||||
fjac_dim1 = *ldfjac;
|
||||
fjac_offset = 1 + fjac_dim1 * 1;
|
||||
fjac -= fjac_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
*info = 0;
|
||||
iflag = 0;
|
||||
*nfev = 0;
|
||||
*njev = 0;
|
||||
|
||||
/* check the input parameters for errors. */
|
||||
|
||||
if (*n <= 0 || *m < *n || *ldfjac < *n || *ftol < 0. || *xtol < 0. ||
|
||||
*gtol < 0. || *maxfev <= 0 || *factor <= 0.) {
|
||||
goto L340;
|
||||
}
|
||||
if (*mode != 2) {
|
||||
goto L20;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (diag[j] <= 0.) {
|
||||
goto L340;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* evaluate the function at the starting point */
|
||||
/* and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
|
||||
*nfev = 1;
|
||||
if (iflag < 0) {
|
||||
goto L340;
|
||||
}
|
||||
fnorm = __minpack_func__(enorm)(m, &fvec[1]);
|
||||
|
||||
/* initialize levenberg-marquardt parameter and iteration counter. */
|
||||
|
||||
par = 0.;
|
||||
iter = 1;
|
||||
|
||||
/* beginning of the outer loop. */
|
||||
|
||||
L30:
|
||||
|
||||
/* if requested, call fcn to enable printing of iterates. */
|
||||
|
||||
if (*nprint <= 0) {
|
||||
goto L40;
|
||||
}
|
||||
iflag = 0;
|
||||
if ((iter - 1) % *nprint == 0) {
|
||||
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
|
||||
}
|
||||
if (iflag < 0) {
|
||||
goto L340;
|
||||
}
|
||||
L40:
|
||||
|
||||
/* compute the qr factorization of the jacobian matrix */
|
||||
/* calculated one row at a time, while simultaneously */
|
||||
/* forming (q transpose)*fvec and storing the first */
|
||||
/* n components in qtf. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
qtf[j] = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
fjac[i__ + j * fjac_dim1] = 0.;
|
||||
/* L50: */
|
||||
}
|
||||
/* L60: */
|
||||
}
|
||||
iflag = 2;
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
|
||||
if (iflag < 0) {
|
||||
goto L340;
|
||||
}
|
||||
temp = fvec[i__];
|
||||
__minpack_func__(rwupdt)(n, &fjac[fjac_offset], ldfjac, &wa3[1], &qtf[1], &temp, &wa1[
|
||||
1], &wa2[1]);
|
||||
++iflag;
|
||||
/* L70: */
|
||||
}
|
||||
++(*njev);
|
||||
|
||||
/* if the jacobian is rank deficient, call qrfac to */
|
||||
/* reorder its columns and update the components of qtf. */
|
||||
|
||||
sing = FALSE_;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
sing = TRUE_;
|
||||
}
|
||||
ipvt[j] = j;
|
||||
wa2[j] = __minpack_func__(enorm)(&j, &fjac[j * fjac_dim1 + 1]);
|
||||
/* L80: */
|
||||
}
|
||||
if (! sing) {
|
||||
goto L130;
|
||||
}
|
||||
__minpack_func__(qrfac)(n, n, &fjac[fjac_offset], ldfjac, &c_true, &ipvt[1], n, &wa1[1], &
|
||||
wa2[1], &wa3[1]);
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (fjac[j + j * fjac_dim1] == 0.) {
|
||||
goto L110;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * qtf[i__];
|
||||
/* L90: */
|
||||
}
|
||||
temp = -sum / fjac[j + j * fjac_dim1];
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
qtf[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L100: */
|
||||
}
|
||||
L110:
|
||||
fjac[j + j * fjac_dim1] = wa1[j];
|
||||
/* L120: */
|
||||
}
|
||||
L130:
|
||||
|
||||
/* on the first iteration and if mode is 1, scale according */
|
||||
/* to the norms of the columns of the initial jacobian. */
|
||||
|
||||
if (iter != 1) {
|
||||
goto L170;
|
||||
}
|
||||
if (*mode == 2) {
|
||||
goto L150;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
diag[j] = wa2[j];
|
||||
if (wa2[j] == 0.) {
|
||||
diag[j] = 1.;
|
||||
}
|
||||
/* L140: */
|
||||
}
|
||||
L150:
|
||||
|
||||
/* on the first iteration, calculate the norm of the scaled x */
|
||||
/* and initialize the step bound delta. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = diag[j] * x[j];
|
||||
/* L160: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
delta = *factor * xnorm;
|
||||
if (delta == 0.) {
|
||||
delta = *factor;
|
||||
}
|
||||
L170:
|
||||
|
||||
/* compute the norm of the scaled gradient. */
|
||||
|
||||
gnorm = 0.;
|
||||
if (fnorm == 0.) {
|
||||
goto L210;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
if (wa2[l] == 0.) {
|
||||
goto L190;
|
||||
}
|
||||
sum = 0.;
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
sum += fjac[i__ + j * fjac_dim1] * (qtf[i__] / fnorm);
|
||||
/* L180: */
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__2 = gnorm, d__3 = (d__1 = sum / wa2[l], abs(d__1));
|
||||
gnorm = max(d__2,d__3);
|
||||
L190:
|
||||
/* L200: */
|
||||
;
|
||||
}
|
||||
L210:
|
||||
|
||||
/* test for convergence of the gradient norm. */
|
||||
|
||||
if (gnorm <= *gtol) {
|
||||
*info = 4;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L340;
|
||||
}
|
||||
|
||||
/* rescale if necessary. */
|
||||
|
||||
if (*mode == 2) {
|
||||
goto L230;
|
||||
}
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
/* Computing MAX */
|
||||
d__1 = diag[j], d__2 = wa2[j];
|
||||
diag[j] = max(d__1,d__2);
|
||||
/* L220: */
|
||||
}
|
||||
L230:
|
||||
|
||||
/* beginning of the inner loop. */
|
||||
|
||||
L240:
|
||||
|
||||
/* determine the levenberg-marquardt parameter. */
|
||||
|
||||
__minpack_func__(lmpar)(n, &fjac[fjac_offset], ldfjac, &ipvt[1], &diag[1], &qtf[1], &delta,
|
||||
&par, &wa1[1], &wa2[1], &wa3[1], &wa4[1]);
|
||||
|
||||
/* store the direction p and x + p. calculate the norm of p. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa1[j] = -wa1[j];
|
||||
wa2[j] = x[j] + wa1[j];
|
||||
wa3[j] = diag[j] * wa1[j];
|
||||
/* L250: */
|
||||
}
|
||||
pnorm = __minpack_func__(enorm)(n, &wa3[1]);
|
||||
|
||||
/* on the first iteration, adjust the initial step bound. */
|
||||
|
||||
if (iter == 1) {
|
||||
delta = min(delta,pnorm);
|
||||
}
|
||||
|
||||
/* evaluate the function at x + p and calculate its norm. */
|
||||
|
||||
iflag = 1;
|
||||
fcnderstr_mn(m, n, &wa2[1], &wa4[1], &wa3[1], &iflag);
|
||||
++(*nfev);
|
||||
if (iflag < 0) {
|
||||
goto L340;
|
||||
}
|
||||
fnorm1 = __minpack_func__(enorm)(m, &wa4[1]);
|
||||
|
||||
/* compute the scaled actual reduction. */
|
||||
|
||||
actred = -1.;
|
||||
if (p1 * fnorm1 < fnorm) {
|
||||
/* Computing 2nd power */
|
||||
d__1 = fnorm1 / fnorm;
|
||||
actred = 1. - d__1 * d__1;
|
||||
}
|
||||
|
||||
/* compute the scaled predicted reduction and */
|
||||
/* the scaled directional derivative. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
wa3[j] = 0.;
|
||||
l = ipvt[j];
|
||||
temp = wa1[l];
|
||||
i__2 = j;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
wa3[i__] += fjac[i__ + j * fjac_dim1] * temp;
|
||||
/* L260: */
|
||||
}
|
||||
/* L270: */
|
||||
}
|
||||
temp1 = __minpack_func__(enorm)(n, &wa3[1]) / fnorm;
|
||||
temp2 = sqrt(par) * pnorm / fnorm;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
prered = d__1 * d__1 + d__2 * d__2 / p5;
|
||||
/* Computing 2nd power */
|
||||
d__1 = temp1;
|
||||
/* Computing 2nd power */
|
||||
d__2 = temp2;
|
||||
dirder = -(d__1 * d__1 + d__2 * d__2);
|
||||
|
||||
/* compute the ratio of the actual to the predicted */
|
||||
/* reduction. */
|
||||
|
||||
ratio = 0.;
|
||||
if (prered != 0.) {
|
||||
ratio = actred / prered;
|
||||
}
|
||||
|
||||
/* update the step bound. */
|
||||
|
||||
if (ratio > p25) {
|
||||
goto L280;
|
||||
}
|
||||
if (actred >= 0.) {
|
||||
temp = p5;
|
||||
}
|
||||
if (actred < 0.) {
|
||||
temp = p5 * dirder / (dirder + p5 * actred);
|
||||
}
|
||||
if (p1 * fnorm1 >= fnorm || temp < p1) {
|
||||
temp = p1;
|
||||
}
|
||||
/* Computing MIN */
|
||||
d__1 = delta, d__2 = pnorm / p1;
|
||||
delta = temp * min(d__1,d__2);
|
||||
par /= temp;
|
||||
goto L300;
|
||||
L280:
|
||||
if (par != 0. && ratio < p75) {
|
||||
goto L290;
|
||||
}
|
||||
delta = pnorm / p5;
|
||||
par = p5 * par;
|
||||
L290:
|
||||
L300:
|
||||
|
||||
/* test for successful iteration. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L330;
|
||||
}
|
||||
|
||||
/* successful iteration. update x, fvec, and their norms. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
x[j] = wa2[j];
|
||||
wa2[j] = diag[j] * x[j];
|
||||
/* L310: */
|
||||
}
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
fvec[i__] = wa4[i__];
|
||||
/* L320: */
|
||||
}
|
||||
xnorm = __minpack_func__(enorm)(n, &wa2[1]);
|
||||
fnorm = fnorm1;
|
||||
++iter;
|
||||
L330:
|
||||
|
||||
/* tests for convergence. */
|
||||
|
||||
if (abs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1.) {
|
||||
*info = 1;
|
||||
}
|
||||
if (delta <= *xtol * xnorm) {
|
||||
*info = 2;
|
||||
}
|
||||
if (abs(actred) <= *ftol && prered <= *ftol && p5 * ratio <= 1. && *info
|
||||
== 2) {
|
||||
*info = 3;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L340;
|
||||
}
|
||||
|
||||
/* tests for termination and stringent tolerances. */
|
||||
|
||||
if (*nfev >= *maxfev) {
|
||||
*info = 5;
|
||||
}
|
||||
if (abs(actred) <= epsmch && prered <= epsmch && p5 * ratio <= 1.) {
|
||||
*info = 6;
|
||||
}
|
||||
if (delta <= epsmch * xnorm) {
|
||||
*info = 7;
|
||||
}
|
||||
if (gnorm <= epsmch) {
|
||||
*info = 8;
|
||||
}
|
||||
if (*info != 0) {
|
||||
goto L340;
|
||||
}
|
||||
|
||||
/* end of the inner loop. repeat if iteration unsuccessful. */
|
||||
|
||||
if (ratio < p0001) {
|
||||
goto L240;
|
||||
}
|
||||
|
||||
/* end of the outer loop. */
|
||||
|
||||
goto L30;
|
||||
L340:
|
||||
|
||||
/* termination, either normal or user imposed. */
|
||||
|
||||
if (iflag < 0) {
|
||||
*info = iflag;
|
||||
}
|
||||
iflag = 0;
|
||||
if (*nprint > 0) {
|
||||
fcnderstr_mn(m, n, &x[1], &fvec[1], &wa3[1], &iflag);
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine lmstr. */
|
||||
|
||||
} /* lmstr_ */
|
||||
|
||||
|
|
@ -0,0 +1,306 @@
|
|||
#ifndef __MINPACK_H__
|
||||
#define __MINPACK_H__
|
||||
|
||||
#include "cminpack.h"
|
||||
|
||||
/* The default floating-point type is "double" for C/C++ and "float" for CUDA,
|
||||
but you can change this by defining one of the following symbols when
|
||||
compiling the library, and before including cminpack.h when using it:
|
||||
__cminpack_long_double__ for long double (requires compiler support)
|
||||
__cminpack_double__ for double
|
||||
__cminpack_float__ for float
|
||||
__cminpack_half__ for half from the OpenEXR library (in this case, you must
|
||||
compile cminpack with a C++ compiler)
|
||||
*/
|
||||
#ifdef __cminpack_double__
|
||||
#define __minpack_func__(func) func ## _
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_long_double__
|
||||
#define __minpack_func__(func) ld ## func ## _
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_float__
|
||||
#define __minpack_func__(func) s ## func ## _
|
||||
#endif
|
||||
|
||||
#ifdef __cminpack_half__
|
||||
#define __minpack_func__(func) h ## func ## _
|
||||
#endif
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#define MINPACK_EXPORT CMINPACK_EXPORT
|
||||
|
||||
#define __minpack_real__ __cminpack_real__
|
||||
#define __minpack_attr__ __cminpack_attr__
|
||||
#if defined(__CUDA_ARCH__) || defined(__CUDACC__)
|
||||
#define __minpack_type_fcn_nn__ __minpack_attr__ void fcn_nn
|
||||
#define __minpack_type_fcnder_nn__ __minpack_attr__ void fcnder_nn
|
||||
#define __minpack_type_fcn_mn__ __minpack_attr__ void fcn_mn
|
||||
#define __minpack_type_fcnder_mn__ __minpack_attr__ void fcnder_mn
|
||||
#define __minpack_type_fcnderstr_mn__ __minpack_attr__ void fcnderstr_mn
|
||||
#define __minpack_decl_fcn_nn__
|
||||
#define __minpack_decl_fcnder_nn__
|
||||
#define __minpack_decl_fcn_mn__
|
||||
#define __minpack_decl_fcnder_mn__
|
||||
#define __minpack_decl_fcnderstr_mn__
|
||||
#define __minpack_param_fcn_nn__
|
||||
#define __minpack_param_fcnder_nn__
|
||||
#define __minpack_param_fcn_mn__
|
||||
#define __minpack_param_fcnder_mn__
|
||||
#define __minpack_param_fcnderstr_mn__
|
||||
#else
|
||||
#define __minpack_type_fcn_nn__ typedef void (*minpack_func_nn)
|
||||
#define __minpack_type_fcnder_nn__ typedef void (*minpack_funcder_nn)
|
||||
#define __minpack_type_fcn_mn__ typedef void (*minpack_func_mn)
|
||||
#define __minpack_type_fcnder_mn__ typedef void (*minpack_funcder_mn)
|
||||
#define __minpack_type_fcnderstr_mn__ typedef void (*minpack_funcderstr_mn)
|
||||
#define __minpack_decl_fcn_nn__ minpack_func_nn fcn_nn,
|
||||
#define __minpack_decl_fcnder_nn__ minpack_funcder_nn fcnder_nn,
|
||||
#define __minpack_decl_fcn_mn__ minpack_func_mn fcn_mn,
|
||||
#define __minpack_decl_fcnder_mn__ minpack_funcder_mn fcnder_mn,
|
||||
#define __minpack_decl_fcnderstr_mn__ minpack_funcderstr_mn fcnderstr_mn,
|
||||
#define __minpack_param_fcn_nn__ fcn_nn,
|
||||
#define __minpack_param_fcnder_nn__ fcnder_nn,
|
||||
#define __minpack_param_fcn_mn__ fcn_mn,
|
||||
#define __minpack_param_fcnder_mn__ fcnder_mn,
|
||||
#define __minpack_param_fcnderstr_mn__ fcnderstr_mn,
|
||||
#endif
|
||||
#undef __cminpack_type_fcn_nn__
|
||||
#undef __cminpack_type_fcnder_nn__
|
||||
#undef __cminpack_type_fcn_mn__
|
||||
#undef __cminpack_type_fcnder_mn__
|
||||
#undef __cminpack_type_fcnderstr_mn__
|
||||
#undef __cminpack_decl_fcn_nn__
|
||||
#undef __cminpack_decl_fcnder_nn__
|
||||
#undef __cminpack_decl_fcn_mn__
|
||||
#undef __cminpack_decl_fcnder_mn__
|
||||
#undef __cminpack_decl_fcnderstr_mn__
|
||||
#undef __cminpack_param_fcn_nn__
|
||||
#undef __cminpack_param_fcnder_nn__
|
||||
#undef __cminpack_param_fcn_mn__
|
||||
#undef __cminpack_param_fcnder_mn__
|
||||
#undef __cminpack_param_fcnderstr_mn__
|
||||
|
||||
/* Declarations for minpack */
|
||||
|
||||
/* Function types: */
|
||||
/* the iflag parameter is input-only (with respect to the FORTRAN */
|
||||
/* version), the output iflag value is the return value of the function. */
|
||||
/* If iflag=0, the function shoulkd just print the current values (see */
|
||||
/* the nprint parameters below). */
|
||||
|
||||
/* for hybrd1 and hybrd: */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* return a negative value to terminate hybrd1/hybrd */
|
||||
__minpack_type_fcn_nn__(const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, int *iflag );
|
||||
|
||||
/* for hybrj1 and hybrj */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* return a negative value to terminate hybrj1/hybrj */
|
||||
__minpack_type_fcnder_nn__(const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
|
||||
const int *ldfjac, int *iflag );
|
||||
|
||||
/* for lmdif1 and lmdif */
|
||||
/* calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = 1 the result is used to compute the residuals. */
|
||||
/* if iflag = 2 the result is used to compute the Jacobian by finite differences. */
|
||||
/* Jacobian computation requires exactly n function calls with iflag = 2. */
|
||||
/* return a negative value to terminate lmdif1/lmdif */
|
||||
__minpack_type_fcn_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
|
||||
int *iflag );
|
||||
|
||||
/* for lmder1 and lmder */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. do not alter fjac. */
|
||||
/* if iflag = 2 calculate the jacobian at x and */
|
||||
/* return this matrix in fjac. do not alter fvec. */
|
||||
/* return a negative value to terminate lmder1/lmder */
|
||||
__minpack_type_fcnder_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
|
||||
__minpack_real__ *fjac, const int *ldfjac, int *iflag );
|
||||
|
||||
/* for lmstr1 and lmstr */
|
||||
/* if iflag = 1 calculate the functions at x and */
|
||||
/* return this vector in fvec. */
|
||||
/* if iflag = i calculate the (i-1)-st row of the */
|
||||
/* jacobian at x and return this vector in fjrow. */
|
||||
/* return a negative value to terminate lmstr1/lmstr */
|
||||
__minpack_type_fcnderstr_mn__(const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec,
|
||||
__minpack_real__ *fjrow, int *iflag );
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (Jacobian calculated by
|
||||
a forward-difference approximation) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(hybrd1)( __minpack_decl_fcn_nn__
|
||||
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *tol, int *info,
|
||||
__minpack_real__ *wa, const int *lwa );
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (Jacobian calculated by
|
||||
a forward-difference approximation, more general). */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(hybrd)( __minpack_decl_fcn_nn__
|
||||
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *xtol, const int *maxfev,
|
||||
const int *ml, const int *mu, const __minpack_real__ *epsfcn, __minpack_real__ *diag, const int *mode,
|
||||
const __minpack_real__ *factor, const int *nprint, int *info, int *nfev,
|
||||
__minpack_real__ *fjac, const int *ldfjac, __minpack_real__ *r, const int *lr, __minpack_real__ *qtf,
|
||||
__minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3, __minpack_real__ *wa4);
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (user-supplied Jacobian) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(hybrj1)( __minpack_decl_fcnder_nn__ const int *n, __minpack_real__ *x,
|
||||
__minpack_real__ *fvec, __minpack_real__ *fjec, const int *ldfjac, const __minpack_real__ *tol,
|
||||
int *info, __minpack_real__ *wa, const int *lwa );
|
||||
|
||||
/* find a zero of a system of N nonlinear functions in N variables by
|
||||
a modification of the Powell hybrid method (user-supplied Jacobian,
|
||||
more general) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(hybrj)( __minpack_decl_fcnder_nn__ const int *n, __minpack_real__ *x,
|
||||
__minpack_real__ *fvec, __minpack_real__ *fjec, const int *ldfjac, const __minpack_real__ *xtol,
|
||||
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
|
||||
const int *nprint, int *info, int *nfev, int *njev, __minpack_real__ *r,
|
||||
const int *lr, __minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2,
|
||||
__minpack_real__ *wa3, __minpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(Jacobian calculated by a forward-difference approximation) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmdif1)( __minpack_decl_fcn_mn__
|
||||
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *tol,
|
||||
int *info, int *iwa, __minpack_real__ *wa, const int *lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(Jacobian calculated by a forward-difference approximation, more
|
||||
general) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmdif)( __minpack_decl_fcn_mn__
|
||||
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, const __minpack_real__ *ftol,
|
||||
const __minpack_real__ *xtol, const __minpack_real__ *gtol, const int *maxfev, const __minpack_real__ *epsfcn,
|
||||
__minpack_real__ *diag, const int *mode, const __minpack_real__ *factor, const int *nprint,
|
||||
int *info, int *nfev, __minpack_real__ *fjac, const int *ldfjac, int *ipvt,
|
||||
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
|
||||
__minpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmder1)( __minpack_decl_fcnder_mn__
|
||||
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
|
||||
const int *ldfjac, const __minpack_real__ *tol, int *info, int *ipvt,
|
||||
__minpack_real__ *wa, const int *lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, more general) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmder)( __minpack_decl_fcnder_mn__
|
||||
const int *m, const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
|
||||
const int *ldfjac, const __minpack_real__ *ftol, const __minpack_real__ *xtol, const __minpack_real__ *gtol,
|
||||
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
|
||||
const int *nprint, int *info, int *nfev, int *njev, int *ipvt,
|
||||
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
|
||||
__minpack_real__ *wa4 );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, minimal storage) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmstr1)( __minpack_decl_fcnderstr_mn__ const int *m, const int *n,
|
||||
__minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac, const int *ldfjac,
|
||||
const __minpack_real__ *tol, int *info, int *ipvt, __minpack_real__ *wa, const int *lwa );
|
||||
|
||||
/* minimize the sum of the squares of nonlinear functions in N
|
||||
variables by a modification of the Levenberg-Marquardt algorithm
|
||||
(user-supplied Jacobian, minimal storage, more general) */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(lmstr)( __minpack_decl_fcnderstr_mn__ const int *m,
|
||||
const int *n, __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjac,
|
||||
const int *ldfjac, const __minpack_real__ *ftol, const __minpack_real__ *xtol, const __minpack_real__ *gtol,
|
||||
const int *maxfev, __minpack_real__ *diag, const int *mode, const __minpack_real__ *factor,
|
||||
const int *nprint, int *info, int *nfev, int *njev, int *ipvt,
|
||||
__minpack_real__ *qtf, __minpack_real__ *wa1, __minpack_real__ *wa2, __minpack_real__ *wa3,
|
||||
__minpack_real__ *wa4 );
|
||||
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(chkder)( const int *m, const int *n, const __minpack_real__ *x, __minpack_real__ *fvec, __minpack_real__ *fjec,
|
||||
const int *ldfjac, __minpack_real__ *xp, __minpack_real__ *fvecp, const int *mode,
|
||||
__minpack_real__ *err );
|
||||
|
||||
__minpack_attr__
|
||||
__minpack_real__ MINPACK_EXPORT __minpack_func__(dpmpar)( const int *i );
|
||||
|
||||
__minpack_attr__
|
||||
__minpack_real__ MINPACK_EXPORT __minpack_func__(enorm)( const int *n, const __minpack_real__ *x );
|
||||
|
||||
/* compute a forward-difference approximation to the m by n jacobian
|
||||
matrix associated with a specified problem of m functions in n
|
||||
variables. */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(fdjac2)(__minpack_decl_fcn_mn__
|
||||
const int *m, const int *n, __minpack_real__ *x, const __minpack_real__ *fvec, __minpack_real__ *fjac,
|
||||
const int *ldfjac, int *iflag, const __minpack_real__ *epsfcn, __minpack_real__ *wa);
|
||||
|
||||
/* compute a forward-difference approximation to the n by n jacobian
|
||||
matrix associated with a specified problem of n functions in n
|
||||
variables. if the jacobian has a banded form, then function
|
||||
evaluations are saved by only approximating the nonzero terms. */
|
||||
__minpack_attr__
|
||||
void MINPACK_EXPORT __minpack_func__(fdjac1)(__minpack_decl_fcn_nn__
|
||||
const int *n, __minpack_real__ *x, const __minpack_real__ *fvec, __minpack_real__ *fjac, const int *ldfjac,
|
||||
int *iflag, const int *ml, const int *mu, const __minpack_real__ *epsfcn, __minpack_real__ *wa1,
|
||||
__minpack_real__ *wa2);
|
||||
|
||||
/* internal MINPACK subroutines */
|
||||
__minpack_attr__
|
||||
void __minpack_func__(dogleg)(const int *n, const __minpack_real__ *r, const int *lr,
|
||||
const __minpack_real__ *diag, const __minpack_real__ *qtb, const __minpack_real__ *delta, __minpack_real__ *x,
|
||||
__minpack_real__ *wa1, __minpack_real__ *wa2);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qrfac)(const int *m, const int *n, __minpack_real__ *a, const int *
|
||||
lda, const int *pivot, int *ipvt, const int *lipvt, __minpack_real__ *rdiag,
|
||||
__minpack_real__ *acnorm, __minpack_real__ *wa);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qrsolv)(const int *n, __minpack_real__ *r, const int *ldr,
|
||||
const int *ipvt, const __minpack_real__ *diag, const __minpack_real__ *qtb, __minpack_real__ *x,
|
||||
__minpack_real__ *sdiag, __minpack_real__ *wa);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qform)(const int *m, const int *n, __minpack_real__ *q, const int *
|
||||
ldq, __minpack_real__ *wa);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(r1updt)(const int *m, const int *n, __minpack_real__ *s, const int *
|
||||
ls, const __minpack_real__ *u, __minpack_real__ *v, __minpack_real__ *w, int *sing);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(r1mpyq)(const int *m, const int *n, __minpack_real__ *a, const int *
|
||||
lda, const __minpack_real__ *v, const __minpack_real__ *w);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(lmpar)(const int *n, __minpack_real__ *r, const int *ldr,
|
||||
const int *ipvt, const __minpack_real__ *diag, const __minpack_real__ *qtb, const __minpack_real__ *delta,
|
||||
__minpack_real__ *par, __minpack_real__ *x, __minpack_real__ *sdiag, __minpack_real__ *wa1,
|
||||
__minpack_real__ *wa2);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(rwupdt)(const int *n, __minpack_real__ *r, const int *ldr,
|
||||
const __minpack_real__ *w, __minpack_real__ *b, __minpack_real__ *alpha, __minpack_real__ *cos,
|
||||
__minpack_real__ *sin);
|
||||
__minpack_attr__
|
||||
void __minpack_func__(covar)(const int *n, __minpack_real__ *r, const int *ldr,
|
||||
const int *ipvt, const __minpack_real__ *tol, __minpack_real__ *wa);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
|
||||
#endif /* __MINPACK_H__ */
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
/* Internal header file for cminpack, by Frederic Devernay. */
|
||||
#ifndef __MINPACKP_H__
|
||||
#define __MINPACKP_H__
|
||||
|
||||
#ifndef __CMINPACK_H__
|
||||
#error "minpackP.h in an internal cminpack header, and must be included after all other headers (including cminpack.h)"
|
||||
#endif
|
||||
|
||||
#include <float.h>
|
||||
|
||||
#define double_EPSILON DBL_EPSILON
|
||||
#define double_MIN DBL_MIN
|
||||
#define double_MAX DBL_MAX
|
||||
#define long_double_EPSILON LDBL_EPSILON
|
||||
#define long_double_MIN LDBL_MIN
|
||||
#define long_double_MAX LDBL_MAX
|
||||
#define float_EPSILON FLT_EPSILON
|
||||
#define float_MIN FLT_MIN
|
||||
#define float_MAX FLT_MAX
|
||||
#define half_EPSILON HALF_EPSILON
|
||||
#define half_MIN HALF_NRM_MIN
|
||||
#define half_MAX HALF_MAX
|
||||
|
||||
#define real __cminpack_real__
|
||||
#ifdef __cminpack_long_double__
|
||||
#define realm long_double
|
||||
#define fabs(x) fabsl(x)
|
||||
#define sqrt(x) sqrtl(x)
|
||||
#define log(x) logl(x)
|
||||
#define exp(x) expl(x)
|
||||
#define sin(x) sinl(x)
|
||||
#define cos(x) cosl(x)
|
||||
#define tan(x) tanl(x)
|
||||
#define asin(x) asinl(x)
|
||||
#define acos(x) acosl(x)
|
||||
#define atan(x) atanl(x)
|
||||
#define floor(x) floorl(x)
|
||||
#define ceil(x) ceill(x)
|
||||
extern long double floorl ( long double );
|
||||
extern long double ellpkl ( long double );
|
||||
#else
|
||||
#define realm real
|
||||
#endif
|
||||
#define min(a,b) ((a) <= (b) ? (a) : (b))
|
||||
#define max(a,b) ((a) >= (b) ? (a) : (b))
|
||||
#define abs(x) ((x) >= 0 ? (x) : -(x))
|
||||
#define TRUE_ (1)
|
||||
#define FALSE_ (0)
|
||||
|
||||
#endif /* !__MINPACKP_H__ */
|
||||
|
|
@ -0,0 +1,116 @@
|
|||
/* qform.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qform)(int m, int n, real *q, int
|
||||
ldq, real *wa)
|
||||
{
|
||||
/* System generated locals */
|
||||
int q_dim1, q_offset;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, k, l, jm1, np1;
|
||||
real sum, temp;
|
||||
int minmn;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qform */
|
||||
|
||||
/* this subroutine proceeds from the computed qr factorization of */
|
||||
/* an m by n matrix a to accumulate the m by m orthogonal matrix */
|
||||
/* q from its factored form. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qform(m,n,q,ldq,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a and the order of q. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* q is an m by m array. on input the full lower trapezoid in */
|
||||
/* the first min(m,n) columns of q contains the factored form. */
|
||||
/* on output q has been accumulated into a square matrix. */
|
||||
|
||||
/* ldq is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array q. */
|
||||
|
||||
/* wa is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... min0 */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
q_dim1 = ldq;
|
||||
q_offset = 1 + q_dim1 * 1;
|
||||
q -= q_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* zero out upper triangle of q in the first min(m,n) columns. */
|
||||
|
||||
minmn = min(m,n);
|
||||
if (minmn >= 2) {
|
||||
for (j = 2; j <= minmn; ++j) {
|
||||
jm1 = j - 1;
|
||||
for (i = 1; i <= jm1; ++i) {
|
||||
q[i + j * q_dim1] = 0.;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* initialize remaining columns to those of the identity matrix. */
|
||||
|
||||
np1 = n + 1;
|
||||
if (m >= np1) {
|
||||
for (j = np1; j <= m; ++j) {
|
||||
for (i = 1; i <= m; ++i) {
|
||||
q[i + j * q_dim1] = 0.;
|
||||
}
|
||||
q[j + j * q_dim1] = 1.;
|
||||
}
|
||||
}
|
||||
|
||||
/* accumulate q from its factored form. */
|
||||
|
||||
for (l = 1; l <= minmn; ++l) {
|
||||
k = minmn - l + 1;
|
||||
for (i = k; i <= m; ++i) {
|
||||
wa[i] = q[i + k * q_dim1];
|
||||
q[i + k * q_dim1] = 0.;
|
||||
}
|
||||
q[k + k * q_dim1] = 1.;
|
||||
if (wa[k] != 0.) {
|
||||
for (j = k; j <= m; ++j) {
|
||||
sum = 0.;
|
||||
for (i = k; i <= m; ++i) {
|
||||
sum += q[i + j * q_dim1] * wa[i];
|
||||
}
|
||||
temp = sum / wa[k];
|
||||
for (i = k; i <= m; ++i) {
|
||||
q[i + j * q_dim1] -= temp * wa[i];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* last card of subroutine qform. */
|
||||
|
||||
} /* qform_ */
|
||||
|
||||
|
|
@ -0,0 +1,144 @@
|
|||
/* qform.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qform)(const int *m, const int *n, real *q, const int *
|
||||
ldq, real *wa)
|
||||
{
|
||||
/* System generated locals */
|
||||
int q_dim1, q_offset, i__1, i__2, i__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, l, jm1, np1;
|
||||
real sum, temp;
|
||||
int minmn;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qform */
|
||||
|
||||
/* this subroutine proceeds from the computed qr factorization of */
|
||||
/* an m by n matrix a to accumulate the m by m orthogonal matrix */
|
||||
/* q from its factored form. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qform(m,n,q,ldq,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a and the order of q. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* q is an m by m array. on input the full lower trapezoid in */
|
||||
/* the first min(m,n) columns of q contains the factored form. */
|
||||
/* on output q has been accumulated into a square matrix. */
|
||||
|
||||
/* ldq is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array q. */
|
||||
|
||||
/* wa is a work array of length m. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... min0 */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
q_dim1 = *ldq;
|
||||
q_offset = 1 + q_dim1 * 1;
|
||||
q -= q_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* zero out upper triangle of q in the first min(m,n) columns. */
|
||||
|
||||
minmn = min(*m,*n);
|
||||
if (minmn < 2) {
|
||||
goto L30;
|
||||
}
|
||||
i__1 = minmn;
|
||||
for (j = 2; j <= i__1; ++j) {
|
||||
jm1 = j - 1;
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
q[i__ + j * q_dim1] = 0.;
|
||||
/* L10: */
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
L30:
|
||||
|
||||
/* initialize remaining columns to those of the identity matrix. */
|
||||
|
||||
np1 = *n + 1;
|
||||
if (*m < np1) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = *m;
|
||||
for (j = np1; j <= i__1; ++j) {
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
q[i__ + j * q_dim1] = 0.;
|
||||
/* L40: */
|
||||
}
|
||||
q[j + j * q_dim1] = 1.;
|
||||
/* L50: */
|
||||
}
|
||||
L60:
|
||||
|
||||
/* accumulate q from its factored form. */
|
||||
|
||||
i__1 = minmn;
|
||||
for (l = 1; l <= i__1; ++l) {
|
||||
k = minmn - l + 1;
|
||||
i__2 = *m;
|
||||
for (i__ = k; i__ <= i__2; ++i__) {
|
||||
wa[i__] = q[i__ + k * q_dim1];
|
||||
q[i__ + k * q_dim1] = 0.;
|
||||
/* L70: */
|
||||
}
|
||||
q[k + k * q_dim1] = 1.;
|
||||
if (wa[k] == 0.) {
|
||||
goto L110;
|
||||
}
|
||||
i__2 = *m;
|
||||
for (j = k; j <= i__2; ++j) {
|
||||
sum = 0.;
|
||||
i__3 = *m;
|
||||
for (i__ = k; i__ <= i__3; ++i__) {
|
||||
sum += q[i__ + j * q_dim1] * wa[i__];
|
||||
/* L80: */
|
||||
}
|
||||
temp = sum / wa[k];
|
||||
i__3 = *m;
|
||||
for (i__ = k; i__ <= i__3; ++i__) {
|
||||
q[i__ + j * q_dim1] -= temp * wa[i__];
|
||||
/* L90: */
|
||||
}
|
||||
/* L100: */
|
||||
}
|
||||
L110:
|
||||
/* L120: */
|
||||
;
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine qform. */
|
||||
|
||||
} /* qform_ */
|
||||
|
||||
|
|
@ -0,0 +1,285 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#ifdef USE_LAPACK
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
#endif
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qrfac)(int m, int n, real *a, int
|
||||
lda, int pivot, int *ipvt, int lipvt, real *rdiag,
|
||||
real *acnorm, real *wa)
|
||||
{
|
||||
#ifdef USE_LAPACK
|
||||
__CLPK_integer m_ = m;
|
||||
__CLPK_integer n_ = n;
|
||||
__CLPK_integer lda_ = lda;
|
||||
__CLPK_integer *jpvt;
|
||||
|
||||
int i, j, k;
|
||||
double t;
|
||||
double* tau = wa;
|
||||
const __CLPK_integer ltau = m > n ? n : m;
|
||||
__CLPK_integer lwork = -1;
|
||||
__CLPK_integer info = 0;
|
||||
double* work;
|
||||
|
||||
if (pivot) {
|
||||
assert( lipvt >= n );
|
||||
if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
|
||||
jpvt = malloc(n*sizeof(__CLPK_integer));
|
||||
} else {
|
||||
/* __CLPK_integer is actually an int, just do a cast */
|
||||
jpvt = (__CLPK_integer *)ipvt;
|
||||
}
|
||||
/* set all columns free */
|
||||
memset(jpvt, 0, sizeof(int)*n);
|
||||
}
|
||||
|
||||
/* query optimal size of work */
|
||||
lwork = -1;
|
||||
if (pivot) {
|
||||
dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,tau,&lwork,&info);
|
||||
lwork = (int)tau[0];
|
||||
assert( lwork >= 3*n+1 );
|
||||
} else {
|
||||
dgeqrf_(&m_,&n_,a,&lda_,tau,tau,&lwork,&info);
|
||||
lwork = (int)tau[0];
|
||||
assert( lwork >= 1 && lwork >= n );
|
||||
}
|
||||
|
||||
assert( info == 0 );
|
||||
|
||||
/* alloc work area */
|
||||
work = (double *)malloc(sizeof(double)*lwork);
|
||||
assert(work != NULL);
|
||||
|
||||
/* set acnorm first (from the doc of qrfac, acnorm may point to the same area as rdiag) */
|
||||
if (acnorm != rdiag) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
acnorm[j] = __cminpack_enorm__(m, &a[j * lda]);
|
||||
}
|
||||
}
|
||||
|
||||
/* QR decomposition */
|
||||
if (pivot) {
|
||||
dgeqp3_(&m_,&n_,a,&lda_,jpvt,tau,work,&lwork,&info);
|
||||
} else {
|
||||
dgeqrf_(&m_,&n_,a,&lda_,tau,work,&lwork,&info);
|
||||
}
|
||||
assert(info == 0);
|
||||
|
||||
/* set rdiag, before the diagonal is replaced */
|
||||
memset(rdiag, 0, sizeof(double)*n);
|
||||
for(i=0 ; i<n ; ++i) {
|
||||
rdiag[i] = a[i*lda+i];
|
||||
}
|
||||
|
||||
/* modify lower trinagular part to look like qrfac's output */
|
||||
for(i=0 ; i<ltau ; ++i) {
|
||||
k = i*lda+i;
|
||||
t = tau[i];
|
||||
a[k] = t;
|
||||
for(j=i+1 ; j<m ; j++) {
|
||||
k++;
|
||||
a[k] *= t;
|
||||
}
|
||||
}
|
||||
|
||||
free(work);
|
||||
if (pivot) {
|
||||
/* convert back jpvt to ipvt */
|
||||
if (sizeof(__CLPK_integer) != sizeof(ipvt[0])) {
|
||||
for(i=0; i<n; ++i) {
|
||||
ipvt[i] = jpvt[i];
|
||||
}
|
||||
free(jpvt);
|
||||
}
|
||||
}
|
||||
#else /* !USE_LAPACK */
|
||||
/* Initialized data */
|
||||
|
||||
#define p05 .05
|
||||
|
||||
/* System generated locals */
|
||||
real d1;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, k, jp1;
|
||||
real sum;
|
||||
real temp;
|
||||
int minmn;
|
||||
real epsmch;
|
||||
real ajnorm;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qrfac */
|
||||
|
||||
/* this subroutine uses householder transformations with column */
|
||||
/* pivoting (optional) to compute a qr factorization of the */
|
||||
/* m by n matrix a. that is, qrfac determines an orthogonal */
|
||||
/* matrix q, a permutation matrix p, and an upper trapezoidal */
|
||||
/* matrix r with diagonal elements of nonincreasing magnitude, */
|
||||
/* such that a*p = q*r. the householder transformation for */
|
||||
/* column k, k = 1,2,...,min(m,n), is of the form */
|
||||
|
||||
/* t */
|
||||
/* i - (1/u(k))*u*u */
|
||||
|
||||
/* where u has zeros in the first k-1 positions. the form of */
|
||||
/* this transformation and the method of pivoting first */
|
||||
/* appeared in the corresponding linpack subroutine. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* a is an m by n array. on input a contains the matrix for */
|
||||
/* which the qr factorization is to be computed. on output */
|
||||
/* the strict upper trapezoidal part of a contains the strict */
|
||||
/* upper trapezoidal part of r, and the lower trapezoidal */
|
||||
/* part of a contains a factored form of q (the non-trivial */
|
||||
/* elements of the u vectors described above). */
|
||||
|
||||
/* lda is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array a. */
|
||||
|
||||
/* pivot is a logical input variable. if pivot is set true, */
|
||||
/* then column pivoting is enforced. if pivot is set false, */
|
||||
/* then no column pivoting is done. */
|
||||
|
||||
/* ipvt is an integer output array of length lipvt. ipvt */
|
||||
/* defines the permutation matrix p such that a*p = q*r. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
/* if pivot is false, ipvt is not referenced. */
|
||||
|
||||
/* lipvt is a positive integer input variable. if pivot is false, */
|
||||
/* then lipvt may be as small as 1. if pivot is true, then */
|
||||
/* lipvt must be at least n. */
|
||||
|
||||
/* rdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of r. */
|
||||
|
||||
/* acnorm is an output array of length n which contains the */
|
||||
/* norms of the corresponding columns of the input matrix a. */
|
||||
/* if this information is not needed, then acnorm can coincide */
|
||||
/* with rdiag. */
|
||||
|
||||
/* wa is a work array of length n. if pivot is false, then wa */
|
||||
/* can coincide with rdiag. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm */
|
||||
|
||||
/* fortran-supplied ... dmax1,dsqrt,min0 */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
(void)lipvt;
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __cminpack_func__(dpmpar)(1);
|
||||
|
||||
/* compute the initial column norms and initialize several arrays. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
acnorm[j] = __cminpack_enorm__(m, &a[j * lda + 0]);
|
||||
rdiag[j] = acnorm[j];
|
||||
wa[j] = rdiag[j];
|
||||
if (pivot) {
|
||||
ipvt[j] = j+1;
|
||||
}
|
||||
}
|
||||
|
||||
/* reduce a to r with householder transformations. */
|
||||
|
||||
minmn = min(m,n);
|
||||
for (j = 0; j < minmn; ++j) {
|
||||
if (pivot) {
|
||||
|
||||
/* bring the column of largest norm into the pivot position. */
|
||||
|
||||
int kmax = j;
|
||||
for (k = j; k < n; ++k) {
|
||||
if (rdiag[k] > rdiag[kmax]) {
|
||||
kmax = k;
|
||||
}
|
||||
}
|
||||
if (kmax != j) {
|
||||
for (i = 0; i < m; ++i) {
|
||||
temp = a[i + j * lda];
|
||||
a[i + j * lda] = a[i + kmax * lda];
|
||||
a[i + kmax * lda] = temp;
|
||||
}
|
||||
rdiag[kmax] = rdiag[j];
|
||||
wa[kmax] = wa[j];
|
||||
k = ipvt[j];
|
||||
ipvt[j] = ipvt[kmax];
|
||||
ipvt[kmax] = k;
|
||||
}
|
||||
}
|
||||
|
||||
/* compute the householder transformation to reduce the */
|
||||
/* j-th column of a to a multiple of the j-th unit vector. */
|
||||
|
||||
ajnorm = __cminpack_enorm__(m - (j+1) + 1, &a[j + j * lda]);
|
||||
if (ajnorm != 0.) {
|
||||
if (a[j + j * lda] < 0.) {
|
||||
ajnorm = -ajnorm;
|
||||
}
|
||||
for (i = j; i < m; ++i) {
|
||||
a[i + j * lda] /= ajnorm;
|
||||
}
|
||||
a[j + j * lda] += 1.;
|
||||
|
||||
/* apply the transformation to the remaining columns */
|
||||
/* and update the norms. */
|
||||
|
||||
jp1 = j + 1;
|
||||
if (n > jp1) {
|
||||
for (k = jp1; k < n; ++k) {
|
||||
sum = 0.;
|
||||
for (i = j; i < m; ++i) {
|
||||
sum += a[i + j * lda] * a[i + k * lda];
|
||||
}
|
||||
temp = sum / a[j + j * lda];
|
||||
for (i = j; i < m; ++i) {
|
||||
a[i + k * lda] -= temp * a[i + j * lda];
|
||||
}
|
||||
if (pivot && rdiag[k] != 0.) {
|
||||
temp = a[j + k * lda] / rdiag[k];
|
||||
/* Computing MAX */
|
||||
d1 = 1. - temp * temp;
|
||||
rdiag[k] *= sqrt((max((real)0.,d1)));
|
||||
/* Computing 2nd power */
|
||||
d1 = rdiag[k] / wa[k];
|
||||
if (p05 * (d1 * d1) <= epsmch) {
|
||||
rdiag[k] = __cminpack_enorm__(m - (j+1), &a[jp1 + k * lda]);
|
||||
wa[k] = rdiag[k];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
rdiag[j] = -ajnorm;
|
||||
}
|
||||
|
||||
/* last card of subroutine qrfac. */
|
||||
#endif /* !USE_LAPACK */
|
||||
} /* qrfac_ */
|
||||
|
||||
|
|
@ -0,0 +1,243 @@
|
|||
/* qrfac.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qrfac)(const int *m, const int *n, real *a, const int *
|
||||
lda, const int *pivot, int *ipvt, const int *lipvt, real *rdiag,
|
||||
real *acnorm, real *wa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p05 .05
|
||||
const int c__1 = 1;
|
||||
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, i__1, i__2, i__3;
|
||||
real d__1, d__2, d__3;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, jp1;
|
||||
real sum;
|
||||
int kmax;
|
||||
real temp;
|
||||
int minmn;
|
||||
real epsmch;
|
||||
real ajnorm;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qrfac */
|
||||
|
||||
/* this subroutine uses householder transformations with column */
|
||||
/* pivoting (optional) to compute a qr factorization of the */
|
||||
/* m by n matrix a. that is, qrfac determines an orthogonal */
|
||||
/* matrix q, a permutation matrix p, and an upper trapezoidal */
|
||||
/* matrix r with diagonal elements of nonincreasing magnitude, */
|
||||
/* such that a*p = q*r. the householder transformation for */
|
||||
/* column k, k = 1,2,...,min(m,n), is of the form */
|
||||
|
||||
/* t */
|
||||
/* i - (1/u(k))*u*u */
|
||||
|
||||
/* where u has zeros in the first k-1 positions. the form of */
|
||||
/* this transformation and the method of pivoting first */
|
||||
/* appeared in the corresponding linpack subroutine. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qrfac(m,n,a,lda,pivot,ipvt,lipvt,rdiag,acnorm,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* a is an m by n array. on input a contains the matrix for */
|
||||
/* which the qr factorization is to be computed. on output */
|
||||
/* the strict upper trapezoidal part of a contains the strict */
|
||||
/* upper trapezoidal part of r, and the lower trapezoidal */
|
||||
/* part of a contains a factored form of q (the non-trivial */
|
||||
/* elements of the u vectors described above). */
|
||||
|
||||
/* lda is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array a. */
|
||||
|
||||
/* pivot is a logical input variable. if pivot is set true, */
|
||||
/* then column pivoting is enforced. if pivot is set false, */
|
||||
/* then no column pivoting is done. */
|
||||
|
||||
/* ipvt is an integer output array of length lipvt. ipvt */
|
||||
/* defines the permutation matrix p such that a*p = q*r. */
|
||||
/* column j of p is column ipvt(j) of the identity matrix. */
|
||||
/* if pivot is false, ipvt is not referenced. */
|
||||
|
||||
/* lipvt is a positive integer input variable. if pivot is false, */
|
||||
/* then lipvt may be as small as 1. if pivot is true, then */
|
||||
/* lipvt must be at least n. */
|
||||
|
||||
/* rdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of r. */
|
||||
|
||||
/* acnorm is an output array of length n which contains the */
|
||||
/* norms of the corresponding columns of the input matrix a. */
|
||||
/* if this information is not needed, then acnorm can coincide */
|
||||
/* with rdiag. */
|
||||
|
||||
/* wa is a work array of length n. if pivot is false, then wa */
|
||||
/* can coincide with rdiag. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar,enorm */
|
||||
|
||||
/* fortran-supplied ... dmax1,dsqrt,min0 */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
--acnorm;
|
||||
--rdiag;
|
||||
a_dim1 = *lda;
|
||||
a_offset = 1 + a_dim1 * 1;
|
||||
a -= a_offset;
|
||||
--ipvt;
|
||||
(void)lipvt;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* epsmch is the machine precision. */
|
||||
|
||||
epsmch = __minpack_func__(dpmpar)(&c__1);
|
||||
|
||||
/* compute the initial column norms and initialize several arrays. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
acnorm[j] = __minpack_func__(enorm)(m, &a[j * a_dim1 + 1]);
|
||||
rdiag[j] = acnorm[j];
|
||||
wa[j] = rdiag[j];
|
||||
if (*pivot) {
|
||||
ipvt[j] = j;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
|
||||
/* reduce a to r with householder transformations. */
|
||||
|
||||
minmn = min(*m,*n);
|
||||
i__1 = minmn;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (! (*pivot)) {
|
||||
goto L40;
|
||||
}
|
||||
|
||||
/* bring the column of largest norm into the pivot position. */
|
||||
|
||||
kmax = j;
|
||||
i__2 = *n;
|
||||
for (k = j; k <= i__2; ++k) {
|
||||
if (rdiag[k] > rdiag[kmax]) {
|
||||
kmax = k;
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
if (kmax == j) {
|
||||
goto L40;
|
||||
}
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
temp = a[i__ + j * a_dim1];
|
||||
a[i__ + j * a_dim1] = a[i__ + kmax * a_dim1];
|
||||
a[i__ + kmax * a_dim1] = temp;
|
||||
/* L30: */
|
||||
}
|
||||
rdiag[kmax] = rdiag[j];
|
||||
wa[kmax] = wa[j];
|
||||
k = ipvt[j];
|
||||
ipvt[j] = ipvt[kmax];
|
||||
ipvt[kmax] = k;
|
||||
L40:
|
||||
|
||||
/* compute the householder transformation to reduce the */
|
||||
/* j-th column of a to a multiple of the j-th unit vector. */
|
||||
|
||||
i__2 = *m - j + 1;
|
||||
ajnorm = __minpack_func__(enorm)(&i__2, &a[j + j * a_dim1]);
|
||||
if (ajnorm == 0.) {
|
||||
goto L100;
|
||||
}
|
||||
if (a[j + j * a_dim1] < 0.) {
|
||||
ajnorm = -ajnorm;
|
||||
}
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
a[i__ + j * a_dim1] /= ajnorm;
|
||||
/* L50: */
|
||||
}
|
||||
a[j + j * a_dim1] += 1.;
|
||||
|
||||
/* apply the transformation to the remaining columns */
|
||||
/* and update the norms. */
|
||||
|
||||
jp1 = j + 1;
|
||||
if (*n < jp1) {
|
||||
goto L100;
|
||||
}
|
||||
i__2 = *n;
|
||||
for (k = jp1; k <= i__2; ++k) {
|
||||
sum = 0.;
|
||||
i__3 = *m;
|
||||
for (i__ = j; i__ <= i__3; ++i__) {
|
||||
sum += a[i__ + j * a_dim1] * a[i__ + k * a_dim1];
|
||||
/* L60: */
|
||||
}
|
||||
temp = sum / a[j + j * a_dim1];
|
||||
i__3 = *m;
|
||||
for (i__ = j; i__ <= i__3; ++i__) {
|
||||
a[i__ + k * a_dim1] -= temp * a[i__ + j * a_dim1];
|
||||
/* L70: */
|
||||
}
|
||||
if (! (*pivot) || rdiag[k] == 0.) {
|
||||
goto L80;
|
||||
}
|
||||
temp = a[j + k * a_dim1] / rdiag[k];
|
||||
/* Computing MAX */
|
||||
/* Computing 2nd power */
|
||||
d__3 = temp;
|
||||
d__1 = 0., d__2 = 1. - d__3 * d__3;
|
||||
rdiag[k] *= sqrt((max(d__1,d__2)));
|
||||
/* Computing 2nd power */
|
||||
d__1 = rdiag[k] / wa[k];
|
||||
if (p05 * (d__1 * d__1) > epsmch) {
|
||||
goto L80;
|
||||
}
|
||||
i__3 = *m - j;
|
||||
rdiag[k] = __minpack_func__(enorm)(&i__3, &a[jp1 + k * a_dim1]);
|
||||
wa[k] = rdiag[k];
|
||||
L80:
|
||||
/* L90: */
|
||||
;
|
||||
}
|
||||
L100:
|
||||
rdiag[j] = -ajnorm;
|
||||
/* L110: */
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine qrfac. */
|
||||
|
||||
} /* qrfac_ */
|
||||
|
||||
|
|
@ -0,0 +1,218 @@
|
|||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(qrsolv)(int n, real *r, int ldr,
|
||||
const int *ipvt, const real *diag, const real *qtb, real *x,
|
||||
real *sdiag, real *wa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
|
||||
/* Local variables */
|
||||
int i, j, k, l;
|
||||
real cos, sin, sum, temp;
|
||||
int nsing;
|
||||
real qtbpj;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qrsolv */
|
||||
|
||||
/* given an m by n matrix a, an n by n diagonal matrix d, */
|
||||
/* and an m-vector b, the problem is to determine an x which */
|
||||
/* solves the system */
|
||||
|
||||
/* a*x = b , d*x = 0 , */
|
||||
|
||||
/* in the least squares sense. */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then qrsolv expects */
|
||||
/* the full upper triangle of r, the permutation matrix p, */
|
||||
/* and the first n components of (q transpose)*b. the system */
|
||||
/* a*x = b, d*x = 0, is then equivalent to */
|
||||
|
||||
/* t t */
|
||||
/* r*z = q *b , p *d*p*z = 0 , */
|
||||
|
||||
/* where x = p*z. if this system does not have full rank, */
|
||||
/* then a least squares solution is obtained. on output qrsolv */
|
||||
/* also provides an upper triangular matrix s such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(a *a + d*d)*p = s *s . */
|
||||
|
||||
/* s is computed within qrsolv and may be of separate interest. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle */
|
||||
/* must contain the full upper triangle of the matrix r. */
|
||||
/* on output the full upper triangle is unaltered, and the */
|
||||
/* strict lower triangle contains the strict upper triangle */
|
||||
/* (transposed) of the upper triangular matrix s. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* x is an output array of length n which contains the least */
|
||||
/* squares solution of the system a*x = b, d*x = 0. */
|
||||
|
||||
/* sdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of the upper triangular matrix s. */
|
||||
|
||||
/* wa is a work array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* copy r and (q transpose)*b to preserve input and initialize s. */
|
||||
/* in particular, save the diagonal elements of r in x. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
for (i = j; i < n; ++i) {
|
||||
r[i + j * ldr] = r[j + i * ldr];
|
||||
}
|
||||
x[j] = r[j + j * ldr];
|
||||
wa[j] = qtb[j];
|
||||
}
|
||||
|
||||
/* eliminate the diagonal matrix d using a givens rotation. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
|
||||
/* prepare the row of d to be eliminated, locating the */
|
||||
/* diagonal element using p from the qr factorization. */
|
||||
|
||||
l = ipvt[j]-1;
|
||||
if (diag[l] != 0.) {
|
||||
for (k = j; k < n; ++k) {
|
||||
sdiag[k] = 0.;
|
||||
}
|
||||
sdiag[j] = diag[l];
|
||||
|
||||
/* the transformations to eliminate the row of d */
|
||||
/* modify only a single element of (q transpose)*b */
|
||||
/* beyond the first n, which is initially zero. */
|
||||
|
||||
qtbpj = 0.;
|
||||
for (k = j; k < n; ++k) {
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* appropriate element in the current row of d. */
|
||||
|
||||
if (sdiag[k] != 0.) {
|
||||
# ifdef USE_LAPACK
|
||||
dlartg_( &r[k + k * ldr], &sdiag[k], &cos, &sin, &temp );
|
||||
# else /* !USE_LAPACK */
|
||||
if (fabs(r[k + k * ldr]) < fabs(sdiag[k])) {
|
||||
real cotan;
|
||||
cotan = r[k + k * ldr] / sdiag[k];
|
||||
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
|
||||
cos = sin * cotan;
|
||||
} else {
|
||||
real tan;
|
||||
tan = sdiag[k] / r[k + k * ldr];
|
||||
cos = p5 / sqrt(p25 + p25 * (tan * tan));
|
||||
sin = cos * tan;
|
||||
}
|
||||
|
||||
/* compute the modified diagonal element of r and */
|
||||
/* the modified element of ((q transpose)*b,0). */
|
||||
|
||||
# endif /* !USE_LAPACK */
|
||||
temp = cos * wa[k] + sin * qtbpj;
|
||||
qtbpj = -sin * wa[k] + cos * qtbpj;
|
||||
wa[k] = temp;
|
||||
|
||||
/* accumulate the tranformation in the row of s. */
|
||||
# ifdef USE_CBLAS
|
||||
cblas_drot( n-k, &r[k + k * ldr], 1, &sdiag[k], 1, cos, sin );
|
||||
# else /* !USE_CBLAS */
|
||||
r[k + k * ldr] = cos * r[k + k * ldr] + sin * sdiag[k];
|
||||
if (n > k+1) {
|
||||
for (i = k+1; i < n; ++i) {
|
||||
temp = cos * r[i + k * ldr] + sin * sdiag[i];
|
||||
sdiag[i] = -sin * r[i + k * ldr] + cos * sdiag[i];
|
||||
r[i + k * ldr] = temp;
|
||||
}
|
||||
}
|
||||
# endif /* !USE_CBLAS */
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* store the diagonal element of s and restore */
|
||||
/* the corresponding diagonal element of r. */
|
||||
|
||||
sdiag[j] = r[j + j * ldr];
|
||||
r[j + j * ldr] = x[j];
|
||||
}
|
||||
|
||||
/* solve the triangular system for z. if the system is */
|
||||
/* singular, then obtain a least squares solution. */
|
||||
|
||||
nsing = n;
|
||||
for (j = 0; j < n; ++j) {
|
||||
if (sdiag[j] == 0. && nsing == n) {
|
||||
nsing = j;
|
||||
}
|
||||
if (nsing < n) {
|
||||
wa[j] = 0.;
|
||||
}
|
||||
}
|
||||
if (nsing >= 1) {
|
||||
for (k = 1; k <= nsing; ++k) {
|
||||
j = nsing - k;
|
||||
sum = 0.;
|
||||
if (nsing > j+1) {
|
||||
for (i = j+1; i < nsing; ++i) {
|
||||
sum += r[i + j * ldr] * wa[i];
|
||||
}
|
||||
}
|
||||
wa[j] = (wa[j] - sum) / sdiag[j];
|
||||
}
|
||||
}
|
||||
|
||||
/* permute the components of z back to components of x. */
|
||||
|
||||
for (j = 0; j < n; ++j) {
|
||||
l = ipvt[j]-1;
|
||||
x[l] = wa[j];
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine qrsolv. */
|
||||
|
||||
} /* qrsolv_ */
|
||||
|
||||
|
|
@ -0,0 +1,273 @@
|
|||
/* qrsolv.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(qrsolv)(const int *n, real *r__, const int *ldr,
|
||||
const int *ipvt, const real *diag, const real *qtb, real *x,
|
||||
real *sdiag, real *wa)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
|
||||
/* System generated locals */
|
||||
int r_dim1, r_offset, i__1, i__2, i__3;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, k, l, jp1, kp1;
|
||||
real tan__, cos__, sin__, sum, temp, cotan;
|
||||
int nsing;
|
||||
real qtbpj;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine qrsolv */
|
||||
|
||||
/* given an m by n matrix a, an n by n diagonal matrix d, */
|
||||
/* and an m-vector b, the problem is to determine an x which */
|
||||
/* solves the system */
|
||||
|
||||
/* a*x = b , d*x = 0 , */
|
||||
|
||||
/* in the least squares sense. */
|
||||
|
||||
/* this subroutine completes the solution of the problem */
|
||||
/* if it is provided with the necessary information from the */
|
||||
/* qr factorization, with column pivoting, of a. that is, if */
|
||||
/* a*p = q*r, where p is a permutation matrix, q has orthogonal */
|
||||
/* columns, and r is an upper triangular matrix with diagonal */
|
||||
/* elements of nonincreasing magnitude, then qrsolv expects */
|
||||
/* the full upper triangle of r, the permutation matrix p, */
|
||||
/* and the first n components of (q transpose)*b. the system */
|
||||
/* a*x = b, d*x = 0, is then equivalent to */
|
||||
|
||||
/* t t */
|
||||
/* r*z = q *b , p *d*p*z = 0 , */
|
||||
|
||||
/* where x = p*z. if this system does not have full rank, */
|
||||
/* then a least squares solution is obtained. on output qrsolv */
|
||||
/* also provides an upper triangular matrix s such that */
|
||||
|
||||
/* t t t */
|
||||
/* p *(a *a + d*d)*p = s *s . */
|
||||
|
||||
/* s is computed within qrsolv and may be of separate interest. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine qrsolv(n,r,ldr,ipvt,diag,qtb,x,sdiag,wa) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the full upper triangle */
|
||||
/* must contain the full upper triangle of the matrix r. */
|
||||
/* on output the full upper triangle is unaltered, and the */
|
||||
/* strict lower triangle contains the strict upper triangle */
|
||||
/* (transposed) of the upper triangular matrix s. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* ipvt is an integer input array of length n which defines the */
|
||||
/* permutation matrix p such that a*p = q*r. column j of p */
|
||||
/* is column ipvt(j) of the identity matrix. */
|
||||
|
||||
/* diag is an input array of length n which must contain the */
|
||||
/* diagonal elements of the matrix d. */
|
||||
|
||||
/* qtb is an input array of length n which must contain the first */
|
||||
/* n elements of the vector (q transpose)*b. */
|
||||
|
||||
/* x is an output array of length n which contains the least */
|
||||
/* squares solution of the system a*x = b, d*x = 0. */
|
||||
|
||||
/* sdiag is an output array of length n which contains the */
|
||||
/* diagonal elements of the upper triangular matrix s. */
|
||||
|
||||
/* wa is a work array of length n. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--wa;
|
||||
--sdiag;
|
||||
--x;
|
||||
--qtb;
|
||||
--diag;
|
||||
--ipvt;
|
||||
r_dim1 = *ldr;
|
||||
r_offset = 1 + r_dim1 * 1;
|
||||
r__ -= r_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* copy r and (q transpose)*b to preserve input and initialize s. */
|
||||
/* in particular, save the diagonal elements of r in x. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
i__2 = *n;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
r__[i__ + j * r_dim1] = r__[j + i__ * r_dim1];
|
||||
/* L10: */
|
||||
}
|
||||
x[j] = r__[j + j * r_dim1];
|
||||
wa[j] = qtb[j];
|
||||
/* L20: */
|
||||
}
|
||||
|
||||
/* eliminate the diagonal matrix d using a givens rotation. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
|
||||
/* prepare the row of d to be eliminated, locating the */
|
||||
/* diagonal element using p from the qr factorization. */
|
||||
|
||||
l = ipvt[j];
|
||||
if (diag[l] == 0.) {
|
||||
goto L90;
|
||||
}
|
||||
i__2 = *n;
|
||||
for (k = j; k <= i__2; ++k) {
|
||||
sdiag[k] = 0.;
|
||||
/* L30: */
|
||||
}
|
||||
sdiag[j] = diag[l];
|
||||
|
||||
/* the transformations to eliminate the row of d */
|
||||
/* modify only a single element of (q transpose)*b */
|
||||
/* beyond the first n, which is initially zero. */
|
||||
|
||||
qtbpj = 0.;
|
||||
i__2 = *n;
|
||||
for (k = j; k <= i__2; ++k) {
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* appropriate element in the current row of d. */
|
||||
|
||||
if (sdiag[k] == 0.) {
|
||||
goto L70;
|
||||
}
|
||||
if ((d__1 = r__[k + k * r_dim1], abs(d__1)) >= (d__2 = sdiag[k],
|
||||
abs(d__2))) {
|
||||
goto L40;
|
||||
}
|
||||
cotan = r__[k + k * r_dim1] / sdiag[k];
|
||||
/* Computing 2nd power */
|
||||
d__1 = cotan;
|
||||
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
cos__ = sin__ * cotan;
|
||||
goto L50;
|
||||
L40:
|
||||
tan__ = sdiag[k] / r__[k + k * r_dim1];
|
||||
/* Computing 2nd power */
|
||||
d__1 = tan__;
|
||||
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
sin__ = cos__ * tan__;
|
||||
L50:
|
||||
|
||||
/* compute the modified diagonal element of r and */
|
||||
/* the modified element of ((q transpose)*b,0). */
|
||||
|
||||
r__[k + k * r_dim1] = cos__ * r__[k + k * r_dim1] + sin__ * sdiag[
|
||||
k];
|
||||
temp = cos__ * wa[k] + sin__ * qtbpj;
|
||||
qtbpj = -sin__ * wa[k] + cos__ * qtbpj;
|
||||
wa[k] = temp;
|
||||
|
||||
/* accumulate the tranformation in the row of s. */
|
||||
|
||||
kp1 = k + 1;
|
||||
if (*n < kp1) {
|
||||
goto L70;
|
||||
}
|
||||
i__3 = *n;
|
||||
for (i__ = kp1; i__ <= i__3; ++i__) {
|
||||
temp = cos__ * r__[i__ + k * r_dim1] + sin__ * sdiag[i__];
|
||||
sdiag[i__] = -sin__ * r__[i__ + k * r_dim1] + cos__ * sdiag[
|
||||
i__];
|
||||
r__[i__ + k * r_dim1] = temp;
|
||||
/* L60: */
|
||||
}
|
||||
L70:
|
||||
/* L80: */
|
||||
;
|
||||
}
|
||||
L90:
|
||||
|
||||
/* store the diagonal element of s and restore */
|
||||
/* the corresponding diagonal element of r. */
|
||||
|
||||
sdiag[j] = r__[j + j * r_dim1];
|
||||
r__[j + j * r_dim1] = x[j];
|
||||
/* L100: */
|
||||
}
|
||||
|
||||
/* solve the triangular system for z. if the system is */
|
||||
/* singular, then obtain a least squares solution. */
|
||||
|
||||
nsing = *n;
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (sdiag[j] == 0. && nsing == *n) {
|
||||
nsing = j - 1;
|
||||
}
|
||||
if (nsing < *n) {
|
||||
wa[j] = 0.;
|
||||
}
|
||||
/* L110: */
|
||||
}
|
||||
if (nsing < 1) {
|
||||
goto L150;
|
||||
}
|
||||
i__1 = nsing;
|
||||
for (k = 1; k <= i__1; ++k) {
|
||||
j = nsing - k + 1;
|
||||
sum = 0.;
|
||||
jp1 = j + 1;
|
||||
if (nsing < jp1) {
|
||||
goto L130;
|
||||
}
|
||||
i__2 = nsing;
|
||||
for (i__ = jp1; i__ <= i__2; ++i__) {
|
||||
sum += r__[i__ + j * r_dim1] * wa[i__];
|
||||
/* L120: */
|
||||
}
|
||||
L130:
|
||||
wa[j] = (wa[j] - sum) / sdiag[j];
|
||||
/* L140: */
|
||||
}
|
||||
L150:
|
||||
|
||||
/* permute the components of z back to components of x. */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
l = ipvt[j];
|
||||
x[l] = wa[j];
|
||||
/* L160: */
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine qrsolv. */
|
||||
|
||||
} /* qrsolv_ */
|
||||
|
||||
|
|
@ -0,0 +1,122 @@
|
|||
/* r1mpyq.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(r1mpyq)(int m, int n, real *a, int
|
||||
lda, const real *v, const real *w)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, nm1, nmj;
|
||||
real cos, sin, temp;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine r1mpyq */
|
||||
|
||||
/* given an m by n matrix a, this subroutine computes a*q where */
|
||||
/* q is the product of 2*(n - 1) transformations */
|
||||
|
||||
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
|
||||
|
||||
/* and gv(i), gw(i) are givens rotations in the (i,n) plane which */
|
||||
/* eliminate elements in the i-th and n-th planes, respectively. */
|
||||
/* q itself is not given, rather the information to recover the */
|
||||
/* gv, gw rotations is supplied. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine r1mpyq(m,n,a,lda,v,w) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* a is an m by n array. on input a must contain the matrix */
|
||||
/* to be postmultiplied by the orthogonal matrix q */
|
||||
/* described above. on output a*q has replaced a. */
|
||||
|
||||
/* lda is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array a. */
|
||||
|
||||
/* v is an input array of length n. v(i) must contain the */
|
||||
/* information necessary to recover the givens rotation gv(i) */
|
||||
/* described above. */
|
||||
|
||||
/* w is an input array of length n. w(i) must contain the */
|
||||
/* information necessary to recover the givens rotation gw(i) */
|
||||
/* described above. */
|
||||
|
||||
/* subroutines called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--w;
|
||||
--v;
|
||||
a_dim1 = lda;
|
||||
a_offset = 1 + a_dim1 * 1;
|
||||
a -= a_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* apply the first set of givens rotations to a. */
|
||||
|
||||
nm1 = n - 1;
|
||||
if (nm1 < 1) {
|
||||
return;
|
||||
}
|
||||
for (nmj = 1; nmj <= nm1; ++nmj) {
|
||||
j = n - nmj;
|
||||
if (fabs(v[j]) > 1.) {
|
||||
cos = 1. / v[j];
|
||||
sin = sqrt(1. - cos * cos);
|
||||
} else {
|
||||
sin = v[j];
|
||||
cos = sqrt(1. - sin * sin);
|
||||
}
|
||||
for (i = 1; i <= m; ++i) {
|
||||
temp = cos * a[i + j * a_dim1] - sin * a[i + n * a_dim1];
|
||||
a[i + n * a_dim1] = sin * a[i + j * a_dim1] + cos * a[
|
||||
i + n * a_dim1];
|
||||
a[i + j * a_dim1] = temp;
|
||||
}
|
||||
}
|
||||
|
||||
/* apply the second set of givens rotations to a. */
|
||||
|
||||
for (j = 1; j <= nm1; ++j) {
|
||||
if (fabs(w[j]) > 1.) {
|
||||
cos = 1. / w[j];
|
||||
sin = sqrt(1. - cos * cos);
|
||||
} else {
|
||||
sin = w[j];
|
||||
cos = sqrt(1. - sin * sin);
|
||||
}
|
||||
for (i = 1; i <= m; ++i) {
|
||||
temp = cos * a[i + j * a_dim1] + sin * a[i + n * a_dim1];
|
||||
a[i + n * a_dim1] = -sin * a[i + j * a_dim1] + cos * a[i + n * a_dim1];
|
||||
a[i + j * a_dim1] = temp;
|
||||
}
|
||||
}
|
||||
|
||||
/* last card of subroutine r1mpyq. */
|
||||
|
||||
} /* r1mpyq_ */
|
||||
|
||||
|
|
@ -0,0 +1,144 @@
|
|||
/* r1mpyq.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(r1mpyq)(const int *m, const int *n, real *a, const int *
|
||||
lda, const real *v, const real *w)
|
||||
{
|
||||
/* System generated locals */
|
||||
int a_dim1, a_offset, i__1, i__2;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, nm1, nmj;
|
||||
real cos__, sin__, temp;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine r1mpyq */
|
||||
|
||||
/* given an m by n matrix a, this subroutine computes a*q where */
|
||||
/* q is the product of 2*(n - 1) transformations */
|
||||
|
||||
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
|
||||
|
||||
/* and gv(i), gw(i) are givens rotations in the (i,n) plane which */
|
||||
/* eliminate elements in the i-th and n-th planes, respectively. */
|
||||
/* q itself is not given, rather the information to recover the */
|
||||
/* gv, gw rotations is supplied. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine r1mpyq(m,n,a,lda,v,w) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of a. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of a. */
|
||||
|
||||
/* a is an m by n array. on input a must contain the matrix */
|
||||
/* to be postmultiplied by the orthogonal matrix q */
|
||||
/* described above. on output a*q has replaced a. */
|
||||
|
||||
/* lda is a positive integer input variable not less than m */
|
||||
/* which specifies the leading dimension of the array a. */
|
||||
|
||||
/* v is an input array of length n. v(i) must contain the */
|
||||
/* information necessary to recover the givens rotation gv(i) */
|
||||
/* described above. */
|
||||
|
||||
/* w is an input array of length n. w(i) must contain the */
|
||||
/* information necessary to recover the givens rotation gw(i) */
|
||||
/* described above. */
|
||||
|
||||
/* subroutines called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--w;
|
||||
--v;
|
||||
a_dim1 = *lda;
|
||||
a_offset = 1 + a_dim1 * 1;
|
||||
a -= a_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* apply the first set of givens rotations to a. */
|
||||
|
||||
nm1 = *n - 1;
|
||||
if (nm1 < 1) {
|
||||
/* goto L50; */
|
||||
return;
|
||||
}
|
||||
i__1 = nm1;
|
||||
for (nmj = 1; nmj <= i__1; ++nmj) {
|
||||
j = *n - nmj;
|
||||
if ((d__1 = v[j], abs(d__1)) > 1.) {
|
||||
cos__ = 1. / v[j];
|
||||
/* Computing 2nd power */
|
||||
d__2 = cos__;
|
||||
sin__ = sqrt(1. - d__2 * d__2);
|
||||
} else {
|
||||
sin__ = v[j];
|
||||
/* Computing 2nd power */
|
||||
d__2 = sin__;
|
||||
cos__ = sqrt(1. - d__2 * d__2);
|
||||
}
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
temp = cos__ * a[i__ + j * a_dim1] - sin__ * a[i__ + *n * a_dim1];
|
||||
a[i__ + *n * a_dim1] = sin__ * a[i__ + j * a_dim1] + cos__ * a[
|
||||
i__ + *n * a_dim1];
|
||||
a[i__ + j * a_dim1] = temp;
|
||||
/* L10: */
|
||||
}
|
||||
/* L20: */
|
||||
}
|
||||
|
||||
/* apply the second set of givens rotations to a. */
|
||||
|
||||
i__1 = nm1;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if ((d__1 = w[j], abs(d__1)) > 1.) {
|
||||
cos__ = 1. / w[j];
|
||||
/* Computing 2nd power */
|
||||
d__2 = cos__;
|
||||
sin__ = sqrt(1. - d__2 * d__2);
|
||||
} else {
|
||||
sin__ = w[j];
|
||||
/* Computing 2nd power */
|
||||
d__2 = sin__;
|
||||
cos__ = sqrt(1. - d__2 * d__2);
|
||||
}
|
||||
i__2 = *m;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
temp = cos__ * a[i__ + j * a_dim1] + sin__ * a[i__ + *n * a_dim1];
|
||||
a[i__ + *n * a_dim1] = -sin__ * a[i__ + j * a_dim1] + cos__ * a[
|
||||
i__ + *n * a_dim1];
|
||||
a[i__ + j * a_dim1] = temp;
|
||||
/* L30: */
|
||||
}
|
||||
/* L40: */
|
||||
}
|
||||
/* L50: */
|
||||
return;
|
||||
|
||||
/* last card of subroutine r1mpyq. */
|
||||
|
||||
} /* r1mpyq_ */
|
||||
|
||||
|
|
@ -0,0 +1,236 @@
|
|||
/* r1updt.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(r1updt)(int m, int n, real *s, int
|
||||
ls, const real *u, real *v, real *w, int *sing)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
|
||||
/* Local variables */
|
||||
int i, j, l, jj, nm1;
|
||||
real tan;
|
||||
int nmj;
|
||||
real cos, sin, tau, temp, giant, cotan;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine r1updt */
|
||||
|
||||
/* given an m by n lower trapezoidal matrix s, an m-vector u, */
|
||||
/* and an n-vector v, the problem is to determine an */
|
||||
/* orthogonal matrix q such that */
|
||||
|
||||
/* t */
|
||||
/* (s + u*v )*q */
|
||||
|
||||
/* is again lower trapezoidal. */
|
||||
|
||||
/* this subroutine determines q as the product of 2*(n - 1) */
|
||||
/* transformations */
|
||||
|
||||
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
|
||||
|
||||
/* where gv(i), gw(i) are givens rotations in the (i,n) plane */
|
||||
/* which eliminate elements in the i-th and n-th planes, */
|
||||
/* respectively. q itself is not accumulated, rather the */
|
||||
/* information to recover the gv, gw rotations is returned. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine r1updt(m,n,s,ls,u,v,w,sing) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of s. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of s. n must not exceed m. */
|
||||
|
||||
/* s is an array of length ls. on input s must contain the lower */
|
||||
/* trapezoidal matrix s stored by columns. on output s contains */
|
||||
/* the lower trapezoidal matrix produced as described above. */
|
||||
|
||||
/* ls is a positive integer input variable not less than */
|
||||
/* (n*(2*m-n+1))/2. */
|
||||
|
||||
/* u is an input array of length m which must contain the */
|
||||
/* vector u. */
|
||||
|
||||
/* v is an array of length n. on input v must contain the vector */
|
||||
/* v. on output v(i) contains the information necessary to */
|
||||
/* recover the givens rotation gv(i) described above. */
|
||||
|
||||
/* w is an output array of length m. w(i) contains information */
|
||||
/* necessary to recover the givens rotation gw(i) described */
|
||||
/* above. */
|
||||
|
||||
/* sing is a logical output variable. sing is set true if any */
|
||||
/* of the diagonal elements of the output s are zero. otherwise */
|
||||
/* sing is set false. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more, */
|
||||
/* john l. nazareth */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--w;
|
||||
--u;
|
||||
--v;
|
||||
--s;
|
||||
(void)ls;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* giant is the largest magnitude. */
|
||||
|
||||
giant = __cminpack_func__(dpmpar)(3);
|
||||
|
||||
/* initialize the diagonal element pointer. */
|
||||
|
||||
jj = n * ((m << 1) - n + 1) / 2 - (m - n);
|
||||
|
||||
/* move the nontrivial part of the last column of s into w. */
|
||||
|
||||
l = jj;
|
||||
for (i = n; i <= m; ++i) {
|
||||
w[i] = s[l];
|
||||
++l;
|
||||
}
|
||||
|
||||
/* rotate the vector v into a multiple of the n-th unit vector */
|
||||
/* in such a way that a spike is introduced into w. */
|
||||
|
||||
nm1 = n - 1;
|
||||
if (nm1 >= 1) {
|
||||
for (nmj = 1; nmj <= nm1; ++nmj) {
|
||||
j = n - nmj;
|
||||
jj -= m - j + 1;
|
||||
w[j] = 0.;
|
||||
if (v[j] != 0.) {
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* j-th element of v. */
|
||||
|
||||
if (fabs(v[n]) < fabs(v[j])) {
|
||||
cotan = v[n] / v[j];
|
||||
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
|
||||
cos = sin * cotan;
|
||||
tau = 1.;
|
||||
if (fabs(cos) * giant > 1.) {
|
||||
tau = 1. / cos;
|
||||
}
|
||||
} else {
|
||||
tan = v[j] / v[n];
|
||||
cos = p5 / sqrt(p25 + p25 * (tan * tan));
|
||||
sin = cos * tan;
|
||||
tau = sin;
|
||||
}
|
||||
|
||||
/* apply the transformation to v and store the information */
|
||||
/* necessary to recover the givens rotation. */
|
||||
|
||||
v[n] = sin * v[j] + cos * v[n];
|
||||
v[j] = tau;
|
||||
|
||||
/* apply the transformation to s and extend the spike in w. */
|
||||
|
||||
l = jj;
|
||||
for (i = j; i <= m; ++i) {
|
||||
temp = cos * s[l] - sin * w[i];
|
||||
w[i] = sin * s[l] + cos * w[i];
|
||||
s[l] = temp;
|
||||
++l;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* add the spike from the rank 1 update to w. */
|
||||
|
||||
for (i = 1; i <= m; ++i) {
|
||||
w[i] += v[n] * u[i];
|
||||
}
|
||||
|
||||
/* eliminate the spike. */
|
||||
|
||||
*sing = FALSE_;
|
||||
if (nm1 >= 1) {
|
||||
for (j = 1; j <= nm1; ++j) {
|
||||
if (w[j] != 0.) {
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* j-th element of the spike. */
|
||||
|
||||
if (fabs(s[jj]) < fabs(w[j])) {
|
||||
cotan = s[jj] / w[j];
|
||||
sin = p5 / sqrt(p25 + p25 * (cotan * cotan));
|
||||
cos = sin * cotan;
|
||||
tau = 1.;
|
||||
if (fabs(cos) * giant > 1.) {
|
||||
tau = 1. / cos;
|
||||
}
|
||||
} else {
|
||||
tan = w[j] / s[jj];
|
||||
cos = p5 / sqrt(p25 + p25 * (tan * tan));
|
||||
sin = cos * tan;
|
||||
tau = sin;
|
||||
}
|
||||
|
||||
/* apply the transformation to s and reduce the spike in w. */
|
||||
|
||||
l = jj;
|
||||
for (i = j; i <= m; ++i) {
|
||||
temp = cos * s[l] + sin * w[i];
|
||||
w[i] = -sin * s[l] + cos * w[i];
|
||||
s[l] = temp;
|
||||
++l;
|
||||
}
|
||||
|
||||
/* store the information necessary to recover the */
|
||||
/* givens rotation. */
|
||||
|
||||
w[j] = tau;
|
||||
}
|
||||
|
||||
/* test for zero diagonal elements in the output s. */
|
||||
|
||||
if (s[jj] == 0.) {
|
||||
*sing = TRUE_;
|
||||
}
|
||||
jj += m - j + 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* move w back into the last column of the output s. */
|
||||
|
||||
l = jj;
|
||||
for (i = n; i <= m; ++i) {
|
||||
s[l] = w[i];
|
||||
++l;
|
||||
}
|
||||
if (s[jj] == 0.) {
|
||||
*sing = TRUE_;
|
||||
}
|
||||
|
||||
/* last card of subroutine r1updt. */
|
||||
|
||||
} /* __minpack_func__(r1updt) */
|
||||
|
||||
|
|
@ -0,0 +1,279 @@
|
|||
/* r1updt.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(r1updt)(const int *m, const int *n, real *s, const int *
|
||||
ls, const real *u, real *v, real *w, int *sing)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
const int c__3 = 3;
|
||||
|
||||
/* System generated locals */
|
||||
int i__1, i__2;
|
||||
real d__1, d__2;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, l, jj, nm1;
|
||||
real tan__;
|
||||
int nmj;
|
||||
real cos__, sin__, tau, temp, giant, cotan;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine r1updt */
|
||||
|
||||
/* given an m by n lower trapezoidal matrix s, an m-vector u, */
|
||||
/* and an n-vector v, the problem is to determine an */
|
||||
/* orthogonal matrix q such that */
|
||||
|
||||
/* t */
|
||||
/* (s + u*v )*q */
|
||||
|
||||
/* is again lower trapezoidal. */
|
||||
|
||||
/* this subroutine determines q as the product of 2*(n - 1) */
|
||||
/* transformations */
|
||||
|
||||
/* gv(n-1)*...*gv(1)*gw(1)*...*gw(n-1) */
|
||||
|
||||
/* where gv(i), gw(i) are givens rotations in the (i,n) plane */
|
||||
/* which eliminate elements in the i-th and n-th planes, */
|
||||
/* respectively. q itself is not accumulated, rather the */
|
||||
/* information to recover the gv, gw rotations is returned. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine r1updt(m,n,s,ls,u,v,w,sing) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* m is a positive integer input variable set to the number */
|
||||
/* of rows of s. */
|
||||
|
||||
/* n is a positive integer input variable set to the number */
|
||||
/* of columns of s. n must not exceed m. */
|
||||
|
||||
/* s is an array of length ls. on input s must contain the lower */
|
||||
/* trapezoidal matrix s stored by columns. on output s contains */
|
||||
/* the lower trapezoidal matrix produced as described above. */
|
||||
|
||||
/* ls is a positive integer input variable not less than */
|
||||
/* (n*(2*m-n+1))/2. */
|
||||
|
||||
/* u is an input array of length m which must contain the */
|
||||
/* vector u. */
|
||||
|
||||
/* v is an array of length n. on input v must contain the vector */
|
||||
/* v. on output v(i) contains the information necessary to */
|
||||
/* recover the givens rotation gv(i) described above. */
|
||||
|
||||
/* w is an output array of length m. w(i) contains information */
|
||||
/* necessary to recover the givens rotation gw(i) described */
|
||||
/* above. */
|
||||
|
||||
/* sing is a logical output variable. sing is set true if any */
|
||||
/* of the diagonal elements of the output s are zero. otherwise */
|
||||
/* sing is set false. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* minpack-supplied ... dpmpar */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, kenneth e. hillstrom, jorge j. more, */
|
||||
/* john l. nazareth */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--w;
|
||||
--u;
|
||||
--v;
|
||||
--s;
|
||||
(void)ls;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
/* giant is the largest magnitude. */
|
||||
|
||||
giant = __minpack_func__(dpmpar)(&c__3);
|
||||
|
||||
/* initialize the diagonal element pointer. */
|
||||
|
||||
jj = *n * ((*m << 1) - *n + 1) / 2 - (*m - *n);
|
||||
|
||||
/* move the nontrivial part of the last column of s into w. */
|
||||
|
||||
l = jj;
|
||||
i__1 = *m;
|
||||
for (i__ = *n; i__ <= i__1; ++i__) {
|
||||
w[i__] = s[l];
|
||||
++l;
|
||||
/* L10: */
|
||||
}
|
||||
|
||||
/* rotate the vector v into a multiple of the n-th unit vector */
|
||||
/* in such a way that a spike is introduced into w. */
|
||||
|
||||
nm1 = *n - 1;
|
||||
if (nm1 < 1) {
|
||||
goto L70;
|
||||
}
|
||||
i__1 = nm1;
|
||||
for (nmj = 1; nmj <= i__1; ++nmj) {
|
||||
j = *n - nmj;
|
||||
jj -= *m - j + 1;
|
||||
w[j] = 0.;
|
||||
if (v[j] == 0.) {
|
||||
goto L50;
|
||||
}
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* j-th element of v. */
|
||||
|
||||
if ((d__1 = v[*n], abs(d__1)) >= (d__2 = v[j], abs(d__2))) {
|
||||
goto L20;
|
||||
}
|
||||
cotan = v[*n] / v[j];
|
||||
/* Computing 2nd power */
|
||||
d__1 = cotan;
|
||||
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
cos__ = sin__ * cotan;
|
||||
tau = 1.;
|
||||
if (abs(cos__) * giant > 1.) {
|
||||
tau = 1. / cos__;
|
||||
}
|
||||
goto L30;
|
||||
L20:
|
||||
tan__ = v[j] / v[*n];
|
||||
/* Computing 2nd power */
|
||||
d__1 = tan__;
|
||||
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
sin__ = cos__ * tan__;
|
||||
tau = sin__;
|
||||
L30:
|
||||
|
||||
/* apply the transformation to v and store the information */
|
||||
/* necessary to recover the givens rotation. */
|
||||
|
||||
v[*n] = sin__ * v[j] + cos__ * v[*n];
|
||||
v[j] = tau;
|
||||
|
||||
/* apply the transformation to s and extend the spike in w. */
|
||||
|
||||
l = jj;
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
temp = cos__ * s[l] - sin__ * w[i__];
|
||||
w[i__] = sin__ * s[l] + cos__ * w[i__];
|
||||
s[l] = temp;
|
||||
++l;
|
||||
/* L40: */
|
||||
}
|
||||
L50:
|
||||
/* L60: */
|
||||
;
|
||||
}
|
||||
L70:
|
||||
|
||||
/* add the spike from the rank 1 update to w. */
|
||||
|
||||
i__1 = *m;
|
||||
for (i__ = 1; i__ <= i__1; ++i__) {
|
||||
w[i__] += v[*n] * u[i__];
|
||||
/* L80: */
|
||||
}
|
||||
|
||||
/* eliminate the spike. */
|
||||
|
||||
*sing = FALSE_;
|
||||
if (nm1 < 1) {
|
||||
goto L140;
|
||||
}
|
||||
i__1 = nm1;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
if (w[j] == 0.) {
|
||||
goto L120;
|
||||
}
|
||||
|
||||
/* determine a givens rotation which eliminates the */
|
||||
/* j-th element of the spike. */
|
||||
|
||||
if ((d__1 = s[jj], abs(d__1)) >= (d__2 = w[j], abs(d__2))) {
|
||||
goto L90;
|
||||
}
|
||||
cotan = s[jj] / w[j];
|
||||
/* Computing 2nd power */
|
||||
d__1 = cotan;
|
||||
sin__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
cos__ = sin__ * cotan;
|
||||
tau = 1.;
|
||||
if (abs(cos__) * giant > 1.) {
|
||||
tau = 1. / cos__;
|
||||
}
|
||||
goto L100;
|
||||
L90:
|
||||
tan__ = w[j] / s[jj];
|
||||
/* Computing 2nd power */
|
||||
d__1 = tan__;
|
||||
cos__ = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
sin__ = cos__ * tan__;
|
||||
tau = sin__;
|
||||
L100:
|
||||
|
||||
/* apply the transformation to s and reduce the spike in w. */
|
||||
|
||||
l = jj;
|
||||
i__2 = *m;
|
||||
for (i__ = j; i__ <= i__2; ++i__) {
|
||||
temp = cos__ * s[l] + sin__ * w[i__];
|
||||
w[i__] = -sin__ * s[l] + cos__ * w[i__];
|
||||
s[l] = temp;
|
||||
++l;
|
||||
/* L110: */
|
||||
}
|
||||
|
||||
/* store the information necessary to recover the */
|
||||
/* givens rotation. */
|
||||
|
||||
w[j] = tau;
|
||||
L120:
|
||||
|
||||
/* test for zero diagonal elements in the output s. */
|
||||
|
||||
if (s[jj] == 0.) {
|
||||
*sing = TRUE_;
|
||||
}
|
||||
jj += *m - j + 1;
|
||||
/* L130: */
|
||||
}
|
||||
L140:
|
||||
|
||||
/* move w back into the last column of the output s. */
|
||||
|
||||
l = jj;
|
||||
i__1 = *m;
|
||||
for (i__ = *n; i__ <= i__1; ++i__) {
|
||||
s[l] = w[i__];
|
||||
++l;
|
||||
/* L150: */
|
||||
}
|
||||
if (s[jj] == 0.) {
|
||||
*sing = TRUE_;
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine r1updt. */
|
||||
|
||||
} /* r1updt_ */
|
||||
|
||||
|
|
@ -0,0 +1,15 @@
|
|||
====== readme for minpack ======
|
||||
|
||||
Minpack includes software for solving nonlinear equations and
|
||||
nonlinear least squares problems. Five algorithmic paths each include
|
||||
a core subroutine and an easy-to-use driver. The algorithms proceed
|
||||
either from an analytic specification of the Jacobian matrix or
|
||||
directly from the problem functions. The paths include facilities for
|
||||
systems of equations with a banded Jacobian matrix, for least squares
|
||||
problems with a large amount of data, and for checking the consistency
|
||||
of the Jacobian matrix with the functions.
|
||||
|
||||
This directory contains the double-precision versions.
|
||||
|
||||
Jorge More', Burt Garbow, and Ken Hillstrom at Argonne National Laboratory.
|
||||
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
/* rwupdt.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "cminpack.h"
|
||||
#include <math.h>
|
||||
#include "cminpackP.h"
|
||||
|
||||
__cminpack_attr__
|
||||
void __cminpack_func__(rwupdt)(int n, real *r, int ldr,
|
||||
const real *w, real *b, real *alpha, real *cos,
|
||||
real *sin)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
|
||||
/* System generated locals */
|
||||
int r_dim1, r_offset;
|
||||
|
||||
/* Local variables */
|
||||
int i, j, jm1;
|
||||
real tan, temp, rowj, cotan;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine rwupdt */
|
||||
|
||||
/* given an n by n upper triangular matrix r, this subroutine */
|
||||
/* computes the qr decomposition of the matrix formed when a row */
|
||||
/* is added to r. if the row is specified by the vector w, then */
|
||||
/* rwupdt determines an orthogonal matrix q such that when the */
|
||||
/* n+1 by n matrix composed of r augmented by w is premultiplied */
|
||||
/* by (q transpose), the resulting matrix is upper trapezoidal. */
|
||||
/* the matrix (q transpose) is the product of n transformations */
|
||||
|
||||
/* g(n)*g(n-1)* ... *g(1) */
|
||||
|
||||
/* where g(i) is a givens rotation in the (i,n+1) plane which */
|
||||
/* eliminates elements in the (n+1)-st plane. rwupdt also */
|
||||
/* computes the product (q transpose)*c where c is the */
|
||||
/* (n+1)-vector (b,alpha). q itself is not accumulated, rather */
|
||||
/* the information to recover the g rotations is supplied. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine rwupdt(n,r,ldr,w,b,alpha,cos,sin) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the upper triangular part of */
|
||||
/* r must contain the matrix to be updated. on output r */
|
||||
/* contains the updated triangular matrix. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* w is an input array of length n which must contain the row */
|
||||
/* vector to be added to r. */
|
||||
|
||||
/* b is an array of length n. on input b must contain the */
|
||||
/* first n elements of the vector c. on output b contains */
|
||||
/* the first n elements of the vector (q transpose)*c. */
|
||||
|
||||
/* alpha is a variable. on input alpha must contain the */
|
||||
/* (n+1)-st element of the vector c. on output alpha contains */
|
||||
/* the (n+1)-st element of the vector (q transpose)*c. */
|
||||
|
||||
/* cos is an output array of length n which contains the */
|
||||
/* cosines of the transforming givens rotations. */
|
||||
|
||||
/* sin is an output array of length n which contains the */
|
||||
/* sines of the transforming givens rotations. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--sin;
|
||||
--cos;
|
||||
--b;
|
||||
--w;
|
||||
r_dim1 = ldr;
|
||||
r_offset = 1 + r_dim1 * 1;
|
||||
r -= r_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
for (j = 1; j <= n; ++j) {
|
||||
rowj = w[j];
|
||||
jm1 = j - 1;
|
||||
|
||||
/* apply the previous transformations to */
|
||||
/* r(i,j), i=1,2,...,j-1, and to w(j). */
|
||||
|
||||
if (jm1 >= 1) {
|
||||
for (i = 1; i <= jm1; ++i) {
|
||||
temp = cos[i] * r[i + j * r_dim1] + sin[i] * rowj;
|
||||
rowj = -sin[i] * r[i + j * r_dim1] + cos[i] * rowj;
|
||||
r[i + j * r_dim1] = temp;
|
||||
}
|
||||
}
|
||||
|
||||
/* determine a givens rotation which eliminates w(j). */
|
||||
|
||||
cos[j] = 1.;
|
||||
sin[j] = 0.;
|
||||
if (rowj != 0.) {
|
||||
if (fabs(r[j + j * r_dim1]) < fabs(rowj)) {
|
||||
cotan = r[j + j * r_dim1] / rowj;
|
||||
sin[j] = p5 / sqrt(p25 + p25 * (cotan * cotan));
|
||||
cos[j] = sin[j] * cotan;
|
||||
} else {
|
||||
tan = rowj / r[j + j * r_dim1];
|
||||
cos[j] = p5 / sqrt(p25 + p25 * (tan * tan));
|
||||
sin[j] = cos[j] * tan;
|
||||
}
|
||||
|
||||
/* apply the current transformation to r(j,j), b(j), and alpha. */
|
||||
|
||||
r[j + j * r_dim1] = cos[j] * r[j + j * r_dim1] + sin[j] * rowj;
|
||||
temp = cos[j] * b[j] + sin[j] * *alpha;
|
||||
*alpha = -sin[j] * b[j] + cos[j] * *alpha;
|
||||
b[j] = temp;
|
||||
}
|
||||
}
|
||||
|
||||
/* last card of subroutine rwupdt. */
|
||||
|
||||
} /* rwupdt_ */
|
||||
|
||||
|
|
@ -0,0 +1,161 @@
|
|||
/* rwupdt.f -- translated by f2c (version 20020621).
|
||||
You must link the resulting object file with the libraries:
|
||||
-lf2c -lm (in that order)
|
||||
*/
|
||||
|
||||
#include "minpack.h"
|
||||
#include <math.h>
|
||||
#include "minpackP.h"
|
||||
|
||||
|
||||
__minpack_attr__
|
||||
void __minpack_func__(rwupdt)(const int *n, real *r__, const int *ldr,
|
||||
const real *w, real *b, real *alpha, real *cos__,
|
||||
real *sin__)
|
||||
{
|
||||
/* Initialized data */
|
||||
|
||||
#define p5 .5
|
||||
#define p25 .25
|
||||
|
||||
/* System generated locals */
|
||||
int r_dim1, r_offset, i__1, i__2;
|
||||
real d__1;
|
||||
|
||||
/* Local variables */
|
||||
int i__, j, jm1;
|
||||
real tan__, temp, rowj, cotan;
|
||||
|
||||
/* ********** */
|
||||
|
||||
/* subroutine rwupdt */
|
||||
|
||||
/* given an n by n upper triangular matrix r, this subroutine */
|
||||
/* computes the qr decomposition of the matrix formed when a row */
|
||||
/* is added to r. if the row is specified by the vector w, then */
|
||||
/* rwupdt determines an orthogonal matrix q such that when the */
|
||||
/* n+1 by n matrix composed of r augmented by w is premultiplied */
|
||||
/* by (q transpose), the resulting matrix is upper trapezoidal. */
|
||||
/* the matrix (q transpose) is the product of n transformations */
|
||||
|
||||
/* g(n)*g(n-1)* ... *g(1) */
|
||||
|
||||
/* where g(i) is a givens rotation in the (i,n+1) plane which */
|
||||
/* eliminates elements in the (n+1)-st plane. rwupdt also */
|
||||
/* computes the product (q transpose)*c where c is the */
|
||||
/* (n+1)-vector (b,alpha). q itself is not accumulated, rather */
|
||||
/* the information to recover the g rotations is supplied. */
|
||||
|
||||
/* the subroutine statement is */
|
||||
|
||||
/* subroutine rwupdt(n,r,ldr,w,b,alpha,cos,sin) */
|
||||
|
||||
/* where */
|
||||
|
||||
/* n is a positive integer input variable set to the order of r. */
|
||||
|
||||
/* r is an n by n array. on input the upper triangular part of */
|
||||
/* r must contain the matrix to be updated. on output r */
|
||||
/* contains the updated triangular matrix. */
|
||||
|
||||
/* ldr is a positive integer input variable not less than n */
|
||||
/* which specifies the leading dimension of the array r. */
|
||||
|
||||
/* w is an input array of length n which must contain the row */
|
||||
/* vector to be added to r. */
|
||||
|
||||
/* b is an array of length n. on input b must contain the */
|
||||
/* first n elements of the vector c. on output b contains */
|
||||
/* the first n elements of the vector (q transpose)*c. */
|
||||
|
||||
/* alpha is a variable. on input alpha must contain the */
|
||||
/* (n+1)-st element of the vector c. on output alpha contains */
|
||||
/* the (n+1)-st element of the vector (q transpose)*c. */
|
||||
|
||||
/* cos is an output array of length n which contains the */
|
||||
/* cosines of the transforming givens rotations. */
|
||||
|
||||
/* sin is an output array of length n which contains the */
|
||||
/* sines of the transforming givens rotations. */
|
||||
|
||||
/* subprograms called */
|
||||
|
||||
/* fortran-supplied ... dabs,dsqrt */
|
||||
|
||||
/* argonne national laboratory. minpack project. march 1980. */
|
||||
/* burton s. garbow, dudley v. goetschel, kenneth e. hillstrom, */
|
||||
/* jorge j. more */
|
||||
|
||||
/* ********** */
|
||||
/* Parameter adjustments */
|
||||
--sin__;
|
||||
--cos__;
|
||||
--b;
|
||||
--w;
|
||||
r_dim1 = *ldr;
|
||||
r_offset = 1 + r_dim1 * 1;
|
||||
r__ -= r_offset;
|
||||
|
||||
/* Function Body */
|
||||
|
||||
i__1 = *n;
|
||||
for (j = 1; j <= i__1; ++j) {
|
||||
rowj = w[j];
|
||||
jm1 = j - 1;
|
||||
|
||||
/* apply the previous transformations to */
|
||||
/* r(i,j), i=1,2,...,j-1, and to w(j). */
|
||||
|
||||
if (jm1 < 1) {
|
||||
goto L20;
|
||||
}
|
||||
i__2 = jm1;
|
||||
for (i__ = 1; i__ <= i__2; ++i__) {
|
||||
temp = cos__[i__] * r__[i__ + j * r_dim1] + sin__[i__] * rowj;
|
||||
rowj = -sin__[i__] * r__[i__ + j * r_dim1] + cos__[i__] * rowj;
|
||||
r__[i__ + j * r_dim1] = temp;
|
||||
/* L10: */
|
||||
}
|
||||
L20:
|
||||
|
||||
/* determine a givens rotation which eliminates w(j). */
|
||||
|
||||
cos__[j] = 1.;
|
||||
sin__[j] = 0.;
|
||||
if (rowj == 0.) {
|
||||
goto L50;
|
||||
}
|
||||
if ((d__1 = r__[j + j * r_dim1], abs(d__1)) >= abs(rowj)) {
|
||||
goto L30;
|
||||
}
|
||||
cotan = r__[j + j * r_dim1] / rowj;
|
||||
/* Computing 2nd power */
|
||||
d__1 = cotan;
|
||||
sin__[j] = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
cos__[j] = sin__[j] * cotan;
|
||||
goto L40;
|
||||
L30:
|
||||
tan__ = rowj / r__[j + j * r_dim1];
|
||||
/* Computing 2nd power */
|
||||
d__1 = tan__;
|
||||
cos__[j] = p5 / sqrt(p25 + p25 * (d__1 * d__1));
|
||||
sin__[j] = cos__[j] * tan__;
|
||||
L40:
|
||||
|
||||
/* apply the current transformation to r(j,j), b(j), and alpha. */
|
||||
|
||||
r__[j + j * r_dim1] = cos__[j] * r__[j + j * r_dim1] + sin__[j] *
|
||||
rowj;
|
||||
temp = cos__[j] * b[j] + sin__[j] * *alpha;
|
||||
*alpha = -sin__[j] * b[j] + cos__[j] * *alpha;
|
||||
b[j] = temp;
|
||||
L50:
|
||||
/* L60: */
|
||||
;
|
||||
}
|
||||
return;
|
||||
|
||||
/* last card of subroutine rwupdt. */
|
||||
|
||||
} /* rwupdt_ */
|
||||
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
add_subdirectory(core)
|
||||
add_subdirectory(fileio)
|
||||
add_subdirectory(util)
|
||||
add_subdirectory(algo)
|
||||
add_subdirectory(viewer)
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
|
||||
set(PROJECT_NAME easy3d_${MODULE_NAME})
|
||||
project(${PROJECT_NAME})
|
||||
|
||||
|
||||
set(${PROJECT_NAME}_HEADERS
|
||||
remove_duplication.h
|
||||
)
|
||||
|
||||
set(${PROJECT_NAME}_SOURCES
|
||||
remove_duplication.cpp
|
||||
)
|
||||
|
||||
|
||||
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS})
|
||||
|
||||
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
|
||||
|
||||
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
|
||||
|
||||
target_link_libraries(${PROJECT_NAME} easy3d_core easy3d_util)
|
||||
|
||||
if (MSVC)
|
||||
target_compile_definitions(${PROJECT_NAME} PRIVATE _CRT_SECURE_NO_DEPRECATE)
|
||||
endif ()
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
/**
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <easy3d/algo/remove_duplication.h>
|
||||
|
||||
#include <cassert>
|
||||
|
||||
#include <easy3d/core/point_cloud.h>
|
||||
#include <3rd_party/kd_tree/Vector3D.h>
|
||||
#include <3rd_party/kd_tree/KdTree.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
std::vector<PointCloud::Vertex> RemoveDuplication::apply(PointCloud *cloud, float epsilon) {
|
||||
const int maxBucketSize = 16;
|
||||
std::vector<vec3>& points = cloud->points();
|
||||
float* pointer = points[0];
|
||||
KdTree kd(reinterpret_cast<Vector3D*>(pointer), points.size(), maxBucketSize);
|
||||
|
||||
std::vector<bool> keep(cloud->vertices_size(), true);
|
||||
|
||||
double sqr_dist = epsilon * epsilon;
|
||||
for (std::size_t i = 0; i < points.size(); ++i) {
|
||||
if (keep[i]) {
|
||||
const vec3 &p = points[i];
|
||||
kd.queryRange(Vector3D(p.x, p.y, p.z), sqr_dist, true);
|
||||
int num = kd.getNOfFoundNeighbours();
|
||||
if (num > 1) {
|
||||
for (int j = 1; j < num; ++j) {
|
||||
int idx = kd.getNeighbourPositionIndex(j);
|
||||
keep[idx] = 0;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
std::vector<PointCloud::Vertex> points_to_remove;
|
||||
for (std::size_t i = 0; i < keep.size(); ++i) {
|
||||
if (!keep[i])
|
||||
points_to_remove.push_back(PointCloud::Vertex(i));
|
||||
}
|
||||
|
||||
return points_to_remove;
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
/**
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#ifndef EASY3D_REMOVE_DUPLICATION_H
|
||||
#define EASY3D_REMOVE_DUPLICATION_H
|
||||
|
||||
|
||||
#include <vector>
|
||||
|
||||
#include <easy3d/core/point_cloud.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
class RemoveDuplication {
|
||||
public:
|
||||
/**
|
||||
* Remove duplicated points of a point clouds.
|
||||
* @param cloud The point cloud.
|
||||
* @param epsilon The distance threshold. Points with a distance smaller than this value will be considered
|
||||
* as having duplications.
|
||||
* @return The vertices that should to deleted.
|
||||
*/
|
||||
static std::vector<PointCloud::Vertex> apply(PointCloud *cloud, float epsilon);
|
||||
};
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
||||
#endif // EASY3D_REMOVE_DUPLICATION_H
|
||||
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
|
||||
set(PROJECT_NAME easy3d_${MODULE_NAME})
|
||||
project(${PROJECT_NAME})
|
||||
|
||||
|
||||
set(${PROJECT_NAME}_HEADERS
|
||||
box.h
|
||||
constant.h
|
||||
eigen_solver.h
|
||||
graph.h
|
||||
line.h
|
||||
mat.h
|
||||
plane.h
|
||||
point_cloud.h
|
||||
principal_axes.h
|
||||
properties.h
|
||||
quat.h
|
||||
random.h
|
||||
rect.h
|
||||
segment.h
|
||||
surface_mesh.h
|
||||
types.h
|
||||
vec.h
|
||||
)
|
||||
|
||||
set(${PROJECT_NAME}_SOURCES
|
||||
graph.cpp
|
||||
point_cloud.cpp
|
||||
surface_mesh.cpp
|
||||
)
|
||||
|
||||
|
||||
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS} )
|
||||
|
||||
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
|
||||
|
||||
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,176 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_GENERIC_BOX_H
|
||||
#define EASY3D_GENERIC_BOX_H
|
||||
|
||||
#include <cassert>
|
||||
#include <algorithm>
|
||||
#include <limits>
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
class GenericBox {
|
||||
public:
|
||||
typedef Vec<DIM, FT> Point;
|
||||
typedef Vec<DIM, FT> Vector;
|
||||
typedef GenericBox<DIM, FT> thisclass;
|
||||
|
||||
public:
|
||||
GenericBox()
|
||||
: min_(std::numeric_limits<FT>::max()) // initialized to an invalid value
|
||||
, max_(-std::numeric_limits<FT>::max())
|
||||
{
|
||||
}
|
||||
|
||||
// defined by the diagonal corners
|
||||
GenericBox(const Point& pmin, const Point& pmax)
|
||||
{
|
||||
// the user might provide wrong order
|
||||
// min_ = pmin;
|
||||
// max_ = pmax;
|
||||
add_point(pmin);
|
||||
add_point(pmax);
|
||||
}
|
||||
|
||||
// defined by center and radius
|
||||
GenericBox(const Point& c, FT r) {
|
||||
Vector dir(1.0);
|
||||
dir.normalize();
|
||||
min_ = c - dir * r;
|
||||
max_ = c + dir * r;
|
||||
}
|
||||
|
||||
inline bool initialized() const {
|
||||
return max_.x >= min_.x - std::numeric_limits<FT>::epsilon();
|
||||
}
|
||||
|
||||
inline void clear() {
|
||||
min_ = Point(std::numeric_limits<FT>::max());
|
||||
max_ = Point(-std::numeric_limits<FT>::max());
|
||||
}
|
||||
|
||||
inline Point min() const {
|
||||
if (initialized())
|
||||
return min_;
|
||||
else
|
||||
return Point(FT(0.0));
|
||||
}
|
||||
|
||||
inline Point max() const {
|
||||
if (initialized())
|
||||
return max_;
|
||||
else
|
||||
return Point(FT(0.0));
|
||||
}
|
||||
|
||||
inline FT min(unsigned int axis) const {
|
||||
assert(axis >= 0 && axis < DIM);
|
||||
if (initialized())
|
||||
return min_[axis];
|
||||
else
|
||||
return FT(0.0);
|
||||
}
|
||||
inline FT max(unsigned int axis) const {
|
||||
assert(axis >= 0 && axis < DIM);
|
||||
if (initialized())
|
||||
return max_[axis];
|
||||
else
|
||||
return FT(0.0);
|
||||
}
|
||||
|
||||
inline FT range(unsigned int axis) const {
|
||||
assert(axis >= 0 && axis < DIM);
|
||||
if (initialized())
|
||||
return max_[axis] - min_[axis];
|
||||
else
|
||||
return FT(0.0);
|
||||
}
|
||||
|
||||
inline Point center() const {
|
||||
if (initialized())
|
||||
return FT(0.5) * (min_ + max_);
|
||||
else
|
||||
return Point(0.0);
|
||||
}
|
||||
|
||||
inline FT diagonal() const {
|
||||
if (initialized()) {
|
||||
FT sqr_len(0.0);
|
||||
for (int i=0; i<DIM; ++i) {
|
||||
FT d = max_[i] - min_[i];
|
||||
sqr_len += d * d;
|
||||
}
|
||||
return std::sqrt(sqr_len);
|
||||
}
|
||||
else
|
||||
return FT(0.0);
|
||||
}
|
||||
|
||||
inline void add_point(const Point& p) {
|
||||
if (initialized()) {
|
||||
for (int i=0; i<DIM; ++i) {
|
||||
min_[i] = std::min(min_[i], p[i]);
|
||||
max_[i] = std::max(max_[i], p[i]);
|
||||
}
|
||||
}
|
||||
else {
|
||||
min_ = p;
|
||||
max_ = p;
|
||||
}
|
||||
}
|
||||
|
||||
inline void add_box(const thisclass& b) {
|
||||
add_point(b.min());
|
||||
add_point(b.max());
|
||||
}
|
||||
|
||||
inline thisclass operator+(const thisclass& b) const {
|
||||
thisclass result = *this;
|
||||
result += b;
|
||||
return result;
|
||||
}
|
||||
|
||||
inline thisclass& operator+=(const thisclass& b) {
|
||||
add_point(b.min());
|
||||
add_point(b.max());
|
||||
return *this;
|
||||
}
|
||||
|
||||
private:
|
||||
Point min_;
|
||||
Point max_;
|
||||
};
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
||||
#endif // EASY3D_GENERIC_BOX_H
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_CONSTANT_H
|
||||
#define EASY3D_CONSTANT_H
|
||||
|
||||
#include <cfloat>
|
||||
#include <climits>
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
#ifndef M_PI
|
||||
#define M_PI 3.14159265358979323846264338327950288419716939937510582 // pi
|
||||
#endif
|
||||
|
||||
#define half_pi M_PI * 0.5
|
||||
#define quarter_pi M_PI * 0.25
|
||||
#define two_pi M_PI * 2.0
|
||||
#define rad2deg(a) ((a) * 180.0 / M_PI)
|
||||
#define deg2rad(a) ((a) * M_PI / 180.0)
|
||||
|
||||
// Function returning min/max for corresponding type
|
||||
template <typename FT> inline FT min();
|
||||
template <typename FT> inline FT max();
|
||||
// Template specializations for float and double
|
||||
template <> inline int min<int>() { return INT_MIN; }
|
||||
template <> inline int max<int>() { return INT_MAX; }
|
||||
template <> inline float min<float>() { return FLT_MIN; }
|
||||
template <> inline float max<float>() { return FLT_MAX; }
|
||||
template <> inline double min<double>() { return DBL_MIN; }
|
||||
template <> inline double max<double>() { return DBL_MAX; }
|
||||
|
||||
// standard epsilon values
|
||||
// Function returning epsilon for corresponding type
|
||||
template <typename FT> inline FT epsilon();
|
||||
template <typename FT> inline FT epsilon_sqr();
|
||||
|
||||
// Template specializations for float and double
|
||||
template <> inline float epsilon<float>() { return 1.0e-6f; }
|
||||
template <> inline float epsilon_sqr<float>() { return 1.0e-12f; }
|
||||
template <> inline double epsilon<double>() { return 1.0e-12; }
|
||||
template <> inline double epsilon_sqr<double>() { return 1.0e-24; }
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_CONSTANT_H
|
||||
|
|
@ -0,0 +1,630 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
/** ----------------------------------------------------------
|
||||
* The code is adapted from Magic Software with significant
|
||||
* modifications and enhancement.
|
||||
* Magic Software, Inc.
|
||||
* http://www.magic-software.com
|
||||
* Copyright(c) 2000, 2001. All Rights Reserved
|
||||
* Source code from Magic Software is supplied under the
|
||||
* terms of a license agreement and may not be copied or
|
||||
* disclosed except in accordance with the terms of that
|
||||
* agreement. The various license agreements may be found
|
||||
* at the Magic Software web site. This file is subject
|
||||
* to the license
|
||||
* FREE SOURCE CODE
|
||||
* http://www.magic-software.com/License/free.pdf
|
||||
*----------------------------------------------------------*/
|
||||
|
||||
|
||||
#ifndef EASY3D_EIGEN_SOLVER_H
|
||||
#define EASY3D_EIGEN_SOLVER_H
|
||||
|
||||
#include <cmath>
|
||||
#include <cassert>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
template <typename FT>
|
||||
class EigenSolver
|
||||
{
|
||||
public:
|
||||
enum SortingMethod { NO_SORTING, INCREASING, DECREASING };
|
||||
|
||||
public:
|
||||
/// @param n: the size of the input matrix
|
||||
EigenSolver(int n);
|
||||
~EigenSolver();
|
||||
|
||||
/// solve
|
||||
/// @param mat: the input matrix (row major 2D array)
|
||||
void solve(FT** mat, SortingMethod sm = NO_SORTING);
|
||||
|
||||
/// the i_th eigenvalue
|
||||
FT eigen_value(int i) const { return diag_[i]; }
|
||||
/// the comp_th component of the i_th eigenvector
|
||||
FT eigen_vector(int comp, int i) const { return matrix_[comp][i]; }
|
||||
|
||||
/// the eigenvalues
|
||||
FT* eigen_values() { return diag_; }
|
||||
/// the eigenvectors (stored as the columns of the returned matrix)
|
||||
FT** eigen_vectors() { return matrix_; }
|
||||
|
||||
protected:
|
||||
int size_;
|
||||
FT** matrix_;
|
||||
FT* diag_;
|
||||
FT* subd_;
|
||||
|
||||
private:
|
||||
// Householder reduction to tridiagonal form
|
||||
static void tridiagonal_2(FT** mat, FT* diag, FT* subd);
|
||||
static void tridiagonal_3(FT** mat, FT* diag, FT* subd);
|
||||
static void tridiagonal_4(FT** mat, FT* diag, FT* subd);
|
||||
static void tridiagonal_n(int n, FT** mat, FT* diag, FT* subd);
|
||||
|
||||
// QL algorithm with implicit shifting, applies to tridiagonal matrices
|
||||
static bool ql_algorithm(int n, FT* diag, FT* subd, FT** mat);
|
||||
|
||||
// sort eigenvalues and eigenvectors in the descending order
|
||||
static void decreasing_sort(int n, FT* eigval, FT** eigvec);
|
||||
|
||||
// sort eigenvalues and eigenvectors in the ascending order
|
||||
static void increasing_sort(int n, FT* eigval, FT** eigvec);
|
||||
};
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------
|
||||
|
||||
|
||||
template <typename FT>
|
||||
EigenSolver<FT>::EigenSolver(int n)
|
||||
{
|
||||
assert( n >= 2 );
|
||||
size_ = n;
|
||||
|
||||
matrix_ = nullptr;
|
||||
|
||||
diag_ = new FT[size_];
|
||||
subd_ = new FT[size_];
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
EigenSolver<FT>::~EigenSolver()
|
||||
{
|
||||
delete[] subd_;
|
||||
delete[] diag_;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::tridiagonal_2(FT** matrix_, FT* diag_, FT* subd_)
|
||||
{
|
||||
// matrix is already tridiagonal
|
||||
diag_[0] = matrix_[0][0];
|
||||
diag_[1] = matrix_[1][1];
|
||||
subd_[0] = matrix_[0][1];
|
||||
subd_[1] = 0.0f;
|
||||
matrix_[0][0] = 1.0f;
|
||||
matrix_[0][1] = 0.0f;
|
||||
matrix_[1][0] = 0.0f;
|
||||
matrix_[1][1] = 1.0f;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::tridiagonal_3(FT** matrix_, FT* diag_, FT* subd_)
|
||||
{
|
||||
FT fM00 = matrix_[0][0];
|
||||
FT fM01 = matrix_[0][1];
|
||||
FT fM02 = matrix_[0][2];
|
||||
FT fM11 = matrix_[1][1];
|
||||
FT fM12 = matrix_[1][2];
|
||||
FT fM22 = matrix_[2][2];
|
||||
|
||||
diag_[0] = fM00;
|
||||
subd_[2] = 0.0f;
|
||||
if( fM02 != 0.0f )
|
||||
{
|
||||
FT fLength = std::sqrt(fM01*fM01+fM02*fM02);
|
||||
FT fInvLength = 1.0f/fLength;
|
||||
fM01 *= fInvLength;
|
||||
fM02 *= fInvLength;
|
||||
FT fQ = 2.0f*fM01*fM12+fM02*(fM22-fM11);
|
||||
diag_[1] = fM11+fM02*fQ;
|
||||
diag_[2] = fM22-fM02*fQ;
|
||||
subd_[0] = fLength;
|
||||
subd_[1] = fM12-fM01*fQ;
|
||||
matrix_[0][0] = 1.0f; matrix_[0][1] = 0.0f; matrix_[0][2] = 0.0f;
|
||||
matrix_[1][0] = 0.0f; matrix_[1][1] = fM01; matrix_[1][2] = fM02;
|
||||
matrix_[2][0] = 0.0f; matrix_[2][1] = fM02; matrix_[2][2] = -fM01;
|
||||
}
|
||||
else
|
||||
{
|
||||
diag_[1] = fM11;
|
||||
diag_[2] = fM22;
|
||||
subd_[0] = fM01;
|
||||
subd_[1] = fM12;
|
||||
matrix_[0][0] = 1.0f; matrix_[0][1] = 0.0f; matrix_[0][2] = 0.0f;
|
||||
matrix_[1][0] = 0.0f; matrix_[1][1] = 1.0f; matrix_[1][2] = 0.0f;
|
||||
matrix_[2][0] = 0.0f; matrix_[2][1] = 0.0f; matrix_[2][2] = 1.0f;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::tridiagonal_4(FT** matrix_, FT* diag_, FT* subd_)
|
||||
{
|
||||
// save matrix M
|
||||
FT fM00 = matrix_[0][0];
|
||||
FT fM01 = matrix_[0][1];
|
||||
FT fM02 = matrix_[0][2];
|
||||
FT fM03 = matrix_[0][3];
|
||||
FT fM11 = matrix_[1][1];
|
||||
FT fM12 = matrix_[1][2];
|
||||
FT fM13 = matrix_[1][3];
|
||||
FT fM22 = matrix_[2][2];
|
||||
FT fM23 = matrix_[2][3];
|
||||
FT fM33 = matrix_[3][3];
|
||||
|
||||
diag_[0] = fM00;
|
||||
subd_[3] = 0.0f;
|
||||
|
||||
matrix_[0][0] = 1.0f;
|
||||
matrix_[0][1] = 0.0f;
|
||||
matrix_[0][2] = 0.0f;
|
||||
matrix_[0][3] = 0.0f;
|
||||
matrix_[1][0] = 0.0f;
|
||||
matrix_[2][0] = 0.0f;
|
||||
matrix_[3][0] = 0.0f;
|
||||
|
||||
FT fLength, fInvLength;
|
||||
|
||||
if( fM02 != 0.0f || fM03 != 0.0f )
|
||||
{
|
||||
FT fQ11, fQ12, fQ13;
|
||||
FT fQ21, fQ22, fQ23;
|
||||
FT fQ31, fQ32, fQ33;
|
||||
|
||||
// build column Q1
|
||||
fLength = std::sqrt(fM01*fM01+fM02*fM02+fM03*fM03);
|
||||
fInvLength = 1.0f/fLength;
|
||||
fQ11 = fM01*fInvLength;
|
||||
fQ21 = fM02*fInvLength;
|
||||
fQ31 = fM03*fInvLength;
|
||||
|
||||
subd_[0] = fLength;
|
||||
|
||||
// compute S*Q1
|
||||
FT fV0 = fM11*fQ11+fM12*fQ21+fM13*fQ31;
|
||||
FT fV1 = fM12*fQ11+fM22*fQ21+fM23*fQ31;
|
||||
FT fV2 = fM13*fQ11+fM23*fQ21+fM33*fQ31;
|
||||
|
||||
diag_[1] = fQ11*fV0+fQ21*fV1+fQ31*fV2;
|
||||
|
||||
// build column Q3 = Q1x(S*Q1)
|
||||
fQ13 = fQ21*fV2-fQ31*fV1;
|
||||
fQ23 = fQ31*fV0-fQ11*fV2;
|
||||
fQ33 = fQ11*fV1-fQ21*fV0;
|
||||
fLength = std::sqrt(fQ13*fQ13+fQ23*fQ23+fQ33*fQ33);
|
||||
if( fLength > 0.0f )
|
||||
{
|
||||
fInvLength = 1.0f/fLength;
|
||||
fQ13 *= fInvLength;
|
||||
fQ23 *= fInvLength;
|
||||
fQ33 *= fInvLength;
|
||||
|
||||
// build column Q2 = Q3xQ1
|
||||
fQ12 = fQ23*fQ31-fQ33*fQ21;
|
||||
fQ22 = fQ33*fQ11-fQ13*fQ31;
|
||||
fQ32 = fQ13*fQ21-fQ23*fQ11;
|
||||
|
||||
fV0 = fQ12*fM11+fQ22*fM12+fQ32*fM13;
|
||||
fV1 = fQ12*fM12+fQ22*fM22+fQ32*fM23;
|
||||
fV2 = fQ12*fM13+fQ22*fM23+fQ32*fM33;
|
||||
subd_[1] = fQ11*fV0+fQ21*fV1+fQ31*fV2;
|
||||
diag_[2] = fQ12*fV0+fQ22*fV1+fQ32*fV2;
|
||||
subd_[2] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
|
||||
|
||||
fV0 = fQ13*fM11+fQ23*fM12+fQ33*fM13;
|
||||
fV1 = fQ13*fM12+fQ23*fM22+fQ33*fM23;
|
||||
fV2 = fQ13*fM13+fQ23*fM23+fQ33*fM33;
|
||||
diag_[3] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
|
||||
}
|
||||
else
|
||||
{
|
||||
// S*Q1 parallel to Q1, choose any valid Q2 and Q3
|
||||
subd_[1] = 0.0f;
|
||||
|
||||
fLength = fQ21*fQ21+fQ31*fQ31;
|
||||
if( fLength > 0.0f )
|
||||
{
|
||||
fInvLength = 1.0f/fLength;
|
||||
FT fTmp = fQ11-1.0f;
|
||||
fQ12 = -fQ21;
|
||||
fQ22 = 1.0f+fTmp*fQ21*fQ21*fInvLength;
|
||||
fQ32 = fTmp*fQ21*fQ31*fInvLength;
|
||||
|
||||
fQ13 = -fQ31;
|
||||
fQ23 = fQ32;
|
||||
fQ33 = 1.0f+fTmp*fQ31*fQ31*fInvLength;
|
||||
|
||||
fV0 = fQ12*fM11+fQ22*fM12+fQ32*fM13;
|
||||
fV1 = fQ12*fM12+fQ22*fM22+fQ32*fM23;
|
||||
fV2 = fQ12*fM13+fQ22*fM23+fQ32*fM33;
|
||||
diag_[2] = fQ12*fV0+fQ22*fV1+fQ32*fV2;
|
||||
subd_[2] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
|
||||
|
||||
fV0 = fQ13*fM11+fQ23*fM12+fQ33*fM13;
|
||||
fV1 = fQ13*fM12+fQ23*fM22+fQ33*fM23;
|
||||
fV2 = fQ13*fM13+fQ23*fM23+fQ33*fM33;
|
||||
diag_[3] = fQ13*fV0+fQ23*fV1+fQ33*fV2;
|
||||
}
|
||||
else
|
||||
{
|
||||
// Q1 =(+-1,0,0)
|
||||
fQ12 = 0.0f; fQ22 = 1.0f; fQ32 = 0.0f;
|
||||
fQ13 = 0.0f; fQ23 = 0.0f; fQ33 = 1.0f;
|
||||
|
||||
diag_[2] = fM22;
|
||||
diag_[3] = fM33;
|
||||
subd_[2] = fM23;
|
||||
}
|
||||
}
|
||||
|
||||
matrix_[1][1] = fQ11; matrix_[1][2] = fQ12; matrix_[1][3] = fQ13;
|
||||
matrix_[2][1] = fQ21; matrix_[2][2] = fQ22; matrix_[2][3] = fQ23;
|
||||
matrix_[3][1] = fQ31; matrix_[3][2] = fQ32; matrix_[3][3] = fQ33;
|
||||
}
|
||||
else
|
||||
{
|
||||
diag_[1] = fM11;
|
||||
subd_[0] = fM01;
|
||||
matrix_[1][1] = 1.0f;
|
||||
matrix_[2][1] = 0.0f;
|
||||
matrix_[3][1] = 0.0f;
|
||||
|
||||
if( fM13 != 0.0f )
|
||||
{
|
||||
fLength = std::sqrt(fM12*fM12+fM13*fM13);
|
||||
fInvLength = 1.0f/fLength;
|
||||
fM12 *= fInvLength;
|
||||
fM13 *= fInvLength;
|
||||
FT fQ = 2.0f*fM12*fM23+fM13*(fM33-fM22);
|
||||
|
||||
diag_[2] = fM22+fM13*fQ;
|
||||
diag_[3] = fM33-fM13*fQ;
|
||||
subd_[1] = fLength;
|
||||
subd_[2] = fM23-fM12*fQ;
|
||||
matrix_[1][2] = 0.0f;
|
||||
matrix_[1][3] = 0.0f;
|
||||
matrix_[2][2] = fM12;
|
||||
matrix_[2][3] = fM13;
|
||||
matrix_[3][2] = fM13;
|
||||
matrix_[3][3] = -fM12;
|
||||
}
|
||||
else
|
||||
{
|
||||
diag_[2] = fM22;
|
||||
diag_[3] = fM33;
|
||||
subd_[1] = fM12;
|
||||
subd_[2] = fM23;
|
||||
matrix_[1][2] = 0.0f;
|
||||
matrix_[1][3] = 0.0f;
|
||||
matrix_[2][2] = 1.0f;
|
||||
matrix_[2][3] = 0.0f;
|
||||
matrix_[3][2] = 0.0f;
|
||||
matrix_[3][3] = 1.0f;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::tridiagonal_n(int n, FT** matrix_, FT* diag_, FT* subd_)
|
||||
{
|
||||
int i0, i1, i2, i3;
|
||||
|
||||
for(i0 = n-1, i3 = n-2; i0 >= 1; i0--, i3--)
|
||||
{
|
||||
FT fH = 0.0f, fScale = 0.0f;
|
||||
|
||||
if( i3 > 0 )
|
||||
{
|
||||
for(i2 = 0; i2 <= i3; i2++)
|
||||
fScale += std::abs(matrix_[i0][i2]);
|
||||
if( fScale == 0 )
|
||||
{
|
||||
subd_[i0] = matrix_[i0][i3];
|
||||
}
|
||||
else
|
||||
{
|
||||
FT fInvScale = 1.0f/fScale;
|
||||
for(i2 = 0; i2 <= i3; i2++)
|
||||
{
|
||||
matrix_[i0][i2] *= fInvScale;
|
||||
fH += matrix_[i0][i2]*matrix_[i0][i2];
|
||||
}
|
||||
FT fF = matrix_[i0][i3];
|
||||
FT fG = std::sqrt(fH);
|
||||
if( fF > 0.0f )
|
||||
fG = -fG;
|
||||
subd_[i0] = fScale*fG;
|
||||
fH -= fF*fG;
|
||||
matrix_[i0][i3] = fF-fG;
|
||||
fF = 0.0f;
|
||||
FT fInvH = 1.0f/fH;
|
||||
for(i1 = 0; i1 <= i3; i1++)
|
||||
{
|
||||
matrix_[i1][i0] = matrix_[i0][i1]*fInvH;
|
||||
fG = 0.0f;
|
||||
for(i2 = 0; i2 <= i1; i2++)
|
||||
fG += matrix_[i1][i2]*matrix_[i0][i2];
|
||||
for(i2 = i1+1; i2 <= i3; i2++)
|
||||
fG += matrix_[i2][i1]*matrix_[i0][i2];
|
||||
subd_[i1] = fG*fInvH;
|
||||
fF += subd_[i1]*matrix_[i0][i1];
|
||||
}
|
||||
FT fHalfFdivH = 0.5f*fF*fInvH;
|
||||
for(i1 = 0; i1 <= i3; i1++)
|
||||
{
|
||||
fF = matrix_[i0][i1];
|
||||
fG = subd_[i1] - fHalfFdivH*fF;
|
||||
subd_[i1] = fG;
|
||||
for(i2 = 0; i2 <= i1; i2++)
|
||||
{
|
||||
matrix_[i1][i2] -= fF*subd_[i2] +
|
||||
fG*matrix_[i0][i2];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
subd_[i0] = matrix_[i0][i3];
|
||||
}
|
||||
|
||||
diag_[i0] = fH;
|
||||
}
|
||||
|
||||
diag_[0] = 0.0f;
|
||||
subd_[0] = 0.0f;
|
||||
for(i0 = 0, i3 = -1; i0 <= n-1; i0++, i3++)
|
||||
{
|
||||
if( diag_[i0] )
|
||||
{
|
||||
for(i1 = 0; i1 <= i3; i1++)
|
||||
{
|
||||
FT fSum = 0.0f;
|
||||
for(i2 = 0; i2 <= i3; i2++)
|
||||
fSum += matrix_[i0][i2]*matrix_[i2][i1];
|
||||
for(i2 = 0; i2 <= i3; i2++)
|
||||
matrix_[i2][i1] -= fSum*matrix_[i2][i0];
|
||||
}
|
||||
}
|
||||
diag_[i0] = matrix_[i0][i0];
|
||||
matrix_[i0][i0] = 1.0f;
|
||||
for(i1 = 0; i1 <= i3; i1++)
|
||||
{
|
||||
matrix_[i1][i0] = 0.0f;
|
||||
matrix_[i0][i1] = 0.0f;
|
||||
}
|
||||
}
|
||||
|
||||
// re-ordering if Eigen<FT>::ql_algorithm is used subsequently
|
||||
for(i0 = 1, i3 = 0; i0 < n; i0++, i3++)
|
||||
subd_[i3] = subd_[i0];
|
||||
subd_[n-1] = 0.0f;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline bool EigenSolver<FT>::ql_algorithm(int n, FT* diag_, FT* subd_, FT** matrix_)
|
||||
{
|
||||
const int iMaxIter = 32;
|
||||
|
||||
for(int i0 = 0; i0 < n; i0++)
|
||||
{
|
||||
int i1;
|
||||
for(i1 = 0; i1 < iMaxIter; i1++)
|
||||
{
|
||||
int i2;
|
||||
for(i2 = i0; i2 <= n-2; i2++)
|
||||
{
|
||||
FT fTmp = std::abs(diag_[i2]) +
|
||||
std::abs(diag_[i2+1]);
|
||||
if( std::abs(subd_[i2]) + fTmp == fTmp )
|
||||
break;
|
||||
}
|
||||
if( i2 == i0 )
|
||||
break;
|
||||
|
||||
FT fG =(diag_[i0+1]-diag_[i0])/(2.0f*subd_[i0]);
|
||||
FT fR = std::sqrt(fG*fG+1.0f);
|
||||
if( fG < 0.0f )
|
||||
fG = diag_[i2]-diag_[i0]+subd_[i0]/(fG-fR);
|
||||
else
|
||||
fG = diag_[i2]-diag_[i0]+subd_[i0]/(fG+fR);
|
||||
FT fSin = 1.0f, fCos = 1.0, fP = 0.0f;
|
||||
for(int i3 = i2-1; i3 >= i0; i3--)
|
||||
{
|
||||
FT fF = fSin*subd_[i3];
|
||||
FT fB = fCos*subd_[i3];
|
||||
if( std::abs(fF) >= std::abs(fG) )
|
||||
{
|
||||
fCos = fG/fF;
|
||||
fR = std::sqrt(fCos*fCos+1.0f);
|
||||
subd_[i3+1] = fF*fR;
|
||||
fSin = 1.0f/fR;
|
||||
fCos *= fSin;
|
||||
}
|
||||
else
|
||||
{
|
||||
fSin = fF/fG;
|
||||
fR = std::sqrt(fSin*fSin+1.0f);
|
||||
subd_[i3+1] = fG*fR;
|
||||
fCos = 1.0f/fR;
|
||||
fSin *= fCos;
|
||||
}
|
||||
fG = diag_[i3+1]-fP;
|
||||
fR =(diag_[i3]-fG)*fSin+2.0f*fB*fCos;
|
||||
fP = fSin*fR;
|
||||
diag_[i3+1] = fG+fP;
|
||||
fG = fCos*fR-fB;
|
||||
|
||||
for(int i4 = 0; i4 < n; i4++)
|
||||
{
|
||||
fF = matrix_[i4][i3+1];
|
||||
matrix_[i4][i3+1] = fSin*matrix_[i4][i3]+fCos*fF;
|
||||
matrix_[i4][i3] = fCos*matrix_[i4][i3]-fSin*fF;
|
||||
}
|
||||
}
|
||||
diag_[i0] -= fP;
|
||||
subd_[i0] = fG;
|
||||
subd_[i2] = 0.0f;
|
||||
}
|
||||
if( i1 == iMaxIter )
|
||||
return false;
|
||||
}
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::decreasing_sort(int n, FT* eigval, FT** eigvec)
|
||||
{
|
||||
// sort eigenvalues in decreasing order, e[0] >= ... >= e[n-1]
|
||||
for(int i0 = 0, i1; i0 <= n-2; i0++)
|
||||
{
|
||||
// locate maximum eigenvalue
|
||||
i1 = i0;
|
||||
FT fMax = eigval[i1];
|
||||
int i2;
|
||||
for(i2 = i0+1; i2 < n; i2++)
|
||||
{
|
||||
if( eigval[i2] > fMax )
|
||||
{
|
||||
i1 = i2;
|
||||
fMax = eigval[i1];
|
||||
}
|
||||
}
|
||||
|
||||
if( i1 != i0 )
|
||||
{
|
||||
// swap eigenvalues
|
||||
eigval[i1] = eigval[i0];
|
||||
eigval[i0] = fMax;
|
||||
|
||||
// swap eigenvectors
|
||||
for(i2 = 0; i2 < n; i2++)
|
||||
{
|
||||
FT fTmp = eigvec[i2][i0];
|
||||
eigvec[i2][i0] = eigvec[i2][i1];
|
||||
eigvec[i2][i1] = fTmp;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::increasing_sort(int n, FT* eigval, FT** eigvec)
|
||||
{
|
||||
// sort eigenvalues in increasing order, e[0] <= ... <= e[n-1]
|
||||
for(int i0 = 0, i1; i0 <= n-2; i0++)
|
||||
{
|
||||
// locate minimum eigenvalue
|
||||
i1 = i0;
|
||||
FT fMin = eigval[i1];
|
||||
int i2;
|
||||
for(i2 = i0+1; i2 < n; i2++)
|
||||
{
|
||||
if( eigval[i2] < fMin )
|
||||
{
|
||||
i1 = i2;
|
||||
fMin = eigval[i1];
|
||||
}
|
||||
}
|
||||
|
||||
if( i1 != i0 )
|
||||
{
|
||||
// swap eigenvalues
|
||||
eigval[i1] = eigval[i0];
|
||||
eigval[i0] = fMin;
|
||||
|
||||
// swap eigenvectors
|
||||
for(i2 = 0; i2 < n; i2++)
|
||||
{
|
||||
FT fTmp = eigvec[i2][i0];
|
||||
eigvec[i2][i0] = eigvec[i2][i1];
|
||||
eigvec[i2][i1] = fTmp;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
inline void EigenSolver<FT>::solve(FT** mat, SortingMethod sm /* = NO_SORTING*/)
|
||||
{
|
||||
matrix_ = mat;
|
||||
|
||||
switch( size_ )
|
||||
{
|
||||
case 2:
|
||||
tridiagonal_2(matrix_,diag_,subd_);
|
||||
break;
|
||||
case 3:
|
||||
tridiagonal_3(matrix_,diag_,subd_);
|
||||
break;
|
||||
case 4:
|
||||
tridiagonal_4(matrix_,diag_,subd_);
|
||||
break;
|
||||
default:
|
||||
tridiagonal_n(size_,matrix_,diag_,subd_);
|
||||
break;
|
||||
}
|
||||
|
||||
ql_algorithm(size_,diag_,subd_,matrix_);
|
||||
|
||||
switch( sm )
|
||||
{
|
||||
case INCREASING:
|
||||
increasing_sort(size_,diag_,matrix_);
|
||||
break;
|
||||
case DECREASING:
|
||||
decreasing_sort(size_,diag_,matrix_);
|
||||
break;
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_EIGEN_SOLVER_H
|
||||
|
|
@ -0,0 +1,411 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/core/graph.h>
|
||||
|
||||
#include <cmath>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
Graph::Graph()
|
||||
{
|
||||
// allocate standard properties
|
||||
// same list is used in operator=() and assign()
|
||||
vconn_ = add_vertex_property<VertexConnectivity>("v:connectivity");
|
||||
econn_ = add_edge_property<EdgeConnectivity>("e:connectivity");
|
||||
vpoint_ = add_vertex_property<vec3>("v:point");
|
||||
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
|
||||
edeleted_ = add_edge_property<bool>("e:deleted", false);
|
||||
|
||||
mprops_.push_back();
|
||||
|
||||
deleted_vertices_ = deleted_edges_ = 0;
|
||||
garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Graph::~Graph()
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Graph& Graph::operator=(const Graph& rhs)
|
||||
{
|
||||
if (this != &rhs)
|
||||
{
|
||||
// deep copy of property containers
|
||||
vprops_ = rhs.vprops_;
|
||||
eprops_ = rhs.eprops_;
|
||||
mprops_ = rhs.mprops_;
|
||||
|
||||
// property handles contain pointers, have to be reassigned
|
||||
vconn_ = vertex_property<VertexConnectivity>("v:connectivity");
|
||||
econn_ = edge_property<EdgeConnectivity>("e:connectivity");
|
||||
vdeleted_ = vertex_property<bool>("v:deleted");
|
||||
edeleted_ = edge_property<bool>("e:deleted");
|
||||
vpoint_ = vertex_property<vec3>("v:point");
|
||||
|
||||
// how many elements are deleted?
|
||||
deleted_vertices_ = rhs.deleted_vertices_;
|
||||
deleted_edges_ = rhs.deleted_edges_;
|
||||
garbage_ = rhs.garbage_;
|
||||
}
|
||||
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Graph& Graph::assign(const Graph& rhs)
|
||||
{
|
||||
if (this != &rhs)
|
||||
{
|
||||
// clear properties
|
||||
vprops_.clear();
|
||||
eprops_.clear();
|
||||
mprops_.clear();
|
||||
|
||||
// allocate standard properties
|
||||
vconn_ = add_vertex_property<VertexConnectivity>("v:connectivity");
|
||||
econn_ = add_edge_property<EdgeConnectivity>("e:connectivity");
|
||||
vpoint_ = add_vertex_property<vec3>("v:point");
|
||||
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
|
||||
edeleted_ = add_edge_property<bool>("e:deleted", false);
|
||||
|
||||
// copy properties from other mesh
|
||||
vconn_.array() = rhs.vconn_.array();
|
||||
econn_.array() = rhs.econn_.array();
|
||||
vpoint_.array() = rhs.vpoint_.array();
|
||||
vdeleted_.array() = rhs.vdeleted_.array();
|
||||
edeleted_.array() = rhs.edeleted_.array();
|
||||
|
||||
// resize (needed by property containers)
|
||||
vprops_.resize(rhs.vertices_size());
|
||||
eprops_.resize(rhs.edges_size());
|
||||
mprops_.resize(1);
|
||||
|
||||
// how many elements are deleted?
|
||||
deleted_vertices_ = rhs.deleted_vertices_;
|
||||
deleted_edges_ = rhs.deleted_edges_;
|
||||
garbage_ = rhs.garbage_;
|
||||
}
|
||||
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void Graph::clear()
|
||||
{
|
||||
vprops_.resize(0);
|
||||
eprops_.resize(0);
|
||||
mprops_.resize(0);
|
||||
|
||||
free_memory();
|
||||
|
||||
deleted_vertices_ = deleted_edges_ = 0;
|
||||
garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void Graph::free_memory()
|
||||
{
|
||||
vprops_.free_memory();
|
||||
eprops_.free_memory();
|
||||
mprops_.free_memory();
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void Graph::reserve(unsigned int nvertices, unsigned int nedges)
|
||||
{
|
||||
vprops_.reserve(nvertices);
|
||||
eprops_.reserve(nedges);
|
||||
mprops_.reserve(1);
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void Graph::property_stats() const
|
||||
{
|
||||
std::vector<std::string> props;
|
||||
|
||||
std::cout << "vertex properties:\n";
|
||||
props = vertex_properties();
|
||||
for (unsigned int i=0; i<props.size(); ++i)
|
||||
std::cout << "\t" << props[i] << std::endl;
|
||||
|
||||
std::cout << "edge properties:\n";
|
||||
props = edge_properties();
|
||||
for (unsigned int i=0; i<props.size(); ++i)
|
||||
std::cout << "\t" << props[i] << std::endl;
|
||||
|
||||
std::cout << "model properties:\n";
|
||||
props = model_properties();
|
||||
for (unsigned int i = 0; i < props.size(); ++i)
|
||||
std::cout << "\t" << props[i] << std::endl;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Graph::Vertex Graph:: add_vertex(const vec3& p)
|
||||
{
|
||||
Vertex v = new_vertex();
|
||||
vpoint_[v] = p;
|
||||
return v;
|
||||
}
|
||||
|
||||
|
||||
Graph::Edge Graph::add_edge(const Vertex& start, const Vertex& end) {
|
||||
assert(start != end);
|
||||
Edge e = new_edge();
|
||||
econn_[e].source_ = start;
|
||||
econn_[e].target_ = end;
|
||||
vconn_[start].edges_.push_back(e);
|
||||
vconn_[end].edges_.push_back(e);
|
||||
return e;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
Graph::Edge Graph::find_edge(Vertex start, Vertex end) const
|
||||
{
|
||||
assert(is_valid(start) && is_valid(end));
|
||||
|
||||
for (auto e : edges(start)) {
|
||||
if (from_vertex(e) == end || to_vertex(e) == end)
|
||||
return e;
|
||||
}
|
||||
|
||||
return Edge();
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
unsigned int Graph::valence(Vertex v) const
|
||||
{
|
||||
return static_cast<unsigned int>(vconn_[v].edges_.size());
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
float Graph::edge_length(Edge e) const
|
||||
{
|
||||
return norm(vpoint_[from_vertex(e)] - vpoint_[to_vertex(e)]);
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
void Graph::delete_vertex(Vertex v)
|
||||
{
|
||||
// if (vdeleted_[v]) return;
|
||||
|
||||
// // collect incident faces
|
||||
// std::vector<Face> incident_faces;
|
||||
// incident_faces.reserve(6);
|
||||
|
||||
// FaceAroundVertexCirculator fc, fc_end;
|
||||
// fc = fc_end = faces(v);
|
||||
|
||||
// if (fc)
|
||||
// do
|
||||
// {
|
||||
// incident_faces.push_back(*fc);
|
||||
// } while (++fc != fc_end);
|
||||
|
||||
// // delete incident faces
|
||||
// std::vector<Face>::iterator fit(incident_faces.begin()),
|
||||
// fend(incident_faces.end());
|
||||
|
||||
// for (; fit != fend; ++fit)
|
||||
// delete_face(*fit);
|
||||
|
||||
// // mark v as deleted if not yet done by delete_face()
|
||||
// if (!vdeleted_[v])
|
||||
// {
|
||||
// vdeleted_[v] = true;
|
||||
// deleted_vertices_++;
|
||||
// garbage_ = true;
|
||||
// }
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void Graph::delete_edge(Edge e)
|
||||
{
|
||||
// if (edeleted_[e]) return;
|
||||
|
||||
// Face f0 = face(halfedge(e, 0));
|
||||
// Face f1 = face(halfedge(e, 1));
|
||||
|
||||
// if (f0.is_valid()) delete_face(f0);
|
||||
// if (f1.is_valid()) delete_face(f1);
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
void Graph::garbage_collection()
|
||||
{
|
||||
// int i, i0, i1,
|
||||
// nV(vertices_size()),
|
||||
// nE(edges_size()),
|
||||
// nH(halfedges_size()),
|
||||
|
||||
// Vertex v;
|
||||
// Halfedge h;
|
||||
|
||||
|
||||
// // setup handle mapping
|
||||
// VertexProperty<Vertex> vmap = add_vertex_property<Vertex>("v:garbage-collection");
|
||||
// EdgeProperty<Edge> emap = add_edge_property<Edge>("e:garbage-collection");
|
||||
|
||||
// for (i=0; i<nV; ++i)
|
||||
// vmap[Vertex(i)] = Vertex(i);
|
||||
// for (i=0; i<nH; ++i)
|
||||
// emap[Edge(i)] = Edge(i);
|
||||
|
||||
// // remove deleted vertices
|
||||
// if (nV > 0)
|
||||
// {
|
||||
// i0=0; i1=nV-1;
|
||||
|
||||
// while (1)
|
||||
// {
|
||||
// // find first deleted and last un-deleted
|
||||
// while (!vdeleted_[Vertex(i0)] && i0 < i1) ++i0;
|
||||
// while ( vdeleted_[Vertex(i1)] && i0 < i1) --i1;
|
||||
// if (i0 >= i1) break;
|
||||
|
||||
// // swap
|
||||
// vprops_.swap(i0, i1);
|
||||
// };
|
||||
|
||||
// // remember new size
|
||||
// nV = vdeleted_[Vertex(i0)] ? i0 : i0+1;
|
||||
// }
|
||||
|
||||
|
||||
// // remove deleted edges
|
||||
// if (nE > 0)
|
||||
// {
|
||||
// i0=0; i1=nE-1;
|
||||
|
||||
// while (1)
|
||||
// {
|
||||
// // find first deleted and last un-deleted
|
||||
// while (!edeleted_[Edge(i0)] && i0 < i1) ++i0;
|
||||
// while ( edeleted_[Edge(i1)] && i0 < i1) --i1;
|
||||
// if (i0 >= i1) break;
|
||||
|
||||
// // swap
|
||||
// eprops_.swap(i0, i1);
|
||||
// eprops_.swap(2*i0, 2*i1);
|
||||
// };
|
||||
|
||||
// // remember new size
|
||||
// nE = edeleted_[Edge(i0)] ? i0 : i0+1;
|
||||
// nH = 2*nE;
|
||||
// }
|
||||
|
||||
// // update vertex connectivity
|
||||
// for (i=0; i<nV; ++i)
|
||||
// {
|
||||
// v = Vertex(i);
|
||||
// if (!is_isolated(v))
|
||||
// set_halfedge(v, hmap[edges(v)]);
|
||||
// }
|
||||
|
||||
|
||||
// // update halfedge connectivity
|
||||
// for (i=0; i<nH; ++i)
|
||||
// {
|
||||
// h = Halfedge(i);
|
||||
// set_vertex(h, vmap[to_vertex(h)]);
|
||||
// set_next_halfedge(h, hmap[next_halfedge(h)]);
|
||||
// if (!is_boundary(h))
|
||||
// set_face(h, fmap[face(h)]);
|
||||
// }
|
||||
|
||||
// // remove handle maps
|
||||
// remove_vertex_property(vmap);
|
||||
// remove_edge_property(emap);
|
||||
|
||||
|
||||
// // finally resize arrays
|
||||
// vprops_.resize(nV); vprops_.free_memory();
|
||||
// eprops_.resize(nH); eprops_.free_memory();
|
||||
|
||||
// deleted_vertices_ = deleted_edges_ = 0;
|
||||
// garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
// std::vector<Graph::Vertex> Graph::vertices(Vertex v) const {
|
||||
// assert(v.is_valid());
|
||||
// std::vector<Graph::Vertex> result;
|
||||
// for (auto e : edges(v)) {
|
||||
// Vertex another = from_vertex(e);
|
||||
// if (another != v)
|
||||
// result.push_back(another);
|
||||
// else
|
||||
// result.push_back(to_vertex(e));
|
||||
// }
|
||||
|
||||
// return result;
|
||||
// }
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,917 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_GRAPH_H
|
||||
#define EASY3D_GRAPH_H
|
||||
|
||||
|
||||
#include <easy3d/viewer/model.h>
|
||||
|
||||
#include <vector>
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
#include <easy3d/core/properties.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
/**
|
||||
* @brief A Graph data structure with easy property management.
|
||||
*/
|
||||
|
||||
|
||||
class Graph : public Model
|
||||
{
|
||||
|
||||
public: //------------------------------------------------------ topology types
|
||||
|
||||
|
||||
/// Base class for all topology types (internally it is basically an index)
|
||||
/// \sa Vertex, Edge
|
||||
class BaseHandle
|
||||
{
|
||||
public:
|
||||
|
||||
/// constructor
|
||||
explicit BaseHandle(int _idx = -1) : idx_(_idx) {}
|
||||
|
||||
/// Get the underlying index of this handle
|
||||
int idx() const { return idx_; }
|
||||
|
||||
/// reset handle to be invalid (index=-1)
|
||||
void reset() { idx_ = -1; }
|
||||
|
||||
/// return whether the handle is valid, i.e., the index is not equal to -1.
|
||||
bool is_valid() const { return idx_ != -1; }
|
||||
|
||||
/// are two handles equal?
|
||||
bool operator==(const BaseHandle& _rhs) const {
|
||||
return idx_ == _rhs.idx_;
|
||||
}
|
||||
|
||||
/// are two handles different?
|
||||
bool operator!=(const BaseHandle& _rhs) const {
|
||||
return idx_ != _rhs.idx_;
|
||||
}
|
||||
|
||||
/// compare operator useful for sorting handles
|
||||
bool operator<(const BaseHandle& _rhs) const {
|
||||
return idx_ < _rhs.idx_;
|
||||
}
|
||||
|
||||
private:
|
||||
friend class VertexIterator;
|
||||
friend class EdgeIterator;
|
||||
friend class Graph;
|
||||
int idx_;
|
||||
};
|
||||
|
||||
|
||||
/// this type represents a vertex (internally it is basically an index)
|
||||
/// \sa Edge
|
||||
struct Vertex : public BaseHandle
|
||||
{
|
||||
/// default constructor (with invalid index)
|
||||
explicit Vertex(int _idx = -1) : BaseHandle(_idx) {}
|
||||
std::ostream& operator<<(std::ostream& os) const { return os << 'v' << idx(); }
|
||||
};
|
||||
|
||||
/// this type represents an edge (internally it is basically an index)
|
||||
/// \sa Vertex, Halfedge, Face
|
||||
struct Edge : public BaseHandle
|
||||
{
|
||||
/// default constructor (with invalid index)
|
||||
explicit Edge(int _idx = -1) : BaseHandle(_idx) {}
|
||||
};
|
||||
|
||||
|
||||
public: //-------------------------------------------------- connectivity types
|
||||
|
||||
/// This type stores the vertex connectivity
|
||||
/// \sa HalfedgeConnectivity, FaceConnectivity
|
||||
struct VertexConnectivity
|
||||
{
|
||||
/// all edges connected with the vertex
|
||||
std::vector<Edge> edges_;
|
||||
};
|
||||
|
||||
|
||||
/// This type stores the edge connectivity
|
||||
/// \sa VertexConnectivity
|
||||
struct EdgeConnectivity
|
||||
{
|
||||
Vertex source_; /// vertex the edge points to
|
||||
Vertex target_; /// vertex the edge originates from
|
||||
};
|
||||
|
||||
|
||||
public: //------------------------------------------------------ property types
|
||||
|
||||
/// Vertex property of type T
|
||||
/// \sa HalfedgeProperty, EdgeProperty, FaceProperty
|
||||
template <class T> class VertexProperty : public Property<T>
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
explicit VertexProperty() {}
|
||||
explicit VertexProperty(Property<T> p) : Property<T>(p) {}
|
||||
|
||||
/// access the data stored for vertex \c v
|
||||
typename Property<T>::reference operator[](Vertex v)
|
||||
{
|
||||
return Property<T>::operator[](v.idx());
|
||||
}
|
||||
|
||||
/// access the data stored for vertex \c v
|
||||
typename Property<T>::const_reference operator[](Vertex v) const
|
||||
{
|
||||
return Property<T>::operator[](v.idx());
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
/// Edge property of type T
|
||||
/// \sa VertexProperty, HalfedgeProperty, FaceProperty
|
||||
template <class T> class EdgeProperty : public Property<T>
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
explicit EdgeProperty() {}
|
||||
explicit EdgeProperty(Property<T> p) : Property<T>(p) {}
|
||||
|
||||
/// access the data stored for edge \c e
|
||||
typename Property<T>::reference operator[](Edge e)
|
||||
{
|
||||
return Property<T>::operator[](e.idx());
|
||||
}
|
||||
|
||||
/// access the data stored for edge \c e
|
||||
typename Property<T>::const_reference operator[](Edge e) const
|
||||
{
|
||||
return Property<T>::operator[](e.idx());
|
||||
}
|
||||
};
|
||||
|
||||
/// Graph property of type T
|
||||
/// \sa VertexProperty, EdgeProperty
|
||||
template <class T> class ModelProperty : public Property<T>
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
explicit ModelProperty() {}
|
||||
explicit ModelProperty(Property<T> p) : Property<T>(p) {}
|
||||
|
||||
/// access the data stored for the mesh
|
||||
typename Property<T>::reference operator[](size_t idx)
|
||||
{
|
||||
return Property<T>::operator[](idx);
|
||||
}
|
||||
|
||||
/// access the data stored for the mesh
|
||||
typename Property<T>::const_reference operator[](size_t idx) const
|
||||
{
|
||||
return Property<T>::operator[](idx);
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
|
||||
public: //------------------------------------------------------ iterator types
|
||||
|
||||
/// this class iterates linearly over all vertices
|
||||
/// \sa vertices_begin(), vertices_end()
|
||||
/// \sa EdgeIterator
|
||||
class VertexIterator
|
||||
{
|
||||
public:
|
||||
|
||||
/// Default constructor
|
||||
VertexIterator(Vertex v = Vertex(), const Graph* g = nullptr) : hnd_(v), graph_(g)
|
||||
{
|
||||
if (graph_ && graph_->garbage()) while (graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
}
|
||||
|
||||
/// get the vertex the iterator refers to
|
||||
Vertex operator*() const { return hnd_; }
|
||||
|
||||
/// are two iterators equal?
|
||||
bool operator==(const VertexIterator& rhs) const
|
||||
{
|
||||
return (hnd_ == rhs.hnd_);
|
||||
}
|
||||
|
||||
/// are two iterators different?
|
||||
bool operator!=(const VertexIterator& rhs) const
|
||||
{
|
||||
return !operator==(rhs);
|
||||
}
|
||||
|
||||
/// pre-increment iterator
|
||||
VertexIterator& operator++()
|
||||
{
|
||||
++hnd_.idx_;
|
||||
assert(graph_);
|
||||
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// pre-decrement iterator
|
||||
VertexIterator& operator--()
|
||||
{
|
||||
--hnd_.idx_;
|
||||
assert(graph_);
|
||||
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) --hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
private:
|
||||
Vertex hnd_;
|
||||
const Graph* graph_;
|
||||
};
|
||||
|
||||
|
||||
/// this class iterates linearly over all edges
|
||||
/// \sa edges_begin(), edges_end()
|
||||
/// \sa VertexIterator
|
||||
class EdgeIterator
|
||||
{
|
||||
public:
|
||||
|
||||
/// Default constructor
|
||||
EdgeIterator(Edge e = Edge(), const Graph* g = nullptr) : hnd_(e), graph_(g)
|
||||
{
|
||||
if (graph_ && graph_->garbage()) while (graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
}
|
||||
|
||||
/// get the edge the iterator refers to
|
||||
Edge operator*() const { return hnd_; }
|
||||
|
||||
/// are two iterators equal?
|
||||
bool operator==(const EdgeIterator& rhs) const
|
||||
{
|
||||
return (hnd_ == rhs.hnd_);
|
||||
}
|
||||
|
||||
/// are two iterators different?
|
||||
bool operator!=(const EdgeIterator& rhs) const
|
||||
{
|
||||
return !operator==(rhs);
|
||||
}
|
||||
|
||||
/// pre-increment iterator
|
||||
EdgeIterator& operator++()
|
||||
{
|
||||
++hnd_.idx_;
|
||||
assert(graph_);
|
||||
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// pre-decrement iterator
|
||||
EdgeIterator& operator--()
|
||||
{
|
||||
--hnd_.idx_;
|
||||
assert(graph_);
|
||||
while (graph_->garbage() && graph_->is_valid(hnd_) && graph_->is_deleted(hnd_)) --hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
private:
|
||||
Edge hnd_;
|
||||
const Graph* graph_;
|
||||
};
|
||||
|
||||
|
||||
public: //-------------------------- containers for C++11 range-based for loops
|
||||
|
||||
/// this helper class is a container for iterating through all
|
||||
/// vertices using C++11 range-based for-loops.
|
||||
/// \sa vertices()
|
||||
class VertexContainer
|
||||
{
|
||||
public:
|
||||
VertexContainer(VertexIterator _begin, VertexIterator _end) : begin_(_begin), end_(_end) {}
|
||||
VertexIterator begin() const { return begin_; }
|
||||
VertexIterator end() const { return end_; }
|
||||
private:
|
||||
VertexIterator begin_, end_;
|
||||
};
|
||||
|
||||
/// this helper class is a container for iterating through all
|
||||
/// edges using C++11 range-based for-loops.
|
||||
/// \sa edges()
|
||||
class EdgeContainer
|
||||
{
|
||||
public:
|
||||
EdgeContainer(EdgeIterator _begin, EdgeIterator _end) : begin_(_begin), end_(_end) {}
|
||||
EdgeIterator begin() const { return begin_; }
|
||||
EdgeIterator end() const { return end_; }
|
||||
private:
|
||||
EdgeIterator begin_, end_;
|
||||
};
|
||||
|
||||
|
||||
public: //---------------------------------------------------- circulator types
|
||||
|
||||
|
||||
/// this class circulates through all edges connected with a vertex.
|
||||
/// it also acts as a container-concept for C++11 range-based for loops.
|
||||
/// \sa VertexAroundVertexCirculator, edges(Vertex)
|
||||
class EdgeAroundVertexCirculator
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
EdgeAroundVertexCirculator(const Graph* g, Vertex v=Vertex())
|
||||
: graph_(g), vertex_(v), finished_(false)
|
||||
{
|
||||
iterator_ = graph_->vconn_[vertex_].edges_.begin();
|
||||
end_ = graph_->vconn_[vertex_].edges_.end();
|
||||
}
|
||||
|
||||
/// are two circulators equal?
|
||||
bool operator==(const EdgeAroundVertexCirculator& rhs) const {
|
||||
assert(graph_);
|
||||
return ((graph_ == rhs.graph_) && (vertex_ == rhs.vertex_) && (iterator_ == rhs.iterator_))
|
||||
|| (finished_); // to behave like a circulator
|
||||
}
|
||||
|
||||
/// are two circulators different?
|
||||
bool operator!=(const EdgeAroundVertexCirculator& rhs) const {
|
||||
return !operator==(rhs);
|
||||
}
|
||||
|
||||
/// pre-increment
|
||||
EdgeAroundVertexCirculator& operator++() {
|
||||
assert(graph_);
|
||||
++iterator_;
|
||||
if (iterator_ == end_) { // to behave like a circulator
|
||||
iterator_ = graph_->vconn_[vertex_].edges_.begin();
|
||||
finished_ = true;
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// pre-decrement
|
||||
EdgeAroundVertexCirculator& operator--()
|
||||
{
|
||||
assert(graph_);
|
||||
--iterator_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// get the edge the circulator refers to
|
||||
Edge operator*() const {
|
||||
assert(graph_);
|
||||
if (iterator_ != end_) return *iterator_;
|
||||
else return Edge();
|
||||
}
|
||||
|
||||
/// cast to bool: true if vertex is not isolated
|
||||
operator bool() const { return graph_->vconn_[vertex_].edges_.size() > 0; }
|
||||
|
||||
/// return current vertex
|
||||
Vertex vertex() const { return vertex_; }
|
||||
|
||||
// helper for C++11 range-based for-loops
|
||||
EdgeAroundVertexCirculator& begin() { iterator_ = graph_->vconn_[vertex_].edges_.begin(); return *this; }
|
||||
// helper for C++11 range-based for-loops
|
||||
EdgeAroundVertexCirculator& end() { iterator_ = end_; return *this; }
|
||||
|
||||
private:
|
||||
const Graph* graph_;
|
||||
const Vertex vertex_;
|
||||
std::vector<Edge>::const_iterator iterator_;
|
||||
// helper for C++11 range-based for-loops
|
||||
std::vector<Edge>::const_iterator end_;
|
||||
bool finished_; // for the circulator behavior
|
||||
};
|
||||
|
||||
|
||||
|
||||
/// this class circulates through all one-ring neighbors of a vertex.
|
||||
/// it also acts as a container-concept for C++11 range-based for loops.
|
||||
/// \sa EdgeAroundVertexCirculator, vertices(Vertex)
|
||||
class VertexAroundVertexCirculator
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
VertexAroundVertexCirculator(const Graph* g, Vertex v = Vertex())
|
||||
: graph_(g), vertex_(v), finished_(false)
|
||||
{
|
||||
iterator_ = graph_->vconn_[vertex_].edges_.begin();
|
||||
end_ = graph_->vconn_[vertex_].edges_.end();
|
||||
}
|
||||
|
||||
/// are two circulators equal?
|
||||
bool operator==(const VertexAroundVertexCirculator& rhs) const {
|
||||
assert(graph_);
|
||||
return ((graph_ == rhs.graph_) && (vertex_ == rhs.vertex_) && (iterator_ == rhs.iterator_))
|
||||
|| (finished_); // to behave like a circulator
|
||||
}
|
||||
|
||||
/// are two circulators different?
|
||||
bool operator!=(const VertexAroundVertexCirculator& rhs) const {
|
||||
return !operator==(rhs);
|
||||
}
|
||||
|
||||
/// pre-increment
|
||||
VertexAroundVertexCirculator& operator++() {
|
||||
assert(graph_);
|
||||
++iterator_;
|
||||
if (iterator_ == end_) { // to behave like a circulator
|
||||
iterator_ = graph_->vconn_[vertex_].edges_.begin();
|
||||
finished_ = true;
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// pre-decrement
|
||||
VertexAroundVertexCirculator& operator--()
|
||||
{
|
||||
assert(graph_);
|
||||
--iterator_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// get the vertex the circulator refers to
|
||||
Vertex operator*() const {
|
||||
assert(graph_);
|
||||
if (iterator_ != end_) {
|
||||
Vertex v = graph_->to_vertex(*iterator_);
|
||||
if (v != vertex_) return v;
|
||||
else return graph_->from_vertex(*iterator_);
|
||||
}
|
||||
return Vertex();
|
||||
}
|
||||
|
||||
/// cast to bool: true if vertex is not isolated
|
||||
operator bool() const { return graph_->vconn_[vertex_].edges_.size() > 0; }
|
||||
|
||||
/// return current vertex
|
||||
Vertex vertex() const { return vertex_; }
|
||||
|
||||
// helper for C++11 range-based for-loops
|
||||
VertexAroundVertexCirculator& begin() {
|
||||
iterator_ = graph_->vconn_[vertex_].edges_.begin();
|
||||
return *this;
|
||||
}
|
||||
// helper for C++11 range-based for-loops
|
||||
VertexAroundVertexCirculator& end() {
|
||||
iterator_ = end_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
private:
|
||||
const Graph* graph_;
|
||||
const Vertex vertex_;
|
||||
std::vector<Edge>::const_iterator iterator_;
|
||||
// helper for C++11 range-based for-loops
|
||||
std::vector<Edge>::const_iterator end_;
|
||||
bool finished_; // for the circulator behavior
|
||||
};
|
||||
|
||||
|
||||
|
||||
public: //-------------------------------------------- constructor / destructor
|
||||
|
||||
/// \name Construct, destruct, assignment
|
||||
//@{
|
||||
|
||||
/// default constructor
|
||||
Graph();
|
||||
|
||||
// destructor (is virtual, since we inherit from Geometry_representation)
|
||||
virtual ~Graph();
|
||||
|
||||
/// copy constructor: copies \c rhs to \c *this. performs a deep copy of all properties.
|
||||
Graph(const Graph& rhs) { operator=(rhs); }
|
||||
|
||||
/// assign \c rhs to \c *this. performs a deep copy of all properties.
|
||||
Graph& operator=(const Graph& rhs);
|
||||
|
||||
/// assign \c rhs to \c *this. does not copy custom properties.
|
||||
Graph& assign(const Graph& rhs);
|
||||
|
||||
//@}
|
||||
|
||||
public: //----------------------------------------------- add new vertex / face
|
||||
|
||||
/// \name Add new elements by hand
|
||||
//@{
|
||||
|
||||
/// add a new vertex with position \c p
|
||||
Vertex add_vertex(const vec3& p);
|
||||
|
||||
/// add a new edge connecting vertices \c v1 and \c v2
|
||||
Edge add_edge(const Vertex& v1, const Vertex& v2);
|
||||
//@}
|
||||
|
||||
public: //--------------------------------------------------- memory management
|
||||
|
||||
/// \name Memory Management
|
||||
//@{
|
||||
|
||||
/// returns number of (deleted and valid) vertices in the mesh
|
||||
unsigned int vertices_size() const { return (unsigned int)vprops_.size(); }
|
||||
/// returns number of (deleted and valid)edges in the mesh
|
||||
unsigned int edges_size() const { return (unsigned int)eprops_.size(); }
|
||||
|
||||
/// returns number of vertices in the mesh
|
||||
unsigned int n_vertices() const { return vertices_size() - deleted_vertices_; }
|
||||
/// returns number of edges in the mesh
|
||||
unsigned int n_edges() const { return edges_size() - deleted_edges_; }
|
||||
|
||||
/// returns true iff the mesh is empty, i.e., has no vertices
|
||||
unsigned int empty() const { return n_vertices() == 0; }
|
||||
|
||||
|
||||
/// clear mesh: remove all vertices, edges, faces
|
||||
void clear();
|
||||
|
||||
/// remove unused memory from vectors
|
||||
void free_memory();
|
||||
|
||||
/// reserve memory (mainly used in file readers)
|
||||
void reserve(unsigned int nvertices, unsigned int nedges);
|
||||
|
||||
/// resizes space for vertices, halfedges, edges, faces, and their currently
|
||||
/// associated properties.
|
||||
/// Note: ne is the number of edges. for halfedges, nh = 2 * ne. */
|
||||
void resize(unsigned int nv, unsigned int ne) {
|
||||
vprops_.resize(nv);
|
||||
eprops_.resize(ne);
|
||||
}
|
||||
|
||||
/// remove deleted vertices/edges/faces
|
||||
void garbage_collection();
|
||||
|
||||
|
||||
/// returns whether vertex \c v is deleted
|
||||
/// \sa garbage_collection()
|
||||
bool is_deleted(Vertex v) const
|
||||
{
|
||||
return vdeleted_[v];
|
||||
}
|
||||
/// returns whether edge \c e is deleted
|
||||
/// \sa garbage_collection()
|
||||
bool is_deleted(Edge e) const
|
||||
{
|
||||
return edeleted_[e];
|
||||
}
|
||||
|
||||
/// return whether vertex \c v is valid, i.e. the index is stores it within the array bounds.
|
||||
bool is_valid(Vertex v) const
|
||||
{
|
||||
return (0 <= v.idx()) && (v.idx() < (int)vertices_size());
|
||||
}
|
||||
/// return whether edge \c e is valid, i.e. the index is stores it within the array bounds.
|
||||
bool is_valid(Edge e) const
|
||||
{
|
||||
return (0 <= e.idx()) && (e.idx() < (int)edges_size());
|
||||
}
|
||||
//@}
|
||||
|
||||
|
||||
public: //---------------------------------------------- low-level connectivity
|
||||
|
||||
/// \name Low-level connectivity
|
||||
//@{
|
||||
|
||||
/// returns whether \c v is isolated, i.e., not incident to any edge
|
||||
bool is_isolated(Vertex v) const
|
||||
{
|
||||
return vconn_[v].edges_.empty();
|
||||
}
|
||||
|
||||
/// returns the vertex the halfedge \c h points to
|
||||
Vertex to_vertex(Edge h) const
|
||||
{
|
||||
return econn_[h].target_;
|
||||
}
|
||||
|
||||
/// returns the vertex the halfedge \c h emanates from
|
||||
Vertex from_vertex(Edge h) const
|
||||
{
|
||||
return econn_[h].source_;
|
||||
}
|
||||
|
||||
//@}
|
||||
|
||||
public: //--------------------------------------------------- property handling
|
||||
|
||||
/// \name Property handling
|
||||
//@{
|
||||
|
||||
/** add a vertex property of type \c T with name \c name and default value \c t.
|
||||
fails if a property named \c name exists already, since the name has to be unique.
|
||||
in this case it returns an invalid property */
|
||||
template <class T> VertexProperty<T> add_vertex_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return VertexProperty<T>(vprops_.add<T>(name, t));
|
||||
}
|
||||
/** add a edge property of type \c T with name \c name and default value \c t.
|
||||
fails if a property named \c name exists already, since the name has to be unique.
|
||||
in this case it returns an invalid property */
|
||||
template <class T> EdgeProperty<T> add_edge_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return EdgeProperty<T>(eprops_.add<T>(name, t));
|
||||
}
|
||||
/** add a model property of type \c T with name \c name and default value \c t.
|
||||
fails if a property named \c name exists already, since the name has to be unique.
|
||||
in this case it returns an invalid property */
|
||||
template <class T> ModelProperty<T> add_model_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return ModelProperty<T>(mprops_.add<T>(name, t));
|
||||
}
|
||||
|
||||
|
||||
/** get the vertex property named \c name of type \c T. returns an invalid
|
||||
VertexProperty if the property does not exist or if the type does not match. */
|
||||
template <class T> VertexProperty<T> get_vertex_property(const std::string& name) const
|
||||
{
|
||||
return VertexProperty<T>(vprops_.get<T>(name));
|
||||
}
|
||||
/** get the edge property named \c name of type \c T. returns an invalid
|
||||
VertexProperty if the property does not exist or if the type does not match. */
|
||||
template <class T> EdgeProperty<T> get_edge_property(const std::string& name) const
|
||||
{
|
||||
return EdgeProperty<T>(eprops_.get<T>(name));
|
||||
}
|
||||
/** get the model property named \c name of type \c T. returns an invalid
|
||||
ModelProperty if the property does not exist or if the type does not match. */
|
||||
template <class T> ModelProperty<T> get_model_property(const std::string& name) const
|
||||
{
|
||||
return ModelProperty<T>(mprops_.get<T>(name));
|
||||
}
|
||||
|
||||
|
||||
/** if a vertex property of type \c T with name \c name exists, it is returned.
|
||||
otherwise this property is added (with default value \c t) */
|
||||
template <class T> VertexProperty<T> vertex_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return VertexProperty<T>(vprops_.get_or_add<T>(name, t));
|
||||
}
|
||||
/** if an edge property of type \c T with name \c name exists, it is returned.
|
||||
otherwise this property is added (with default value \c t) */
|
||||
template <class T> EdgeProperty<T> edge_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return EdgeProperty<T>(eprops_.get_or_add<T>(name, t));
|
||||
}
|
||||
|
||||
/** if a model property of type \c T with name \c name exists, it is returned.
|
||||
otherwise this property is added (with default value \c t) */
|
||||
template <class T> ModelProperty<T> model_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return ModelProperty<T>(mprops_.get_or_add<T>(name, t));
|
||||
}
|
||||
|
||||
|
||||
/// remove the vertex property \c p
|
||||
template <class T> void remove_vertex_property(VertexProperty<T>& p)
|
||||
{
|
||||
vprops_.remove(p);
|
||||
}
|
||||
/// remove the edge property \c p
|
||||
template <class T> void remove_edge_property(EdgeProperty<T>& p)
|
||||
{
|
||||
eprops_.remove(p);
|
||||
}
|
||||
/// remove the model property \c p
|
||||
template <class T> void remove_model_property(ModelProperty<T>& p)
|
||||
{
|
||||
mprops_.remove(p);
|
||||
}
|
||||
|
||||
|
||||
/** get the type_info \c T of vertex property named \c. returns an typeid(void)
|
||||
if the property does not exist or if the type does not match. */
|
||||
const std::type_info& get_vertex_property_type(const std::string& name)
|
||||
{
|
||||
return vprops_.get_type(name);
|
||||
}
|
||||
/** get the type_info \c T of edge property named \c. returns an typeid(void)
|
||||
if the property does not exist or if the type does not match. */
|
||||
const std::type_info& get_edge_property_type(const std::string& name)
|
||||
{
|
||||
return eprops_.get_type(name);
|
||||
}
|
||||
/** get the type_info \c T of model property named \c. returns an typeid(void)
|
||||
if the property does not exist or if the type does not match. */
|
||||
const std::type_info& get_model_property_type(const std::string& name) const
|
||||
{
|
||||
return mprops_.get_type(name);
|
||||
}
|
||||
|
||||
|
||||
/// returns the names of all vertex properties
|
||||
std::vector<std::string> vertex_properties() const
|
||||
{
|
||||
return vprops_.properties();
|
||||
}
|
||||
/// returns the names of all edge properties
|
||||
std::vector<std::string> edge_properties() const
|
||||
{
|
||||
return eprops_.properties();
|
||||
}
|
||||
/// returns the names of all model properties
|
||||
std::vector<std::string> model_properties() const
|
||||
{
|
||||
return mprops_.properties();
|
||||
}
|
||||
|
||||
/// prints the names of all properties
|
||||
void property_stats() const;
|
||||
|
||||
//@}
|
||||
|
||||
|
||||
public: //--------------------------------------------- iterators & circulators
|
||||
|
||||
/// \name Iterators & Circulators
|
||||
//@{
|
||||
|
||||
/// returns start iterator for vertices
|
||||
VertexIterator vertices_begin() const
|
||||
{
|
||||
return VertexIterator(Vertex(0), this);
|
||||
}
|
||||
|
||||
/// returns end iterator for vertices
|
||||
VertexIterator vertices_end() const
|
||||
{
|
||||
return VertexIterator(Vertex(vertices_size()), this);
|
||||
}
|
||||
|
||||
/// returns vertex container for C++11 range-based for-loops
|
||||
VertexContainer vertices() const
|
||||
{
|
||||
return VertexContainer(vertices_begin(), vertices_end());
|
||||
}
|
||||
|
||||
/// returns start iterator for edges
|
||||
EdgeIterator edges_begin() const
|
||||
{
|
||||
return EdgeIterator(Edge(0), this);
|
||||
}
|
||||
|
||||
/// returns end iterator for edges
|
||||
EdgeIterator edges_end() const
|
||||
{
|
||||
return EdgeIterator(Edge(edges_size()), this);
|
||||
}
|
||||
|
||||
/// returns edge container for C++11 range-based for-loops
|
||||
EdgeContainer edges() const
|
||||
{
|
||||
return EdgeContainer(edges_begin(), edges_end());
|
||||
}
|
||||
|
||||
/// returns circulator for vertices around vertex \c v
|
||||
VertexAroundVertexCirculator vertices(Vertex v) const
|
||||
{
|
||||
return VertexAroundVertexCirculator(this, v);
|
||||
}
|
||||
|
||||
/// returns circulator for edges around vertex \c v
|
||||
EdgeAroundVertexCirculator edges(Vertex v) const
|
||||
{
|
||||
return EdgeAroundVertexCirculator(this, v);
|
||||
}
|
||||
//@}
|
||||
|
||||
|
||||
public: //--------------------------------------------- higher-level operations
|
||||
|
||||
/// \name Higher-level Topological Operations
|
||||
//@{
|
||||
|
||||
|
||||
/** returns the valence (number of incident edges or neighboring vertices)
|
||||
of vertex \c v. */
|
||||
unsigned int valence(Vertex v) const;
|
||||
|
||||
/// find the edge (a,b)
|
||||
Edge find_edge(Vertex a, Vertex b) const;
|
||||
|
||||
/// deletes the vertex \c v from the mesh
|
||||
void delete_vertex(Vertex v);
|
||||
|
||||
/// deletes the edge \c e from the mesh
|
||||
void delete_edge(Edge e);
|
||||
//@}
|
||||
|
||||
|
||||
public: //------------------------------------------ geometry-related functions
|
||||
|
||||
/// \name Geometry-related Functions
|
||||
//@{
|
||||
|
||||
/// position of a vertex (read only)
|
||||
const vec3& position(Vertex v) const { return vpoint_[v]; }
|
||||
|
||||
/// position of a vertex
|
||||
vec3& position(Vertex v) { return vpoint_[v]; }
|
||||
|
||||
/// vector of vertex positions (read only)
|
||||
const std::vector<vec3>& points() const { return vpoint_.vector(); }
|
||||
|
||||
/// vector of vertex positions
|
||||
std::vector<vec3>& points() { return vpoint_.vector(); }
|
||||
|
||||
/// compute the length of edge \c e.
|
||||
float edge_length(Edge e) const;
|
||||
|
||||
//@}
|
||||
|
||||
|
||||
private: //---------------------------------------------- allocate new elements
|
||||
|
||||
/// allocate a new vertex, resize vertex properties accordingly.
|
||||
Vertex new_vertex()
|
||||
{
|
||||
vprops_.push_back();
|
||||
return Vertex(vertices_size() - 1);
|
||||
}
|
||||
|
||||
/// allocate a new edge, resize edge roperties accordingly.
|
||||
Edge new_edge()
|
||||
{
|
||||
eprops_.push_back();
|
||||
return Edge(edges_size() - 1);
|
||||
}
|
||||
|
||||
|
||||
private: //--------------------------------------------------- helper functions
|
||||
|
||||
/// are there deleted vertices, edges or faces?
|
||||
bool garbage() const { return garbage_; }
|
||||
|
||||
|
||||
private: //------------------------------------------------------- private data
|
||||
|
||||
PropertyContainer vprops_;
|
||||
PropertyContainer eprops_;
|
||||
PropertyContainer mprops_;
|
||||
|
||||
VertexProperty<VertexConnectivity> vconn_;
|
||||
EdgeProperty<EdgeConnectivity> econn_;
|
||||
|
||||
VertexProperty<bool> vdeleted_;
|
||||
EdgeProperty<bool> edeleted_;
|
||||
|
||||
VertexProperty<vec3> vpoint_;
|
||||
|
||||
unsigned int deleted_vertices_;
|
||||
unsigned int deleted_edges_;
|
||||
bool garbage_;
|
||||
};
|
||||
|
||||
|
||||
//------------------------------------------------------------ output operators
|
||||
|
||||
|
||||
inline std::ostream& operator<<(std::ostream& os, Graph::Vertex v)
|
||||
{
|
||||
return (os << 'v' << v.idx());
|
||||
}
|
||||
|
||||
inline std::ostream& operator<<(std::ostream& os, Graph::Edge e)
|
||||
{
|
||||
return (os << 'e' << e.idx());
|
||||
}
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
#endif // EASY3D_SURFACE_MESH_H
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,104 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_LINE_H
|
||||
#define EASY3D_LINE_H
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
class GenericLine {
|
||||
public:
|
||||
typedef Vec<DIM, FT> Point;
|
||||
typedef Vec<DIM, FT> Vector;
|
||||
typedef GenericLine<DIM, FT> thisclass;
|
||||
|
||||
public:
|
||||
static GenericLine from_point_and_direction(const Point& p, const Vector& dir) { return GenericLine(p, dir); }
|
||||
static GenericLine from_two_points(const Point& p, const Point& q) { return GenericLine(p, q - p); }
|
||||
|
||||
GenericLine() {}
|
||||
void set(const Point& p, const Vector& dir) {
|
||||
p_ = p;
|
||||
dir_ = normalize(dir);
|
||||
}
|
||||
|
||||
const Vector& direction() const { return dir_; }
|
||||
|
||||
const Point& point() const { return p_; }
|
||||
|
||||
GenericLine opposite() const { return GenericLine(p_, -dir_); }
|
||||
|
||||
// the projection of p on this line
|
||||
Point projection(const Point &p) const { return p_ + dir_ * dot(p - p_, dir_); }
|
||||
|
||||
FT squared_ditance(const Point &p) const { return length2(projection(p) - p); }
|
||||
|
||||
private: // Ambiguities exist for this one.
|
||||
GenericLine(const Point & p, const Vector & dir);
|
||||
|
||||
private:
|
||||
Point p_;
|
||||
Vector dir_;
|
||||
};
|
||||
|
||||
|
||||
template <int DIM, typename FT> inline
|
||||
GenericLine<DIM, FT>::GenericLine(const Point & p, const Vector & dir) : p_(p) {
|
||||
dir_ = normalize(dir);
|
||||
|
||||
#ifndef NDEBUG // degenerate case
|
||||
if (length(dir_) < 1e-15) {
|
||||
std::cerr << "degenerate line constructed from point ("
|
||||
<< p << ") and direction (" << dir << ")" << std::endl;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT> inline
|
||||
std::ostream& operator<<(std::ostream& os, const GenericLine<DIM, FT>& line) {
|
||||
return os << line.point() << " " << line.direction();
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT> inline
|
||||
std::istream& operator>>(std::istream& is, GenericLine<DIM, FT>& line) {
|
||||
typename GenericLine<DIM, FT>::Point p;
|
||||
typename GenericLine<DIM, FT>::Vector dir;
|
||||
is >> p >> dir;
|
||||
line.set(p, dir);
|
||||
return is;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_LINE_H
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,360 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#ifndef EASY3D_PLANE_H
|
||||
#define EASY3D_PLANE_H
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
#include <easy3d/core/line.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
// A 3D Plane of equation a.x + b.y + c.z + d = 0
|
||||
template <typename FT>
|
||||
class GenericPlane
|
||||
{
|
||||
public:
|
||||
typedef Vec<2, FT> Point2;
|
||||
typedef Vec<3, FT> Point3;
|
||||
typedef Vec<3, FT> Vector3;
|
||||
typedef GenericLine<3, FT> Line3;
|
||||
typedef GenericPlane<FT> thisclass;
|
||||
|
||||
public:
|
||||
GenericPlane(const Point3& p1, const Point3& p2, const Point3& p3);
|
||||
GenericPlane(const Point3& p, const Vector3& n);
|
||||
GenericPlane(FT a, FT b, FT c, FT d) { coeff_[0] = a; coeff_[1] = b; coeff_[2] = c; coeff_[3] = d; }
|
||||
GenericPlane() {}
|
||||
|
||||
inline FT a() const { return coeff_[0]; }
|
||||
inline FT b() const { return coeff_[1]; }
|
||||
inline FT c() const { return coeff_[2]; }
|
||||
inline FT d() const { return coeff_[3]; }
|
||||
|
||||
inline FT& operator[](size_t idx) { assert(idx < 4); return coeff_[idx]; }
|
||||
inline const FT& operator[](size_t idx) const { assert(idx < 4); return coeff_[idx]; }
|
||||
|
||||
// returns the normal of the plane
|
||||
Vector3 normal() const;
|
||||
|
||||
// return a point lying on this plane.
|
||||
// NOTE: it is a fixed point (anytime you can this function it returns
|
||||
// the same point).
|
||||
Point3 point() const;
|
||||
|
||||
// return two orthogonal directions on this plane
|
||||
Vector3 base1() const;
|
||||
Vector3 base2() const;
|
||||
|
||||
// 2D / 3D conversion: relative to the coordinate system defined
|
||||
// by the three orthogonal vectors: (base1, base2, normal).
|
||||
// NOTE: after 3D->2D and then 2D->3D conversion, the resulted 3D
|
||||
// point will remain unchanged ONLY IF the input point lies
|
||||
// on the plane. In case the original 3D point does not lie
|
||||
// on the plane, the resulted 3D point will have coordinates
|
||||
// equal to the projection of the input point onto the plane.
|
||||
Point2 to_2d(const Point3& p) const;
|
||||
Point3 to_3d(const Point2& p) const;
|
||||
|
||||
// the projection of a point 'p' on this plane
|
||||
Point3 projection(const Point3 &p) const;
|
||||
|
||||
// given a point 'p', compute the value of the equation
|
||||
inline FT value(const Point3& p) const { return (coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z + coeff_[3]); }
|
||||
|
||||
// squared distance of a point 'p' to this plane
|
||||
FT squared_ditance(const Point3 &p) const;
|
||||
|
||||
// compute the intersection with 'line'.
|
||||
// returns false if the line is parallel with this plane.
|
||||
// NOTE: both line and the plane are unlimited.
|
||||
bool intersect(const Line3& line, Point3& p) const;
|
||||
// test if this plane intersects with a line.
|
||||
bool intersect(const Line3& line) const;
|
||||
|
||||
// compute the intersection with a line segment (s, t).
|
||||
// returns false if there is no intersection (i.e., s and t lie in the same side).
|
||||
bool intersect(const Point3& s, const Point3& t, Point3& p) const;
|
||||
// test if this plane intersects with a line segment (s, t).
|
||||
bool intersect(const Point3& s, const Point3& t) const;
|
||||
|
||||
// return values:
|
||||
// 1: p is on the positive side
|
||||
// 0: p is belonging to the plane
|
||||
// -1: p is on the negative side
|
||||
int orient(const Point3& p) const;
|
||||
|
||||
// returns the memory address of the coefficients.
|
||||
const FT* data() const { return coeff_; }
|
||||
FT* data() { return coeff_; }
|
||||
|
||||
// Conversion operator returning the memory address of the coefficients.
|
||||
// Very convenient to pass the data pointer as a parameter to functions.
|
||||
operator const FT*() const { return coeff_; }
|
||||
operator FT*() { return coeff_; }
|
||||
|
||||
private:
|
||||
FT coeff_[4]; // representing the a, b, c, and d, respectively
|
||||
};
|
||||
|
||||
|
||||
|
||||
template <typename FT> std::ostream& operator<<(std::ostream& os, const GenericPlane<FT>& plane);
|
||||
template <typename FT> std::istream& operator>>(std::istream& is, GenericPlane<FT>& plane);
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
GenericPlane<FT>::GenericPlane(const Point3& p1, const Point3& p2, const Point3& p3) {
|
||||
Vector3 n = cross(p2 - p1, p3 - p1);
|
||||
n = normalize(n);
|
||||
|
||||
coeff_[0] = n.x;
|
||||
coeff_[1] = n.y;
|
||||
coeff_[2] = n.z;
|
||||
coeff_[3] = -(coeff_[0] * p1.x + coeff_[1] * p1.y + coeff_[2] * p1.z);
|
||||
|
||||
#ifndef NDEBUG // degenerate case
|
||||
if (length(n) < 1e-15) {
|
||||
std::cerr << "degenerate plane constructed from 3 points:" << std::endl
|
||||
<< "\t(" << p1 << ")" << std::endl
|
||||
<< "\t(" << p2 << ")" << std::endl
|
||||
<< "\t(" << p3 << ")" << std::endl;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
template <typename FT> inline
|
||||
GenericPlane<FT>::GenericPlane(const Point3& p, const Vector3& n) {
|
||||
Vector3 nn = normalize(n);
|
||||
coeff_[0] = nn.x;
|
||||
coeff_[1] = nn.y;
|
||||
coeff_[2] = nn.z;
|
||||
coeff_[3] = -(coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z);
|
||||
|
||||
#ifndef NDEBUG // degenerate case
|
||||
if (length(nn) < 1e-15) {
|
||||
std::cerr << "degenerate plane constructed from point ("
|
||||
<< p << ") and normal (" << n << ")" << std::endl;
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::normal() const {
|
||||
Vector3 n = normalize(Vector3(coeff_[0], coeff_[1], coeff_[2]));
|
||||
|
||||
#ifndef NDEBUG // degenerate case
|
||||
if (length(n) < 1e-15) {
|
||||
std::cerr << "degenerate plane with normal: (" << n << ")" << std::endl;
|
||||
}
|
||||
#endif
|
||||
return n;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::base1() const {
|
||||
if (coeff_[0] == 0) // parallel to x-axis
|
||||
return Vector3(FT(1), FT(0), FT(0));
|
||||
else if (coeff_[1] == 0) // parallel to y-axis
|
||||
return Vector3(FT(0), FT(1), FT(0));
|
||||
else if (coeff_[2] == 0) // parallel to z-axis
|
||||
return Vector3(FT(0), FT(0), FT(1));
|
||||
else {
|
||||
Vector3 base(-coeff_[1], coeff_[0], FT(0));
|
||||
return normalize(base);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Vector3 GenericPlane<FT>::base2() const {
|
||||
Vector3 base = cross(normal(), base1());
|
||||
return normalize(base);
|
||||
}
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Point2 GenericPlane<FT>::to_2d(const Point3& p) const {
|
||||
Vector3 vec = p - point();
|
||||
FT x = dot(vec, base1());
|
||||
FT y = dot(vec, base2());
|
||||
return Point2(x, y);
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Point3 GenericPlane<FT>::to_3d(const Point2& p) const {
|
||||
return point() + base1() * p.x + base2() * p.y;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Point3 GenericPlane<FT>::point() const {
|
||||
Point3 p(FT(0), FT(0), FT(0));
|
||||
if (coeff_[0] >= coeff_[1] && coeff_[0] >= coeff_[2])
|
||||
p.x = -coeff_[3] / coeff_[0];
|
||||
else if (coeff_[1] >= coeff_[0] && coeff_[1] >= coeff_[2])
|
||||
p.y = -coeff_[3] / coeff_[1];
|
||||
else
|
||||
p.z = -coeff_[3] / coeff_[2];
|
||||
return p;
|
||||
|
||||
// the code below is not numerically stable
|
||||
//Point3 p(FT(0), FT(0), FT(0));
|
||||
//if (coeff_[0] != 0)
|
||||
// p.x = -coeff_[3] / coeff_[0];
|
||||
//else if (coeff_[1] != 0)
|
||||
// p.y = -coeff_[3] / coeff_[1];
|
||||
//else
|
||||
// p.z = -coeff_[3] / coeff_[2];
|
||||
//return p;
|
||||
}
|
||||
|
||||
|
||||
// return values:
|
||||
// 1: p is on the positive side
|
||||
// -1: p is on the negative side
|
||||
// 0: the point p is and 0 if the point is belonging the plane.
|
||||
template <typename FT> inline
|
||||
int GenericPlane<FT>::orient(const Point3& p) const {
|
||||
FT v = value(p);
|
||||
if (std::abs(v) < 1e-15)
|
||||
return 0;
|
||||
|
||||
return (v > 0.0 ? 1 : -1);
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
typename GenericPlane<FT>::Point3 GenericPlane<FT>::projection(const Point3& p) const {
|
||||
// the equation of the plane is Ax+By+Cz+D=0
|
||||
// the normal direction is (A,B,C)
|
||||
// the projected point is p-lambda(A,B,C) where
|
||||
// A(x-lambda*A) + B(y-lambda*B) + C(z-lambda*C) + D = 0
|
||||
|
||||
FT num = coeff_[0] * p.x + coeff_[1] * p.y + coeff_[2] * p.z + coeff_[3];
|
||||
FT den = coeff_[0] * coeff_[0] + coeff_[1] * coeff_[1] + coeff_[2] * coeff_[2];
|
||||
FT lambda = num / den;
|
||||
|
||||
FT x = p.x - lambda * coeff_[0];
|
||||
FT y = p.y - lambda * coeff_[1];
|
||||
FT z = p.z - lambda * coeff_[2];
|
||||
return Point3(x, y, z);
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
FT GenericPlane<FT>::squared_ditance(const Point3& p) const {
|
||||
FT v = value(p);
|
||||
return (v * v) / (coeff_[0] * coeff_[0] + coeff_[1] * coeff_[1] + coeff_[2] * coeff_[2]);
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
bool GenericPlane<FT>::intersect(const Line3& line) const {
|
||||
Vector3 dir = line.direction();
|
||||
FT c = dot(dir, normal());
|
||||
if (std::abs(c) < 1e-15)
|
||||
return false;
|
||||
else
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
bool GenericPlane<FT>::intersect(const Line3& line, Point3& p) const {
|
||||
const Vector3& dir = line.direction();
|
||||
FT c = dot(dir, normal());
|
||||
if (std::abs(c) < 1e-15)
|
||||
return false;
|
||||
|
||||
const Point3& p0 = line.point();
|
||||
// p = p0 + dir * t
|
||||
// equation: p is in the plane (so we first compute t)
|
||||
FT t = -(coeff_[0] * p0.x + coeff_[1] * p0.y + coeff_[2] * p0.z + coeff_[3]) / (coeff_[0] * dir.x + coeff_[1] * dir.y + coeff_[2] * dir.z);
|
||||
p = p0 + dir * t;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
bool GenericPlane<FT>::intersect(const Point3& s, const Point3& t) const {
|
||||
int ss = orient(s);
|
||||
int st = orient(t);
|
||||
if ((ss == 1 && st == -1) || (ss == -1 && st == 1))
|
||||
return true;
|
||||
else if (ss == 0 || st == 0)
|
||||
return true;
|
||||
else
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
bool GenericPlane<FT>::intersect(const Point3& s, const Point3& t, Point3& p) const {
|
||||
int ss = orient(s);
|
||||
int st = orient(t);
|
||||
if ((ss == 1 && st == -1) || (ss == -1 && st == 1)) {
|
||||
if (intersection(Line3::from_two_points(s, t), p))
|
||||
return true;
|
||||
else {
|
||||
std::cerr << "fatal error. Should have intersection" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (ss == 0) {
|
||||
p = s;
|
||||
return true;
|
||||
}
|
||||
else if (st == 0) {
|
||||
p = t;
|
||||
return true;
|
||||
}
|
||||
else {
|
||||
// no intersection with the plane
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT> inline
|
||||
std::ostream& operator<<(std::ostream& os, const GenericPlane<FT>& plane) {
|
||||
return os << plane[0] << ' ' << plane[1] << ' ' << plane[2] << ' ' << plane[3];
|
||||
}
|
||||
|
||||
template <typename FT> inline
|
||||
std::istream& operator>>(std::istream& is, GenericPlane<FT>& plane) {
|
||||
return is >> plane[0] >> plane[1] >> plane[2] >> plane[3];
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_PLANE_H
|
||||
|
|
@ -0,0 +1,250 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/** ----------------------------------------------------------
|
||||
*
|
||||
* the code is adapted from Surface_mesh with modifications.
|
||||
* - Surface_mesh (version 1.1)
|
||||
* The original code is available at
|
||||
* https://opensource.cit-ec.de/projects/surface_mesh
|
||||
*
|
||||
* Surface_mesh is a halfedge-based mesh data structure for
|
||||
* representing and processing 2-manifold polygonal surface
|
||||
* meshes. It is implemented in C++ and designed with an
|
||||
* emphasis on simplicity and efficiency.
|
||||
*
|
||||
*----------------------------------------------------------*/
|
||||
|
||||
|
||||
//== INCLUDES =================================================================
|
||||
|
||||
|
||||
#include <easy3d/core/point_cloud.h>
|
||||
|
||||
#include <cmath>
|
||||
|
||||
|
||||
//== NAMESPACE ================================================================
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
//== IMPLEMENTATION ===========================================================
|
||||
|
||||
|
||||
PointCloud::PointCloud()
|
||||
{
|
||||
// allocate standard properties
|
||||
// same list is used in operator=() and assign()
|
||||
vpoint_ = add_vertex_property<vec3>("v:point");
|
||||
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
|
||||
|
||||
mprops_.push_back();
|
||||
|
||||
deleted_vertices_ = 0;
|
||||
garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
PointCloud::~PointCloud()
|
||||
{
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
PointCloud& PointCloud::operator=(const PointCloud& rhs)
|
||||
{
|
||||
if (this != &rhs)
|
||||
{
|
||||
// deep copy of property containers
|
||||
vprops_ = rhs.vprops_;
|
||||
mprops_ = rhs.mprops_;
|
||||
|
||||
// property handles contain pointers, have to be reassigned
|
||||
vdeleted_ = vertex_property<bool>("v:deleted");
|
||||
vpoint_ = vertex_property<vec3>("v:point");
|
||||
|
||||
// how many elements are deleted?
|
||||
deleted_vertices_ = rhs.deleted_vertices_;
|
||||
garbage_ = rhs.garbage_;
|
||||
}
|
||||
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
PointCloud& PointCloud::assign(const PointCloud& rhs)
|
||||
{
|
||||
if (this != &rhs)
|
||||
{
|
||||
// clear properties
|
||||
vprops_.clear();
|
||||
mprops_.clear();
|
||||
|
||||
// allocate standard properties
|
||||
vpoint_ = add_vertex_property<vec3>("v:point");
|
||||
vdeleted_ = add_vertex_property<bool>("v:deleted", false);
|
||||
|
||||
// copy properties from other cloud
|
||||
vpoint_.array() = rhs.vpoint_.array();
|
||||
vdeleted_.array() = rhs.vdeleted_.array();
|
||||
|
||||
// resize (needed by property containers)
|
||||
vprops_.resize(rhs.vertices_size());
|
||||
mprops_.resize(1);
|
||||
|
||||
// how many elements are deleted?
|
||||
deleted_vertices_ = rhs.deleted_vertices_;
|
||||
garbage_ = rhs.garbage_;
|
||||
}
|
||||
|
||||
return *this;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void PointCloud::clear()
|
||||
{
|
||||
vprops_.resize(0);
|
||||
|
||||
free_memory();
|
||||
|
||||
deleted_vertices_ = 0;
|
||||
garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void PointCloud::free_memory()
|
||||
{
|
||||
vprops_.free_memory();
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void PointCloud::property_stats() const
|
||||
{
|
||||
std::vector<std::string> props = vertex_properties();
|
||||
|
||||
std::cout << "vertex properties:\n";
|
||||
for (unsigned int i=0; i<props.size(); ++i)
|
||||
std::cout << "\t" << props[i] << std::endl;
|
||||
|
||||
std::cout << "model properties:\n";
|
||||
props = model_properties();
|
||||
for (unsigned int i = 0; i < props.size(); ++i)
|
||||
std::cout << "\t" << props[i] << std::endl;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
PointCloud::Vertex PointCloud::add_vertex(const vec3& p)
|
||||
{
|
||||
Vertex v = new_vertex();
|
||||
vpoint_[v] = p;
|
||||
return v;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void PointCloud::delete_vertex(Vertex v)
|
||||
{
|
||||
if (vdeleted_[v]) return;
|
||||
|
||||
// mark v as deleted
|
||||
vdeleted_[v] = true;
|
||||
deleted_vertices_++;
|
||||
garbage_ = true;
|
||||
}
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
void PointCloud::garbage_collection()
|
||||
{
|
||||
int nV(vertices_size());
|
||||
|
||||
// setup handle mapping
|
||||
VertexProperty<Vertex> vmap = add_vertex_property<Vertex>("v:garbage-collection");
|
||||
for (int i=0; i<nV; ++i)
|
||||
vmap[Vertex(i)] = Vertex(i);
|
||||
|
||||
// remove deleted vertices
|
||||
if (nV > 0)
|
||||
{
|
||||
int i0 = 0;
|
||||
int i1 = nV - 1;
|
||||
|
||||
while (1)
|
||||
{
|
||||
// find first deleted and last un-deleted
|
||||
while (!vdeleted_[Vertex(i0)] && i0 < i1) ++i0;
|
||||
while ( vdeleted_[Vertex(i1)] && i0 < i1) --i1;
|
||||
if (i0 >= i1) break;
|
||||
|
||||
// swap
|
||||
vprops_.swap(i0, i1);
|
||||
};
|
||||
|
||||
// remember new size
|
||||
nV = vdeleted_[Vertex(i0)] ? i0 : i0+1;
|
||||
}
|
||||
|
||||
// remove handle maps
|
||||
remove_vertex_property(vmap);
|
||||
|
||||
// finally resize arrays
|
||||
vprops_.resize(nV);
|
||||
vprops_.free_memory();
|
||||
|
||||
deleted_vertices_ = 0;
|
||||
garbage_ = false;
|
||||
}
|
||||
|
||||
|
||||
//=============================================================================
|
||||
} // namespace point_cloud
|
||||
//=============================================================================
|
||||
|
|
@ -0,0 +1,500 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/** ----------------------------------------------------------
|
||||
*
|
||||
* the code is adapted from Surface_mesh with modifications.
|
||||
* - Surface_mesh (version 1.1)
|
||||
* The original code is available at
|
||||
* https://opensource.cit-ec.de/projects/surface_mesh
|
||||
*
|
||||
* Surface_mesh is a halfedge-based mesh data structure for
|
||||
* representing and processing 2-manifold polygonal surface
|
||||
* meshes. It is implemented in C++ and designed with an
|
||||
* emphasis on simplicity and efficiency.
|
||||
*
|
||||
*----------------------------------------------------------*/
|
||||
|
||||
|
||||
// I would like to process/visualize huge scans (tens of millions of points, or even more),
|
||||
// an earlier implementation based on double-connected list has the following issues:
|
||||
// 1) no random access of the data;
|
||||
// 2) OpenGL renderring overhead (needs packing to transfer data to GPU);
|
||||
// 3) hard to employ OMP support;
|
||||
// 4) file management (unable to read and write large blocks);
|
||||
// 5) selection, etc.
|
||||
// Thus I have this implementation inspired by (actually some code is taken from)
|
||||
// Surface_mesh: https://opensource.cit-ec.de/projects/surface_mesh
|
||||
// The idea behind is that point coordinates and associated attribute values are stored as
|
||||
// std::vector<T>.
|
||||
|
||||
|
||||
#ifndef EASY3D_POINT_CLOUD_H
|
||||
#define EASY3D_POINT_CLOUD_H
|
||||
|
||||
|
||||
//== INCLUDES =================================================================
|
||||
|
||||
#include <easy3d/viewer/model.h>
|
||||
#include <easy3d/core/types.h>
|
||||
#include <easy3d/core/properties.h>
|
||||
|
||||
|
||||
//== NAMESPACE ================================================================
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
//== CLASS DEFINITION =========================================================
|
||||
|
||||
|
||||
/// A for point clouds.
|
||||
class PointCloud : public Model
|
||||
{
|
||||
|
||||
public: //------------------------------------------------------ topology types
|
||||
|
||||
|
||||
/// Base class for topology types (internally it is basically an index)
|
||||
/// \sa Vertex
|
||||
class BaseHandle
|
||||
{
|
||||
public:
|
||||
|
||||
/// constructor
|
||||
explicit BaseHandle(int _idx=-1) : idx_(_idx) {}
|
||||
|
||||
/// Get the underlying index of this handle
|
||||
int idx() const { return idx_; }
|
||||
|
||||
/// reset handle to be invalid (index=-1)
|
||||
void reset() { idx_=-1; }
|
||||
|
||||
/// return whether the handle is valid, i.e., the index is not equal to -1.
|
||||
bool is_valid() const { return idx_ != -1; }
|
||||
|
||||
/// are two handles equal?
|
||||
bool operator==(const BaseHandle& _rhs) const {
|
||||
return idx_ == _rhs.idx_;
|
||||
}
|
||||
|
||||
/// are two handles different?
|
||||
bool operator!=(const BaseHandle& _rhs) const {
|
||||
return idx_ != _rhs.idx_;
|
||||
}
|
||||
|
||||
/// compare operator useful for sorting handles
|
||||
bool operator<(const BaseHandle& _rhs) const {
|
||||
return idx_ < _rhs.idx_;
|
||||
}
|
||||
|
||||
private:
|
||||
friend class VertexIterator;
|
||||
friend class PointCloud;
|
||||
int idx_;
|
||||
};
|
||||
|
||||
|
||||
/// this type represents a vertex (internally it is basically an index)
|
||||
struct Vertex : public BaseHandle
|
||||
{
|
||||
/// default constructor (with invalid index)
|
||||
explicit Vertex(int _idx=-1) : BaseHandle(_idx) {}
|
||||
std::ostream& operator<<(std::ostream& os) const { return os << 'v' << idx(); }
|
||||
};
|
||||
|
||||
|
||||
public: //------------------------------------------------------ property types
|
||||
|
||||
/// Vertex property of type T
|
||||
template <class T> class VertexProperty : public Property<T>
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
explicit VertexProperty() {}
|
||||
explicit VertexProperty(Property<T> p) : Property<T>(p) {}
|
||||
|
||||
/// access the data stored for vertex \c v
|
||||
typename Property<T>::reference operator[](Vertex v)
|
||||
{
|
||||
return Property<T>::operator[](v.idx());
|
||||
}
|
||||
|
||||
/// access the data stored for vertex \c v
|
||||
typename Property<T>::const_reference operator[](Vertex v) const
|
||||
{
|
||||
return Property<T>::operator[](v.idx());
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
/// Cloud property of type T
|
||||
/// \sa VertexProperty
|
||||
template <class T> class ModelProperty : public Property<T>
|
||||
{
|
||||
public:
|
||||
|
||||
/// default constructor
|
||||
explicit ModelProperty() {}
|
||||
explicit ModelProperty(Property<T> p) : Property<T>(p) {}
|
||||
|
||||
/// access the data stored for the cloud
|
||||
typename Property<T>::reference operator[](size_t idx)
|
||||
{
|
||||
return Property<T>::operator[](idx);
|
||||
}
|
||||
|
||||
/// access the data stored for the cloud
|
||||
typename Property<T>::const_reference operator[](size_t idx) const
|
||||
{
|
||||
return Property<T>::operator[](idx);
|
||||
}
|
||||
};
|
||||
|
||||
|
||||
|
||||
public: //------------------------------------------------------ iterator types
|
||||
|
||||
/// this class iterates linearly over all vertices
|
||||
/// \sa vertices_begin(), vertices_end()
|
||||
class VertexIterator
|
||||
{
|
||||
public:
|
||||
|
||||
/// Default constructor
|
||||
VertexIterator(Vertex v=Vertex(), const PointCloud* m=nullptr) : hnd_(v), cloud_(m)
|
||||
{
|
||||
if (cloud_ && cloud_->garbage()) while (cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
}
|
||||
|
||||
/// get the vertex the iterator refers to
|
||||
Vertex operator*() const { return hnd_; }
|
||||
|
||||
/// are two iterators equal?
|
||||
bool operator==(const VertexIterator& rhs) const
|
||||
{
|
||||
return (hnd_==rhs.hnd_);
|
||||
}
|
||||
|
||||
/// are two iterators different?
|
||||
bool operator!=(const VertexIterator& rhs) const
|
||||
{
|
||||
return !operator==(rhs);
|
||||
}
|
||||
|
||||
/// pre-increment iterator
|
||||
VertexIterator& operator++()
|
||||
{
|
||||
++hnd_.idx_;
|
||||
assert(cloud_);
|
||||
while (cloud_->garbage() && cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) ++hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/// pre-decrement iterator
|
||||
VertexIterator& operator--()
|
||||
{
|
||||
--hnd_.idx_;
|
||||
assert(cloud_);
|
||||
while (cloud_->garbage() && cloud_->is_valid(hnd_) && cloud_->is_deleted(hnd_)) --hnd_.idx_;
|
||||
return *this;
|
||||
}
|
||||
|
||||
private:
|
||||
Vertex hnd_;
|
||||
const PointCloud* cloud_;
|
||||
};
|
||||
|
||||
|
||||
public: //-------------------------- containers for C++11 range-based for loops
|
||||
|
||||
/// this helper class is a container for iterating through all
|
||||
/// vertices using C++11 range-based for-loops.
|
||||
/// \sa vertices()
|
||||
class VertexContainer
|
||||
{
|
||||
public:
|
||||
VertexContainer(VertexIterator _begin, VertexIterator _end) : begin_(_begin), end_(_end) {}
|
||||
VertexIterator begin() const { return begin_; }
|
||||
VertexIterator end() const { return end_; }
|
||||
private:
|
||||
VertexIterator begin_, end_;
|
||||
};
|
||||
|
||||
|
||||
public: //-------------------------------------------- constructor / destructor
|
||||
|
||||
/// \name Construct, destruct, assignment
|
||||
//@{
|
||||
|
||||
/// default constructor
|
||||
PointCloud();
|
||||
|
||||
// destructor (is virtual, since we inherit from Geometry_representation)
|
||||
virtual ~PointCloud();
|
||||
|
||||
/// copy constructor: copies \c rhs to \c *this. performs a deep copy of all properties.
|
||||
PointCloud(const PointCloud& rhs) { operator=(rhs); }
|
||||
|
||||
/// assign \c rhs to \c *this. performs a deep copy of all properties.
|
||||
PointCloud& operator=(const PointCloud& rhs);
|
||||
|
||||
/// assign \c rhs to \c *this. does not copy custom properties.
|
||||
PointCloud& assign(const PointCloud& rhs);
|
||||
|
||||
//@}
|
||||
|
||||
|
||||
public: //----------------------------------------------- add new vertex
|
||||
|
||||
/// \name Add new elements by hand
|
||||
//@{
|
||||
|
||||
/// add a new vertex with position \c p
|
||||
Vertex add_vertex(const vec3& p);
|
||||
|
||||
//@}
|
||||
|
||||
|
||||
public: //--------------------------------------------------- memory management
|
||||
|
||||
/// \name Memory Management
|
||||
//@{
|
||||
|
||||
/// returns number of (deleted and valid) vertices in the cloud
|
||||
unsigned int vertices_size() const { return (unsigned int) vprops_.size(); }
|
||||
|
||||
/// returns number of vertices in the cloud
|
||||
unsigned int n_vertices() const { return vertices_size() - deleted_vertices_; }
|
||||
|
||||
/// returns true iff the cloud is empty, i.e., has no vertices
|
||||
unsigned int empty() const { return n_vertices() == 0; }
|
||||
|
||||
/// clear cloud: remove all vertices
|
||||
void clear();
|
||||
|
||||
/// remove unused memory from vectors
|
||||
void free_memory();
|
||||
|
||||
/// resize space for vertices and their currently associated properties.
|
||||
void resize(unsigned int nv) { vprops_.resize(nv); }
|
||||
|
||||
/// remove deleted vertices
|
||||
void garbage_collection();
|
||||
|
||||
/// deletes the vertex \c v from the cloud
|
||||
void delete_vertex(Vertex v);
|
||||
|
||||
/// returns whether vertex \c v is deleted
|
||||
/// \sa garbage_collection()
|
||||
bool is_deleted(Vertex v) const
|
||||
{
|
||||
return vdeleted_[v];
|
||||
}
|
||||
|
||||
/// return whether vertex \c v is valid, i.e. the index is stores it within the array bounds.
|
||||
bool is_valid(Vertex v) const
|
||||
{
|
||||
return (0 <= v.idx()) && (v.idx() < (int)vertices_size());
|
||||
}
|
||||
|
||||
//@}
|
||||
|
||||
public: //--------------------------------------------------- property handling
|
||||
|
||||
/// \name Property handling
|
||||
//@{
|
||||
|
||||
/** add a vertex property of type \c T with name \c name and default value \c t.
|
||||
fails if a property named \c name exists already, since the name has to be unique.
|
||||
in this case it returns an invalid property */
|
||||
template <class T> VertexProperty<T> add_vertex_property(const std::string& name, const T t=T())
|
||||
{
|
||||
return VertexProperty<T>(vprops_.add<T>(name, t));
|
||||
}
|
||||
/** add a model property of type \c T with name \c name and default value \c t.
|
||||
fails if a property named \c name exists already, since the name has to be unique.
|
||||
in this case it returns an invalid property */
|
||||
template <class T> ModelProperty<T> add_model_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return ModelProperty<T>(mprops_.add<T>(name, t));
|
||||
}
|
||||
|
||||
/** get the vertex property named \c name of type \c T. returns an invalid
|
||||
VertexProperty if the property does not exist or if the type does not match. */
|
||||
template <class T> VertexProperty<T> get_vertex_property(const std::string& name) const
|
||||
{
|
||||
return VertexProperty<T>(vprops_.get<T>(name));
|
||||
}
|
||||
/** get the model property named \c name of type \c T. returns an invalid
|
||||
ModelProperty if the property does not exist or if the type does not match. */
|
||||
template <class T> ModelProperty<T> get_model_property(const std::string& name) const
|
||||
{
|
||||
return ModelProperty<T>(mprops_.get<T>(name));
|
||||
}
|
||||
|
||||
/** if a vertex property of type \c T with name \c name exists, it is returned.
|
||||
otherwise this property is added (with default value \c t) */
|
||||
template <class T> VertexProperty<T> vertex_property(const std::string& name, const T t=T())
|
||||
{
|
||||
return VertexProperty<T>(vprops_.get_or_add<T>(name, t));
|
||||
}
|
||||
/** if a model property of type \c T with name \c name exists, it is returned.
|
||||
otherwise this property is added (with default value \c t) */
|
||||
template <class T> ModelProperty<T> model_property(const std::string& name, const T t = T())
|
||||
{
|
||||
return ModelProperty<T>(mprops_.get_or_add<T>(name, t));
|
||||
}
|
||||
|
||||
/// remove the vertex property \c p
|
||||
template <class T> void remove_vertex_property(VertexProperty<T>& p)
|
||||
{
|
||||
vprops_.remove(p);
|
||||
}
|
||||
/// remove the model property \c p
|
||||
template <class T> void remove_model_property(ModelProperty<T>& p)
|
||||
{
|
||||
mprops_.remove(p);
|
||||
}
|
||||
|
||||
|
||||
/** get the type_info \c T of vertex property named \c. returns an typeid(void)
|
||||
if the property does not exist or if the type does not match. */
|
||||
const std::type_info& get_vertex_property_type(const std::string& name)
|
||||
{
|
||||
return vprops_.get_type(name);
|
||||
}
|
||||
/** get the type_info \c T of model property named \c. returns an typeid(void)
|
||||
if the property does not exist or if the type does not match. */
|
||||
const std::type_info& get_model_property_type(const std::string& name) const
|
||||
{
|
||||
return mprops_.get_type(name);
|
||||
}
|
||||
|
||||
/// returns the names of all vertex properties
|
||||
std::vector<std::string> vertex_properties() const
|
||||
{
|
||||
return vprops_.properties();
|
||||
}
|
||||
/// returns the names of all model properties
|
||||
std::vector<std::string> model_properties() const
|
||||
{
|
||||
return mprops_.properties();
|
||||
}
|
||||
|
||||
/// prints the names of all properties
|
||||
void property_stats() const;
|
||||
|
||||
//@}
|
||||
|
||||
|
||||
public: //--------------------------------------------- iterators
|
||||
|
||||
/// \name Iterators
|
||||
//@{
|
||||
|
||||
/// returns start iterator for vertices
|
||||
VertexIterator vertices_begin() const
|
||||
{
|
||||
return VertexIterator(Vertex(0), this);
|
||||
}
|
||||
|
||||
/// returns end iterator for vertices
|
||||
VertexIterator vertices_end() const
|
||||
{
|
||||
return VertexIterator(Vertex(vertices_size()), this);
|
||||
}
|
||||
|
||||
/// returns vertex container for C++11 range-based for-loops
|
||||
VertexContainer vertices() const
|
||||
{
|
||||
return VertexContainer(vertices_begin(), vertices_end());
|
||||
}
|
||||
|
||||
//@}
|
||||
|
||||
public: //------------------------------------------ geometry-related functions
|
||||
|
||||
/// \name Geometry-related Functions
|
||||
//@{
|
||||
|
||||
/// position of a vertex (read only)
|
||||
const vec3& position(Vertex v) const { return vpoint_[v]; }
|
||||
|
||||
/// position of a vertex
|
||||
vec3& position(Vertex v) { return vpoint_[v]; }
|
||||
|
||||
/// vector of vertex positions (read only)
|
||||
const std::vector<vec3>& points() const { return vpoint_.vector(); }
|
||||
|
||||
/// vector of vertex positions
|
||||
std::vector<vec3>& points() { return vpoint_.vector(); }
|
||||
|
||||
//@}
|
||||
|
||||
private: //---------------------------------------------- allocate new elements
|
||||
|
||||
/// allocate a new vertex, resize vertex properties accordingly.
|
||||
Vertex new_vertex()
|
||||
{
|
||||
vprops_.push_back();
|
||||
return Vertex(vertices_size()-1);
|
||||
}
|
||||
|
||||
|
||||
private: //--------------------------------------------------- helper functions
|
||||
|
||||
/// are there deleted vertices
|
||||
bool garbage() const { return garbage_; }
|
||||
|
||||
private: //------------------------------------------------------- private data
|
||||
|
||||
PropertyContainer vprops_;
|
||||
PropertyContainer mprops_;
|
||||
|
||||
VertexProperty<bool> vdeleted_;
|
||||
VertexProperty<vec3> vpoint_;
|
||||
|
||||
unsigned int deleted_vertices_;
|
||||
bool garbage_;
|
||||
};
|
||||
|
||||
|
||||
//------------------------------------------------------------ output operators
|
||||
|
||||
|
||||
inline std::ostream& operator<<(std::ostream& os, PointCloud::Vertex v)
|
||||
{
|
||||
return (os << 'v' << v.idx());
|
||||
}
|
||||
|
||||
//=============================================================================
|
||||
} // namespace easy3d
|
||||
//=============================================================================
|
||||
#endif // EASY3D_POINT_CLOUD_H
|
||||
//=============================================================================
|
||||
|
|
@ -0,0 +1,213 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_PRINCIPAL_AXIS_H
|
||||
#define EASY3D_PRINCIPAL_AXIS_H
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
/**
|
||||
* PrincipalAxes computes the center and inertia axes of
|
||||
* a set of 2D or 3D points.
|
||||
* @tparam DIM dimension (must be 2 or 3)
|
||||
*/
|
||||
|
||||
//NOTE: 2D cases has not been tested!!!
|
||||
|
||||
template <int DIM, typename FT>
|
||||
class PrincipalAxes {
|
||||
public:
|
||||
PrincipalAxes();
|
||||
~PrincipalAxes();
|
||||
|
||||
// add point one by one
|
||||
void begin();
|
||||
void add_point(const Vec<DIM, FT>& p, FT weight = FT(1.0));
|
||||
void end();
|
||||
|
||||
// add a set of point (it internally calls add_point())
|
||||
template <typename InputIterator>
|
||||
void add_points(InputIterator first, InputIterator last);
|
||||
|
||||
Vec<DIM, FT> center() const;
|
||||
|
||||
// eigen values are sorted in descending order,
|
||||
// eigen vectors are sorted in accordance.
|
||||
Vec<DIM, FT> axis(int i) const;
|
||||
FT eigen_value(int i) const ;
|
||||
|
||||
private:
|
||||
FT center_[DIM];
|
||||
FT axis_[DIM][DIM];
|
||||
FT eigen_value_[DIM];
|
||||
|
||||
FT** M_;
|
||||
int nb_points_;
|
||||
FT sum_weights_;
|
||||
} ;
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
||||
#include <cassert>
|
||||
#include <easy3d/core/eigen_solver.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
PrincipalAxes<DIM, FT>::PrincipalAxes() {
|
||||
M_ = new FT*[DIM];
|
||||
for (unsigned short i = 0; i < DIM; ++i)
|
||||
M_[i] = new FT[DIM];
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
PrincipalAxes<DIM, FT>::~PrincipalAxes() {
|
||||
for (unsigned short i = 0; i < DIM; ++i)
|
||||
delete[] M_[i];
|
||||
delete[] M_;
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
inline Vec<DIM, FT> PrincipalAxes<DIM, FT>::center() const {
|
||||
return Vec<DIM, FT>(center_) ;
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
inline Vec<DIM, FT> PrincipalAxes<DIM, FT>::axis(int i) const {
|
||||
assert(i >= 0 && i < DIM) ;
|
||||
return Vec<DIM, FT>(axis_[i]) ;
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
inline FT PrincipalAxes<DIM, FT>::eigen_value(int i) const {
|
||||
assert(i >= 0 && i < DIM) ;
|
||||
return eigen_value_[i] ;
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
inline void PrincipalAxes<DIM, FT>::begin() {
|
||||
nb_points_ = 0 ;
|
||||
sum_weights_ = 0 ;
|
||||
for (unsigned short i = 0; i < DIM; ++i) {
|
||||
center_[i] = 0;
|
||||
for (unsigned short j = 0; j < DIM; ++j)
|
||||
M_[i][j] = 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
inline void PrincipalAxes<DIM, FT>::end() {
|
||||
for (unsigned short i = 0; i < DIM; ++i)
|
||||
center_[i] /= sum_weights_;
|
||||
|
||||
// If the system is under-determined, return the trivial basis.
|
||||
if(nb_points_ < DIM + 1) {
|
||||
for (unsigned short i = 0; i < DIM; ++i) {
|
||||
eigen_value_[i] = FT(1.0) ;
|
||||
for (unsigned short j = 0; j < DIM; ++j)
|
||||
axis_[i][j] = (i == j ? FT(1) : FT(0));
|
||||
}
|
||||
}
|
||||
else {
|
||||
for (unsigned short i = 0; i < DIM; ++i) {
|
||||
for (unsigned short j = i; j < DIM; ++j) {
|
||||
M_[i][j] = M_[i][j]/sum_weights_ - center_[i]*center_[j];
|
||||
if (i != j)
|
||||
M_[j][i] = M_[i][j];
|
||||
}
|
||||
|
||||
if( M_[i][i] <= FT(0) )
|
||||
M_[i][i] = std::numeric_limits<FT>::min();
|
||||
}
|
||||
|
||||
EigenSolver<FT> solver(DIM);
|
||||
solver.solve(M_, EigenSolver<FT>::DECREASING);
|
||||
|
||||
for (unsigned short i=0; i<DIM; ++i) {
|
||||
eigen_value_[i] = solver.eigen_value(i);
|
||||
for (unsigned short j=0; j<DIM; ++j)
|
||||
axis_[i][j] = solver.eigen_vector(j, i); // eigenvectors are stored in columns
|
||||
}
|
||||
|
||||
// Normalize the eigen vectors
|
||||
for(unsigned short i=0; i<DIM; i++) {
|
||||
FT sqr_len(0);
|
||||
for(unsigned short j=0; j<DIM; j++)
|
||||
sqr_len += (axis_[i][j] * axis_[i][j]);
|
||||
FT s = std::sqrt(sqr_len);
|
||||
s = (s > std::numeric_limits<FT>::min()) ? FT(1.0) / s : FT(0.0);
|
||||
for (unsigned short j = 0; j < DIM; ++j)
|
||||
axis_[i][j] *= s;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// The covariance matrix:
|
||||
// If A and B have components a_i and b_j respectively, then
|
||||
// the covariance matrix C has a_i*b_j as its ij-th entry.
|
||||
template <int DIM, typename FT>
|
||||
inline void PrincipalAxes<DIM, FT>::add_point(const Vec<DIM, FT>& p, FT weight) {
|
||||
for (unsigned short i = 0; i < DIM; ++i) {
|
||||
center_[i] += p[i] * weight ;
|
||||
for (unsigned short j = i; j < DIM; ++j)
|
||||
M_[i][j] += weight * p[i] * p[j];
|
||||
}
|
||||
nb_points_++ ;
|
||||
sum_weights_ += weight ;
|
||||
}
|
||||
|
||||
|
||||
// add a set of point (it internally calls add_point())
|
||||
template <int DIM, typename FT>
|
||||
template <typename InputIterator >
|
||||
inline void PrincipalAxes<DIM, FT>::add_points(InputIterator first, InputIterator last) {
|
||||
assert(first != last);
|
||||
begin();
|
||||
for (InputIterator it = first; it != last; ++it) {
|
||||
add_point(*it);
|
||||
}
|
||||
end();
|
||||
}
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
|
|
@ -0,0 +1,458 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/** ----------------------------------------------------------
|
||||
*
|
||||
* the code is adapted from Surface_mesh with modifications.
|
||||
* - Surface_mesh (version 1.1)
|
||||
* The original code is available at
|
||||
* https://opensource.cit-ec.de/projects/surface_mesh
|
||||
*
|
||||
* Surface_mesh is a halfedge-based mesh data structure for
|
||||
* representing and processing 2-manifold polygonal surface
|
||||
* meshes. It is implemented in C++ and designed with an
|
||||
* emphasis on simplicity and efficiency.
|
||||
*
|
||||
*----------------------------------------------------------*/
|
||||
|
||||
|
||||
#ifndef EASY3D_PROPERTIES_H
|
||||
#define EASY3D_PROPERTIES_H
|
||||
|
||||
|
||||
//== INCLUDES =================================================================
|
||||
|
||||
|
||||
#include <vector>
|
||||
#include <string>
|
||||
#include <iostream>
|
||||
#include <algorithm>
|
||||
#include <typeinfo>
|
||||
#include <cassert>
|
||||
|
||||
|
||||
//== NAMESPACE ================================================================
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
//== CLASS DEFINITION =========================================================
|
||||
|
||||
|
||||
class BasePropertyArray
|
||||
{
|
||||
public:
|
||||
|
||||
/// Default constructor
|
||||
BasePropertyArray(const std::string& name) : name_(name) {}
|
||||
|
||||
/// Destructor.
|
||||
virtual ~BasePropertyArray() {}
|
||||
|
||||
/// Reserve memory for n elements.
|
||||
virtual void reserve(size_t n) = 0;
|
||||
|
||||
/// Resize storage to hold n elements.
|
||||
virtual void resize(size_t n) = 0;
|
||||
|
||||
/// Free unused memory.
|
||||
virtual void free_memory() = 0;
|
||||
|
||||
/// Extend the number of elements by one.
|
||||
virtual void push_back() = 0;
|
||||
|
||||
/// Let two elements swap their storage place.
|
||||
virtual void swap(size_t i0, size_t i1) = 0;
|
||||
|
||||
/// Return a deep copy of self.
|
||||
virtual BasePropertyArray* clone () const = 0;
|
||||
|
||||
/// Return the type_info of the property
|
||||
virtual const std::type_info& type() = 0;
|
||||
|
||||
/// Return the name of the property
|
||||
const std::string& name() const { return name_; }
|
||||
|
||||
|
||||
protected:
|
||||
|
||||
std::string name_;
|
||||
};
|
||||
|
||||
|
||||
|
||||
//== CLASS DEFINITION =========================================================
|
||||
|
||||
|
||||
template <class T>
|
||||
class PropertyArray : public BasePropertyArray
|
||||
{
|
||||
public:
|
||||
|
||||
typedef T value_type;
|
||||
typedef std::vector<value_type> vector_type;
|
||||
typedef typename vector_type::reference reference;
|
||||
typedef typename vector_type::const_reference const_reference;
|
||||
|
||||
PropertyArray(const std::string& name, T t=T()) : BasePropertyArray(name), value_(t) {}
|
||||
|
||||
|
||||
public: // virtual interface of BasePropertyArray
|
||||
|
||||
virtual void reserve(size_t n)
|
||||
{
|
||||
data_.reserve(n);
|
||||
}
|
||||
|
||||
virtual void resize(size_t n)
|
||||
{
|
||||
data_.resize(n, value_);
|
||||
}
|
||||
|
||||
virtual void push_back()
|
||||
{
|
||||
data_.push_back(value_);
|
||||
}
|
||||
|
||||
virtual void free_memory()
|
||||
{
|
||||
vector_type(data_).swap(data_);
|
||||
}
|
||||
|
||||
virtual void swap(size_t i0, size_t i1)
|
||||
{
|
||||
T d(data_[i0]);
|
||||
data_[i0]=data_[i1];
|
||||
data_[i1]=d;
|
||||
}
|
||||
|
||||
virtual BasePropertyArray* clone() const
|
||||
{
|
||||
PropertyArray<T>* p = new PropertyArray<T>(name_, value_);
|
||||
p->data_ = data_;
|
||||
return p;
|
||||
}
|
||||
|
||||
virtual const std::type_info& type() { return typeid(T); }
|
||||
|
||||
|
||||
public:
|
||||
|
||||
/// Get pointer to array (does not work for T==bool)
|
||||
const T* data() const
|
||||
{
|
||||
return &data_[0];
|
||||
}
|
||||
|
||||
|
||||
/// Get reference to the underlying vector
|
||||
std::vector<T>& vector()
|
||||
{
|
||||
return data_;
|
||||
}
|
||||
|
||||
|
||||
/// Access the i'th element. No range check is performed!
|
||||
reference operator[](size_t _idx)
|
||||
{
|
||||
assert( size_t(_idx) < data_.size() );
|
||||
return data_[_idx];
|
||||
}
|
||||
|
||||
/// Const access to the i'th element. No range check is performed!
|
||||
const_reference operator[](size_t _idx) const
|
||||
{
|
||||
assert( size_t(_idx) < data_.size());
|
||||
return data_[_idx];
|
||||
}
|
||||
|
||||
|
||||
private:
|
||||
vector_type data_;
|
||||
value_type value_;
|
||||
};
|
||||
|
||||
|
||||
// specialization for bool properties
|
||||
template <>
|
||||
inline const bool*
|
||||
PropertyArray<bool>::data() const
|
||||
{
|
||||
assert(false);
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
|
||||
|
||||
//== CLASS DEFINITION =========================================================
|
||||
|
||||
|
||||
template <class T>
|
||||
class Property
|
||||
{
|
||||
public:
|
||||
|
||||
typedef typename PropertyArray<T>::reference reference;
|
||||
typedef typename PropertyArray<T>::const_reference const_reference;
|
||||
|
||||
friend class PropertyContainer;
|
||||
|
||||
public:
|
||||
|
||||
Property(PropertyArray<T>* p=nullptr) : parray_(p) {}
|
||||
|
||||
void reset()
|
||||
{
|
||||
parray_ = nullptr;
|
||||
}
|
||||
|
||||
operator bool() const
|
||||
{
|
||||
return parray_ != nullptr;
|
||||
}
|
||||
|
||||
reference operator[](size_t i)
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return (*parray_)[i];
|
||||
}
|
||||
|
||||
const_reference operator[](size_t i) const
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return (*parray_)[i];
|
||||
}
|
||||
|
||||
const T* data() const
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return parray_->data();
|
||||
}
|
||||
|
||||
std::vector<T>& vector()
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return parray_->vector();
|
||||
}
|
||||
|
||||
const std::vector<T>& vector() const
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return parray_->vector();
|
||||
}
|
||||
|
||||
PropertyArray<T>& array()
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return *parray_;
|
||||
}
|
||||
|
||||
const PropertyArray<T>& array() const
|
||||
{
|
||||
assert(parray_ != nullptr);
|
||||
return *parray_;
|
||||
}
|
||||
|
||||
private:
|
||||
PropertyArray<T>* parray_;
|
||||
};
|
||||
|
||||
|
||||
|
||||
//== CLASS DEFINITION =========================================================
|
||||
|
||||
|
||||
class PropertyContainer
|
||||
{
|
||||
public:
|
||||
|
||||
// default constructor
|
||||
PropertyContainer() : size_(0) {}
|
||||
|
||||
// destructor (deletes all property arrays)
|
||||
virtual ~PropertyContainer() { clear(); }
|
||||
|
||||
// copy constructor: performs deep copy of property arrays
|
||||
PropertyContainer(const PropertyContainer& _rhs) { operator=(_rhs); }
|
||||
|
||||
// assignment: performs deep copy of property arrays
|
||||
PropertyContainer& operator=(const PropertyContainer& _rhs)
|
||||
{
|
||||
if (this != &_rhs)
|
||||
{
|
||||
clear();
|
||||
parrays_.resize(_rhs.n_properties());
|
||||
size_ = _rhs.size();
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i] = _rhs.parrays_[i]->clone();
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
// returns the current size of the property arrays
|
||||
size_t size() const { return size_; }
|
||||
|
||||
// returns the number of property arrays
|
||||
size_t n_properties() const { return parrays_.size(); }
|
||||
|
||||
// returns a vector of all property names
|
||||
std::vector<std::string> properties() const
|
||||
{
|
||||
std::vector<std::string> names;
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
names.push_back(parrays_[i]->name());
|
||||
return names;
|
||||
}
|
||||
|
||||
|
||||
// add a property with name \c name and default value \c t
|
||||
template <class T> Property<T> add(const std::string& name, const T t=T())
|
||||
{
|
||||
// if a property with this name already exists, return an invalid property
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
{
|
||||
if (parrays_[i]->name() == name)
|
||||
{
|
||||
std::cerr << "[PropertyContainer] A property with name \""
|
||||
<< name << "\" already exists. Returning invalid property.\n";
|
||||
return Property<T>();
|
||||
}
|
||||
}
|
||||
|
||||
// otherwise add the property
|
||||
PropertyArray<T>* p = new PropertyArray<T>(name, t);
|
||||
p->resize(size_);
|
||||
parrays_.push_back(p);
|
||||
return Property<T>(p);
|
||||
}
|
||||
|
||||
|
||||
// get a property by its name. returns invalid property if it does not exist.
|
||||
template <class T> Property<T> get(const std::string& name) const
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
if (parrays_[i]->name() == name)
|
||||
return Property<T>(dynamic_cast<PropertyArray<T>*>(parrays_[i]));
|
||||
return Property<T>();
|
||||
}
|
||||
|
||||
|
||||
// returns a property if it exists, otherwise it creates it first.
|
||||
template <class T> Property<T> get_or_add(const std::string& name, const T t=T())
|
||||
{
|
||||
Property<T> p = get<T>(name);
|
||||
if (!p) p = add<T>(name, t);
|
||||
return p;
|
||||
}
|
||||
|
||||
|
||||
// get the type of property by its name. returns typeid(void) if it does not exist.
|
||||
const std::type_info& get_type(const std::string& name) const
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
if (parrays_[i]->name() == name)
|
||||
return parrays_[i]->type();
|
||||
return typeid(void);
|
||||
}
|
||||
|
||||
|
||||
// delete a property
|
||||
template <class T> void remove(Property<T>& h)
|
||||
{
|
||||
std::vector<BasePropertyArray*>::iterator it=parrays_.begin(), end=parrays_.end();
|
||||
for (; it!=end; ++it)
|
||||
{
|
||||
if (*it == h.parray_)
|
||||
{
|
||||
delete *it;
|
||||
parrays_.erase(it);
|
||||
h.reset();
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// delete all properties
|
||||
void clear()
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
delete parrays_[i];
|
||||
parrays_.clear();
|
||||
size_ = 0;
|
||||
}
|
||||
|
||||
|
||||
// reserve memory for n entries in all arrays
|
||||
void reserve(size_t n) const
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i]->reserve(n);
|
||||
}
|
||||
|
||||
// resize all arrays to size n
|
||||
void resize(size_t n)
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i]->resize(n);
|
||||
size_ = n;
|
||||
}
|
||||
|
||||
// free unused space in all arrays
|
||||
void free_memory() const
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i]->free_memory();
|
||||
}
|
||||
|
||||
// add a new element to each vector
|
||||
void push_back()
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i]->push_back();
|
||||
++size_;
|
||||
}
|
||||
|
||||
// swap elements i0 and i1 in all arrays
|
||||
void swap(size_t i0, size_t i1) const
|
||||
{
|
||||
for (size_t i=0; i<parrays_.size(); ++i)
|
||||
parrays_[i]->swap(i0, i1);
|
||||
}
|
||||
|
||||
|
||||
private:
|
||||
std::vector<BasePropertyArray*> parrays_;
|
||||
size_t size_;
|
||||
};
|
||||
|
||||
|
||||
//=============================================================================
|
||||
} // namespace easy3d
|
||||
//=============================================================================
|
||||
#endif // EASY3D_PROPERTIES_H
|
||||
//=============================================================================
|
||||
|
|
@ -0,0 +1,714 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
/** ----------------------------------------------------------
|
||||
*
|
||||
* The code is adapted from libQGLViewer with modifications.
|
||||
* - libQGLViewer (version Version 2.7.1, Nov 17th, 2017)
|
||||
* The original code is available at
|
||||
* http://libqglviewer.com/
|
||||
*
|
||||
* libQGLViewer is a C++ library based on Qt that eases the
|
||||
* creation of OpenGL 3D viewers.
|
||||
*
|
||||
*----------------------------------------------------------*/
|
||||
|
||||
#ifndef EASY3D_QUATERNION_H
|
||||
#define EASY3D_QUATERNION_H
|
||||
|
||||
|
||||
#include <easy3d/core/constant.h>
|
||||
#include <easy3d/core/vec.h>
|
||||
#include <easy3d/core/mat.h>
|
||||
|
||||
/**
|
||||
* Euler angles VS Quaternion
|
||||
*
|
||||
* Euler angles are the easiest way to represent rotation. This representation simply
|
||||
* stores the three rotation angles around the X, Y and Z axes. These 3 rotations are
|
||||
* then applied successively, usually in this order: first Y, then Z, then X (but not
|
||||
* necessarily). Using a different order yields different results.
|
||||
* Euler angles are usually used to set a character's orientation since game characters
|
||||
* only rotate on the vertical axis. Therefore, it is easier to write, understand and
|
||||
* maintain "float direction" than 3 different orientations. Another good use of Euler
|
||||
* angles is an FPS camera: you have one angle for heading (Y), and one for up/down (X).
|
||||
* However, when things get more complex, Euler angle will be hard to work with, eg.,:
|
||||
* - Interpolating smoothly between 2 orientations is hard. Naively interpolating the
|
||||
* X, Y, and Z angles will be ugly.
|
||||
* - Applying several rotations is complicated and unprecise: you have to compute the
|
||||
* final rotation matrix, and guess the Euler angles from this matrix.
|
||||
* - A well-known problem, the "Gimbal Lock", will sometimes block your rotations, and
|
||||
* other singularities which will flip your model upside-down.
|
||||
* - Different angles make the same rotation (-180 and 180 degrees, for instance)
|
||||
* - It is a mess - as said above, usually the right order is YZX, but if you also use
|
||||
* a library with a different order, you'll be in trouble.
|
||||
* - Some operations are complicated, e.g., rotation of N degrees around a specific axis.
|
||||
* Quaternions are a tool to represent rotations, which solves these problems.
|
||||
*
|
||||
*
|
||||
* The Quaternion class represents 3D rotations and orientations.
|
||||
*
|
||||
* The Quaternion is an appropriate (although not very intuitive) representation for
|
||||
* 3D rotations and orientations. Many tools are provided to ease the definition of a
|
||||
* Quaternion: see constructors, set_axis_angle(), set_from_rotation_matrix(),
|
||||
* set_from_rotated_basis().
|
||||
*
|
||||
* You can apply the rotation represented by the Quaternion to 3D points using rotate()
|
||||
* and inverse_rotate().
|
||||
*
|
||||
* You can apply the Quaternion q rotation to the OpenGL matrices using
|
||||
* glMultMatrixd(q.matrix());
|
||||
* which is equvalent to
|
||||
* glRotate(q.angle()*180.0/M_PI, q.axis().x, q.axis().y, q.axis().z);
|
||||
*
|
||||
* Internal representation
|
||||
* The internal representation of a Quaternion is a set of 4 numbers, [x y z w], which
|
||||
* represents rotations the following way:
|
||||
* x = axis.x * sin(angle / 2)
|
||||
* y = axis.y * sin(angle / 2)
|
||||
* z = axis.z * sin(angle / 2)
|
||||
* w = cos(angle / 2)
|
||||
* NOTE:
|
||||
* - the angle is in radians and the axis is a unit vector.
|
||||
* - certain implementations place the cosine term in the first position (instead of last).
|
||||
*
|
||||
* A Quaternion is always normalized, so that its inverse() is actually its conjugate.
|
||||
*/
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
template <typename FT>
|
||||
class Quat
|
||||
{
|
||||
public:
|
||||
typedef Vec<3, FT> Vec3;
|
||||
typedef Quat<FT> thisclass;
|
||||
|
||||
public:
|
||||
/* Defining a Quat */
|
||||
/* Default constructor, builds an identity rotation. */
|
||||
Quat()
|
||||
{
|
||||
_q[0] = _q[1] = _q[2] = FT(0); _q[3] = FT(1);
|
||||
}
|
||||
|
||||
/* Constructor from rotation axis (non null) and angle (in radians). See also set_axis_angle(). */
|
||||
Quat(const Vec3& axis, FT angle)
|
||||
{
|
||||
set_axis_angle(axis, angle);
|
||||
}
|
||||
|
||||
/* Constructs a Quaternion that will rotate from the \p from direction to the \p to direction.
|
||||
Note that this rotation is not uniquely defined. The selected axis is usually orthogonal to \p from
|
||||
and \p to, minimizing the rotation angle. This method is robust and can handle small or almost identical vectors. */
|
||||
Quat(const Vec3& from, const Vec3& to);
|
||||
|
||||
/* Constructor from the four values of a Quaternion. First three values are axis*sin(angle/2) and
|
||||
last one is cos(angle/2).
|
||||
|
||||
\attention The identity Quaternion is Quat(0,0,0,1) and not Quat(0,0,0,0) (which is
|
||||
not unitary). The default Quat() creates such identity Quaternion. */
|
||||
Quat(FT q0, FT q1, FT q2, FT q3)
|
||||
{ _q[0]=q0; _q[1]=q1; _q[2]=q2; _q[3]=q3; }
|
||||
|
||||
/* Copy constructor. */
|
||||
Quat(const thisclass& Q)
|
||||
{ for (int i=0; i<4; ++i) _q[i] = Q._q[i]; }
|
||||
|
||||
/* Equal operator. */
|
||||
Quat& operator=(const thisclass& Q) {
|
||||
for (int i=0; i<4; ++i)
|
||||
_q[i] = Q._q[i];
|
||||
return (*this);
|
||||
}
|
||||
|
||||
/* Sets the Quaternion as a rotation of axis and angle (in radians).
|
||||
\p axis does not need to be normalized. A null axis will result in an identity Quaternion. */
|
||||
void set_axis_angle(const Vec3& axis, FT angle);
|
||||
|
||||
/* Sets the Quaternion value. */
|
||||
void set_value(FT q0, FT q1, FT q2, FT q3)
|
||||
{ _q[0]=q0; _q[1]=q1; _q[2]=q2; _q[3]=q3; }
|
||||
|
||||
/* Set the Quaternion from a (supposedly correct) 3x3 rotation matrix.
|
||||
The matrix is expressed in European format: its three columns are the images by the rotation of
|
||||
the three vectors of an orthogonal basis. */
|
||||
// see http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
|
||||
void set_from_rotation_matrix(const Mat3<FT>& m);
|
||||
|
||||
/* set_from_rotated_basis() sets a Quaternion from the three axis of a rotated frame. It actually fills
|
||||
the three columns of a matrix with these rotated basis vectors and calls this method. */
|
||||
void set_from_rotated_basis(const Vec3& X, const Vec3& Y, const Vec3& Z);
|
||||
|
||||
/* Returns the normalized axis direction of the rotation represented by the Quaternion.
|
||||
It is null for an identity Quaternion. See also angle() and get_axis_angle(). */
|
||||
Vec3 axis() const;
|
||||
|
||||
/* Returns the angle (in radians) of the rotation represented by the Quaternion.
|
||||
This value is always in the range [0-pi]. Larger rotational angles are obtained by inverting the
|
||||
axis() direction. See also axis() and get_axis_angle(). */
|
||||
FT angle() const;
|
||||
|
||||
/* Returns the axis vector and the angle (in radians) of the rotation represented by the Quaternion.*/
|
||||
void get_axis_angle(Vec3& axis, FT& angle) const;
|
||||
|
||||
/* Bracket operator, with a constant return value. i must range in [0..3]. */
|
||||
FT operator[](int i) const { return _q[i]; }
|
||||
|
||||
/* Bracket operator returning an l-value. i must range in [0..3]. */
|
||||
FT& operator[](int i) { return _q[i]; }
|
||||
|
||||
/* Rotation computations */
|
||||
|
||||
/* Returns the composition of the a and b rotations.
|
||||
The order is important. When applied to a Vec v (see operator*(const Quaternion&, const Vec&)
|
||||
and rotate()) the resulting Quaternion acts as if b was applied first and then a was applied.
|
||||
This is obvious since the image v' of v by the composited rotation satisfies:
|
||||
v'= (a*b) * v = a * (b*v)
|
||||
Note that a*b usually differs from b*a.
|
||||
\attention For efficiency reasons, the resulting Quaternion is not normalized. Use normalize() in
|
||||
case of numerical drift with small rotation composition. */
|
||||
friend Quat operator*(const Quat& a, const Quat& b)
|
||||
{
|
||||
return Quat(
|
||||
a._q[3]*b._q[0] + b._q[3]*a._q[0] + a._q[1]*b._q[2] - a._q[2]*b._q[1],
|
||||
a._q[3]*b._q[1] + b._q[3]*a._q[1] + a._q[2]*b._q[0] - a._q[0]*b._q[2],
|
||||
a._q[3]*b._q[2] + b._q[3]*a._q[2] + a._q[0]*b._q[1] - a._q[1]*b._q[0],
|
||||
a._q[3]*b._q[3] - b._q[0]*a._q[0] - a._q[1]*b._q[1] - a._q[2]*b._q[2]
|
||||
);
|
||||
}
|
||||
|
||||
/* Quaternion rotation is composed with q.
|
||||
See operator*(), since this is equivalent to this = this * q.
|
||||
\note For efficiency reasons, the resulting Quaternion is not normalized.
|
||||
You may normalize() it after each application in case of numerical drift. */
|
||||
Quat& operator*=(const Quat &q) {
|
||||
*this = (*this)*q;
|
||||
return *this;
|
||||
}
|
||||
|
||||
/* Returns the image of v by the rotation q.
|
||||
Same as q.rotate(v). See rotate() and inverse_rotate(). */
|
||||
friend Vec3 operator*(const Quat& q, const Vec3& v) { return q.rotate(v); }
|
||||
|
||||
/* Returns the image of v by the Quaternion rotation.
|
||||
See also inverse_rotate() and operator*(const Quat&, const Vec&). */
|
||||
Vec3 rotate(const Vec3& v) const;
|
||||
|
||||
/* Returns the image of v by the Quaternion inverse() rotation.
|
||||
rotate() performs an inverse transformation. Same as inverse().rotate(v). */
|
||||
Vec3 inverse_rotate(const Vec3& v) const {
|
||||
return inverse().rotate(v);
|
||||
}
|
||||
|
||||
/* Inversion */
|
||||
/* Returns the inverse Quaternion (inverse rotation).
|
||||
Result has a negated axis() direction and the same angle(). A composition (see operator*()) of a
|
||||
Quaternion and its inverse() results in an identity function.
|
||||
Use invert() to actually modify the Quaternion. */
|
||||
Quat inverse() const { return Quat(-_q[0], -_q[1], -_q[2], _q[3]); }
|
||||
|
||||
/* Inverses the Quaternion (same rotation angle(), but negated axis()).
|
||||
See also inverse(). */
|
||||
void invert() { _q[0] = -_q[0]; _q[1] = -_q[1]; _q[2] = -_q[2]; }
|
||||
|
||||
/* Negates all the coefficients of the Quaternion.
|
||||
This results in an other representation of the same rotation (opposite rotation angle, but with
|
||||
a negated axis direction: the two cancel out). However, note that the results of axis() and
|
||||
angle() are unchanged after a call to this method since angle() always returns a value in [0,pi].
|
||||
This method is mainly useful for Quaternion interpolation, so that the spherical interpolation
|
||||
takes the shortest path on the unit sphere. See slerp() for details. */
|
||||
void negate() { invert(); _q[3] = -_q[3]; }
|
||||
|
||||
FT length() const {
|
||||
return std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
|
||||
}
|
||||
|
||||
/* Normalizes the Quaternion coefficients.
|
||||
This method should not need to be called since we only deal with unit Quaternions. This is however
|
||||
useful to prevent numerical drifts, especially with small rotational increments. See also
|
||||
normalized(). */
|
||||
FT normalize() {
|
||||
const FT norm = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
|
||||
for (int i=0; i<4; ++i)
|
||||
_q[i] /= norm;
|
||||
return norm;
|
||||
}
|
||||
|
||||
/* Returns a normalized version of the Quaternion.
|
||||
See also normalize(). */
|
||||
Quat normalized() const {
|
||||
FT Q[4];
|
||||
const FT norm = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2] + _q[3] * _q[3]);
|
||||
for (int i=0; i<4; ++i)
|
||||
Q[i] = _q[i] / norm;
|
||||
return Quat(Q[0], Q[1], Q[2], Q[3]);
|
||||
}
|
||||
|
||||
/* Returns the Quaternion associated 4x4 rotation matrix.
|
||||
Use glMultMatrixf(q.matrix()) to apply the rotation represented by Quaternion q to the
|
||||
current OpenGL matrix. */
|
||||
Mat4<FT> matrix() const;
|
||||
|
||||
/* Returns the associated 4x4 inverse rotation matrix. This is simply the matrix() of the inverse().*/
|
||||
Mat4<FT> inverse_matrix() const;
|
||||
|
||||
/* Interpolate between 2 quaternions */
|
||||
/* Slerp(Spherical Linear intERPolation) interpolation */
|
||||
/* Returns the slerp interpolation of Quaternions a and b, at time t. t should range in [0,1].
|
||||
Result is a when t=0 and b when t=1.
|
||||
When allowFlip is true (default) the slerp interpolation will always use the "shortest path" between
|
||||
the Quaternions' orientations, by "flipping" the source Quaternion if needed (see negate()). */
|
||||
static Quat slerp(const Quat<FT>& a, const Quat<FT>& b, FT t, bool allowFlip = true);
|
||||
|
||||
/* Returns the slerp interpolation of the two Quaternions a and b, at time t, using tangents tgA and tgB.
|
||||
The resulting Quaternion is "between" a and b (result is a when t=0 and b for t=1).
|
||||
Use squad_tangent() to define the Quaternion tangents tgA and tgB. */
|
||||
static Quat squad(const Quat<FT>& a, const Quat<FT>& tgA, const Quat<FT>& tgB, const Quat<FT>& b, FT t);
|
||||
|
||||
/* Returns the "dot" product of a and b: a[0]*b[0] + a[1]*b[1] + a[2]*b[2] + a[3]*b[3]. */
|
||||
static FT dot(const Quat<FT>& a, const Quat<FT>& b) { return a[0] * b[0] + a[1] * b[1] + a[2] * b[2] + a[3] * b[3]; }
|
||||
|
||||
/* Returns the logarithm of the Quaternion. See also exp(). */
|
||||
Quat log();
|
||||
/* Returns the exponential of the Quaternion. See also log(). */
|
||||
Quat exp();
|
||||
|
||||
/* Returns log(a. inverse() * b). Useful for squad_tangent(). */
|
||||
static Quat ln_dif(const Quat<FT>& a, const Quat<FT>& b);
|
||||
/* Returns a tangent Quaternion for \p center, defined by \p before and \p after Quaternions.
|
||||
Useful for smooth spline interpolation of Quaternion with squad() and slerp(). */
|
||||
static Quat squad_tangent(const Quat<FT>& before, const Quat<FT>& center, const Quat<FT>& after);
|
||||
|
||||
/* Returns a random unit Quaternion.
|
||||
You can create a randomly directed unit vector using:
|
||||
Vec randomDir = Quat::random_quat() * Vec(1.0, 0.0, 0.0); // or any other Vec
|
||||
\note This function uses rand() to create pseudo-random numbers and the random number generator can
|
||||
be initialized using srand().*/
|
||||
static thisclass random_quat();
|
||||
|
||||
//data intentionally left public to allow q.x ...
|
||||
public:
|
||||
/* The internal data representation is private, use operator[] to access values. */
|
||||
union {
|
||||
struct { FT x; FT y; FT z; FT w; };
|
||||
FT _q[4];
|
||||
};
|
||||
};
|
||||
|
||||
template <typename FT> std::ostream& operator<<(std::ostream& os, const Quat<FT>& q);
|
||||
template <typename FT> std::istream& operator>>(std::istream& is, Quat<FT>& q);
|
||||
|
||||
|
||||
//-------------- implementation -----------------
|
||||
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT>::Quat(const Vec3& from, const Vec3& to)
|
||||
{
|
||||
const FT epsilon = FT(1E-10);
|
||||
|
||||
const FT fromSqNorm = from.length2();
|
||||
const FT toSqNorm = to.length2();
|
||||
// Identity Quaternion when one vector is null
|
||||
if ((fromSqNorm < epsilon) || (toSqNorm < epsilon))
|
||||
{
|
||||
_q[0] = _q[1] = _q[2] = 0.0;
|
||||
_q[3] = 1.0;
|
||||
}
|
||||
else
|
||||
{
|
||||
Vec3 axis = cross(from, to);
|
||||
const FT axisSqNorm = axis.length2();
|
||||
|
||||
// Aligned vectors, pick any axis, not aligned with from or to
|
||||
if (axisSqNorm < epsilon)
|
||||
axis = orthogonal(from);
|
||||
|
||||
FT angle = std::asin(std::sqrt(axisSqNorm / (fromSqNorm * toSqNorm)));
|
||||
|
||||
if (easy3d::dot(from, to) < 0.0)
|
||||
angle = FT(M_PI - angle);
|
||||
|
||||
set_axis_angle(axis, angle);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
void Quat<FT>::set_axis_angle(const Vec3& axis, FT angle)
|
||||
{
|
||||
const FT norm = axis.length();
|
||||
if (norm < 1E-8)
|
||||
{
|
||||
// Null rotation
|
||||
_q[0] = FT(0); _q[1] = FT(0); _q[2] = FT(0); _q[3] = FT(1);
|
||||
}
|
||||
else
|
||||
{
|
||||
const FT sin_half_angle = std::sin(angle / 2.0f);
|
||||
_q[0] = sin_half_angle*axis[0] / norm;
|
||||
_q[1] = sin_half_angle*axis[1] / norm;
|
||||
_q[2] = sin_half_angle*axis[2] / norm;
|
||||
_q[3] = (FT)std::cos(angle / 2.0f);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
typename Quat<FT>::Vec3 Quat<FT>::rotate(const Vec3& v) const
|
||||
{
|
||||
const FT q00 = FT(2.0l * _q[0] * _q[0]);
|
||||
const FT q11 = FT(2.0l * _q[1] * _q[1]);
|
||||
const FT q22 = FT(2.0l * _q[2] * _q[2]);
|
||||
|
||||
const FT q01 = FT(2.0l * _q[0] * _q[1]);
|
||||
const FT q02 = FT(2.0l * _q[0] * _q[2]);
|
||||
const FT q03 = FT(2.0l * _q[0] * _q[3]);
|
||||
|
||||
const FT q12 = FT(2.0l * _q[1] * _q[2]);
|
||||
const FT q13 = FT(2.0l * _q[1] * _q[3]);
|
||||
|
||||
const FT q23 = FT(2.0l * _q[2] * _q[3]);
|
||||
|
||||
return Vec3(
|
||||
FT((1.0 - q11 - q22)*v[0] + (q01 - q23)*v[1] + (q02 + q13)*v[2]),
|
||||
FT((q01 + q23)*v[0] + (1.0 - q22 - q00)*v[1] + (q12 - q03)*v[2]),
|
||||
FT((q02 - q13)*v[0] + (q12 + q03)*v[1] + (1.0 - q11 - q00)*v[2]));
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
void Quat<FT>::set_from_rotation_matrix(const Mat3<FT>& m)
|
||||
{
|
||||
// see http://www.euclideanspace.com/maths/geometry/rotations/conversions/matrixToQuaternion/index.htm
|
||||
// Compute one plus the trace of the matrix
|
||||
const FT onePlusTrace = FT(1.0) + m(0, 0) + m(1, 1) + m(2, 2);
|
||||
|
||||
if (onePlusTrace > 1E-5) {
|
||||
// Direct computation
|
||||
const FT s = std::sqrt(onePlusTrace) * FT(2.0);
|
||||
_q[0] = (m(2, 1) - m(1, 2)) / s;
|
||||
_q[1] = (m(0, 2) - m(2, 0)) / s;
|
||||
_q[2] = (m(1, 0) - m(0, 1)) / s;
|
||||
_q[3] = FT(0.25) * s;
|
||||
}
|
||||
else
|
||||
{
|
||||
// Computation depends on major diagonal term
|
||||
if ((m(0, 0) > m(1, 1)) && (m(0, 0) > m(2, 2))) {
|
||||
const FT s = std::sqrt(FT(1.0) + m(0, 0) - m(1, 1) - m(2, 2)) * FT(2.0);
|
||||
_q[0] = FT(0.25) * s;
|
||||
_q[1] = (m(0, 1) + m(1, 0)) / s;
|
||||
_q[2] = (m(0, 2) + m(2, 0)) / s;
|
||||
_q[3] = (m(1, 2) - m(2, 1)) / s;
|
||||
}
|
||||
else if (m(1, 1) > m(2, 2)) {
|
||||
const FT s = std::sqrt(FT(1.0) + m(1, 1) - m(0, 0) - m(2, 2)) * FT(2.0);
|
||||
_q[0] = (m(0, 1) + m(1, 0)) / s;
|
||||
_q[1] = FT(0.25) * s;
|
||||
_q[2] = (m(1, 2) + m(2, 1)) / s;
|
||||
_q[3] = (m(0, 2) - m(2, 0)) / s;
|
||||
}
|
||||
else {
|
||||
const FT s = std::sqrt(FT(1.0) + m(2, 2) - m(0, 0) - m(1, 1)) * FT(2.0);
|
||||
_q[0] = (m(0, 2) + m(2, 0)) / s;
|
||||
_q[1] = (m(1, 2) + m(2, 1)) / s;
|
||||
_q[2] = FT(0.25) * s;
|
||||
_q[3] = (m(0, 1) - m(1, 0)) / s;
|
||||
}
|
||||
}
|
||||
normalize();
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
void Quat<FT>::set_from_rotated_basis(const Vec3& X, const Vec3& Y, const Vec3& Z)
|
||||
{
|
||||
Mat3<FT> m;
|
||||
FT normX = X.length();
|
||||
FT normY = Y.length();
|
||||
FT normZ = Z.length();
|
||||
|
||||
for (int i = 0; i < 3; ++i) {
|
||||
m(i, 0) = X[i] / normX;
|
||||
m(i, 1) = Y[i] / normY;
|
||||
m(i, 2) = Z[i] / normZ;
|
||||
}
|
||||
|
||||
set_from_rotation_matrix(m);
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
void Quat<FT>::get_axis_angle(Vec3& axis, FT& angle) const
|
||||
{
|
||||
// The normalize() is here to prevent failure introduced by numerical error.
|
||||
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
|
||||
if (_q[3] > FT(1)) {
|
||||
const_cast<Quat*>(this)->normalize();
|
||||
}
|
||||
angle = FT(2.0) * std::acos(_q[3]);
|
||||
axis = Vec3(_q[0], _q[1], _q[2]);
|
||||
const FT sinus = axis.length();
|
||||
if (sinus > 1E-8)
|
||||
axis = axis / sinus;
|
||||
|
||||
if (angle > M_PI) {
|
||||
angle = 2.0*M_PI - angle;
|
||||
axis = -axis;
|
||||
}
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
typename Quat<FT>::Vec3 Quat<FT>::axis() const
|
||||
{
|
||||
Vec3 res(_q[0], _q[1], _q[2]);
|
||||
const FT sinus = res.length();
|
||||
if (sinus > 1E-8)
|
||||
res = res / sinus;
|
||||
|
||||
// The normalize() is here to prevent failure introduced by numerical error.
|
||||
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
|
||||
if (_q[3] > FT(1)) {
|
||||
const_cast<Quat*>(this)->normalize();
|
||||
}
|
||||
return (std::acos(_q[3]) <= M_PI / 2.0) ? res : -res;
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
FT Quat<FT>::angle() const
|
||||
{
|
||||
// The normalize() is here to prevent failure introduced by numerical error.
|
||||
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
|
||||
if (_q[3] > FT(1)) {
|
||||
const_cast<Quat*>(this)->normalize();
|
||||
}
|
||||
const FT angle = FT(2.0) * std::acos(_q[3]);
|
||||
return (angle <= M_PI) ? angle : FT(2.0*M_PI - angle);
|
||||
}
|
||||
|
||||
|
||||
//Mat4 quat_to_matrix(const Quat& q)
|
||||
//{
|
||||
// Mat4 M;
|
||||
//
|
||||
// const double x = q.vector()[0];
|
||||
// const double y = q.vector()[1];
|
||||
// const double z = q.vector()[2];
|
||||
// const double w = q.scalar();
|
||||
// const double s = 2 / norm(q);
|
||||
//
|
||||
// M(0, 0) = 1 - s*(y*y + z*z); M(0, 1) = s*(x*y - w*z); M(0, 2) = s*(x*z + w*y); M(0, 3) = 0;
|
||||
// M(1, 0) = s*(x*y + w*z); M(1, 1) = 1 - s*(x*x + z*z); M(1, 2) = s*(y*z - w*x); M(1, 3) = 0;
|
||||
// M(2, 0) = s*(x*z - w*y); M(2, 1) = s*(y*z + w*x); M(2, 2) = 1 - s*(x*x + y*y); M(2, 3) = 0;
|
||||
// M(3, 0) = 0; M(3, 1) = 0; M(3, 2) = 0; M(3, 3) = 1;
|
||||
//
|
||||
// return M;
|
||||
//}
|
||||
//
|
||||
//Mat4 unit_quat_to_matrix(const Quat& q)
|
||||
//{
|
||||
// Mat4 M;
|
||||
//
|
||||
// const double x = q.vector()[0];
|
||||
// const double y = q.vector()[1];
|
||||
// const double z = q.vector()[2];
|
||||
// const double w = q.scalar();
|
||||
//
|
||||
// M(0, 0) = 1 - 2 * (y*y + z*z); M(0, 1) = 2 * (x*y - w*z); M(0, 2) = 2 * (x*z + w*y); M(0, 3) = 0;
|
||||
// M(1, 0) = 2 * (x*y + w*z); M(1, 1) = 1 - 2 * (x*x + z*z); M(1, 2) = 2 * (y*z - w*x); M(1, 3) = 0;
|
||||
// M(2, 0) = 2 * (x*z - w*y); M(2, 1) = 2 * (y*z + w*x); M(2, 2) = 1 - 2 * (x*x + y*y); M(2, 3) = 0;
|
||||
// M(3, 0) = 0; M(3, 1) = 0; M(3, 2) = 0; M(3, 3) = 1;
|
||||
//
|
||||
// return M;
|
||||
//}
|
||||
|
||||
|
||||
template <typename FT>
|
||||
Mat4<FT> Quat<FT>::matrix() const
|
||||
{
|
||||
const FT q00 = FT(2.0l * _q[0] * _q[0]);
|
||||
const FT q11 = FT(2.0l * _q[1] * _q[1]);
|
||||
const FT q22 = FT(2.0l * _q[2] * _q[2]);
|
||||
|
||||
const FT q01 = FT(2.0l * _q[0] * _q[1]);
|
||||
const FT q02 = FT(2.0l * _q[0] * _q[2]);
|
||||
const FT q03 = FT(2.0l * _q[0] * _q[3]);
|
||||
|
||||
const FT q12 = FT(2.0l * _q[1] * _q[2]);
|
||||
const FT q13 = FT(2.0l * _q[1] * _q[3]);
|
||||
|
||||
const FT q23 = FT(2.0l * _q[2] * _q[3]);
|
||||
|
||||
Mat4<FT> m;
|
||||
m(0, 0) = FT(1.0) - q11 - q22;
|
||||
m(0, 1) = q01 - q23;
|
||||
m(0, 2) = q02 + q13;
|
||||
|
||||
m(1, 0) = q01 + q23;
|
||||
m(1, 1) = FT(1.0) - q22 - q00;
|
||||
m(1, 2) = q12 - q03;
|
||||
|
||||
m(2, 0) = q02 - q13;
|
||||
m(2, 1) = q12 + q03;
|
||||
m(2, 2) = FT(1.0) - q11 - q00;
|
||||
|
||||
m(3, 0) = FT(0.0);
|
||||
m(3, 1) = FT(0.0);
|
||||
m(3, 2) = FT(0.0);
|
||||
|
||||
m(0, 3) = FT(0.0);
|
||||
m(1, 3) = FT(0.0);
|
||||
m(2, 3) = FT(0.0);
|
||||
m(3, 3) = FT(1.0);
|
||||
|
||||
return m;
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Mat4<FT> Quat<FT>::inverse_matrix() const
|
||||
{
|
||||
return inverse().matrix();
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::slerp(const Quat<FT>& a, const Quat<FT>& b, FT t, bool allowFlip)
|
||||
{
|
||||
FT cosAngle = Quat<FT>::dot(a, b);
|
||||
|
||||
FT c1, c2;
|
||||
// Linear interpolation for close orientations
|
||||
if ((1.0 - std::fabs(cosAngle)) < 0.01)
|
||||
{
|
||||
c1 = FT(1.0) - t;
|
||||
c2 = t;
|
||||
}
|
||||
else
|
||||
{
|
||||
// Spherical interpolation
|
||||
FT angle = std::acos(std::fabs(cosAngle));
|
||||
FT sinAngle = std::sin(angle);
|
||||
c1 = std::sin(angle * (1.0 - t)) / sinAngle;
|
||||
c2 = std::sin(angle * t) / sinAngle;
|
||||
}
|
||||
|
||||
// Use the shortest path
|
||||
if (allowFlip && (cosAngle < 0.0))
|
||||
c1 = -c1;
|
||||
|
||||
return Quat(c1*a[0] + c2*b[0], c1*a[1] + c2*b[1], c1*a[2] + c2*b[2], c1*a[3] + c2*b[3]);
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::squad(const Quat<FT>& a, const Quat<FT>& tgA, const Quat<FT>& tgB, const Quat<FT>& b, FT t)
|
||||
{
|
||||
Quat<FT> ab = Quat<FT>::slerp(a, b, t);
|
||||
Quat<FT> tg = Quat<FT>::slerp(tgA, tgB, t, false);
|
||||
return Quat<FT>::slerp(ab, tg, 2.0*t*(1.0 - t), false);
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::log()
|
||||
{
|
||||
FT len = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2]);
|
||||
|
||||
if (len < 1E-6)
|
||||
return Quat(_q[0], _q[1], _q[2], 0.0);
|
||||
else
|
||||
{
|
||||
// The normalize() is here to prevent failure introduced by numerical error.
|
||||
// We call std::acos(_q[3]), but _q[3] equaling to 1 can actually be e.g., 1.00000012.
|
||||
if (_q[3] > FT(1)) {
|
||||
const_cast<Quat*>(this)->normalize();
|
||||
} FT coef = std::acos(_q[3]) / len;
|
||||
return Quat(_q[0] * coef, _q[1] * coef, _q[2] * coef, 0.0);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::exp()
|
||||
{
|
||||
FT theta = std::sqrt(_q[0] * _q[0] + _q[1] * _q[1] + _q[2] * _q[2]);
|
||||
|
||||
if (theta < 1E-6)
|
||||
return Quat(_q[0], _q[1], _q[2], std::cos(theta));
|
||||
else
|
||||
{
|
||||
FT coef = std::sin(theta) / theta;
|
||||
return Quat(_q[0] * coef, _q[1] * coef, _q[2] * coef, std::cos(theta));
|
||||
}
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::ln_dif(const Quat& a, const Quat& b)
|
||||
{
|
||||
Quat<FT> dif = a.inverse()*b;
|
||||
dif.normalize();
|
||||
return dif.log();
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::squad_tangent(const Quat<FT>& before, const Quat<FT>& center, const Quat<FT>& after)
|
||||
{
|
||||
Quat<FT> l1 = Quat<FT>::ln_dif(center, before);
|
||||
Quat<FT> l2 = Quat<FT>::ln_dif(center, after);
|
||||
Quat<FT> e;
|
||||
for (int i = 0; i < 4; ++i)
|
||||
e._q[i] = -0.25 * (l1._q[i] + l2._q[i]);
|
||||
e = center*(e.exp());
|
||||
|
||||
// if (Quat<FT>::dot(e,b) < 0.0)
|
||||
// e.negate();
|
||||
|
||||
return e;
|
||||
}
|
||||
|
||||
template <typename FT>
|
||||
Quat<FT> Quat<FT>::random_quat()
|
||||
{
|
||||
// The rand() function is not very portable and may not be available on your system.
|
||||
// Add the appropriate include or replace by an other random function in case of problem.
|
||||
FT seed = rand() / (FT)RAND_MAX;
|
||||
FT r1 = std::sqrt(1.0f - seed);
|
||||
FT r2 = std::sqrt(seed);
|
||||
FT t1 = 2.0f * M_PI * (rand() / (FT)RAND_MAX);
|
||||
FT t2 = 2.0f * M_PI * (rand() / (FT)RAND_MAX);
|
||||
return Quat(std::sin(t1)*r1, std::cos(t1)*r1, std::sin(t2)*r2, std::cos(t2)*r2);
|
||||
}
|
||||
|
||||
template <typename FT> inline
|
||||
std::ostream& operator<<(std::ostream& os, const Quat<FT>& Q)
|
||||
{
|
||||
return os << Q[0] << ' ' << Q[1] << ' ' << Q[2] << ' ' << Q[3];
|
||||
}
|
||||
|
||||
template <typename FT> inline
|
||||
std::istream& operator>>(std::istream& is, Quat<FT>& Q) {
|
||||
return is >> Q[0] >> Q[1] >> Q[2] >> Q[3];
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_QUATERNION_H
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_RANDOM_H
|
||||
#define EASY3D_RANDOM_H
|
||||
|
||||
#include <random>
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
/* Random real in [0, 1]. */
|
||||
inline float random_float() {
|
||||
return float(std::rand()) / float(RAND_MAX);
|
||||
}
|
||||
|
||||
/* Random real number in the range [min, max] */
|
||||
inline float random_float(float min, float max) {
|
||||
return min + random_float() * (max - min);
|
||||
}
|
||||
|
||||
inline vec3 random_color(bool allow_dark = false) {
|
||||
float min_rgb = 0.3f;
|
||||
if (allow_dark)
|
||||
min_rgb = 0.0f;
|
||||
|
||||
return vec3(
|
||||
random_float(min_rgb, 1.0f),
|
||||
random_float(min_rgb, 1.0f),
|
||||
random_float(min_rgb, 1.0f)
|
||||
);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_RANDOM_H
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_RECTANGLE_H
|
||||
#define EASY3D_RECTANGLE_H
|
||||
|
||||
#include <algorithm>
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
// Seems duplicating 2D bounding box?
|
||||
|
||||
template <typename FT>
|
||||
class GenericRect {
|
||||
public:
|
||||
GenericRect(const Vec<2, FT>& p, const Vec<2, FT>& q) {
|
||||
x_min_ = std::min(q.x, p.x);
|
||||
y_min_ = std::min(q.y, p.y);
|
||||
x_max_ = std::max(q.x, p.x);
|
||||
y_max_ = std::max(q.x, p.y);
|
||||
|
||||
}
|
||||
|
||||
GenericRect(FT xmin, FT xmax, FT ymin, FT ymax)
|
||||
: x_min_(xmin)
|
||||
, x_max_(xmax)
|
||||
, y_min_(ymin)
|
||||
, y_max_(ymax)
|
||||
{
|
||||
}
|
||||
|
||||
FT x_min() const { return x_min_; }
|
||||
FT y_min() const { return y_min_; }
|
||||
FT x_max() const { return x_max_; }
|
||||
FT y_max() const { return y_max_; }
|
||||
|
||||
FT x() const { return x_min_; }
|
||||
FT y() const { return y_min_; }
|
||||
FT width() const { return x_max() - x_min(); }
|
||||
FT height() const { return y_max() - y_min(); }
|
||||
|
||||
FT left() const { return x_min_; }
|
||||
FT top() const { return y_min_; }
|
||||
FT right() const { return x_max_; }
|
||||
FT bottom() const { return y_max_; }
|
||||
|
||||
Vec<2, FT> top_left() const { return Vec<2, FT>(x_min_, y_min_); }
|
||||
Vec<2, FT> bottom_right() const { return Vec<2, FT>(x_max_, y_max_); }
|
||||
Vec<2, FT> top_right() const { return Vec<2, FT>(x_max_, y_min_); }
|
||||
Vec<2, FT> bottom_left() const { return Vec<2, FT>(x_min_, y_max_); }
|
||||
|
||||
Vec<2, FT> min() const { return Vec<2, FT>(x_min_, y_min_); }
|
||||
Vec<2, FT> max() const { return Vec<2, FT>(x_max_, y_max_); }
|
||||
Vec<2, FT> center() const {
|
||||
return Vec<2, FT>(FT(0.5) * (x_max() + x_min()), FT(0.5) * (y_max() + y_min()));
|
||||
}
|
||||
|
||||
private:
|
||||
FT x_min_;
|
||||
FT y_min_;
|
||||
FT x_max_;
|
||||
FT y_max_;
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_RECTANGLE_H
|
||||
|
|
@ -0,0 +1,116 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_SEGMENT_H
|
||||
#define EASY3D_SEGMENT_H
|
||||
|
||||
|
||||
#include <algorithm>
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
#include <easy3d/core/line.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
template <int DIM, typename FT>
|
||||
class GenericSegment {
|
||||
public:
|
||||
typedef Vec<DIM, FT> Point;
|
||||
typedef Vec<DIM, FT> Vector;
|
||||
typedef GenericLine<DIM, FT> Line;
|
||||
typedef GenericSegment<DIM, FT> thisclass;
|
||||
|
||||
public:
|
||||
GenericSegment(const Point& s, const Point& t);
|
||||
GenericSegment() {}
|
||||
|
||||
const Point& source() const { return s_; }
|
||||
const Point& target() const { return t_; }
|
||||
void set_source(const Point& s) { s_ = s; }
|
||||
void set_target(const Point& t) { t_ = t; }
|
||||
|
||||
Line supporting_line() const { return Line::from_two_points(s_, t_); }
|
||||
|
||||
Vector to_vector() const { return t_ - s_; }
|
||||
|
||||
// the projection of p on the supporting line
|
||||
Point projection(const Point &p) const;
|
||||
|
||||
// test if the projection of p is inside the two end points
|
||||
bool projected_inside(const Point& p) const;
|
||||
|
||||
FT squared_ditance(const Point &p) const;
|
||||
|
||||
private:
|
||||
Point s_;
|
||||
Point t_;
|
||||
};
|
||||
|
||||
|
||||
|
||||
template<int DIM, typename FT> inline
|
||||
GenericSegment<DIM, FT>::GenericSegment(const Point& s, const Point& t) : s_(s), t_(t) {
|
||||
#ifndef NDEBUG // degenerate case
|
||||
if (distance2(s, t) < 1e-15) {
|
||||
std::cerr << "degenerate segment constructed from 2 points:" << std::endl
|
||||
<< "\t(" << s << ")" << std::endl
|
||||
<< "\t(" << t << ")" << std::endl;
|
||||
}
|
||||
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
template<int DIM, typename FT> inline
|
||||
typename GenericSegment<DIM, FT>::Point GenericSegment<DIM, FT>::projection(const Point &p) const {
|
||||
Vector dir = normalize(t_ - s_);
|
||||
return (s_ + dir * dot(p - s_, dir));
|
||||
}
|
||||
|
||||
|
||||
template<int DIM, typename FT> inline
|
||||
bool GenericSegment<DIM, FT>::projected_inside(const Point& p) const {
|
||||
return (dot(s_ - p, t_ - p) < 0);
|
||||
}
|
||||
|
||||
|
||||
template<int DIM, typename FT> inline
|
||||
FT GenericSegment<DIM, FT>::squared_ditance(const Point &p) const {
|
||||
if (projected_inside(p))
|
||||
return distance2(projection(p), p);
|
||||
else {
|
||||
FT ds = distance2(s_, p);
|
||||
FT dt = distance2(t_, p);
|
||||
return std::min(ds, dt);
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#endif // EASY3D_SEGMENT_H
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -0,0 +1,228 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_TYPES_H
|
||||
#define EASY3D_TYPES_H
|
||||
|
||||
#include <cstdint>
|
||||
|
||||
#include <easy3d/core/vec.h>
|
||||
#include <easy3d/core/mat.h>
|
||||
#include <easy3d/core/rect.h>
|
||||
#include <easy3d/core/line.h>
|
||||
#include <easy3d/core/segment.h>
|
||||
#include <easy3d/core/plane.h>
|
||||
#include <easy3d/core/box.h>
|
||||
#include <easy3d/core/quat.h>
|
||||
|
||||
|
||||
/**
|
||||
* Gathers different basic types for geometric operations.
|
||||
* Types defined here are points/vectors, lines, segments,
|
||||
* planes, boxes and matrices in 2D and 3D.
|
||||
*/
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
//____________________ default types___________________
|
||||
|
||||
typedef Vec<2, float> vec2;
|
||||
typedef Vec<3, float> vec3;
|
||||
typedef Vec<4, float> vec4;
|
||||
|
||||
typedef Vec<2, double> dvec2;
|
||||
typedef Vec<3, double> dvec3;
|
||||
typedef Vec<4, double> dvec4;
|
||||
|
||||
typedef Vec<2, int32_t> ivec2;
|
||||
typedef Vec<3, int32_t> ivec3;
|
||||
typedef Vec<4, int32_t> ivec4;
|
||||
|
||||
typedef Mat2<float> mat2;
|
||||
typedef Mat3<float> mat3;
|
||||
typedef Mat4<float> mat4;
|
||||
typedef Mat<3, 4, float> mat34;
|
||||
typedef Mat<4, 3, float> mat43;
|
||||
|
||||
typedef Mat2<double> dmat2;
|
||||
typedef Mat3<double> dmat3;
|
||||
typedef Mat4<double> dmat4;
|
||||
typedef Mat<3, 4, double> dmat34;
|
||||
typedef Mat<4, 3, double> dmat43;
|
||||
|
||||
typedef Quat<float> quat;
|
||||
typedef Quat<double> dquat;
|
||||
|
||||
typedef GenericLine<2, float> Line2;
|
||||
typedef GenericLine<3, float> Line3;
|
||||
|
||||
typedef GenericSegment<2, float> Segment2;
|
||||
typedef GenericSegment<3, float> Segment3;
|
||||
|
||||
typedef GenericPlane<float> Plane3;
|
||||
|
||||
typedef GenericBox<2, float> Box2;
|
||||
typedef GenericBox<3, float> Box3;
|
||||
|
||||
typedef GenericRect<float> Rect;
|
||||
typedef GenericRect<int32_t> iRect;
|
||||
|
||||
|
||||
namespace geom {
|
||||
|
||||
/* Returns a vector orthogonal to v. Its norm() depends on v, but is zero only for a null v.*/
|
||||
inline vec3 orthogonal(const vec3& v) {
|
||||
float absx = std::fabs(v.x);
|
||||
float absy = std::fabs(v.y);
|
||||
float absz = std::fabs(v.z);
|
||||
// Find smallest component. Keep equal case for null values.
|
||||
if ((absy >= absx) && (absz >= absx))
|
||||
return vec3(0.0, -v.z, v.y);
|
||||
else {
|
||||
if ((absx >= absy) && (absz >= absy))
|
||||
return vec3(-v.z, 0.0f, v.x);
|
||||
else
|
||||
return vec3(-v.y, v.x, 0.0f);
|
||||
}
|
||||
}
|
||||
|
||||
// bounding box for 3D/2D point set
|
||||
template <typename Box, typename InputIterator >
|
||||
inline Box bounding_box(InputIterator first, InputIterator last) {
|
||||
assert(first != last);
|
||||
Box result;
|
||||
for (InputIterator it = first; it != last; ++it) {
|
||||
result.add_point(*it);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
// centroid for 3D/2D point set
|
||||
template <typename Vec, typename InputIterator >
|
||||
inline Vec centroid(InputIterator begin, InputIterator end) {
|
||||
assert(begin != end);
|
||||
Vec v;
|
||||
unsigned int nb_pts = 0;
|
||||
for (InputIterator it = begin; it != end; ++it) {
|
||||
v += (*it);
|
||||
++nb_pts;
|
||||
}
|
||||
return v / nb_pts;
|
||||
}
|
||||
|
||||
template < typename Vec >
|
||||
inline Vec barycenter(const Vec& p1, const Vec& p2) {
|
||||
return (p1 + p2) * 0.5f;
|
||||
}
|
||||
|
||||
template < typename Vec >
|
||||
inline Vec barycenter(const Vec& p1, const Vec& p2, const Vec& p3) {
|
||||
return (p1 + p2 + p3) / 3.0f;
|
||||
}
|
||||
|
||||
template < typename Vec >
|
||||
inline Vec barycenter(const Vec& p1, const Vec& p2, const Vec& p3, const Vec& p4) {
|
||||
return (p1 + p2 + p3 + p4) * 0.25f;
|
||||
}
|
||||
|
||||
inline float cos_angle(const vec3& a, const vec3& b) {
|
||||
float na2 = length2(a);
|
||||
float nb2 = length2(b);
|
||||
return dot(a, b) / ::sqrt(na2 * nb2);
|
||||
}
|
||||
|
||||
inline float angle(const vec3& a, const vec3& b) {
|
||||
return std::acos(cos_angle(a, b));
|
||||
}
|
||||
|
||||
|
||||
inline float cos_angle(const vec2& a, const vec2& b) {
|
||||
float na2 = length2(a);
|
||||
float nb2 = length2(b);
|
||||
return dot(a, b) / std::sqrt(na2 * nb2);
|
||||
}
|
||||
|
||||
inline float det(const vec2& a, const vec2& b) {
|
||||
return a.x*b.y - a.y*b.x;
|
||||
}
|
||||
|
||||
/* returns the angle in the interval [-pi .. pi] */
|
||||
inline float angle(const vec2& a, const vec2& b) {
|
||||
return det(a, b) > 0 ?
|
||||
std::acos(cos_angle(a, b)) :
|
||||
-std::acos(cos_angle(a, b));
|
||||
}
|
||||
|
||||
// round the given floating point number v to be num_digits.
|
||||
// TODO: this function should not be in this file.
|
||||
template <class T>
|
||||
T truncate_digits(const T& v, int num_digits) {
|
||||
T tmp = std::pow(10.0f, num_digits);
|
||||
long long des = static_cast<long long>((v < 0) ? (v * tmp - 0.5f) : (v * tmp + 0.5f));
|
||||
T result = T(des) / tmp;
|
||||
return result;
|
||||
}
|
||||
|
||||
// radians
|
||||
template <typename T>
|
||||
inline T to_radians(T degrees) {
|
||||
return degrees * static_cast<T>(0.01745329251994329576923690768489);
|
||||
}
|
||||
|
||||
|
||||
// degrees
|
||||
template <typename T>
|
||||
inline T to_degrees(T radians) {
|
||||
return radians * static_cast<T>(57.295779513082320876798154814105);
|
||||
}
|
||||
|
||||
|
||||
inline float triangle_area(
|
||||
const vec3& p1, const vec3& p2, const vec3& p3
|
||||
) {
|
||||
return 0.5f * length(cross(p2 - p1, p3 - p1));
|
||||
}
|
||||
|
||||
inline float triangle_signed_area(
|
||||
const vec2& p1, const vec2& p2, const vec2& p3
|
||||
) {
|
||||
return 0.5f * det(p2 - p1, p3 - p1);
|
||||
}
|
||||
|
||||
inline vec3 triangle_normal(
|
||||
const vec3& p1, const vec3& p2, const vec3& p3
|
||||
) {
|
||||
vec3 n = cross(p2 - p1, p3 - p2);
|
||||
return normalize(n);
|
||||
}
|
||||
|
||||
} // namespace Geom
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_TYPES_H
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,745 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_VEC_H
|
||||
#define EASY3D_VEC_H
|
||||
|
||||
#include <cassert>
|
||||
#include <iostream>
|
||||
#include <cmath>
|
||||
#include <cfloat>
|
||||
#include <limits>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
#if 1
|
||||
template <size_t N, class T>
|
||||
class Vec {
|
||||
public:
|
||||
typedef Vec<N, T> thisclass;
|
||||
|
||||
Vec() { for (size_t i = 0; i < N; i++) { data_[i] = T(0); } }
|
||||
|
||||
explicit Vec(const T& s) { for (size_t i = 0; i < N; i++) { data_[i] = s; } }
|
||||
|
||||
// This one should never be called : a template constructor cannot be a copy constructor
|
||||
template<class T2> explicit Vec(const Vec<N, T2>& rhs) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] = T(rhs[i]);
|
||||
}
|
||||
}
|
||||
|
||||
// to avoid compilation problems
|
||||
template<class T2, size_t M> explicit Vec(const Vec<M, T2>& rhs) {
|
||||
assert(M == N);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] = T(rhs[i]);
|
||||
}
|
||||
}
|
||||
template<class T2> explicit Vec(const T2* rhs) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] = T(rhs[i]);
|
||||
}
|
||||
}
|
||||
|
||||
thisclass& operator=(const thisclass& rhs) {
|
||||
memcpy(data_, rhs.data(), N*sizeof(T));
|
||||
return *this;
|
||||
}
|
||||
|
||||
size_t dimension() const { return (size_t)N; }
|
||||
size_t size() const { return dimension(); }
|
||||
|
||||
// returns the memory address of the vector.
|
||||
T* data() { return data_; }
|
||||
const T* data() const { return data_; }
|
||||
|
||||
// Conversion operator returning the memory address of the data.
|
||||
// Very convenient to pass the data pointer as a parameter to functions.
|
||||
// e.g., glVertex3fv(pos);
|
||||
operator const T*() const { return data_; }
|
||||
operator T*() { return data_; }
|
||||
|
||||
inline T& operator[](int idx) {
|
||||
assert(idx < N);
|
||||
return data()[idx];
|
||||
}
|
||||
|
||||
inline const T& operator[](int idx) const {
|
||||
assert(idx < N);
|
||||
return data()[idx];
|
||||
}
|
||||
|
||||
inline T length2() const {
|
||||
T result = T(0);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result += data_[i] * data_[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
inline T length() const {
|
||||
return sqrt(length2());
|
||||
}
|
||||
|
||||
inline T norm() const {
|
||||
return length();
|
||||
}
|
||||
|
||||
inline T distance2(const thisclass &rhs) const {
|
||||
T result = T(0);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
T val = rhs.data_[i] - data_[i];
|
||||
result += val*val;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
inline thisclass& normalize() {
|
||||
T s = length();
|
||||
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
|
||||
*this *= s;
|
||||
return *this;
|
||||
}
|
||||
|
||||
// operators
|
||||
inline thisclass& operator+=(const thisclass& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] += v.data_[i];
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
inline thisclass& operator-=(const thisclass& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] -= v.data_[i];
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
inline thisclass& operator*=(const thisclass& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] *= v.data_[i];
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
inline thisclass& operator/=(const thisclass& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] /= v.data_[i];
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
template <class T2> inline thisclass& operator*=(T2 s) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] *= T(s);
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
template <class T2> inline thisclass& operator/=(T2 s) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
data_[i] /= T(s);
|
||||
}
|
||||
return *this;
|
||||
}
|
||||
|
||||
inline thisclass operator+ (const thisclass& v) const {
|
||||
thisclass result(*this);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result.data_[i] += v.data_[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
inline thisclass operator- (const thisclass& v) const {
|
||||
thisclass result(*this);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result.data_[i] -= v.data_[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <class T2> inline thisclass operator* (T2 s) const {
|
||||
thisclass result(*this);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result.data_[i] *= T(s);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <class T2> inline thisclass operator/ (T2 s) const {
|
||||
thisclass result(*this);
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result.data_[i] /= T(s);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
inline thisclass operator- () const {
|
||||
thisclass result;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result.data_[i] = -data_[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
|
||||
private:
|
||||
T data_[N];
|
||||
};
|
||||
|
||||
|
||||
template <size_t N, class T> inline T dot(const Vec<N, T>& v1, const Vec<N, T>& v2) {
|
||||
T result = 0;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result += v1[i] * v2[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <size_t N, class T> inline Vec<N, T> operator-(const Vec<N, T>& v1) {
|
||||
Vec<N, T> result;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result[i] = -v1[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <class T2, size_t N, class T> inline Vec<N, T> operator*(T2 s, const Vec<N, T>& v) {
|
||||
Vec<N, T> result;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result[i] = T(s)*v[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <size_t N, class T> inline Vec<N, T> operator+(const Vec<N, T>& v1, const Vec<N, T>& v2) {
|
||||
Vec<N, T> result;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result[i] = v1[i] + v2[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
template <size_t N, class T> inline Vec<N, T> operator-(const Vec<N, T>& v1, const Vec<N, T>& v2) {
|
||||
Vec<N, T> result;
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
result[i] = v1[i] - v2[i];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
// Compatibility with GLSL
|
||||
template <size_t N, class T> inline T length(const Vec<N, T>& v) { return v.length(); }
|
||||
template <size_t N, class T> inline T norm(const Vec<N, T>& v) { return v.length(); }
|
||||
template <size_t N, class T> inline T length2(const Vec<N, T>& v) { return v.length2(); }
|
||||
template <size_t N, class T> inline T distance(const Vec<N, T>& v1, const Vec<N, T>& v2) { return length(v2 - v1); }
|
||||
template <size_t N, class T> inline T distance2(const Vec<N, T>& v1, const Vec<N, T>& v2) { return v2.distance2(v1); }
|
||||
template <size_t N, class T> inline Vec<N, T> normalize(const Vec<N, T>& v) {
|
||||
T s = v.length();
|
||||
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
|
||||
return v * s;
|
||||
}
|
||||
|
||||
// linear interpolation between x and y using a to weight between them.
|
||||
// The return value is computed as (1 − w) * v1 + w * v2.
|
||||
template <size_t N, class T> inline Vec<N, T> mix(const Vec<N, T>& v1, const Vec<N, T>& v2, T w) {
|
||||
return (T(1) - w) * v1 + w * v2;
|
||||
}
|
||||
|
||||
//-------------------- vec2 -------------------------------------------------------------------
|
||||
|
||||
template <class T>
|
||||
class Vec<2, T> {
|
||||
public:
|
||||
typedef Vec<2, T> thisclass;
|
||||
|
||||
Vec() : x(0), y(0) { }
|
||||
Vec(T x_in, T y_in) : x(x_in), y(y_in) { }
|
||||
Vec(const Vec<3, T>& v) : x(v.x), y(v.y) { } // very useful for inverse promoting from homogeneous coordinates
|
||||
|
||||
explicit Vec(const T& s) : x(s), y(s) { }
|
||||
|
||||
template<class T2> explicit Vec(const Vec<2, T2> & v)
|
||||
: x(v.x), y(v.y) {}
|
||||
|
||||
template<class T2> explicit Vec(const T2* v)
|
||||
: x(T(v[0])), y(T(v[1])) {}
|
||||
|
||||
|
||||
inline T length2() const { return x*x + y*y; }
|
||||
inline T length() const { return std::sqrt(x*x + y*y); }
|
||||
inline T norm() const { return length(); }
|
||||
inline T distance2(const thisclass& rhs) const {
|
||||
T dx = rhs.x - x;
|
||||
T dy = rhs.y - y;
|
||||
return dx*dx + dy*dy;
|
||||
}
|
||||
|
||||
inline thisclass& normalize() {
|
||||
T s = length();
|
||||
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
|
||||
*this *= s;
|
||||
return *this;
|
||||
}
|
||||
|
||||
// operators
|
||||
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; return *this; }
|
||||
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; return *this; }
|
||||
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; return *this; }
|
||||
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; return *this; }
|
||||
template <class T2> inline thisclass& operator*=(T2 s) { x *= T(s); y *= T(s); return *this; }
|
||||
template <class T2> inline thisclass& operator/=(T2 s) { x /= T(s); y /= T(s); return *this; }
|
||||
|
||||
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y); }
|
||||
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y); }
|
||||
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s)); }
|
||||
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s)); }
|
||||
inline thisclass operator- () const { return thisclass(-x, -y); }
|
||||
|
||||
size_t dimension() const { return (size_t)2; }
|
||||
size_t size() const { return dimension(); }
|
||||
|
||||
T* data() { return _array; }
|
||||
const T* data() const { return _array; }
|
||||
|
||||
// Conversion operator returning the memory address of the data.
|
||||
// Very convenient to pass the data pointer as a parameter to functions.
|
||||
// e.g., glVertex2fv(pos);
|
||||
operator const T*() const { return _array; }
|
||||
operator T*() { return _array; }
|
||||
|
||||
inline T& operator[](int idx) {
|
||||
assert(idx < 2);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
inline const T& operator[](int idx) const {
|
||||
assert(idx < 2);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
//data intentionally left public to allow vec.x
|
||||
union {
|
||||
struct { T x, y; }; // standard names for components
|
||||
struct { T u, v; }; // standard names for components
|
||||
T _array[2]; // array access
|
||||
};
|
||||
};
|
||||
|
||||
template <class T> inline T dot(const Vec<2, T>& v1, const Vec<2, T>& v2) { return v1.x*v2.x + v1.y*v2.y; }
|
||||
|
||||
template <class T> inline T det(const Vec<2, T>& v1, const Vec<2, T>& v2) {
|
||||
return v1.x*v2.y - v1.y*v2.x;
|
||||
}
|
||||
|
||||
|
||||
template <class T> inline Vec<2, T> operator-(const Vec<2, T>& v1) {
|
||||
return Vec<2, T>(-v1.x, -v1.y);
|
||||
}
|
||||
template <class T2, class T> inline Vec<2, T> operator*(T2 s, const Vec<2, T>& v) {
|
||||
return Vec<2, T>(T(s)*v.x, T(s)*v.y);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<2, T> operator+(const Vec<2, T>& v1, const Vec<2, T>& v2) {
|
||||
return Vec<2, T>(v1.x + v2.x, v1.y + v2.y);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<2, T> operator-(const Vec<2, T>& v1, const Vec<2, T>& v2) {
|
||||
return Vec<2, T>(v1.x - v2.x, v1.y - v2.y);
|
||||
}
|
||||
|
||||
|
||||
//---------------- vec3 ------------------------------------------------------------------------
|
||||
|
||||
template <class T>
|
||||
class Vec<3, T> {
|
||||
public:
|
||||
typedef Vec<3, T> thisclass;
|
||||
|
||||
Vec() : x(0), y(0), z(0) {}
|
||||
Vec(const Vec<2, T>& v, const T& s = 0) : x(v.x), y(v.y), z(s) {} // very useful for promoting to homogeneous coordinates
|
||||
Vec(const Vec<4, T>& v) : x(v.x), y(v.y), z(v.z) {} // very useful for inverse promoting from homogeneous coordinates
|
||||
|
||||
Vec(T x_in, T y_in, T z_in) : x(x_in), y(y_in), z(z_in) {}
|
||||
|
||||
explicit Vec(const T& s) : x(s), y(s), z(s) { }
|
||||
|
||||
template<class T2> explicit Vec(const Vec<3, T2> & v) : x(v.x), y(v.y), z(v.z) {}
|
||||
template<class T2> explicit Vec(const T2* v)
|
||||
: x(T(v[0])), y(T(v[1])), z(T(v[2])) {}
|
||||
|
||||
inline T length2() const { return x*x + y*y + z*z; }
|
||||
inline T length() const { return std::sqrt(x*x + y*y + z*z); }
|
||||
inline T norm() const { return length(); }
|
||||
inline T distance2(const thisclass& rhs) const {
|
||||
T dx = rhs.x - x;
|
||||
T dy = rhs.y - y;
|
||||
T dz = rhs.z - z;
|
||||
return dx*dx + dy*dy + dz*dz;
|
||||
}
|
||||
|
||||
inline thisclass& normalize() {
|
||||
T s = length();
|
||||
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
|
||||
*this *= s;
|
||||
return *this;
|
||||
}
|
||||
|
||||
// operators
|
||||
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; z += v.z; return *this; }
|
||||
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; z -= v.z; return *this; }
|
||||
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; z *= v.z; return *this; }
|
||||
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; z /= v.z; return *this; }
|
||||
template <class T2> inline thisclass& operator*=(T2 s) { x *= T(s); y *= T(s); z *= T(s); return *this; }
|
||||
template <class T2> inline thisclass& operator/=(T2 s) { x /= T(s); y /= T(s); z /= T(s); return *this; }
|
||||
|
||||
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y, z + v.z); }
|
||||
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y, z - v.z); }
|
||||
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s), z*T(s)); }
|
||||
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s), z / T(s)); }
|
||||
|
||||
inline thisclass operator- () const { return thisclass(-x, -y, -z); }
|
||||
|
||||
size_t dimension() const { return (size_t)3; }
|
||||
size_t size() const { return dimension(); }
|
||||
|
||||
T* data() { return _array; }
|
||||
const T* data() const { return _array; }
|
||||
|
||||
// Conversion operator returning the memory address of the data.
|
||||
// Very convenient to pass the data pointer as a parameter to functions.
|
||||
// ------------
|
||||
// vec3 pos, normal;
|
||||
// glNormal3fv(normal);
|
||||
// glVertex3fv(pos);
|
||||
// ------------
|
||||
operator const T*() const { return _array; }
|
||||
operator T*() { return _array; }
|
||||
|
||||
inline T& operator[](int idx) {
|
||||
assert(idx < 3);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
inline const T& operator[](int idx) const {
|
||||
assert(idx < 3);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
//data intentionally left public to allow vec.x
|
||||
union {
|
||||
struct { T x, y, z; }; // standard names for components
|
||||
struct { T u, v, w; }; // standard names for components
|
||||
struct { T r, g, b; }; // standard names for components
|
||||
T _array[3]; // array access
|
||||
};
|
||||
};
|
||||
|
||||
template <class T> inline T dot(const Vec<3, T>& v1, const Vec<3, T>& v2) {
|
||||
return v1.x*v2.x + v1.y*v2.y + v1.z*v2.z;
|
||||
}
|
||||
|
||||
template <class T> inline Vec<3, T> cross(const Vec<3, T>& v1, const Vec<3, T>& v2) {
|
||||
return Vec<3, T>(
|
||||
v1.y*v2.z - v1.z*v2.y,
|
||||
v1.z*v2.x - v1.x*v2.z,
|
||||
v1.x*v2.y - v1.y*v2.x
|
||||
);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<3, T> operator-(const Vec<3, T>& v1) { return Vec<3, T>(-v1.x, -v1.y, -v1.z); }
|
||||
template <class T2, class T> inline Vec<3, T> operator*(T2 s, const Vec<3, T>& v) {
|
||||
return Vec<3, T>(T(s)*v.x, T(s)*v.y, T(s)*v.z);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<3, T> operator+(const Vec<3, T>& v1, const Vec<3, T>& v2) {
|
||||
return Vec<3, T>(v1.x + v2.x, v1.y + v2.y, v1.z + v2.z);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<3, T> operator-(const Vec<3, T>& v1, const Vec<3, T>& v2) {
|
||||
return Vec<3, T>(v1.x - v2.x, v1.y - v2.y, v1.z - v2.z);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<3, T> orthogonal(const Vec<3, T>& v) {
|
||||
T absx = ::fabs(v.x);
|
||||
T absy = ::fabs(v.y);
|
||||
T absz = ::fabs(v.z);
|
||||
// Find smallest component. Keep equal case for null values.
|
||||
if ((absy >= absx) && (absz >= absx))
|
||||
return Vec<3, T>(0.0, -v.z, v.y);
|
||||
else
|
||||
if ((absx >= absy) && (absz >= absy))
|
||||
return Vec<3, T>(-v.z, 0.0f, v.x);
|
||||
else
|
||||
return Vec<3, T>(-v.y, v.x, 0.0f);
|
||||
}
|
||||
|
||||
// ----------------- vec4 ----------------------------------------------------------------------------------
|
||||
|
||||
template <class T>
|
||||
class Vec<4, T> {
|
||||
public:
|
||||
typedef Vec<4, T> thisclass;
|
||||
|
||||
Vec() : x(0), y(0), z(0), w(0) {}
|
||||
Vec(const Vec<3, T>& v, const T& s = 0) : x(v.x), y(v.y), z(v.z), w(s) {} // very useful for promoting to homogeneous coordinates
|
||||
Vec(T x_in, T y_in, T z_in, T w_in) : x(x_in), y(y_in), z(z_in), w(w_in) {}
|
||||
|
||||
explicit Vec(const T& s) : x(s), y(s), z(s), w(s) { }
|
||||
|
||||
template<class T2> explicit Vec(const Vec<4, T2> & v)
|
||||
: x(v.x), y(v.y), z(v.z), w(v.w) {}
|
||||
template<class T2> explicit Vec(const T2* v)
|
||||
: x(v[0]), y(v[1]), z(v[2]), w(v[3]) {}
|
||||
|
||||
inline T length2() const { return x*x + y*y + z*z + w*w; }
|
||||
inline T length() const { return std::sqrt(x*x + y*y + z*z + w*w); }
|
||||
inline T norm() const { return length(); }
|
||||
inline T distance2(const thisclass& rhs) const {
|
||||
T dx = rhs.x - x;
|
||||
T dy = rhs.y - y;
|
||||
T dz = rhs.z - z;
|
||||
T dw = rhs.w - w;
|
||||
return dx*dx + dy*dy + dz*dz + dw*dw;
|
||||
}
|
||||
|
||||
inline thisclass& normalize() {
|
||||
T s = length();
|
||||
s = (s > std::numeric_limits<T>::min()) ? T(1.0) / s : T(0.0);
|
||||
*this *= s;
|
||||
return *this;
|
||||
}
|
||||
|
||||
size_t dimension() const { return (size_t)4; }
|
||||
size_t size() const { return dimension(); }
|
||||
|
||||
// operators
|
||||
inline thisclass& operator+=(const thisclass& v) { x += v.x; y += v.y; z += v.z; w += v.w; return *this; }
|
||||
inline thisclass& operator-=(const thisclass& v) { x -= v.x; y -= v.y; z -= v.z; w -= v.w; return *this; }
|
||||
inline thisclass& operator*=(const thisclass& v) { x *= v.x; y *= v.y; z *= v.z; w *= v.w; return *this; }
|
||||
inline thisclass& operator/=(const thisclass& v) { x /= v.x; y /= v.y; z /= v.z; w /= v.w; return *this; }
|
||||
template <class T2> inline thisclass& operator*=(T2 s) {
|
||||
x *= T(s); y *= T(s); z *= T(s); w *= T(s); return *this;
|
||||
}
|
||||
template <class T2> inline thisclass& operator/=(T2 s) {
|
||||
x /= T(s); y /= T(s); z /= T(s); w /= T(s); return *this;
|
||||
}
|
||||
inline thisclass operator+ (const thisclass& v) const { return thisclass(x + v.x, y + v.y, z + v.z, w + v.w); }
|
||||
inline thisclass operator- (const thisclass& v) const { return thisclass(x - v.x, y - v.y, z - v.z, w - v.w); }
|
||||
template <class T2> inline thisclass operator* (T2 s) const { return thisclass(x*T(s), y*T(s), z*T(s), w*T(s)); }
|
||||
template <class T2> inline thisclass operator/ (T2 s) const { return thisclass(x / T(s), y / T(s), z / T(s), w / T(s)); }
|
||||
inline thisclass operator- () const { return thisclass(-x, -y, -z, -w); }
|
||||
|
||||
T* data() { return _array; }
|
||||
const T* data() const { return _array; }
|
||||
|
||||
// Conversion operator returning the memory address of the data.
|
||||
// Very convenient to pass the data pointer as a parameter to functions.
|
||||
// e.g., glColor4fv(c);
|
||||
operator const T*() const { return _array; }
|
||||
operator T*() { return _array; }
|
||||
|
||||
inline T& operator[](int idx) {
|
||||
assert(idx < 4);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
inline const T& operator[](int idx) const {
|
||||
assert(idx < 4);
|
||||
return _array[idx];
|
||||
}
|
||||
|
||||
//data intentionally left public to allow vec.x
|
||||
union {
|
||||
struct { T x, y, z, w; }; // standard names for components
|
||||
struct { T r, g, b, a; }; // standard names for components
|
||||
T _array[4]; // array access
|
||||
};
|
||||
};
|
||||
|
||||
template <class T> inline T dot(const Vec<4, T>& v1, const Vec<4, T>& v2) {
|
||||
return v1.x*v2.x + v1.y*v2.y + v1.z*v2.z + v1.w*v2.w;
|
||||
}
|
||||
|
||||
template <class T> inline Vec<4, T> operator-(const Vec<4, T>& v1) { return Vec<4, T>(-v1.x, -v1.y, -v1.z, -v1.w); }
|
||||
template <class T2, class T> inline Vec<4, T> operator*(T2 s, const Vec<4, T>& v) {
|
||||
return Vec<4, T>(T(s)*v.x, T(s)*v.y, T(s)*v.z, T(s)*v.w);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<4, T> operator+(const Vec<4, T>& v1, const Vec<4, T>& v2) {
|
||||
return Vec<4, T>(v1.x + v2.x, v1.y + v2.y, v1.z + v2.z, v1.w + v2.w);
|
||||
}
|
||||
|
||||
template <class T> inline Vec<4, T> operator-(const Vec<4, T>& v1, const Vec<4, T>& v2) {
|
||||
return Vec<4, T>(v1.x - v2.x, v1.y - v2.y, v1.z - v2.z, v1.w - v2.w);
|
||||
}
|
||||
|
||||
|
||||
template <size_t N, class T>
|
||||
inline bool has_nan(const Vec<N, T> &v) {
|
||||
for (std::size_t i = 0; i < N; ++i) {
|
||||
if (std::isnan(v[i]) || std::isinf(v[i]))
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
//------------------------------- IO (input/output) ----------------------------
|
||||
|
||||
template <size_t N, class T> inline std::ostream& operator<<(std::ostream& out, const Vec<N, T>& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
out << v[i] << " ";
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
template <size_t N, class T> inline std::istream& operator>>(std::istream& in, Vec<N, T>& v) {
|
||||
for (size_t i = 0; i < N; i++) {
|
||||
in >> v[i];
|
||||
}
|
||||
return in;
|
||||
}
|
||||
|
||||
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<2, T>& v) {
|
||||
return out << v.x << " " << v.y;
|
||||
}
|
||||
|
||||
template <class T> inline std::istream& operator>>(std::istream& in, Vec<2, T>& v) {
|
||||
return in >> v.x >> v.y;
|
||||
}
|
||||
|
||||
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<3, T>& v) {
|
||||
return out << v.x << " " << v.y << " " << v.z;
|
||||
}
|
||||
|
||||
template <class T> inline std::istream& operator>>(std::istream& in, Vec<3, T>& v) {
|
||||
return in >> v.x >> v.y >> v.z;
|
||||
}
|
||||
|
||||
template <class T> inline std::ostream& operator<<(std::ostream& out, const Vec<4, T>& v) {
|
||||
return out << v.x << " " << v.y << " " << v.z << " " << v.w;
|
||||
}
|
||||
|
||||
template <class T> inline std::istream& operator>>(std::istream& in, Vec<4, T>& v) {
|
||||
return in >> v.x >> v.y >> v.z >> v.w;
|
||||
}
|
||||
|
||||
|
||||
#else
|
||||
|
||||
|
||||
template <size_t DIM, typename T> struct Vec {
|
||||
Vec() { for (size_t i=DIM; i--; data_[i] = T()); }
|
||||
T& operator[](const size_t i) { assert(i<DIM); return data_[i]; }
|
||||
const T& operator[](const size_t i) const { assert(i<DIM); return data_[i]; }
|
||||
private:
|
||||
T data_[DIM];
|
||||
};
|
||||
|
||||
typedef Vec<2, float> vec2;
|
||||
typedef Vec<3, float> vec3;
|
||||
typedef Vec<3, int > vec3i;
|
||||
typedef Vec<4, float> vec4;
|
||||
|
||||
template <typename T> struct Vec<2,T> {
|
||||
Vec() : x(T()), y(T()) {}
|
||||
Vec(T X, T Y) : x(X), y(Y) {}
|
||||
template <class U> Vec<2,T>(const Vec<2,U> &v);
|
||||
T& operator[](const size_t i) { assert(i<2); return i<=0 ? x : y; }
|
||||
const T& operator[](const size_t i) const { assert(i<2); return i<=0 ? x : y; }
|
||||
T x,y;
|
||||
};
|
||||
|
||||
template <typename T> struct Vec<3,T> {
|
||||
Vec() : x(T()), y(T()), z(T()) {}
|
||||
Vec(T X, T Y, T Z) : x(X), y(Y), z(Z) {}
|
||||
T& operator[](const size_t i) { assert(i<3); return i<=0 ? x : (1==i ? y : z); }
|
||||
const T& operator[](const size_t i) const { assert(i<3); return i<=0 ? x : (1==i ? y : z); }
|
||||
float norm() { return std::sqrt(x*x+y*y+z*z); }
|
||||
Vec<3,T> & normalize(T l=1) { *this = (*this)*(l/norm()); return *this; }
|
||||
T x,y,z;
|
||||
};
|
||||
|
||||
template <typename T> struct Vec<4,T> {
|
||||
Vec() : x(T()), y(T()), z(T()), w(T()) {}
|
||||
Vec(T X, T Y, T Z, T W) : x(X), y(Y), z(Z), w(W) {}
|
||||
T& operator[](const size_t i) { assert(i<4); return i<=0 ? x : (1==i ? y : (2==i ? z : w)); }
|
||||
const T& operator[](const size_t i) const { assert(i<4); return i<=0 ? x : (1==i ? y : (2==i ? z : w)); }
|
||||
T x,y,z,w;
|
||||
};
|
||||
|
||||
template<size_t DIM,typename T> T operator*(const Vec<DIM,T>& lhs, const Vec<DIM,T>& rhs) {
|
||||
T ret = T();
|
||||
for (size_t i=DIM; i--; ret+=lhs[i]*rhs[i]);
|
||||
return ret;
|
||||
}
|
||||
|
||||
template<size_t DIM,typename T>Vec<DIM,T> operator+(Vec<DIM,T> lhs, const Vec<DIM,T>& rhs) {
|
||||
for (size_t i=DIM; i--; lhs[i]+=rhs[i]);
|
||||
return lhs;
|
||||
}
|
||||
|
||||
template<size_t DIM,typename T>Vec<DIM,T> operator-(Vec<DIM,T> lhs, const Vec<DIM,T>& rhs) {
|
||||
for (size_t i=DIM; i--; lhs[i]-=rhs[i]);
|
||||
return lhs;
|
||||
}
|
||||
|
||||
template<size_t DIM,typename T,typename U> Vec<DIM,T> operator*(const Vec<DIM,T> &lhs, const U& rhs) {
|
||||
Vec<DIM,T> ret;
|
||||
for (size_t i=DIM; i--; ret[i]=lhs[i]*rhs);
|
||||
return ret;
|
||||
}
|
||||
|
||||
template<size_t DIM,typename T> Vec<DIM,T> operator-(const Vec<DIM,T> &lhs) {
|
||||
return lhs*T(-1);
|
||||
}
|
||||
|
||||
|
||||
template<size_t DIM,typename T> T dot(const Vec<DIM,T>& lhs, const Vec<DIM,T>& rhs) {
|
||||
T ret = T();
|
||||
for (size_t i=DIM; i--; ret+=lhs[i]*rhs[i]);
|
||||
return ret;
|
||||
}
|
||||
|
||||
template <typename T> Vec<3,T> cross(Vec<3,T> v1, Vec<3,T> v2) {
|
||||
return Vec<3,T>(v1.y*v2.z - v1.z*v2.y, v1.z*v2.x - v1.x*v2.z, v1.x*v2.y - v1.y*v2.x);
|
||||
}
|
||||
|
||||
template <size_t DIM, typename T> std::ostream& operator<<(std::ostream& out, const Vec<DIM,T>& v) {
|
||||
for(unsigned int i=0; i<DIM; i++) out << v[i] << " " ;
|
||||
return out ;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_VEC_H
|
||||
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
|
||||
set(PROJECT_NAME easy3d_${MODULE_NAME})
|
||||
project(${PROJECT_NAME})
|
||||
|
||||
|
||||
set(${PROJECT_NAME}_HEADERS
|
||||
graph_io.h
|
||||
ply_reader_writer.h
|
||||
point_cloud_io.h
|
||||
surface_mesh_io.h
|
||||
|
||||
)
|
||||
|
||||
set(${PROJECT_NAME}_SOURCES
|
||||
graph_io.cpp
|
||||
graph_io_ply.cpp
|
||||
ply_reader_writer.cpp
|
||||
point_cloud_io.cpp
|
||||
point_cloud_io_xyz.cpp
|
||||
surface_mesh_io.cpp
|
||||
surface_mesh_io_obj.cpp
|
||||
)
|
||||
|
||||
|
||||
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS} )
|
||||
|
||||
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
|
||||
|
||||
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
|
||||
|
||||
target_link_libraries(${PROJECT_NAME} easy3d_core 3rd_rply easy3d_util)
|
||||
|
||||
if (MSVC)
|
||||
target_compile_definitions(${PROJECT_NAME} PRIVATE _CRT_SECURE_NO_DEPRECATE)
|
||||
endif()
|
||||
|
|
@ -0,0 +1,124 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/graph_io.h>
|
||||
|
||||
#include <clocale>
|
||||
|
||||
#include <easy3d/core/graph.h>
|
||||
#include <easy3d/util/file_system.h>
|
||||
#include <easy3d/util/stop_watch.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
Graph* GraphIO::load(const std::string& file_name)
|
||||
{
|
||||
std::setlocale(LC_NUMERIC, "C");
|
||||
|
||||
Graph* graph = new Graph;
|
||||
graph->set_name(file_name);
|
||||
|
||||
StopWatch w;
|
||||
bool success = false;
|
||||
|
||||
const std::string& ext = file_system::extension(file_name, true);
|
||||
if (ext == "ply")
|
||||
success = io::load_ply(file_name, graph);
|
||||
else if (ext.empty()){
|
||||
std::cerr << "unknown file format: no extention" << ext << std::endl;
|
||||
success = false;
|
||||
}
|
||||
else {
|
||||
std::cerr << "unknown file format: " << ext << ". Only PLY format is supported for Graph" << ext << std::endl;
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
if (!success || graph->n_vertices() == 0) {
|
||||
delete graph;
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
|
||||
#ifndef NDEBUG
|
||||
std::cout << "vertex properties on graph " << file_system::simple_name(file_name) << std::endl;
|
||||
const auto& vnames = graph->vertex_properties();
|
||||
for (const auto& n : vnames)
|
||||
std::cout << "\t" << n << std::endl;
|
||||
|
||||
std::cout << "edge properties on graph " << file_system::simple_name(file_name) << std::endl;
|
||||
const auto& enames = graph->edge_properties();
|
||||
for (const auto& n : enames)
|
||||
std::cout << "\t" << n << std::endl;
|
||||
#endif
|
||||
|
||||
if (success)
|
||||
std::cout << "load model done. time: " << w.time_string() << std::endl;
|
||||
else
|
||||
std::cout << "load model failed" << std::endl;
|
||||
|
||||
return graph;
|
||||
}
|
||||
|
||||
|
||||
bool GraphIO::save(const std::string& file_name, const Graph* graph)
|
||||
{
|
||||
if (!graph || graph->vertices_size() == 0) {
|
||||
std::cerr << "graph is null" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
StopWatch w;
|
||||
bool success = false;
|
||||
|
||||
std::string final_name = file_name;
|
||||
const std::string& ext = file_system::extension(file_name, true);
|
||||
|
||||
if (ext == "ply" || ext.empty()) {
|
||||
if (ext.empty()) {
|
||||
std::cerr << "No extention specified. Default to ply" << ext << std::endl;
|
||||
final_name = final_name + ".ply";
|
||||
}
|
||||
success = io::save_ply(final_name, graph, true);
|
||||
}
|
||||
else {
|
||||
std::cerr << "unknown file format: " << ext << ". Only PLY format is supported for Graph" << ext << std::endl;
|
||||
success = false;
|
||||
}
|
||||
|
||||
if (success) {
|
||||
std::cout << "save model done. time: " << w.time_string() << std::endl;
|
||||
return true;
|
||||
}
|
||||
else {
|
||||
std::cout << "save model failed" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_FILEIO_GRAPH_IO_H
|
||||
#define EASY3D_FILEIO_GRAPH_IO_H
|
||||
|
||||
|
||||
#include <string>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
class Graph;
|
||||
|
||||
// TODO: add a general purpose file format 'map' capable of storing
|
||||
// point clouds, graphs, and meshes with arbitrary types of
|
||||
// properties (similar to PLY, each property is read/written
|
||||
// as a whole. Check PLY and POLY formats as reference.
|
||||
// When this is done, I don't need BIN and POLY any more).
|
||||
|
||||
|
||||
class GraphIO
|
||||
{
|
||||
public:
|
||||
// return nullptr if failed. Currently only PLY format is supported.
|
||||
static Graph* load(const std::string& file_name);
|
||||
|
||||
// save the graph to a file. return false if failed.
|
||||
static bool save(const std::string& file_name, const Graph* graph);
|
||||
};
|
||||
|
||||
namespace io {
|
||||
|
||||
bool load_ply(const std::string& file_name, Graph* graph);
|
||||
bool save_ply(const std::string& file_name, const Graph* graph, bool binary = true);
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
#endif // EASY3D_FILEIO_GRAPH_IO_H
|
||||
|
|
@ -0,0 +1,271 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/graph_io.h>
|
||||
#include <easy3d/fileio/ply_reader_writer.h>
|
||||
#include <easy3d/core/graph.h>
|
||||
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace io {
|
||||
|
||||
|
||||
namespace details {
|
||||
|
||||
template <typename PropertyT>
|
||||
inline bool extract_named_property(std::vector<PropertyT>& properties, PropertyT& wanted, const std::string& name) {
|
||||
typename std::vector< PropertyT >::iterator it = properties.begin();
|
||||
for (; it != properties.end(); ++it) {
|
||||
const PropertyT& prop = *it;
|
||||
if (prop.name == name) {
|
||||
wanted = prop;
|
||||
properties.erase(it);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
template <typename T, typename PropertyT>
|
||||
inline void add_vertex_properties(Graph* graph, const std::vector<PropertyT>& properties)
|
||||
{
|
||||
for (const auto& p : properties) {
|
||||
std::string name = p.name;
|
||||
if (p.size() != graph->vertices_size()) {
|
||||
std::cerr << "vertex property size (" << p.size() << ") does not match number of vertices (" << graph->vertices_size() << ")" << std::endl;
|
||||
continue;
|
||||
}
|
||||
if (name.find("v:") == std::string::npos)
|
||||
name = "v:" + name;
|
||||
auto prop = graph->vertex_property<T>(name);
|
||||
prop.vector() = p;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename T, typename PropertyT>
|
||||
inline void add_edge_properties(Graph* graph, const std::vector<PropertyT>& properties)
|
||||
{
|
||||
for (const auto& p : properties) {
|
||||
std::string name = p.name;
|
||||
if (p.size() != graph->edges_size()) {
|
||||
std::cerr << "edge property size (" << p.size() << ") does not match number of edges (" << graph->edges_size() << ")" << std::endl;
|
||||
continue;
|
||||
}
|
||||
if (name.find("e:") == std::string::npos)
|
||||
name = "e:" + name;
|
||||
auto prop = graph->edge_property<T>(name);
|
||||
prop.vector() = p;
|
||||
}
|
||||
}
|
||||
|
||||
} // namespace details
|
||||
|
||||
|
||||
bool load_ply(const std::string& file_name, Graph* graph)
|
||||
{
|
||||
if (!graph) {
|
||||
std::cerr << "null graph pointer" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
std::vector<Element> elements;
|
||||
PlyReader reader;
|
||||
if (!reader.read(file_name, elements))
|
||||
return false;
|
||||
|
||||
Vec3Property coordinates;
|
||||
IntListProperty edge_vertex_indices;
|
||||
|
||||
for (std::size_t i = 0; i < elements.size(); ++i) {
|
||||
Element& e = elements[i];
|
||||
if (e.name == "vertex") {
|
||||
if (details::extract_named_property(e.vec3_properties, coordinates, "point"))
|
||||
continue;
|
||||
else {
|
||||
std::cerr << "vertex coordinates (x, y, z properties) do not exist" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else if (e.name == "edge") {
|
||||
if (details::extract_named_property(e.int_list_properties, edge_vertex_indices, "vertex_indices"))
|
||||
continue;
|
||||
else {
|
||||
std::cerr << "edge properties might not be parsed correctly because \'vertex_indices\' does not defined on edges" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
for (auto p : coordinates)
|
||||
graph->add_vertex(p);
|
||||
|
||||
for (auto e : edge_vertex_indices) {
|
||||
if (e.size() == 2)
|
||||
graph->add_edge(Graph::Vertex(e[0]), Graph::Vertex(e[1]));
|
||||
else {
|
||||
std::cerr << "The size of edge property \'vertex_indices\' is not 2" << std::endl;
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
// now let's add the properties
|
||||
for (std::size_t i = 0; i < elements.size(); ++i) {
|
||||
Element& e = elements[i];
|
||||
if (e.name == "vertex") {
|
||||
details::add_vertex_properties<vec3>(graph, e.vec3_properties);
|
||||
details::add_vertex_properties<float>(graph, e.float_properties);
|
||||
details::add_vertex_properties<int>(graph, e.int_properties);
|
||||
details::add_vertex_properties< std::vector<int> >(graph, e.int_list_properties);
|
||||
details::add_vertex_properties< std::vector<float> >(graph, e.float_list_properties);
|
||||
}
|
||||
else if (e.name == "face")
|
||||
std::cerr << "The Graph has face information (ignored). Is it a mesh?" << std::endl;
|
||||
else if (e.name == "edge") {
|
||||
details::add_edge_properties<vec3>(graph, e.vec3_properties);
|
||||
details::add_edge_properties<float>(graph, e.float_properties);
|
||||
details::add_edge_properties<int>(graph, e.int_properties);
|
||||
details::add_edge_properties< std::vector<int> >(graph, e.int_list_properties);
|
||||
details::add_edge_properties< std::vector<float> >(graph, e.float_list_properties);
|
||||
}
|
||||
else
|
||||
std::cerr << "The Graph has unknown element: " << e.name << " (ignored)" << std::endl;
|
||||
}
|
||||
|
||||
return graph->n_vertices() > 0;
|
||||
}
|
||||
|
||||
|
||||
namespace details {
|
||||
|
||||
|
||||
template <typename T>
|
||||
inline void collect_vertex_properties(const Graph* graph, std::vector< GenericProperty<T> >& properties) {
|
||||
const auto& all_properties = graph->vertex_properties();
|
||||
for (auto name : all_properties) {
|
||||
auto prop = graph->get_vertex_property<T>(name);
|
||||
if (prop) {
|
||||
if (name.substr(0, 2) == "v:")
|
||||
name = name.substr(2, name.length() - 1);
|
||||
GenericProperty<T> p("vertex", name, prop.vector());
|
||||
properties.push_back(p);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
template <typename T>
|
||||
inline void collect_edge_properties(const Graph* graph, std::vector< GenericProperty<T> >& properties) {
|
||||
const auto& all_properties = graph->edge_properties();
|
||||
for (auto name : all_properties) {
|
||||
auto prop = graph->get_edge_property<T>(name);
|
||||
if (prop) {
|
||||
if (name.substr(0, 2) == "e:")
|
||||
name = name.substr(2, name.length() - 1);
|
||||
GenericProperty<T> p("edge", name, prop.vector());
|
||||
properties.push_back(p);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
} // namespace details
|
||||
|
||||
|
||||
bool save_ply(const std::string& file_name, const Graph* graph, bool binary) {
|
||||
if (!graph || graph->n_vertices() == 0) {
|
||||
std::cerr << "empty graph data" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
dvec3 p0(0.0f, 0.0f, 0.0f);
|
||||
auto offset = graph->get_model_property<easy3d::dvec3>("translation");
|
||||
if (offset)
|
||||
p0 = offset[0];
|
||||
|
||||
std::vector<Element> elements;
|
||||
|
||||
//-----------------------------------------------------
|
||||
|
||||
// element vertex
|
||||
Element element_vertex("vertex", graph->n_vertices());
|
||||
|
||||
// v:point
|
||||
auto vertices = graph->get_vertex_property<vec3>("v:point");
|
||||
GenericProperty<vec3> points("vertex", "point", vertices.vector());
|
||||
for (auto& p : points)
|
||||
p += vec3(p0.x, p0.y, p0.z);
|
||||
element_vertex.vec3_properties.push_back(points);
|
||||
std::cout << "graph model translated by [" << p0 << "]" << std::endl;
|
||||
|
||||
// attributes defined on element "vertex"
|
||||
details::collect_vertex_properties(graph, element_vertex.float_properties);
|
||||
details::collect_vertex_properties(graph, element_vertex.int_properties);
|
||||
details::collect_vertex_properties(graph, element_vertex.int_list_properties);
|
||||
details::collect_vertex_properties(graph, element_vertex.float_list_properties);
|
||||
|
||||
elements.emplace_back(element_vertex);
|
||||
|
||||
//-----------------------------------------------------
|
||||
|
||||
// element edge
|
||||
Element element_edge("edge", graph->n_edges());
|
||||
|
||||
// vertex_indices
|
||||
IntListProperty edge_vertex_indices;
|
||||
edge_vertex_indices.name = "vertex_indices";
|
||||
edge_vertex_indices.reserve(graph->edges_size());
|
||||
for (auto e : graph->edges()) {
|
||||
int id0 = graph->from_vertex(e).idx();
|
||||
int id1 = graph->to_vertex(e).idx();
|
||||
edge_vertex_indices.push_back({ id0, id1 });
|
||||
}
|
||||
element_edge.int_list_properties.emplace_back(edge_vertex_indices);
|
||||
|
||||
// attributes defined on element "edge"
|
||||
details::collect_edge_properties(graph, element_edge.vec3_properties);
|
||||
details::collect_edge_properties(graph, element_edge.float_properties);
|
||||
details::collect_edge_properties(graph, element_edge.int_properties);
|
||||
details::collect_edge_properties(graph, element_edge.int_list_properties);
|
||||
details::collect_edge_properties(graph, element_edge.float_list_properties);
|
||||
|
||||
elements.emplace_back(element_edge);
|
||||
|
||||
//-----------------------------------------------------
|
||||
|
||||
if (!binary)
|
||||
std::cout << "TODO: use binary format" << std::endl;
|
||||
|
||||
PlyWriter writer;
|
||||
return writer.write(file_name, elements, "Saved by Liangliang Nan (liangliang.nan@gmail.com)", binary);
|
||||
}
|
||||
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3
|
||||
|
|
@ -0,0 +1,570 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/ply_reader_writer.h>
|
||||
|
||||
#include <cstring>
|
||||
#include <iostream>
|
||||
|
||||
#include <3rd_party/rply/rply.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace io {
|
||||
|
||||
|
||||
#define VERTEX "vertex"
|
||||
#define FACE "face"
|
||||
#define EDGE "edge"
|
||||
|
||||
|
||||
bool PlyWriter::is_big_endian() {
|
||||
const int i = 1;
|
||||
const char *p = reinterpret_cast<const char *>(&i);
|
||||
if (p[0] == 1) // Lowest address contains the least significant byte
|
||||
return false; // LITTLE_ENDIAN
|
||||
else
|
||||
return true; // BIG_ENDIAN
|
||||
}
|
||||
|
||||
|
||||
bool PlyWriter::write(
|
||||
const std::string& file_name,
|
||||
const std::vector<Element>& elements,
|
||||
const std::string& comment /* = "" */,
|
||||
bool binary /* = false */) const
|
||||
{
|
||||
e_ply_storage_mode mode = PLY_DEFAULT;
|
||||
if (binary) {
|
||||
if (is_big_endian())
|
||||
mode = PLY_BIG_ENDIAN;
|
||||
else
|
||||
mode = PLY_LITTLE_ENDIAN;
|
||||
}
|
||||
else
|
||||
mode = PLY_ASCII;
|
||||
|
||||
p_ply ply = ply_create(file_name.c_str(), mode, nullptr, 0, nullptr);
|
||||
if (!ply) {
|
||||
std::cerr << "failed to create ply file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (!ply_add_comment(ply, "Saved by Easy3D (Contact: liangliang.nan@gmail.com)")) {
|
||||
std::cerr << "failed to add comment" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
if (!comment.empty() && !ply_add_comment(ply, comment.c_str())) {
|
||||
std::cerr << "failed to add comment" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
|
||||
// For most scenarios (e.g., num of vertices in a face), PLY_UCHAR is enough: [0, 255].
|
||||
// But I want to store segmentation information (e.g., the vertex indices), which
|
||||
// requires a large integers, so I choose unsigned int.
|
||||
e_ply_type length_type = PLY_UINT32;
|
||||
|
||||
for (std::size_t i = 0; i < elements.size(); ++i) {
|
||||
const std::string& element_name = elements[i].name;
|
||||
const std::size_t num = elements[i].num_instances;
|
||||
|
||||
// add elements
|
||||
if (!ply_add_element(ply, element_name.data(), static_cast<long>(num))) {
|
||||
std::cerr << "failed to add element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
|
||||
//-------------------------------------------
|
||||
// add properties
|
||||
|
||||
// int list properties
|
||||
const std::vector< IntListProperty >& int_list_properties = elements[i].int_list_properties;
|
||||
for (std::size_t j = 0; j < int_list_properties.size(); ++j) {
|
||||
const std::string& name = int_list_properties[j].name;
|
||||
if (!ply_add_property(ply, name.data(), PLY_LIST, length_type, PLY_INT)) {
|
||||
std::cerr << "failed to add property \'" << name << "\' for element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
// float list properties
|
||||
const std::vector< FloatListProperty >& float_list_properties = elements[i].float_list_properties;
|
||||
for (std::size_t j = 0; j < float_list_properties.size(); ++j) {
|
||||
const std::string& name = float_list_properties[j].name;
|
||||
if (!ply_add_property(ply, name.data(), PLY_LIST, length_type, PLY_FLOAT)) {
|
||||
std::cerr << "failed to add property \'" << name << "\' for element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
// vector properties
|
||||
const std::vector< Vec3Property >& vector_properties = elements[i].vec3_properties;
|
||||
for (std::size_t j = 0; j < vector_properties.size(); ++j) {
|
||||
const std::string& name = vector_properties[j].name;
|
||||
|
||||
std::string names[3];
|
||||
if (name == "point") {
|
||||
names[0] = "x"; names[1] = "y"; names[2] = "z";
|
||||
}
|
||||
else if (name == "normal") {
|
||||
names[0] = "nx"; names[1] = "ny"; names[2] = "nz";
|
||||
}
|
||||
else if (name == "color") {
|
||||
names[0] = "r"; names[1] = "g"; names[2] = "b";
|
||||
}
|
||||
else {
|
||||
names[0] = name + "_x"; names[1] = name + "_y"; names[2] = name + "_z";
|
||||
}
|
||||
|
||||
for (std::size_t k = 0; k < 3; ++k) {
|
||||
if (!ply_add_property(ply, names[k].data(), PLY_FLOAT, length_type, PLY_FLOAT)) {
|
||||
std::cerr << "failed to add property \'" << names[k] << "\' for element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
const std::vector< FloatProperty >& float_properties = elements[i].float_properties;
|
||||
for (std::size_t j = 0; j < float_properties.size(); ++j) {
|
||||
const std::string& name = float_properties[j].name;
|
||||
if (!ply_add_property(ply, name.data(), PLY_FLOAT, length_type, PLY_FLOAT)) {
|
||||
std::cerr << "failed to add property \'" << name << "\' for element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
const std::vector< IntProperty >& int_properties = elements[i].int_properties;
|
||||
for (std::size_t j = 0; j < int_properties.size(); ++j) {
|
||||
const std::string& name = int_properties[j].name;
|
||||
if (!ply_add_property(ply, name.data(), PLY_INT, length_type, PLY_INT)) {
|
||||
std::cerr << "failed to add property \'" << name << "\' for element \'" << element_name << "\'" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// write output header
|
||||
if (!ply_write_header(ply))
|
||||
return false;
|
||||
|
||||
for (std::size_t i = 0; i < elements.size(); ++i) {
|
||||
const std::size_t num = elements[i].num_instances;
|
||||
|
||||
for (std::size_t j = 0; j < num; ++j) {
|
||||
const std::vector< IntListProperty >& int_list_properties = elements[i].int_list_properties;
|
||||
for (std::size_t k = 0; k < int_list_properties.size(); ++k) {
|
||||
const std::vector<int>& values = int_list_properties[k][j];
|
||||
ply_write(ply, static_cast<double>(values.size()));
|
||||
for (std::size_t m = 0; m < values.size(); ++m)
|
||||
ply_write(ply, values[m]);
|
||||
}
|
||||
|
||||
const std::vector< FloatListProperty >& float_list_properties = elements[i].float_list_properties;
|
||||
for (std::size_t k = 0; k < float_list_properties.size(); ++k) {
|
||||
const std::vector<float>& values = float_list_properties[k][j];
|
||||
ply_write(ply, static_cast<double>(values.size()));
|
||||
for (std::size_t m = 0; m < values.size(); ++m)
|
||||
ply_write(ply, static_cast<double>(values[m]));
|
||||
}
|
||||
|
||||
const std::vector< Vec3Property >& vec3_properties = elements[i].vec3_properties;
|
||||
for (std::size_t k = 0; k < vec3_properties.size(); ++k) {
|
||||
const std::vector<vec3>& values = vec3_properties[k];
|
||||
const vec3& v = values[j];
|
||||
ply_write(ply, static_cast<double>(v.x));
|
||||
ply_write(ply, static_cast<double>(v.y));
|
||||
ply_write(ply, static_cast<double>(v.z));
|
||||
}
|
||||
|
||||
const std::vector< FloatProperty >& float_properties = elements[i].float_properties;
|
||||
for (std::size_t k = 0; k < float_properties.size(); ++k) {
|
||||
const std::vector<float>& values = float_properties[k];
|
||||
ply_write(ply, static_cast<double>(values[j]));
|
||||
}
|
||||
|
||||
const std::vector< IntProperty >& int_properties = elements[i].int_properties;
|
||||
for (std::size_t k = 0; k < int_properties.size(); ++k) {
|
||||
const std::vector<int>& values = int_properties[k];
|
||||
ply_write(ply, static_cast<double>(values[j]));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// close up, we are done
|
||||
if (!ply_close(ply)) {
|
||||
std::cerr << "failed to close the ply file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
bool PlyReader::read(const std::string& file_name, std::vector<Element>& elements)
|
||||
{
|
||||
p_ply ply = ply_open(file_name.c_str(), nullptr, 0, nullptr);
|
||||
if (!ply) {
|
||||
std::cerr << "failed to open ply file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
if (!ply_read_header(ply)) {
|
||||
std::cerr << "failed to read ply header" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
|
||||
// setup callbacks
|
||||
auto callback_value_property = [](p_ply_argument argument) -> int {
|
||||
long instance_index = 0; // the index of the current element instance
|
||||
ply_get_argument_element(argument, nullptr, &instance_index);
|
||||
|
||||
ValueProperty* prop_ptr = nullptr;
|
||||
ply_get_argument_user_data(argument, (void**)(&prop_ptr), nullptr);
|
||||
|
||||
auto& prop = *prop_ptr;
|
||||
prop[instance_index] = ply_get_argument_value(argument);
|
||||
|
||||
return 1;
|
||||
};
|
||||
|
||||
auto callback_list_property = [](p_ply_argument argument) -> int {
|
||||
long instance_index = 0; // the index of the current element instance
|
||||
ply_get_argument_element(argument, nullptr, &instance_index);
|
||||
|
||||
long length = 0, value_index = 0;
|
||||
ply_get_argument_property(argument, nullptr, &length, &value_index);
|
||||
if (value_index < 0 || value_index >= length) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
ListProperty* prop_ptr = nullptr;
|
||||
ply_get_argument_user_data(argument, (void**)(&prop_ptr), nullptr);
|
||||
|
||||
auto& prop = *prop_ptr;
|
||||
auto& entry = prop[instance_index];
|
||||
if (entry.empty())
|
||||
entry.resize(length);
|
||||
entry[value_index] = ply_get_argument_value(argument);
|
||||
|
||||
return 1;
|
||||
};
|
||||
|
||||
p_ply_element element = nullptr;
|
||||
/* iterate over all elements in input file */
|
||||
while ((element = ply_get_next_element(ply, element))) {
|
||||
long num_instances = 0;
|
||||
const char *element_name = nullptr;
|
||||
ply_get_element_info(element, &element_name, &num_instances);
|
||||
if (num_instances <= 0)
|
||||
continue;
|
||||
|
||||
p_ply_property property = nullptr;
|
||||
/* iterate over all properties of current element */
|
||||
while ((property = ply_get_next_property(element, property))) {
|
||||
const char *property_name = nullptr;
|
||||
e_ply_type type, length_type, value_type;
|
||||
ply_get_property_info(property, &property_name, &type, &length_type, &value_type);
|
||||
|
||||
if (strcmp(element_name, VERTEX) && strcmp(element_name, FACE) && strcmp(element_name, EDGE)) {
|
||||
std::cerr << "unknown element type: " << element_name << std::endl;
|
||||
continue;
|
||||
}
|
||||
|
||||
// It is possible to save all properties as PLY_LIST of value type double. This allows me to use
|
||||
// the same callback function to handle all the properties. But the performance is low. So I handle
|
||||
// list properties and value properties separately.
|
||||
if (type == PLY_LIST) {
|
||||
ListProperty* prop = new ListProperty;
|
||||
prop->element_name = element_name;
|
||||
prop->name = property_name;
|
||||
prop->orig_value_type = value_type;
|
||||
prop->resize(num_instances);
|
||||
list_properties_.push_back(prop);
|
||||
if (!ply_set_read_cb(ply, element_name, property_name, callback_list_property, prop, 0)) {
|
||||
std::cerr << "failed to set callback for list property of \'" << element_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else {
|
||||
ValueProperty* prop = new ValueProperty;
|
||||
prop->element_name = element_name;
|
||||
prop->name = property_name;
|
||||
prop->orig_value_type = type;
|
||||
prop->resize(num_instances);
|
||||
value_properties_.push_back(prop);
|
||||
if (!ply_set_read_cb(ply, element_name, property_name, callback_value_property, prop, 0)) {
|
||||
std::cerr << "failed to set callback for list property of \'" << element_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
if (!ply_read(ply)) {
|
||||
std::cerr << "error occurred while parsing ply file" << std::endl;
|
||||
ply_close(ply);
|
||||
return false;
|
||||
}
|
||||
|
||||
ply_close(ply);
|
||||
|
||||
// create the elements
|
||||
collect_elements(elements);
|
||||
|
||||
// cleaning
|
||||
for (auto prop : list_properties_) delete prop;
|
||||
list_properties_.clear();
|
||||
for (auto prop : value_properties_) delete prop;
|
||||
value_properties_.clear();
|
||||
|
||||
return (elements.size() > 0 && elements[0].num_instances > 0);
|
||||
}
|
||||
|
||||
|
||||
std::size_t PlyReader::num_instances(const std::string& file_name, const std::string& name) {
|
||||
p_ply ply = ply_open(file_name.c_str(), nullptr, 0, nullptr);
|
||||
if (!ply) {
|
||||
std::cerr << "failed to open ply file \'" << file_name << "\'" << std::endl;
|
||||
return 0;
|
||||
}
|
||||
|
||||
if (!ply_read_header(ply)) {
|
||||
std::cerr << "failed to read ply header" << std::endl;
|
||||
ply_close(ply);
|
||||
return 0;
|
||||
}
|
||||
|
||||
p_ply_element element = nullptr;
|
||||
/* iterate over all elements in input file */
|
||||
while ((element = ply_get_next_element(ply, element))) {
|
||||
long num_element = 0;
|
||||
const char *element_name = nullptr;
|
||||
ply_get_element_info(element, &element_name, &num_element);
|
||||
|
||||
if (!strcmp(element_name, name.c_str())) {
|
||||
if (num_element > 0) {
|
||||
ply_close(ply);
|
||||
return static_cast<std::size_t>(num_element);
|
||||
}
|
||||
}
|
||||
}
|
||||
ply_close(ply);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
namespace details {
|
||||
|
||||
template <typename VT_Input, typename VT_Output>
|
||||
inline void convert(const GenericProperty<VT_Input>& input, GenericProperty<VT_Output>& output) {
|
||||
output.resize(input.size());
|
||||
output.element_name = input.element_name;
|
||||
output.name = input.name;
|
||||
for (std::size_t i = 0; i < input.size(); ++i) {
|
||||
output[i] = static_cast<VT_Output>(input[i]);
|
||||
}
|
||||
}
|
||||
|
||||
template <typename VT_Input, typename VT_Output>
|
||||
inline void convert(const GenericProperty< std::vector<VT_Input> >& input, GenericProperty< std::vector<VT_Output> >& output) {
|
||||
output.resize(input.size());
|
||||
output.element_name = input.element_name;
|
||||
output.name = input.name;
|
||||
for (std::size_t i = 0; i < input.size(); ++i) {
|
||||
const auto& v_in = input[i];
|
||||
auto& v_out = output[i];
|
||||
v_out.resize(v_in.size());
|
||||
for (std::size_t j = 0; j < v_in.size(); ++j)
|
||||
v_out[j] = static_cast<VT_Output>(v_in[j]);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
template <typename PropertyT>
|
||||
inline bool extract_named_property(std::vector<PropertyT>& properties, PropertyT& wanted, const std::string& name) {
|
||||
typename std::vector< PropertyT >::iterator it = properties.begin();
|
||||
for (; it != properties.end(); ++it) {
|
||||
const PropertyT& property = *it;
|
||||
if (property.name == name) {
|
||||
wanted = property;
|
||||
properties.erase(it);
|
||||
return true;
|
||||
}
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
template <typename PropertyT>
|
||||
inline bool extract_vector_property(std::vector< PropertyT >& properties,
|
||||
const std::string& x_name, const std::string& y_name, const std::string& z_name,
|
||||
Vec3Property& prop)
|
||||
{
|
||||
PropertyT x_coords, y_coords, z_coords;
|
||||
if (details::extract_named_property(properties, x_coords, x_name) &&
|
||||
details::extract_named_property(properties, y_coords, y_name) &&
|
||||
details::extract_named_property(properties, z_coords, z_name))
|
||||
{
|
||||
std::size_t num = x_coords.size();
|
||||
prop.resize(num);
|
||||
for (std::size_t j = 0; j < num; ++j)
|
||||
prop[j] = vec3(
|
||||
static_cast<float>(x_coords[j]),
|
||||
static_cast<float>(y_coords[j]),
|
||||
static_cast<float>(z_coords[j])
|
||||
);
|
||||
return true;
|
||||
}
|
||||
else
|
||||
return false;
|
||||
}
|
||||
|
||||
} // namespace details
|
||||
|
||||
|
||||
void PlyReader::collect_elements(std::vector<Element>& elements) const {
|
||||
elements.clear();
|
||||
|
||||
for (auto prop : list_properties_) {
|
||||
std::size_t num_instances = prop->size();
|
||||
if (num_instances <= 0)
|
||||
continue;
|
||||
|
||||
// the intermediate results are just a set of properties.
|
||||
Element* element = nullptr;
|
||||
for (auto& e : elements) {
|
||||
if (e.name == prop->element_name) {
|
||||
element = &e;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!element) {
|
||||
elements.push_back(Element(prop->element_name, num_instances));
|
||||
element = &elements.back();
|
||||
}
|
||||
|
||||
e_ply_type type = e_ply_type(prop->orig_value_type);
|
||||
if (type == PLY_FLOAT || type == PLY_DOUBLE || type == PLY_FLOAT32 || type == PLY_FLOAT64) {
|
||||
FloatListProperty values;
|
||||
details::convert(*prop, values);
|
||||
element->float_list_properties.push_back(values);
|
||||
}
|
||||
else { // must be one of the following integer types:
|
||||
// PLY_INT8, PLY_UINT8, PLY_INT16, PLY_UINT16, PLY_INT32, PLY_UINT32,
|
||||
// PLY_CHAR, PLY_UCHAR, PLY_SHORT, PLY_USHORT, PLY_INT, PLY_UINT
|
||||
IntListProperty values;
|
||||
details::convert(*prop, values);
|
||||
element->int_list_properties.push_back(values);
|
||||
}
|
||||
}
|
||||
|
||||
for (auto prop : value_properties_) {
|
||||
std::size_t num_instances = prop->size();
|
||||
if (num_instances <= 0)
|
||||
continue;
|
||||
|
||||
// the intermediate results are just a set of properties.
|
||||
Element* element = nullptr;
|
||||
for (auto& e : elements) {
|
||||
if (e.name == prop->element_name) {
|
||||
element = &e;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!element) {
|
||||
elements.push_back(Element(prop->element_name, num_instances));
|
||||
element = &elements.back();
|
||||
}
|
||||
|
||||
e_ply_type type = e_ply_type(prop->orig_value_type);
|
||||
if (type == PLY_FLOAT || type == PLY_DOUBLE || type == PLY_FLOAT32 || type == PLY_FLOAT64) {
|
||||
FloatProperty values;
|
||||
details::convert(*prop, values);
|
||||
element->float_properties.push_back(values);
|
||||
}
|
||||
else { // must be one of the following integer types:
|
||||
// PLY_INT8, PLY_UINT8, PLY_INT16, PLY_UINT16, PLY_INT32, PLY_UINT32,
|
||||
// PLY_CHAR, PLY_UCHAR, PLY_SHORT, PLY_USHORT, PLY_INT, PLY_UINT
|
||||
IntProperty values;
|
||||
details::convert(*prop, values);
|
||||
element->int_properties.push_back(values);
|
||||
}
|
||||
}
|
||||
|
||||
// extract some standard vec3 properties, e.g., points, normals, colors, texture coords
|
||||
for (auto& element : elements) {
|
||||
Vec3Property prop_point(element.name, "point");
|
||||
if (details::extract_vector_property(element.float_properties, "x", "y", "z", prop_point) ||
|
||||
details::extract_vector_property(element.float_properties, "X", "Y", "Z", prop_point))
|
||||
{
|
||||
element.vec3_properties.push_back(prop_point);
|
||||
}
|
||||
|
||||
Vec3Property prop_normal(element.name, "normal");
|
||||
if (details::extract_vector_property(element.float_properties, "nx", "ny", "nz", prop_normal))
|
||||
element.vec3_properties.push_back(prop_normal);
|
||||
|
||||
Vec3Property prop_color(element.name, "color");
|
||||
if (details::extract_vector_property(element.float_properties, "r", "g", "b", prop_color))
|
||||
element.vec3_properties.push_back(prop_color);
|
||||
else if (details::extract_vector_property(element.int_properties, "red", "green", "blue", prop_color) ||
|
||||
details::extract_vector_property(element.int_properties, "diffuse_red", "diffuse_green", "diffuse_blue", prop_color))
|
||||
{
|
||||
for (std::size_t i = 0; i < prop_color.size(); ++i)
|
||||
prop_color[i] /= 255.0f;
|
||||
element.vec3_properties.push_back(prop_color);
|
||||
}
|
||||
|
||||
// "alpha" property is stored speperately (if exists)
|
||||
FloatProperty prop_alpha(element.name, "alpha");
|
||||
if (details::extract_named_property(element.float_properties, prop_alpha, "a"))
|
||||
element.float_properties.push_back(prop_alpha);
|
||||
|
||||
else { // might be in Int format
|
||||
IntProperty temp(element.name, "alpha");
|
||||
if (details::extract_named_property(element.int_properties, temp, "alpha")) {
|
||||
prop_alpha.resize(temp.size());
|
||||
for (std::size_t i = 0; i < prop_alpha.size(); ++i)
|
||||
prop_alpha[i] = temp[i] / 255.0f;
|
||||
element.float_properties.push_back(prop_alpha);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_FILEIO_PLY_READER_WRITER_H
|
||||
#define EASY3D_FILEIO_PLY_READER_WRITER_H
|
||||
|
||||
|
||||
#include <string>
|
||||
#include <vector>
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace io {
|
||||
|
||||
// VT: the value type, e.g., int, float, string, vec3, std::vector
|
||||
template <typename VT>
|
||||
class GenericProperty : public std::vector<VT> {
|
||||
public:
|
||||
GenericProperty(const std::string& elem_name = "", const std::string& prop_name = "", const std::vector<VT>& values = std::vector<VT>())
|
||||
: std::vector<VT>(values)
|
||||
, element_name(elem_name)
|
||||
, name(prop_name)
|
||||
{}
|
||||
|
||||
std::string element_name; // i.e., "vertex", "edge", "face"
|
||||
std::string name;
|
||||
};
|
||||
|
||||
typedef GenericProperty<vec3> Vec3Property;
|
||||
typedef GenericProperty<float> FloatProperty;
|
||||
typedef GenericProperty<int> IntProperty;
|
||||
typedef GenericProperty< std::vector<float> > FloatListProperty;
|
||||
typedef GenericProperty< std::vector<int> > IntListProperty;
|
||||
|
||||
// model element (e.g., faces, vertices, edges) with optional properties
|
||||
struct Element {
|
||||
Element(const std::string& elem_name, std::size_t n_instances = 0)
|
||||
: name(elem_name)
|
||||
, num_instances(n_instances)
|
||||
{}
|
||||
|
||||
std::string name; // e.g., "vertex", "face", "edge"
|
||||
std::size_t num_instances; // number of instances
|
||||
|
||||
std::vector<Vec3Property> vec3_properties; // for "point", "normal", "color", and vector fields
|
||||
std::vector<FloatProperty> float_properties; // for scalar fields of float values
|
||||
std::vector<IntProperty> int_properties; // for scalar fields of integer values
|
||||
|
||||
std::vector<FloatListProperty> float_list_properties; // for properties of a list of float values
|
||||
std::vector<IntListProperty> int_list_properties; // for properties of a list of integer values
|
||||
};
|
||||
|
||||
// A general purpose PLY file writer
|
||||
// This class is internally used by PointCloudIO and SurfaceMeshIO.
|
||||
// Client code should use PointCloudIO and SurfaceMeshIO.
|
||||
class PlyWriter {
|
||||
public:
|
||||
bool write(
|
||||
const std::string& file_name,
|
||||
const std::vector<Element>& elements,
|
||||
const std::string& comment = "",
|
||||
bool binary = false
|
||||
) const;
|
||||
|
||||
static bool is_big_endian();
|
||||
};
|
||||
|
||||
|
||||
// A general purpose PLY file reader
|
||||
// This class is internally used by PointCloudIO and SurfaceMeshIO.
|
||||
// Client code should use PointCloudIO and SurfaceMeshIO.
|
||||
class PlyReader
|
||||
{
|
||||
public:
|
||||
bool read(const std::string& file_name, std::vector<Element>& elements);
|
||||
|
||||
/**
|
||||
* \brief A quick check of the number of instances of type \c 'element'.
|
||||
* This is helpfull to determine if a file store a point cloud,
|
||||
* a graph, or a mesh. Internally it reads the ply file header only
|
||||
* (without loading the entire file).
|
||||
* \param name A string denoting the type of the element to be checked.
|
||||
* It must be one of "vertex", "face", or "edge".
|
||||
* \return The number of instances of type \c 'element'.
|
||||
*/
|
||||
static std::size_t num_instances(const std::string& file_name, const std::string& name);
|
||||
|
||||
private:
|
||||
// convert the "list" intermediate representation into the user requested format
|
||||
void collect_elements(std::vector<Element>& elements) const;
|
||||
|
||||
private:
|
||||
// For simpler code, it is possible to save all data as properties of type PLY_LIST
|
||||
// with value type double. This can allow us to use a single callback function to
|
||||
// handle all the properties. However, the performance is not optimal. Thus, I process
|
||||
// list properties and value properties separately.
|
||||
|
||||
struct PlyProperty {
|
||||
int orig_value_type; // e.g., PLY_INT, PLY_FLOAT
|
||||
};
|
||||
struct ListProperty : PlyProperty, GenericProperty< std::vector<double> > {};
|
||||
struct ValueProperty : PlyProperty, GenericProperty< double > {};
|
||||
|
||||
std::vector< ListProperty* > list_properties_;
|
||||
std::vector< ValueProperty* > value_properties_;
|
||||
};
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
#endif
|
||||
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/point_cloud_io.h>
|
||||
|
||||
#include <clocale>
|
||||
#include <fstream>
|
||||
|
||||
#include <easy3d/core/point_cloud.h>
|
||||
#include <easy3d/util/file_system.h>
|
||||
#include <easy3d/util/stop_watch.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
PointCloud* PointCloudIO::load(const std::string& file_name)
|
||||
{
|
||||
std::setlocale(LC_NUMERIC, "C");
|
||||
|
||||
const std::string& ext = file_system::extension(file_name, true);
|
||||
|
||||
PointCloud* cloud = new PointCloud;
|
||||
cloud->set_name(file_name);
|
||||
|
||||
StopWatch w;
|
||||
|
||||
bool success = false;
|
||||
if (ext == "xyz")
|
||||
success = io::load_xyz(file_name, cloud);
|
||||
else {
|
||||
std::cerr << "only xyz format is supported" << std::endl;
|
||||
success = false;
|
||||
}
|
||||
|
||||
if (!success || cloud->n_vertices() == 0) {
|
||||
delete cloud;
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
std::cout << "load model done. time: " << w.time_string() << std::endl;
|
||||
|
||||
return cloud;
|
||||
}
|
||||
|
||||
|
||||
bool PointCloudIO::save(const std::string& file_name, const PointCloud* cloud) {
|
||||
if (!cloud) {
|
||||
std::cerr << "Point cloud is null" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
std::string ext = file_system::extension(file_name, true);
|
||||
bool success = false;
|
||||
if (ext == "xyz")
|
||||
success = io::save_xyz(file_name, cloud);
|
||||
else {
|
||||
std::cerr << "only xyz format is supported" << std::endl;
|
||||
success = false;
|
||||
}
|
||||
|
||||
return success;
|
||||
}
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_FILEIO_POINT_CLOUD_IO_H
|
||||
#define EASY3D_FILEIO_POINT_CLOUD_IO_H
|
||||
|
||||
#include <iostream>
|
||||
#include <vector>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
class PointCloud;
|
||||
|
||||
// TODO: add a general purpose file format 'map' capable of storing
|
||||
// both point clouds and meshes with arbitrary types of
|
||||
// properties (similar to PLY, each property is read/written
|
||||
// as a whole. Check PLY and POLY formats as reference.
|
||||
// When this is done, I don't need BIN and POLY any more).
|
||||
|
||||
class PointCloudIO
|
||||
{
|
||||
public:
|
||||
// return nullptr if fails
|
||||
static PointCloud* load(const std::string& file_name);
|
||||
|
||||
// save the cloud to a file. return false if failed.
|
||||
static bool save(const std::string& file_name, const PointCloud* point_set);
|
||||
};
|
||||
|
||||
|
||||
namespace io {
|
||||
// each line with only point: (x, y, z)
|
||||
bool load_xyz(const std::string& file_name, PointCloud* cloud);
|
||||
bool save_xyz(const std::string& file_name, const PointCloud* cloud);
|
||||
bool load_bxyz(const std::string& file_name, PointCloud* cloud);
|
||||
bool save_bxyz(const std::string& file_name, const PointCloud* cloud);
|
||||
};
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,166 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/point_cloud_io.h>
|
||||
|
||||
#include <fstream>
|
||||
|
||||
#include <easy3d/core/point_cloud.h>
|
||||
#include <easy3d/util/line_stream.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace io {
|
||||
|
||||
bool load_xyz(const std::string& file_name, PointCloud* cloud) {
|
||||
std::ifstream input(file_name.c_str());
|
||||
if (input.fail()) {
|
||||
std::cerr << "could not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
io::LineInputStream in(input);
|
||||
|
||||
double x0, y0, z0; // the first point
|
||||
bool got_first_point = false;
|
||||
while (!input.eof()) {
|
||||
in.get_line();;
|
||||
if (in.current_line()[0] != '#') {
|
||||
in >> x0 >> y0 >> z0;
|
||||
if (!in.fail()) {
|
||||
cloud->add_vertex(vec3(0,0,0));
|
||||
got_first_point = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!got_first_point)
|
||||
return false;
|
||||
|
||||
double x, y, z;
|
||||
while (!input.eof()) {
|
||||
in.get_line();
|
||||
if (in.current_line()[0] != '#') {
|
||||
in >> x >> y >> z;
|
||||
if (!in.fail()) {
|
||||
cloud->add_vertex(vec3(x-x0, y-y0, z-z0));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Store first point coordinates as translation offset.
|
||||
// This allows to work with double-precision coordinates.
|
||||
easy3d::PointCloud::ModelProperty<easy3d::dvec3> prop = cloud->add_model_property<dvec3>("translation");
|
||||
prop[0] = dvec3(x0, y0, z0);
|
||||
std::cout << "input point cloud translated by [" << -prop[0] << "]" << std::endl;
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
bool save_xyz(const std::string& file_name, const PointCloud* cloud) {
|
||||
std::ofstream output(file_name.c_str());
|
||||
if (output.fail()) {
|
||||
std::cerr << "could not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
output.precision(16);
|
||||
|
||||
PointCloud::VertexProperty<vec3> points = cloud->get_vertex_property<vec3>("v:point");
|
||||
|
||||
// ProgressLogger progress(cloud->n_vertices());
|
||||
for (auto v : cloud->vertices()) {
|
||||
output << points[v] << std::endl;
|
||||
// progress.next();
|
||||
}
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
bool load_bxyz(const std::string& file_name, PointCloud* cloud) {
|
||||
std::ifstream input(file_name.c_str(), std::fstream::binary);
|
||||
if (input.fail()) {
|
||||
std::cerr << "could not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
std::size_t element_per_point = 3;
|
||||
std::size_t element_size = sizeof(float) * element_per_point;
|
||||
// check size of types
|
||||
if (sizeof(vec3) != sizeof(float) * 3) {
|
||||
std::cerr << "point coordinates must be \'float\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
// get length of file
|
||||
input.seekg(0, input.end);
|
||||
std::streamoff length = input.tellg();
|
||||
input.seekg(0, input.beg);
|
||||
|
||||
// num of points in the file
|
||||
std::size_t num = length / element_size;
|
||||
if (num <= 0)
|
||||
return false;
|
||||
|
||||
cloud->resize(static_cast<unsigned int>(num));
|
||||
|
||||
PointCloud::VertexProperty<vec3> points = cloud->get_vertex_property<vec3>("v:point");
|
||||
|
||||
input.read((char*)points.data(), num * element_size); // read the entire blocks
|
||||
if (input.fail()) {
|
||||
std::cerr
|
||||
<< input.gcount() << " bytes of the block could not be read" << std::endl;
|
||||
return false;
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
bool save_bxyz(const std::string& file_name, const PointCloud* cloud) {
|
||||
// open file
|
||||
std::ofstream output(file_name.c_str(), std::fstream::binary);
|
||||
if (output.fail()) {
|
||||
std::cerr << "could not open file\'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
// check size of types
|
||||
if (sizeof(vec3) != sizeof(float) * 3) {
|
||||
std::cerr << "point coordinates must be \'float\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
PointCloud::VertexProperty<vec3> points = cloud->get_vertex_property<vec3>("v:point");
|
||||
|
||||
output.write((const char*)points.data(), sizeof(vec3) * cloud->n_vertices());
|
||||
return true;
|
||||
}
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/surface_mesh_io.h>
|
||||
|
||||
#include <clocale>
|
||||
|
||||
#include <easy3d/core/surface_mesh.h>
|
||||
#include <easy3d/util/file_system.h>
|
||||
#include <easy3d/util/stop_watch.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
SurfaceMesh* SurfaceMeshIO::load(const std::string& file_name)
|
||||
{
|
||||
std::setlocale(LC_NUMERIC, "C");
|
||||
|
||||
const std::string& ext = file_system::extension(file_name, true);
|
||||
|
||||
SurfaceMesh* mesh = new SurfaceMesh;
|
||||
mesh->set_name(file_name);
|
||||
|
||||
StopWatch w;
|
||||
|
||||
bool success = false;
|
||||
if (ext == "obj")
|
||||
success = io::load_obj(file_name, mesh);
|
||||
else {
|
||||
std::cerr << "only obj format is supported" << std::endl;
|
||||
success = false;
|
||||
}
|
||||
|
||||
if (!success || mesh->n_faces() == 0) {
|
||||
delete mesh;
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
std::cout << "load model done. time: " << w.time_string() << std::endl;
|
||||
|
||||
return mesh;
|
||||
}
|
||||
|
||||
|
||||
bool SurfaceMeshIO::save(const std::string& file_name, const SurfaceMesh* mesh)
|
||||
{
|
||||
if (!mesh) {
|
||||
std::cerr << "surface mesh is null" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
std::string ext = file_system::extension(file_name, true);
|
||||
|
||||
StopWatch w;
|
||||
|
||||
bool success = false;
|
||||
if (ext == "obj")
|
||||
success = io::save_obj(file_name, mesh);
|
||||
else {
|
||||
std::cerr << "only obj format is supported" << std::endl;
|
||||
success = false;
|
||||
}
|
||||
|
||||
std::cout << "save model done. time: " << w.time_string() << std::endl;
|
||||
|
||||
return success;
|
||||
}
|
||||
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,75 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_FILEIO_MESH_IO_H
|
||||
#define EASY3D_FILEIO_MESH_IO_H
|
||||
|
||||
|
||||
#include <string>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
class SurfaceMesh;
|
||||
|
||||
// TODO: add a general purpose file format 'map' capable of storing
|
||||
// both point clouds and meshes with arbitrary types of
|
||||
// properties (similar to PLY, each property is read/written
|
||||
// as a whole. Check PLY and POLY formats as reference.
|
||||
// When this is done, I don't need BIN and POLY any more).
|
||||
|
||||
class SurfaceMeshIO
|
||||
{
|
||||
public:
|
||||
// return nullptr if failed.
|
||||
static SurfaceMesh* load(const std::string& file_name);
|
||||
|
||||
// save the mesh to a file. return false if failed.
|
||||
static bool save(const std::string& file_name, const SurfaceMesh* mesh);
|
||||
};
|
||||
|
||||
namespace io {
|
||||
|
||||
bool load_poly(const std::string& file_name, SurfaceMesh* mesh);
|
||||
bool save_poly(const std::string& file_name, const SurfaceMesh* mesh);
|
||||
|
||||
bool load_ply(const std::string& file_name, SurfaceMesh* mesh);
|
||||
bool save_ply(const std::string& file_name, const SurfaceMesh* mesh, bool binary = true);
|
||||
|
||||
bool load_off(const std::string& file_name, SurfaceMesh* mesh);
|
||||
bool save_off(const std::string& file_name, const SurfaceMesh* mesh);
|
||||
|
||||
bool load_obj(const std::string& file_name, SurfaceMesh* mesh);
|
||||
bool save_obj(const std::string& file_name, const SurfaceMesh* mesh);
|
||||
|
||||
bool load_stl(const std::string& file_name, SurfaceMesh* mesh);
|
||||
bool save_stl(const std::string& file_name, const SurfaceMesh* mesh);
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
#endif // EASY3D_FILEIO_MESH_IO_H
|
||||
|
|
@ -0,0 +1,568 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/fileio/surface_mesh_io.h>
|
||||
|
||||
#include <cstdio>
|
||||
#include <cstring>
|
||||
|
||||
#include <easy3d/core/surface_mesh.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace io {
|
||||
|
||||
#if 1
|
||||
bool load_obj(const std::string& file_name, SurfaceMesh* mesh)
|
||||
{
|
||||
if (!mesh) {
|
||||
std::cerr << "null mesh pointer" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
char s[200];
|
||||
float x, y, z;
|
||||
std::vector<SurfaceMesh::Vertex> vertices;
|
||||
std::vector<vec2> all_tex_coords; //individual texture coordinates
|
||||
std::vector<int> halfedge_tex_idx; //texture coordinates sorted for halfedges
|
||||
SurfaceMesh::HalfedgeProperty <vec2> tex_coords = mesh->halfedge_property<vec2>("h:texcoord");
|
||||
bool with_tex_coord = false;
|
||||
|
||||
// clear mesh
|
||||
mesh->clear();
|
||||
|
||||
|
||||
// open file (in ASCII mode)
|
||||
FILE* in = fopen(file_name.c_str(), "r");
|
||||
if (!in) {
|
||||
std::cerr << "count not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
// clear line once
|
||||
memset(&s, 0, 200);
|
||||
|
||||
|
||||
// parse line by line (currently only supports vertex positions & faces
|
||||
while (in && !feof(in) && fgets(s, 200, in))
|
||||
{
|
||||
// comment
|
||||
if (s[0] == '#' || isspace(s[0])) continue;
|
||||
|
||||
// vertex
|
||||
else if (strncmp(s, "v ", 2) == 0)
|
||||
{
|
||||
if (sscanf(s, "v %f %f %f", &x, &y, &z))
|
||||
{
|
||||
mesh->add_vertex(vec3(x, y, z));
|
||||
}
|
||||
}
|
||||
// normal
|
||||
else if (strncmp(s, "vn ", 3) == 0)
|
||||
{
|
||||
if (sscanf(s, "vn %f %f %f", &x, &y, &z))
|
||||
{
|
||||
// problematic as it can be either a vertex property when interpolated
|
||||
// or a halfedge property for hard edges
|
||||
}
|
||||
}
|
||||
|
||||
// texture coordinate
|
||||
else if (strncmp(s, "vt ", 3) == 0)
|
||||
{
|
||||
if (sscanf(s, "vt %f %f", &x, &y))
|
||||
{
|
||||
all_tex_coords.push_back(vec2(x, y));
|
||||
}
|
||||
}
|
||||
|
||||
// face
|
||||
else if (strncmp(s, "f ", 2) == 0)
|
||||
{
|
||||
int component(0), nV(0);
|
||||
bool endOfVertex(false);
|
||||
char *p0, *p1(s + 1);
|
||||
|
||||
vertices.clear();
|
||||
halfedge_tex_idx.clear();
|
||||
|
||||
// skip white-spaces
|
||||
while (*p1 == ' ') ++p1;
|
||||
|
||||
while (p1)
|
||||
{
|
||||
p0 = p1;
|
||||
|
||||
// overwrite next separator
|
||||
|
||||
// skip '/', '\n', ' ', '\0', '\r' <-- don't forget Windows
|
||||
while (*p1 != '/' && *p1 != '\r' && *p1 != '\n' && *p1 != ' ' && *p1 != '\0') ++p1;
|
||||
|
||||
// detect end of vertex
|
||||
if (*p1 != '/')
|
||||
{
|
||||
endOfVertex = true;
|
||||
}
|
||||
|
||||
// replace separator by '\0'
|
||||
if (*p1 != '\0')
|
||||
{
|
||||
*p1 = '\0';
|
||||
p1++; // point to next token
|
||||
}
|
||||
|
||||
// detect end of line and break
|
||||
if (*p1 == '\0' || *p1 == '\n')
|
||||
{
|
||||
p1 = 0;
|
||||
}
|
||||
|
||||
// read next vertex component
|
||||
if (*p0 != '\0')
|
||||
{
|
||||
switch (component)
|
||||
{
|
||||
case 0: // vertex
|
||||
{
|
||||
vertices.push_back(SurfaceMesh::Vertex(atoi(p0) - 1));
|
||||
break;
|
||||
}
|
||||
case 1: // texture coord
|
||||
{
|
||||
int idx = atoi(p0) - 1;
|
||||
halfedge_tex_idx.push_back(idx);
|
||||
with_tex_coord = true;
|
||||
break;
|
||||
}
|
||||
case 2: // normal
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
++component;
|
||||
|
||||
if (endOfVertex)
|
||||
{
|
||||
component = 0;
|
||||
nV++;
|
||||
endOfVertex = false;
|
||||
}
|
||||
}
|
||||
|
||||
SurfaceMesh::Face f = mesh->add_face(vertices);
|
||||
|
||||
|
||||
// add texture coordinates
|
||||
if (with_tex_coord)
|
||||
{
|
||||
SurfaceMesh::HalfedgeAroundFaceCirculator h_fit = mesh->halfedges(f);
|
||||
SurfaceMesh::HalfedgeAroundFaceCirculator h_end = h_fit;
|
||||
unsigned v_idx = 0;
|
||||
do
|
||||
{
|
||||
tex_coords[*h_fit] = all_tex_coords.at(halfedge_tex_idx.at(v_idx));
|
||||
++v_idx;
|
||||
++h_fit;
|
||||
} while (h_fit != h_end);
|
||||
}
|
||||
}
|
||||
// clear line
|
||||
memset(&s, 0, 200);
|
||||
}
|
||||
|
||||
fclose(in);
|
||||
return mesh->n_faces() > 0;
|
||||
}
|
||||
#else // use the tokenizer
|
||||
bool load_obj(const std::string& file_name, SurfaceMesh* mesh)
|
||||
{
|
||||
if (!mesh) {
|
||||
std::cerr << "null mesh pointer" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
// open file (in binary mode)
|
||||
FILE* fp = nullptr;
|
||||
if ((fopen_s(&fp, file_name.c_str(), "rb") != 0) || (fp == nullptr)) {
|
||||
std::cerr << "count not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
fseek(fp, 0, SEEK_END);
|
||||
std::size_t length = ftell(fp);
|
||||
fseek(fp, 0, SEEK_SET);
|
||||
|
||||
char *data = new char[length + 1];
|
||||
fread(data, 1, length, fp);
|
||||
fclose(fp);
|
||||
data[length] = '\0';
|
||||
|
||||
#ifndef NDEBUG
|
||||
fprintf(stderr, "Read file '%s', %zd bytes\n", file_name.c_str(), length);
|
||||
#endif
|
||||
|
||||
float val[4];
|
||||
int32_t idx[3][3];
|
||||
int32_t match;
|
||||
char format = 0;
|
||||
bool vtx4Comp = false;
|
||||
bool tex3Comp = false;
|
||||
std::vector<SurfaceMesh::Vertex> vertices;
|
||||
std::vector<vec2> all_tex_coords; //individual texture coordinates
|
||||
std::vector<int> halfedge_tex_idx; //texture coordinates sorted for halfedges
|
||||
SurfaceMesh::HalfedgeProperty <vec2> tex_coords = mesh->halfedge_property<vec2>("h:texcoord");
|
||||
bool with_tex_coord = false;
|
||||
|
||||
// clear mesh
|
||||
mesh->clear();
|
||||
|
||||
|
||||
NvTokenizer tok(data, "/");
|
||||
#ifndef NDEBUG
|
||||
tok.setVerbose();
|
||||
#endif
|
||||
|
||||
// parse line by line (currently only supports vertex positions & faces
|
||||
while (!tok.atEOF())
|
||||
{
|
||||
if (!tok.readToken()) {
|
||||
tok.consumeToEOL();
|
||||
continue; // likely EOL we didn't explicitly handle?
|
||||
}
|
||||
|
||||
|
||||
const char* tmp = tok.getLastTokenPtr();
|
||||
switch (tmp[0]) {
|
||||
case '#':
|
||||
//comment line, eat the remainder
|
||||
tok.consumeToEOL();
|
||||
break;
|
||||
case 'v':
|
||||
switch (tmp[1]) {
|
||||
case '\0': //vertex, 3 or 4 components
|
||||
val[3] = 1.0f; //default w coordinate
|
||||
match = tok.getTokenFloatArray(val, 4);
|
||||
mesh->add_vertex(vec3(val));
|
||||
vtx4Comp |= (match == 4);
|
||||
assert(match > 2 && match < 5);
|
||||
break;
|
||||
case 'n': //normal, 3 components
|
||||
match = tok.getTokenFloatArray(val, 3);
|
||||
// problematic as it can be either a vertex property when interpolated
|
||||
// or a halfedge property for hard edges
|
||||
assert(match == 3);
|
||||
break;
|
||||
case 't': //texcoord, 2 or 3 components
|
||||
val[2] = 0.0f; //default r coordinate
|
||||
match = tok.getTokenFloatArray(val, 3);
|
||||
all_tex_coords.push_back(vec2(val[0], val[1]));
|
||||
tex3Comp |= (match == 3);
|
||||
assert(match > 1 && match < 4);
|
||||
break;
|
||||
case 'p': // Parameter space vertices not supported...
|
||||
tok.consumeToEOL();
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case 'f':
|
||||
{
|
||||
//face
|
||||
// determine the type, and read the initial vertex, all entries in a face must have the same format
|
||||
// formats are:
|
||||
// 1 #
|
||||
// 2 #/#
|
||||
// 3 #/#/#
|
||||
// 4 #//#
|
||||
// we need to 'hand read' the first run, to decode the formatting.
|
||||
format = 0;
|
||||
if (!tok.getTokenInt(idx[0][0])) {
|
||||
assert(0);
|
||||
return false;
|
||||
}
|
||||
// on our way.
|
||||
format = 1;
|
||||
if (tok.consumeOneDelim()) {
|
||||
if (tok.consumeOneDelim()) {
|
||||
// automatically format 4.
|
||||
format = 4;
|
||||
}
|
||||
if (!tok.getTokenInt(idx[0][1])) {
|
||||
assert(0);
|
||||
return false;
|
||||
}
|
||||
if (format != 4)
|
||||
{
|
||||
format = 2; // at least format 2.
|
||||
tok.setConsumeWS(false);
|
||||
if (tok.consumeOneDelim()) {
|
||||
if (tok.getTokenInt(idx[0][2])) {
|
||||
// automatically format 3
|
||||
format = 3;
|
||||
}
|
||||
// else remain format 2, in case of "#/#/" wacky format.
|
||||
}
|
||||
tok.setConsumeWS(true);
|
||||
}
|
||||
}
|
||||
switch (format) {
|
||||
case 1: // #
|
||||
{ //This face has only vertex indices
|
||||
//grab the second vertex to prime
|
||||
tok.getTokenInt(idx[1][0]);
|
||||
while (tok.getTokenInt(idx[2][0])) {
|
||||
//add the indices
|
||||
vertices.clear();
|
||||
for (unsigned char ii = 0; ii < 3; ii++) {
|
||||
vertices.push_back(SurfaceMesh::Vertex(idx[ii][0] - 1));
|
||||
}
|
||||
//prepare for the next iteration
|
||||
idx[1][0] = idx[2][0];
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
case 2: // #/#
|
||||
{ //This face has vertex and texture coordinate indices
|
||||
|
||||
//grab the second vertex to prime
|
||||
tok.getTokenIntArray(idx[1], 2);
|
||||
|
||||
while (tok.getTokenIntArray(idx[2], 2) == 2) {
|
||||
|
||||
//add the indices
|
||||
vertices.clear();
|
||||
halfedge_tex_idx.clear();
|
||||
for (unsigned char ii = 0; ii < 3; ii++) {
|
||||
vertices.push_back(SurfaceMesh::Vertex(idx[ii][0] - 1));
|
||||
halfedge_tex_idx.push_back(idx[ii][1] - 1);
|
||||
}
|
||||
//prepare for the next iteration
|
||||
idx[1][0] = idx[2][0];
|
||||
idx[1][1] = idx[2][1];
|
||||
}
|
||||
with_tex_coord = true;
|
||||
break;
|
||||
}
|
||||
|
||||
|
||||
case 3: // #/#/#
|
||||
{ //This face has vertex, texture coordinate, and normal indices
|
||||
|
||||
//grab the second vertex to prime
|
||||
tok.getTokenIntArray(idx[1], 3);
|
||||
|
||||
//create the fan
|
||||
while (tok.getTokenIntArray(idx[2], 3) == 3) {
|
||||
|
||||
//add the indices
|
||||
vertices.clear();
|
||||
halfedge_tex_idx.clear();
|
||||
for (unsigned char ii = 0; ii < 3; ii++) {
|
||||
vertices.push_back(SurfaceMesh::Vertex(idx[ii][0] - 1));
|
||||
halfedge_tex_idx.push_back(idx[ii][1] - 1);
|
||||
//_nIndex.push_back( idx[ii][2]);
|
||||
}
|
||||
|
||||
//prepare for the next iteration
|
||||
idx[1][0] = idx[2][0];
|
||||
idx[1][1] = idx[2][1];
|
||||
idx[1][2] = idx[2][2];
|
||||
}
|
||||
|
||||
with_tex_coord = true;
|
||||
break;
|
||||
}
|
||||
|
||||
case 4: // #//#
|
||||
{ //This face has vertex and normal indices
|
||||
|
||||
//grab the second vertex to prime
|
||||
tok.getTokenIntArray(idx[1], 2);
|
||||
|
||||
//create the fan
|
||||
while (tok.getTokenIntArray(idx[2], 2) == 2) {
|
||||
|
||||
//add the indices
|
||||
vertices.clear();
|
||||
for (unsigned char ii = 0; ii < 3; ii++) {
|
||||
vertices.push_back(SurfaceMesh::Vertex(idx[ii][0] - 1));
|
||||
}
|
||||
//prepare for the next iteration
|
||||
idx[1][0] = idx[2][0];
|
||||
idx[1][1] = idx[2][1];
|
||||
}
|
||||
|
||||
//hasNormals = true;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
SurfaceMesh::Face f = mesh->add_face(vertices);
|
||||
// add texture coordinates
|
||||
if (with_tex_coord)
|
||||
{
|
||||
SurfaceMesh::HalfedgeAroundFaceCirculator h_fit = mesh->halfedges(f);
|
||||
SurfaceMesh::HalfedgeAroundFaceCirculator h_end = h_fit;
|
||||
unsigned v_idx = 0;
|
||||
do
|
||||
{
|
||||
tex_coords[*h_fit] = all_tex_coords.at(halfedge_tex_idx.at(v_idx));
|
||||
++v_idx;
|
||||
++h_fit;
|
||||
} while (h_fit != h_end);
|
||||
}
|
||||
|
||||
}
|
||||
break;
|
||||
|
||||
case 's':
|
||||
case 'g':
|
||||
case 'u':
|
||||
//all presently ignored
|
||||
default:
|
||||
tok.consumeToEOL();
|
||||
}
|
||||
}
|
||||
std::cout << "read file done" << std::endl;
|
||||
return mesh->n_faces() > 0;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
//-----------------------------------------------------------------------------
|
||||
|
||||
|
||||
bool save_obj(const std::string& file_name, const SurfaceMesh* mesh)
|
||||
{
|
||||
if (!mesh) {
|
||||
std::cerr << "null mesh pointer" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
FILE* out = fopen(file_name.c_str(), "w");
|
||||
if (!out) {
|
||||
std::cerr << "count not open file \'" << file_name << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
dvec3 p0(0.0f, 0.0f, 0.0f);
|
||||
auto offset = mesh->get_model_property<easy3d::dvec3>("translation");
|
||||
if (offset) {
|
||||
// Read translation offset.
|
||||
// This allows to work with double-precision coordinates.
|
||||
p0 = offset[0];
|
||||
}
|
||||
|
||||
// comment
|
||||
fprintf(out, "# OBJ exported from Easy3D\n");
|
||||
|
||||
//vertices
|
||||
SurfaceMesh::VertexProperty<vec3> points = mesh->get_vertex_property<vec3>("v:point");
|
||||
for (SurfaceMesh::VertexIterator vit = mesh->vertices_begin(); vit != mesh->vertices_end(); ++vit)
|
||||
{
|
||||
const vec3& p = points[*vit];
|
||||
fprintf(out, "v %.10f %.10f %.10f\n", p[0] + p0[0], p[1] + p0[1], p[2] + p0[2]);
|
||||
}
|
||||
std::cout << "surface mesh model translated by [" << p0 << "]" << std::endl;
|
||||
|
||||
//normals
|
||||
SurfaceMesh::VertexProperty<vec3> normals = mesh->get_vertex_property<vec3>("v:normal");
|
||||
if (normals)
|
||||
{
|
||||
for (SurfaceMesh::VertexIterator vit = mesh->vertices_begin(); vit != mesh->vertices_end(); ++vit)
|
||||
{
|
||||
const vec3& p = normals[*vit];
|
||||
fprintf(out, "vn %.10f %.10f %.10f\n", p[0], p[1], p[2]);
|
||||
}
|
||||
}
|
||||
|
||||
//optionally texture coordinates
|
||||
// do we have them?
|
||||
std::vector<std::string> h_props = mesh->halfedge_properties();
|
||||
bool with_tex_coord = false;
|
||||
std::vector<std::string>::iterator h_prop_end = h_props.end();
|
||||
std::vector<std::string>::iterator h_prop_start = h_props.begin();
|
||||
while (h_prop_start != h_prop_end)
|
||||
{
|
||||
if (0 == (*h_prop_start).compare("h:texcoord"))
|
||||
{
|
||||
with_tex_coord = true;
|
||||
}
|
||||
++h_prop_start;
|
||||
}
|
||||
|
||||
//if so then add
|
||||
if (with_tex_coord)
|
||||
{
|
||||
SurfaceMesh::HalfedgeProperty<vec2> tex_coord = mesh->get_halfedge_property<vec2>("h:texcoord");
|
||||
for (SurfaceMesh::HalfedgeIterator hit = mesh->halfedges_begin(); hit != mesh->halfedges_end(); ++hit)
|
||||
{
|
||||
const vec2& pt = tex_coord[*hit];
|
||||
fprintf(out, "vt %.10f %.10f\n", pt[0], pt[1]);
|
||||
}
|
||||
}
|
||||
|
||||
//faces
|
||||
for (SurfaceMesh::FaceIterator fit = mesh->faces_begin(); fit != mesh->faces_end(); ++fit)
|
||||
{
|
||||
fprintf(out, "f");
|
||||
SurfaceMesh::VertexAroundFaceCirculator fvit = mesh->vertices(*fit), fvend = fvit;
|
||||
SurfaceMesh::HalfedgeAroundFaceCirculator fhit = mesh->halfedges(*fit);
|
||||
do
|
||||
{
|
||||
if (with_tex_coord)
|
||||
{
|
||||
// write vertex index, tex_coord index and normal index
|
||||
fprintf(out, " %d/%d/%d", (*fvit).idx() + 1, (*fhit).idx() + 1, (*fvit).idx() + 1);
|
||||
++fhit;
|
||||
}
|
||||
else
|
||||
{
|
||||
// write vertex index
|
||||
if (normals) {
|
||||
// and normal index if provided
|
||||
fprintf(out, " %d//%d", (*fvit).idx() + 1, (*fvit).idx() + 1);
|
||||
} else {
|
||||
// in case we don't have normals, just
|
||||
// construct the faces.
|
||||
fprintf(out, " %d", (*fvit).idx() + 1);
|
||||
}
|
||||
}
|
||||
} while (++fvit != fvend);
|
||||
fprintf(out, "\n");
|
||||
}
|
||||
|
||||
fclose(out);
|
||||
return true;
|
||||
}
|
||||
|
||||
|
||||
} // namespace io
|
||||
|
||||
} // namespace easy3d
|
||||
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
cmake_minimum_required(VERSION 3.1)
|
||||
|
||||
get_filename_component(MODULE_NAME ${CMAKE_CURRENT_SOURCE_DIR} NAME)
|
||||
set(PROJECT_NAME easy3d_${MODULE_NAME})
|
||||
project(${PROJECT_NAME})
|
||||
|
||||
|
||||
set(${PROJECT_NAME}_HEADERS
|
||||
chrono_watch.h
|
||||
dialogs.h
|
||||
file_system.h
|
||||
line_stream.h
|
||||
stop_watch.h
|
||||
string.h
|
||||
timer.h
|
||||
)
|
||||
|
||||
set(${PROJECT_NAME}_SOURCES
|
||||
dialogs.cpp
|
||||
file_system.cpp
|
||||
chrono_watch.cpp
|
||||
stop_watch.cpp
|
||||
string.cpp
|
||||
)
|
||||
|
||||
|
||||
add_library(${PROJECT_NAME} STATIC ${${PROJECT_NAME}_SOURCES} ${${PROJECT_NAME}_HEADERS} )
|
||||
|
||||
set_target_properties(${PROJECT_NAME} PROPERTIES FOLDER "3rd_party/easy3d")
|
||||
|
||||
target_include_directories(${PROJECT_NAME} PRIVATE ${ADTREE_easy3d_INCLUDE_DIR})
|
||||
|
||||
find_package(Threads REQUIRED)
|
||||
target_link_libraries(${PROJECT_NAME} Threads::Threads)
|
||||
|
||||
if (MSVC)
|
||||
target_compile_definitions(${PROJECT_NAME} PRIVATE _CRT_SECURE_NO_WARNINGS _CRT_SECURE_NO_DEPRECATE)
|
||||
endif()
|
||||
|
|
@ -0,0 +1,141 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/util/chrono_watch.h>
|
||||
|
||||
#include <cassert>
|
||||
#include <cmath>
|
||||
#include <sstream>
|
||||
#include <iomanip>
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
ChronoWatch::ChronoWatch()
|
||||
: started_(false)
|
||||
, paused_(false)
|
||||
{
|
||||
}
|
||||
|
||||
void ChronoWatch::start() {
|
||||
assert(!started_);
|
||||
started_ = true;
|
||||
paused_ = false;
|
||||
start_time_ = std::chrono::high_resolution_clock::now();
|
||||
}
|
||||
|
||||
void ChronoWatch::pause() {
|
||||
assert(started_);
|
||||
paused_ = true;
|
||||
pause_time_ = std::chrono::high_resolution_clock::now();
|
||||
}
|
||||
|
||||
void ChronoWatch::resume() {
|
||||
assert(paused_);
|
||||
paused_ = false;
|
||||
start_time_ += std::chrono::high_resolution_clock::now() - pause_time_;
|
||||
}
|
||||
|
||||
void ChronoWatch::reset() {
|
||||
assert(started_ || paused_);
|
||||
started_ = false;
|
||||
paused_ = false;
|
||||
pause_time_ = start_time_ = std::chrono::high_resolution_clock::now();
|
||||
}
|
||||
|
||||
std::size_t ChronoWatch::duration_count() const {
|
||||
assert(started_);
|
||||
if (paused_) {
|
||||
auto duration = std::chrono::duration_cast<std::chrono::milliseconds>(pause_time_ - start_time_);
|
||||
return static_cast<std::size_t>(duration.count());
|
||||
}
|
||||
else {
|
||||
auto duration = std::chrono::duration_cast<std::chrono::milliseconds>(std::chrono::high_resolution_clock::now() - start_time_);
|
||||
return static_cast<std::size_t>(duration.count());
|
||||
}
|
||||
}
|
||||
|
||||
float ChronoWatch::elapsed_milliseconds(int num_digits) const {
|
||||
auto t = duration_count();
|
||||
return geom::truncate_digits(static_cast<float>(t), num_digits);
|
||||
}
|
||||
|
||||
float ChronoWatch::elapsed_seconds(int num_digits) const {
|
||||
auto t = duration_count() / 1e3f;
|
||||
return geom::truncate_digits(static_cast<float>(t), num_digits);
|
||||
}
|
||||
|
||||
float ChronoWatch::elapsed_minutes(int num_digits) const {
|
||||
auto t = duration_count() / 1e3f / 60.0f;
|
||||
return geom::truncate_digits(static_cast<float>(t), num_digits);
|
||||
}
|
||||
|
||||
float ChronoWatch::elapsed_hours(int num_digits) const {
|
||||
auto t = duration_count() / 1e3f / 60.0f / 60.0f;
|
||||
return geom::truncate_digits(static_cast<float>(t), num_digits);
|
||||
}
|
||||
|
||||
void ChronoWatch::print_seconds(std::ostream& output) const {
|
||||
output << "Elapsed time: " << elapsed_seconds() << " seconds." << std::endl;
|
||||
}
|
||||
|
||||
void ChronoWatch::print_minutes(std::ostream& output) const {
|
||||
output << "Elapsed time: " << elapsed_minutes() << " minutes." << std::endl;
|
||||
}
|
||||
|
||||
void ChronoWatch::print_hours(std::ostream& output) const {
|
||||
output << "Elapsed time: " << elapsed_hours() << " hours." << std::endl;
|
||||
}
|
||||
|
||||
std::string ChronoWatch::time_string(int num_digits /* = 1*/) const {
|
||||
double time = static_cast<double>(duration_count());
|
||||
if (std::isnan(time) || std::isinf(time))
|
||||
return "inf";
|
||||
|
||||
std::string suffix = "ms";
|
||||
if (time > 1000) {
|
||||
time /= 1000; suffix = "s";
|
||||
if (time > 60) {
|
||||
time /= 60; suffix = "m";
|
||||
if (time > 60) {
|
||||
time /= 60; suffix = "h";
|
||||
if (time > 12) {
|
||||
time /= 12; suffix = "d";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
std::ostringstream os;
|
||||
os << std::setprecision(num_digits)
|
||||
<< std::fixed << time << suffix;
|
||||
|
||||
return os.str();
|
||||
}
|
||||
|
||||
} // namespace easy3d
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_UTIL_CHRONO_WATCH_H
|
||||
#define EASY3D_UTIL_CHRONO_WATCH_H
|
||||
|
||||
|
||||
#include <chrono>
|
||||
#include <ostream>
|
||||
#include <string>
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
/**
|
||||
* usage example:
|
||||
* {
|
||||
* ChronoWatch t;
|
||||
* t.start();
|
||||
*
|
||||
* // do task_1 ...
|
||||
* std::cout << "task_1 done. time: " << t.time_string() << std::endl;
|
||||
*
|
||||
* t.reset(), t.start();
|
||||
* // do task_2 ...
|
||||
* std::cout << "task_1 done. time: " << t.time_string() << std::endl;
|
||||
* }
|
||||
*/
|
||||
|
||||
// Liangliang:
|
||||
// std::chrono::high_resolution_clock has disappointing accuracy on windows.
|
||||
// On windows, you should use the WinAPI QueryPerformanceFrequency().
|
||||
// If you care much about accuracy, use the StopWatch instead.
|
||||
class ChronoWatch
|
||||
{
|
||||
public:
|
||||
ChronoWatch();
|
||||
~ChronoWatch() {}
|
||||
|
||||
void start();
|
||||
|
||||
void pause();
|
||||
void resume();
|
||||
|
||||
void reset();
|
||||
|
||||
float elapsed_milliseconds(int num_digits = 1) const;
|
||||
float elapsed_seconds(int num_digits = 1) const;
|
||||
float elapsed_minutes(int num_digits = 1) const;
|
||||
float elapsed_hours(int num_digits = 1) const;
|
||||
|
||||
void print_seconds(std::ostream& output) const;
|
||||
void print_minutes(std::ostream& output) const;
|
||||
void print_hours(std::ostream& output) const;
|
||||
|
||||
std::string time_string(int num_digits = 1) const;
|
||||
|
||||
private:
|
||||
std::size_t duration_count() const;
|
||||
|
||||
private:
|
||||
bool started_;
|
||||
std::chrono::high_resolution_clock::time_point start_time_;
|
||||
|
||||
bool paused_;
|
||||
std::chrono::high_resolution_clock::time_point pause_time_;
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_UTIL_CHRONO_WATCH_H
|
||||
|
|
@ -0,0 +1,185 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#include <easy3d/util/dialogs.h>
|
||||
|
||||
#include <cstring>
|
||||
|
||||
#include <3rd_party/tinyfiledialogs/tinyfiledialogs.h>
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
|
||||
std::string FileDialog::open(
|
||||
const std::vector<std::string> & filetypes,
|
||||
const std::string& default_path /* = ""*/
|
||||
)
|
||||
{
|
||||
auto result = open(filetypes, false, default_path);
|
||||
return result.empty() ? "" : result.front();
|
||||
}
|
||||
|
||||
|
||||
std::vector<std::string> FileDialog::open(
|
||||
const std::vector<std::string>& filetypes,
|
||||
bool multiple,
|
||||
const std::string& default_path /* = ""*/
|
||||
)
|
||||
{
|
||||
const char** filters = nullptr;
|
||||
if (!filetypes.empty()) {
|
||||
filters = new const char*[filetypes.size()];
|
||||
for (std::size_t i =0; i<filetypes.size(); ++i)
|
||||
filters[i] = filetypes[i].c_str();
|
||||
}
|
||||
|
||||
std::string types_string;
|
||||
for (std::size_t i=0; i<filetypes.size(); ++i)
|
||||
types_string = types_string + filetypes[i] + ((i == filetypes.size() - 1) ? "" : "; ");
|
||||
types_string = "Supported formats (" + types_string + ")";
|
||||
|
||||
const char* buffer = tinyfd_openFileDialog(
|
||||
"Please select the file(s) to open",
|
||||
default_path.c_str(),
|
||||
static_cast<int>(filetypes.size()),
|
||||
filters,
|
||||
types_string.c_str(),
|
||||
multiple
|
||||
);
|
||||
|
||||
std::vector<std::string> files;
|
||||
|
||||
if (buffer) {
|
||||
const char* p = buffer;
|
||||
bool skip_empty_fields = true;
|
||||
const char seperator = '|';
|
||||
std::string sequence(p);
|
||||
std::string::size_type pos = sequence.find_last_of('\n');
|
||||
if (pos != std::string::npos)
|
||||
sequence = sequence.substr(0, pos);
|
||||
std::size_t length = sequence.length();
|
||||
std::size_t start = 0;
|
||||
while (start < length) {
|
||||
std::size_t end = sequence.find(seperator, start);
|
||||
if (end == std::string::npos) {
|
||||
end = length;
|
||||
}
|
||||
if (!skip_empty_fields || (end - start > 0)) {
|
||||
files.push_back(sequence.substr(start, end - start));
|
||||
}
|
||||
start = end + 1;
|
||||
}
|
||||
p += strlen( p );
|
||||
}
|
||||
|
||||
if (filters)
|
||||
delete [] filters;
|
||||
|
||||
return files;
|
||||
}
|
||||
|
||||
|
||||
std::string FileDialog::save(
|
||||
const std::vector<std::string>& filetypes,
|
||||
const std::string& default_file_name /* = ""*/
|
||||
)
|
||||
{
|
||||
const char** filters = nullptr;
|
||||
if (!filetypes.empty()) {
|
||||
filters = new const char*[filetypes.size()];
|
||||
for (std::size_t i =0; i<filetypes.size(); ++i)
|
||||
filters[i] = filetypes[i].c_str();
|
||||
}
|
||||
|
||||
std::string types_string;
|
||||
for (std::size_t i=0; i<filetypes.size(); ++i)
|
||||
types_string = types_string + filetypes[i] + ((i == filetypes.size() - 1) ? "" : "; ");
|
||||
types_string = "Supported formats (" + types_string + ")";
|
||||
|
||||
const char* file = tinyfd_saveFileDialog(
|
||||
"Please specify the file name to save",
|
||||
default_file_name.c_str(),
|
||||
static_cast<int>(filetypes.size()),
|
||||
filters,
|
||||
types_string.c_str()
|
||||
);
|
||||
|
||||
if (filters)
|
||||
delete [] filters;
|
||||
|
||||
if (file)
|
||||
return std::string(file);
|
||||
else
|
||||
return "";
|
||||
}
|
||||
|
||||
|
||||
int message_box(
|
||||
const std::string& title,
|
||||
const std::string& message,
|
||||
const Type& type,
|
||||
const Choice& choice
|
||||
)
|
||||
{
|
||||
// 0 for cancel/no , 1 for ok/yes , 2 for no in yesnocancel
|
||||
int aDefaultButton = 1;
|
||||
|
||||
const char* aDialogType = nullptr;
|
||||
switch (choice) {
|
||||
case Choice::ok: aDialogType = "ok"; break;
|
||||
case Choice::ok_cancel: aDialogType = "okcancel"; break;
|
||||
case Choice::yes_no: aDialogType = "yesno"; break;
|
||||
case Choice::yes_no_cancel: aDialogType = "yesnocancel"; break;
|
||||
}
|
||||
|
||||
const char* aIconType = nullptr;
|
||||
switch (type) {
|
||||
case Type::info: aIconType = "info"; break;
|
||||
case Type::warning: aIconType = "warning"; break;
|
||||
case Type::error: aIconType = "error"; break;
|
||||
case Type::question: aIconType = "question"; break;
|
||||
}
|
||||
return tinyfd_messageBox(
|
||||
title.c_str(),
|
||||
message.c_str(),
|
||||
aDialogType,
|
||||
aIconType,
|
||||
aDefaultButton);
|
||||
}
|
||||
|
||||
|
||||
// c is the current color
|
||||
vec3 ColorDialog::pick(const vec3& c) {
|
||||
unsigned char color[] = {
|
||||
static_cast<unsigned char>(c.x * 255), static_cast<unsigned char>(c.y * 255), static_cast<unsigned char>(c.z * 255)
|
||||
};
|
||||
unsigned char result[3];
|
||||
tinyfd_colorChooser("Choose a color", nullptr, color, result);
|
||||
return vec3(result[0]/255.0f, result[1]/255.0f, result[2]/255.0f);
|
||||
}
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef EASY3D_FILE_DIALOG_H
|
||||
#define EASY3D_FILE_DIALOG_H
|
||||
|
||||
#include <string>
|
||||
#include <vector>
|
||||
|
||||
#include <easy3d/core/types.h>
|
||||
|
||||
|
||||
namespace easy3d
|
||||
{
|
||||
class FileDialog
|
||||
{
|
||||
public:
|
||||
/**
|
||||
* \brief Open a native file open dialog.
|
||||
* \param filetypes The accepted file extentions, e.g., "{"*.jpg","*.png"}"
|
||||
* \param default_path The default file path.
|
||||
*/
|
||||
static std::string open(
|
||||
const std::vector<std::string> & filetypes,
|
||||
const std::string& default_path = ""
|
||||
);
|
||||
|
||||
/**
|
||||
* \brief Open a native file open dialog, which allows multiple selection.
|
||||
* \param filetypes The accepted file extentions, e.g., "{"*.jpg","*.png"}"
|
||||
* \param default_path The default file path.
|
||||
* \param multiple Set to ``true`` if you would like to be able to select multiple
|
||||
* files at once.
|
||||
*/
|
||||
static std::vector<std::string> open(
|
||||
const std::vector<std::string>& filetypes,
|
||||
bool multiple,
|
||||
const std::string& default_path = ""
|
||||
);
|
||||
|
||||
|
||||
/**
|
||||
* \brief Open a native file save dialog.
|
||||
* \param default_file_name The suggested file name, e.g., the file's original name.
|
||||
*/
|
||||
static std::string save(
|
||||
const std::vector<std::string>& filetypes,
|
||||
const std::string& default_file_name = ""
|
||||
);
|
||||
};
|
||||
|
||||
|
||||
enum class Type {
|
||||
info = 0,
|
||||
warning,
|
||||
error,
|
||||
question
|
||||
};
|
||||
|
||||
enum class Choice {
|
||||
ok = 0,
|
||||
ok_cancel,
|
||||
yes_no,
|
||||
yes_no_cancel
|
||||
};
|
||||
int message_box(
|
||||
const std::string& title,
|
||||
const std::string& message,
|
||||
const Type& type = Type::info,
|
||||
const Choice& choice = Choice::ok_cancel
|
||||
);
|
||||
|
||||
|
||||
class ColorDialog {
|
||||
public:
|
||||
// c is the current color
|
||||
static vec3 pick(const vec3& c);
|
||||
};
|
||||
|
||||
}
|
||||
|
||||
#endif // EASY3D_FILE_DIALOG_H
|
||||
|
||||
|
|
@ -0,0 +1,695 @@
|
|||
/*
|
||||
* Copyright (C) 2015 by Liangliang Nan (liangliang.nan@gmail.com)
|
||||
* https://3d.bk.tudelft.nl/liangliang/
|
||||
*
|
||||
* This file is part of Easy3D. If it is useful in your research/work,
|
||||
* I would be grateful if you show your appreciation by citing it:
|
||||
* ------------------------------------------------------------------
|
||||
* Liangliang Nan.
|
||||
* Easy3D: a lightweight, easy-to-use, and efficient C++
|
||||
* library for processing and rendering 3D data. 2018.
|
||||
* ------------------------------------------------------------------
|
||||
*
|
||||
* Easy3D is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License Version 3
|
||||
* as published by the Free Software Foundation.
|
||||
*
|
||||
* Easy3D 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.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
*/
|
||||
|
||||
#include <easy3d/util/file_system.h>
|
||||
#include <easy3d/util/string.h>
|
||||
|
||||
#include <iostream>
|
||||
#include <fstream>
|
||||
#include <cassert>
|
||||
#include <algorithm>
|
||||
#include <cstring>
|
||||
#include <ctime> // for get_time_string()
|
||||
|
||||
#ifdef WIN32
|
||||
#include <Windows.h>
|
||||
#include <io.h>
|
||||
#include <direct.h> // for _mkdir
|
||||
#include <sys/stat.h> // for _stat64
|
||||
#include <ShlObj.h> // for SHGetFolderPathA
|
||||
#else
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <dirent.h>
|
||||
#include <unistd.h>
|
||||
#include <stdio.h>
|
||||
#include <pwd.h>
|
||||
#include <libgen.h>
|
||||
#endif
|
||||
|
||||
#ifdef __APPLE__
|
||||
#include <libproc.h>
|
||||
#endif
|
||||
|
||||
#ifndef PATH_MAX
|
||||
#define PATH_MAX 1024
|
||||
#endif
|
||||
|
||||
|
||||
|
||||
namespace easy3d {
|
||||
|
||||
namespace file_system {
|
||||
|
||||
const char UNIX_PATH_SEPARATOR = '/';
|
||||
const char WINDOWS_PATH_SEPARATOR = '\\';
|
||||
|
||||
static const char* const PATH_SEPARATORS = "/\\";
|
||||
static const unsigned int PATH_SEPARATORS_LEN = 2;
|
||||
|
||||
|
||||
//_______________________OS-dependent functions__________________________
|
||||
|
||||
|
||||
bool is_file(const std::string& filename) {
|
||||
struct stat statbuf;
|
||||
if (::stat(filename.c_str(), &statbuf) != 0)
|
||||
return false; // path does not exist
|
||||
#ifdef _WIN32
|
||||
return (statbuf.st_mode & S_IFREG);
|
||||
#else
|
||||
return S_ISREG(statbuf.st_mode);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
bool is_directory(const std::string& path) {
|
||||
if (path == path_root(path)) // already the root of the path
|
||||
return true;
|
||||
struct stat statbuf;
|
||||
if (::stat(path.c_str(), &statbuf) != 0)
|
||||
return false; // path does not exist
|
||||
#ifdef _WIN32
|
||||
return (statbuf.st_mode & S_IFDIR);
|
||||
#else
|
||||
return S_ISDIR(statbuf.st_mode);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
bool create_directory(const std::string& dir) {
|
||||
if (is_directory(dir)) {
|
||||
std::cout << "directory \'" << dir << "\' already exists" << std::endl;
|
||||
return true;
|
||||
}
|
||||
|
||||
// make sure the parent directory exists
|
||||
const std::string& parent_dir = parent_directory(dir);
|
||||
if (!is_directory(parent_dir))
|
||||
create_directory(parent_dir);
|
||||
|
||||
#ifdef WIN32
|
||||
if (::_mkdir(dir.c_str()) == 0) { // use '_wmkdir()' for Multi-Byte Character Set
|
||||
#else
|
||||
if (::mkdir(dir.c_str(), S_IRWXU | S_IRGRP | S_IXGRP) == 0) {
|
||||
#endif
|
||||
return true;
|
||||
}
|
||||
|
||||
//std::cerr << "could not create directory: " << dir << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
bool delete_contents(const std::string& path) {
|
||||
if (!is_directory(path))
|
||||
return true; // no need to delete
|
||||
|
||||
std::vector<std::string> entries;
|
||||
get_directory_entries(path, entries, false);
|
||||
for (unsigned int i = 0; i < entries.size(); ++i) {
|
||||
const std::string& entry = path + "/" + entries[i];
|
||||
if (is_directory(entry)) {
|
||||
if (!delete_directory(entry)) {
|
||||
std::cerr << "could not delete subdirectory \'" << entry << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
else {
|
||||
if (!delete_file(entry)) {
|
||||
std::cerr << "could not delete file \'" << entry << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
}
|
||||
}
|
||||
return true;
|
||||
}
|
||||
|
||||
bool delete_directory(const std::string& path) {
|
||||
if (!is_directory(path))
|
||||
return true; // no need to delete
|
||||
|
||||
// delete contents first
|
||||
delete_contents(path);
|
||||
|
||||
#ifdef WIN32
|
||||
return (::_rmdir(path.c_str()) == 0);
|
||||
#else
|
||||
return (::rmdir(path.c_str()) == 0);
|
||||
#endif
|
||||
}
|
||||
|
||||
bool delete_file(const std::string& filename) {
|
||||
#ifdef WIN32
|
||||
return (::_unlink(filename.c_str()) == 0); // you can also use "remove()"
|
||||
#else
|
||||
return (::unlink(filename.c_str()) == 0); // you can also use "remove()"
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
std::string current_working_directory() {
|
||||
char path[PATH_MAX] = { 0 };
|
||||
#ifdef WIN32
|
||||
return std::string(::_getcwd(path, PATH_MAX));
|
||||
#else
|
||||
return std::string(::getcwd(path, PATH_MAX));
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
bool set_current_working_directory(const std::string& path) {
|
||||
#ifdef WIN32
|
||||
return (::_chdir(path.c_str()) == 0); // // use '_wchdir()' for Multi-Byte Character Set
|
||||
#else
|
||||
return (::chdir(path.c_str()) == 0); // // use '_wchdir()' for Multi-Byte Character Set
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
std::string home_directory() {
|
||||
char path[PATH_MAX] = { 0 };
|
||||
// TODO: Use HOME environment variable?
|
||||
#ifdef _WIN32
|
||||
// SHGetFolderPathA seems to expect non-wide chars
|
||||
// http://msdn.microsoft.com/en-us/library/bb762181(VS.85).aspx
|
||||
// FIXME: Max length of home path?
|
||||
if (!SUCCEEDED(::SHGetFolderPathA(nullptr, CSIDL_APPDATA, nullptr, 0, path)))
|
||||
std::cerr << "Cannot determine home directory" << std::endl;
|
||||
#else // _WIN32
|
||||
uid_t user_id = ::geteuid();
|
||||
struct passwd* user_info = ::getpwuid(user_id);
|
||||
if (user_info == nullptr || user_info->pw_dir == nullptr)
|
||||
std::cerr << "Cannot determine home directory" << std::endl;
|
||||
std::strncpy(path, user_info->pw_dir, PATH_MAX);
|
||||
#endif // _WIN32
|
||||
|
||||
return path;
|
||||
}
|
||||
|
||||
|
||||
std::string executable() {
|
||||
char path[PATH_MAX] = { 0 };
|
||||
#ifdef _WIN32
|
||||
// When NULL is passed to GetModuleHandle, the handle of the exe itself is returned
|
||||
HMODULE hModule = GetModuleHandle(nullptr);
|
||||
if (hModule) {
|
||||
GetModuleFileName(hModule, path, MAX_PATH);
|
||||
return path;
|
||||
}
|
||||
#elif defined (__APPLE__)
|
||||
pid_t pid = getpid();
|
||||
// proc_pidpath() gets the full process name including directories to the
|
||||
// executable and the full executable name.
|
||||
int ret = proc_pidpath(pid, path, sizeof(path));
|
||||
if (ret > 0)
|
||||
return path;
|
||||
#else
|
||||
ssize_t count = readlink("/proc/self/exe", path, PATH_MAX);
|
||||
if (count != -1)
|
||||
return path;
|
||||
#endif // _WIN32
|
||||
// If failed, simply returns current working directory.
|
||||
return current_working_directory();
|
||||
}
|
||||
|
||||
|
||||
std::string executable_directory() {
|
||||
return parent_directory(executable());
|
||||
}
|
||||
|
||||
|
||||
bool rename_file(const std::string& old_name, const std::string& new_name) {
|
||||
if (is_file(new_name)) {
|
||||
return false;
|
||||
}
|
||||
return (::rename(old_name.c_str(), new_name.c_str()) == 0);
|
||||
}
|
||||
|
||||
|
||||
time_t time_stamp(const std::string& file_or_dir) {
|
||||
struct stat buffer;
|
||||
if (!stat(file_or_dir.c_str(), &buffer))
|
||||
return (buffer.st_mtime);
|
||||
return 0;
|
||||
}
|
||||
|
||||
std::string time_string(const std::string& file_or_dir) {
|
||||
time_t stamp = time_stamp(file_or_dir);
|
||||
if (stamp != 0) {
|
||||
struct tm* timeinfo = localtime(&stamp);
|
||||
std::string tstr = asctime(timeinfo);
|
||||
//return tstr;
|
||||
return tstr.substr(0, tstr.length() - 1); // discard the terminating null-character
|
||||
}
|
||||
else
|
||||
return "Unknown. Error occurred.";
|
||||
}
|
||||
|
||||
std::ifstream::pos_type file_size(const std::string& filename) {
|
||||
std::ifstream in(filename, std::ifstream::ate | std::ifstream::binary);
|
||||
return in.tellg();
|
||||
}
|
||||
|
||||
|
||||
void get_directory_entries(const std::string& dir, std::vector<std::string>& contents) {
|
||||
if (!is_directory(dir)) {
|
||||
std::cerr << "directory \'" << dir << " \' does not exist" << std::endl;
|
||||
}
|
||||
|
||||
#if defined(WIN32) && !defined(__CYGWIN__)
|
||||
|
||||
std::string path = dir + "/*.*";
|
||||
_finddata_t data;
|
||||
intptr_t handle = _findfirst(path.c_str(), &data);
|
||||
if (handle != -1) {
|
||||
do {
|
||||
// "." and ".." seems always there on Windows
|
||||
if (std::strcmp(data.name, ".") != 0 && std::strcmp(data.name, "..") != 0)
|
||||
contents.push_back(data.name);
|
||||
} while (_findnext(handle, &data) != -1);
|
||||
|
||||
_findclose(handle);
|
||||
}
|
||||
#else
|
||||
DIR *handle = opendir(dir.c_str());
|
||||
if (handle)
|
||||
{
|
||||
dirent *rc;
|
||||
while ((rc = readdir(handle)) != nullptr) {
|
||||
// some OSs (e.g., macOS) may include ".", "..", and ".DS_Store" in directory entries
|
||||
if (std::strcmp(rc->d_name, ".") != 0 && std::strcmp(rc->d_name, "..") != 0 && std::strcmp(rc->d_name, ".DS_Store") != 0)
|
||||
contents.push_back(rc->d_name);
|
||||
}
|
||||
closedir(handle);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
//_______________________OS-independent functions__________________________
|
||||
|
||||
|
||||
std::string extension(const std::string& file_name, bool lowercase) {
|
||||
std::string::size_type dot = file_name.find_last_of('.');
|
||||
std::string::size_type slash = file_name.find_last_of(PATH_SEPARATORS);
|
||||
if (dot == std::string::npos || (slash != std::string::npos && dot < slash))
|
||||
return std::string("");
|
||||
|
||||
std::string ext(file_name.begin() + dot + 1, file_name.end());
|
||||
if (lowercase)
|
||||
return string::to_lowercase(ext);
|
||||
else
|
||||
return ext;
|
||||
}
|
||||
|
||||
std::string base_name(const std::string& file_path) {
|
||||
const std::string& simpleName = simple_name(file_path);
|
||||
return name_less_extension(simpleName);
|
||||
}
|
||||
|
||||
std::string parent_directory(const std::string& file_name) {
|
||||
std::string::size_type slash = file_name.find_last_of(PATH_SEPARATORS);
|
||||
if (slash == std::string::npos)
|
||||
return std::string();
|
||||
else
|
||||
return std::string(file_name, 0, slash);
|
||||
}
|
||||
|
||||
std::string simple_name(const std::string& file_name) {
|
||||
std::string::size_type slash = file_name.find_last_of(PATH_SEPARATORS);
|
||||
if (slash == std::string::npos)
|
||||
return file_name;
|
||||
else
|
||||
return std::string(file_name.begin() + slash + 1, file_name.end());
|
||||
}
|
||||
|
||||
|
||||
// strip one level of extension from the filename.
|
||||
std::string name_less_extension(const std::string& file_name)
|
||||
{
|
||||
std::string::size_type dot = file_name.find_last_of('.');
|
||||
std::string::size_type slash = file_name.find_last_of(PATH_SEPARATORS); // Finds forward slash *or* back slash
|
||||
if (dot == std::string::npos || (slash != std::string::npos && dot < slash))
|
||||
return file_name;
|
||||
|
||||
return std::string(file_name.begin(), file_name.begin() + dot);
|
||||
}
|
||||
|
||||
|
||||
// strip all extensions from the filename.
|
||||
std::string name_less_all_extensions(const std::string& file_name) {
|
||||
// Finds start serach position: from last slash, or the begining of the string if none found
|
||||
std::string::size_type startPos = file_name.find_last_of(PATH_SEPARATORS); // Finds forward slash *or* back slash
|
||||
if (startPos == std::string::npos)
|
||||
startPos = 0;
|
||||
std::string::size_type dot = file_name.find_first_of('.', startPos); // Finds *FIRST* dot from start pos
|
||||
if (dot == std::string::npos)
|
||||
return file_name;
|
||||
|
||||
return std::string(file_name.begin(), file_name.begin() + dot);
|
||||
}
|
||||
|
||||
std::string replace_extension(std::string const& file_name, std::string const& ext)
|
||||
{
|
||||
std::size_t slashpos = file_name.find_last_of(PATH_SEPARATORS);
|
||||
if (slashpos == std::string::npos)
|
||||
slashpos = 0;
|
||||
|
||||
std::size_t dotpos = file_name.find_last_of('.');
|
||||
if (dotpos == std::string::npos || dotpos < slashpos)
|
||||
return file_name + "." + ext;
|
||||
|
||||
return file_name.substr(0, dotpos) + "." + ext;
|
||||
}
|
||||
|
||||
std::string path_root(const std::string& path) {
|
||||
// Test for unix root
|
||||
if (path.empty())
|
||||
return "";
|
||||
if (path[0] == '/')
|
||||
return "/";
|
||||
// Now test for Windows root
|
||||
if (path.length() < 2)
|
||||
return "";
|
||||
if (path[1] == ':') {
|
||||
// We should check that path[0] is a letter, but as ':' is invalid in paths in other cases, that's not a problem.
|
||||
return path.substr(0, 2);
|
||||
}
|
||||
|
||||
return "";
|
||||
}
|
||||
|
||||
bool is_absolute_path(const std::string& path) {
|
||||
if (path.empty())
|
||||
return false;
|
||||
// Unix-like OS: /path/to/file
|
||||
if (path.front() == '/')
|
||||
return true;
|
||||
// Windows: \\server\user\file
|
||||
if (path.size() > 1 && path[0] == '\\' && path[1] == '\\') {
|
||||
return true;
|
||||
}
|
||||
// Windows: X:\path\to\file
|
||||
if (path.size() > 2 && ::isalpha(path[0]) && path[1] == ':' &&
|
||||
path[2] == '\\') {
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
namespace details {
|
||||
/** Helper to iterate over elements of a path (including Windows' root, if any). **/
|
||||
class PathIterator {
|
||||
public:
|
||||
PathIterator(const std::string & v);
|
||||
bool valid() const { return start!=end; }
|
||||
PathIterator & operator++();
|
||||
std::string operator*();
|
||||
|
||||
protected:
|
||||
std::string::const_iterator end; ///< End of path string
|
||||
std::string::const_iterator start; ///< Points to the first char of an element, or ==end() if no more
|
||||
std::string::const_iterator stop; ///< Points to the separator after 'start', or ==end()
|
||||
|
||||
/// Iterate until 'it' points to something different from a separator
|
||||
std::string::const_iterator skipSeparators(std::string::const_iterator it);
|
||||
std::string::const_iterator next(std::string::const_iterator it);
|
||||
};
|
||||
|
||||
PathIterator::PathIterator(const std::string & v) : end(v.end()), start(v.begin()), stop(v.begin()) { operator++(); }
|
||||
PathIterator& PathIterator::operator++()
|
||||
{
|
||||
if (!valid()) return *this;
|
||||
start = skipSeparators(stop);
|
||||
if (start != end) stop = next(start);
|
||||
return *this;
|
||||
}
|
||||
|
||||
std::string PathIterator::operator*()
|
||||
{
|
||||
if (!valid()) return std::string();
|
||||
return std::string(start, stop);
|
||||
}
|
||||
|
||||
std::string::const_iterator PathIterator::skipSeparators(std::string::const_iterator it)
|
||||
{
|
||||
for (; it!=end && std::find_first_of(it, it+1, PATH_SEPARATORS, PATH_SEPARATORS+PATH_SEPARATORS_LEN) != it+1; ++it) {}
|
||||
return it;
|
||||
}
|
||||
|
||||
std::string::const_iterator PathIterator::next(std::string::const_iterator it)
|
||||
{
|
||||
return std::find_first_of(it, end, PATH_SEPARATORS, PATH_SEPARATORS+PATH_SEPARATORS_LEN);
|
||||
}
|
||||
}
|
||||
|
||||
//std::string testA = relative_path("C:\\a\\b", "C:\\a/b/d/f"); // d/f
|
||||
//std::string testB = relative_path("C:\\a\\d", "C:\\a/b/d/f"); // ../b/d/f
|
||||
//std::string testC = relative_path("C:\\ab", "C:\\a/b/d/f"); // ../a/b/d/f
|
||||
//std::string testD = relative_path("a/d", "a/d"); // ""
|
||||
//std::string testE = relative_path("a", "a/d"); // ../d
|
||||
//std::string testF = relative_path("C:/a/b", "a/d"); // Precondition fail. Returns d.
|
||||
//std::string testG = relative_path("/a/b", "a/d"); // Precondition fail. Returns d.
|
||||
//std::string testH = relative_path("a/b", "/a/d"); // Precondition fail. Returns d.
|
||||
//
|
||||
// See Qt's QDir::absoluteFilePath(), QDir::relativeFilePath() ...
|
||||
std::string relative_path(const std::string& from_path, const std::string& to_path) {
|
||||
// This implementation is not 100% robust, and should be replaced with C++0x "std::path" as soon as possible.
|
||||
|
||||
// Definition: an "element" is a part between slashes. Ex: "/a/b" has two elements ("a" and "b").
|
||||
// Algorithm:
|
||||
// 1. If paths are neither both absolute nor both relative, we need to make them absolute.
|
||||
// 2. If both paths are absolute and root isn't the same (for Windows only, as roots are of the type "C:", "D:"), then the operation is impossible. Return.
|
||||
// 3. Iterate over two paths elements until elements are equal
|
||||
// 4. For each remaining element in "from", add ".." to result
|
||||
// 5. For each remaining element in "to", add this element to result
|
||||
|
||||
// 1 & 2
|
||||
const std::string& from = absolute_path(from_path);
|
||||
const std::string& to = absolute_path(to_path);
|
||||
|
||||
const std::string root = path_root(from);
|
||||
if (root != path_root(to)) {
|
||||
std::cerr << "Cannot relativise paths. From=" << from << ", To=" << to << ". Returning 'to' unchanged." << std::endl;
|
||||
//return to;
|
||||
return simple_name(to);
|
||||
}
|
||||
|
||||
// 3
|
||||
details::PathIterator itFrom(from), itTo(to);
|
||||
// Iterators may point to Windows roots. As we tested they are equal, there is no need to ++itFrom and ++itTo.
|
||||
// However, if we got an Unix root, we must add it to the result.
|
||||
std::string res(root == "/" ? "/" : "");
|
||||
for(; itFrom.valid() && itTo.valid() && *itFrom==*itTo; ++itFrom, ++itTo) {}
|
||||
|
||||
// 4
|
||||
for(; itFrom.valid(); ++itFrom) res += "../";
|
||||
|
||||
// 5
|
||||
for(; itTo.valid(); ++itTo) res += *itTo + "/";
|
||||
|
||||
// Remove trailing slash before returning
|
||||
if (!res.empty() && std::find_first_of(res.rbegin(), res.rbegin()+1, PATH_SEPARATORS, PATH_SEPARATORS+PATH_SEPARATORS_LEN) != res.rbegin()+1)
|
||||
{
|
||||
return res.substr(0, res.length()-1);
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
std::string absolute_path(const std::string& path)
|
||||
{
|
||||
char resolved_path[PATH_MAX] = { 0 };
|
||||
#if defined(WIN32) && !defined(__CYGWIN__)
|
||||
if (_fullpath(resolved_path, path.c_str(), PATH_MAX) != 0)
|
||||
return resolved_path;
|
||||
else {
|
||||
std::cerr << "invalid path. Returning 'path' unchanged." << std::endl;
|
||||
return path;
|
||||
}
|
||||
#else
|
||||
char* result = realpath(path.c_str(), resolved_path);
|
||||
if (result)
|
||||
return std::string(resolved_path);
|
||||
else
|
||||
return path;
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
std::string convert_to_windows_style(const std::string& path) {
|
||||
std::string new_fileName(path);
|
||||
|
||||
std::string::size_type slash = 0;
|
||||
while ((slash = new_fileName.find_first_of(UNIX_PATH_SEPARATOR, slash)) != std::string::npos)
|
||||
{
|
||||
new_fileName[slash] = WINDOWS_PATH_SEPARATOR;
|
||||
}
|
||||
return new_fileName;
|
||||
}
|
||||
|
||||
std::string convert_to_unix_style(const std::string& path) {
|
||||
std::string new_fileName(path);
|
||||
|
||||
std::string::size_type slash = 0;
|
||||
while ((slash = new_fileName.find_first_of(WINDOWS_PATH_SEPARATOR, slash)) != std::string::npos)
|
||||
{
|
||||
new_fileName[slash] = UNIX_PATH_SEPARATOR;
|
||||
}
|
||||
|
||||
return new_fileName;
|
||||
}
|
||||
|
||||
char native_path_separator() {
|
||||
#if defined(WIN32) && !defined(__CYGWIN__)
|
||||
return WINDOWS_PATH_SEPARATOR;
|
||||
#else
|
||||
return UNIX_PATH_SEPARATOR;
|
||||
#endif
|
||||
}
|
||||
|
||||
bool is_native_style(const std::string& path) {
|
||||
#if defined(WIN32) && !defined(__CYGWIN__)
|
||||
return path.find(UNIX_PATH_SEPARATOR) == std::string::npos; // return true if no unix style slash exist
|
||||
#else
|
||||
return path.find(WINDOWS_PATH_SEPARATOR) == std::string::npos; // return true if no windows style backslash exist
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
std::string convert_to_native_style(const std::string& path) {
|
||||
#if defined(WIN32) && !defined(__CYGWIN__)
|
||||
return convert_to_windows_style(path);
|
||||
#else
|
||||
return convert_to_unix_style(path);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
void get_directory_entries(
|
||||
const std::string& dir, std::vector<std::string>& result, bool recursive
|
||||
)
|
||||
{
|
||||
get_directory_entries(dir, result);
|
||||
if (recursive) {
|
||||
for (unsigned int i = 0; i < result.size(); i++) {
|
||||
const std::string path = dir + "/" + result[i];
|
||||
if (is_directory(path)) {
|
||||
std::vector<std::string> entries;
|
||||
// no need recursion because 'result' is continuously growing and
|
||||
// the new entries are continuously be checked.
|
||||
get_directory_entries(path, entries);
|
||||
for (unsigned int j = 0; j < entries.size(); ++j)
|
||||
result.push_back(result[i] + "/" + entries[j]);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void get_files(const std::string& dir, std::vector<std::string>& result, bool recursive) {
|
||||
std::vector<std::string> entries;
|
||||
get_directory_entries(dir, entries, recursive);
|
||||
for (unsigned int i = 0; i < entries.size(); i++) {
|
||||
const std::string name = dir + "/" + entries[i];
|
||||
if (is_file(name)) {
|
||||
result.push_back(name);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void get_sub_directories(const std::string& dir, std::vector<std::string>& result, bool recursive) {
|
||||
std::vector<std::string> entries;
|
||||
get_directory_entries(dir, entries, recursive);
|
||||
for (unsigned int i = 0; i < entries.size(); i++) {
|
||||
const std::string name = dir + "/" + entries[i];
|
||||
if (is_directory(name)) {
|
||||
result.push_back(name);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
bool copy_file(const std::string& original, const std::string& copy) {
|
||||
std::ifstream in(original.c_str());
|
||||
if (in.fail()) {
|
||||
std::cerr << "could not open file \'" << original << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
std::ofstream out(copy.c_str());
|
||||
if (in.fail()) {
|
||||
std::cerr << "could not open file \'" << copy << "\'" << std::endl;
|
||||
return false;
|
||||
}
|
||||
|
||||
std::string line;
|
||||
while (in.good()) {
|
||||
getline(in, line);
|
||||
out << line << std::endl;
|
||||
}
|
||||
|
||||
return true;
|
||||
}
|
||||
|
||||
bool file_contains_string(const std::string& file_name, const std::string& x) {
|
||||
std::ifstream in(file_name.c_str());
|
||||
std::string buff;
|
||||
while (in) {
|
||||
getline(in, buff);
|
||||
if (buff.find(x) != std::string::npos)
|
||||
return true;
|
||||
}
|
||||
return false;
|
||||
}
|
||||
|
||||
|
||||
void read_file_to_string(const std::string& filename, std::string& data) {
|
||||
std::ifstream in(filename.c_str(), std::fstream::binary);
|
||||
if (in.fail()) {
|
||||
std::cerr << "Could not open file \'" << filename << "\'" << std::endl;
|
||||
return;
|
||||
}
|
||||
|
||||
in.seekg(0, std::ios::end);
|
||||
std::fstream::pos_type length = in.tellg();
|
||||
in.seekg(0, std::ios::beg);
|
||||
data.resize(length);
|
||||
in.read(&(data[0]), length);
|
||||
in.close();
|
||||
}
|
||||
|
||||
void write_string_to_file(const std::string& data, const std::string& filename) {
|
||||
std::ofstream out(filename.c_str(), std::ios::binary);
|
||||
if (out.fail()) {
|
||||
std::cerr << "Could not open file \'" << filename << "\'" << std::endl;
|
||||
return;
|
||||
}
|
||||
out.write(data.c_str(), data.length());
|
||||
out.close();
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
} // namespace easy3
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue