bool qr(const cmat &A, cmat &Q, cmat &R, bmat &P)
{
int info;
int m = A.rows();
int n = A.cols();
int lwork = n;
int k = std::min(m, n);
cvec tau(k);
cvec work(lwork);
vec rwork(std::max(1, 2*n));
ivec jpvt(n);
jpvt.zeros();
R = A;
// perform workspace query for optimum lwork value
int lwork_tmp = -1;
zgeqp3_(&m, &n, R._data(), &m, jpvt._data(), tau._data(), work._data(),
&lwork_tmp, rwork._data(), &info);
if (info == 0) {
lwork = static_cast<int>(real(work(0)));
work.set_size(lwork, false);
}
zgeqp3_(&m, &n, R._data(), &m, jpvt._data(), tau._data(), work._data(),
&lwork, rwork._data(), &info);
Q = R;
Q.set_size(m, m, true);
// construct permutation matrix
P = zeros_b(n, n);
for (int j = 0; j < n; j++)
P(jpvt(j) - 1, j) = 1;
// construct R
for (int i = 0; i < m; i++)
for (int j = 0; j < std::min(i, n); j++)
R(i, j) = 0;
// perform workspace query for optimum lwork value
lwork_tmp = -1;
zungqr_(&m, &m, &k, Q._data(), &m, tau._data(), work._data(), &lwork_tmp,
&info);
if (info == 0) {
lwork = static_cast<int>(real(work(0)));
work.set_size(lwork, false);
}
zungqr_(&m, &m, &k, Q._data(), &m, tau._data(), work._data(), &lwork,
&info);
return (info == 0);
}
void PolyFit1D(UInt nsamples, const double coord[], const double vals[], const std::vector<POLY*> &poly, double coef[])
{
#ifdef ESMCI_LAPACK
UInt ncoef = poly.size();
int m = nsamples, n = ncoef, nrhs = 1, info = 0, rank, ldb;
ldb = std::max(std::max(m,n),1);
std::vector<double> mat(nsamples*ncoef);
std::vector<double> rhs(ldb);
for (UInt i = 0; i < nsamples; i++) {
rhs[i] = vals[i]; // sizing might not be right, so copy
for (UInt j = 0; j < ncoef; j++) {
mat[j*nsamples + i] = EvalPoly<POLY>()(*poly[j], coord[i]);
}
}
std::vector<int> jpvt(ncoef, 0);
//int lwork = std::max(std::min(m,n)+2*n+1, 2*std::min(m,n)+nrhs);
// TODO figure this out
int lwork = 4028;
std::vector<double> work(lwork, 0);
double rcond=0.0000000000001;
FTN(dgelsy)(
&m, &n, &nrhs, &mat[0], &m, &rhs[0], &ldb, &jpvt[0], &rcond, &rank, &work[0], &lwork, &info);
for (UInt i = 0; i < ncoef; i++) coef[i] = rhs[i];
#endif
}
int ccdl::LeastSquaresFit
( int const nobs, int const nparam,
double const * A_obs_by_param,
double * x_param,
double const * b_obs,
double relative_accuracy_of_the_obs )
{
// min (xt.At-bt).(A.x-b)
std::vector<double> A( A_obs_by_param, A_obs_by_param + nparam*nobs );
int nmax = std::max( nparam, nobs );
std::vector<double> X( nmax, 0. );
std::copy( b_obs, b_obs + nobs, X.data() );
std::vector<int> jpvt( nparam, 0 );
int LWORK = -1;
int INFO = 0;
double twork = 0;
int rank = 0;
int nrhs=1;
dgelsy_( &nobs, &nparam, &nrhs,
A.data(), &nobs, X.data(), &nmax,
jpvt.data(), &relative_accuracy_of_the_obs, &rank,
&twork, &LWORK, &INFO );
if ( INFO == 0 )
{
LWORK = twork+1;
std::vector<double> WORK( LWORK, 0. );
#ifdef PDBG
std::printf("dgelsy_\n");
#endif
dgelsy_( &nobs, &nparam, &nrhs,
A.data(), &nobs, X.data(), &nmax,
jpvt.data(), &relative_accuracy_of_the_obs, &rank,
WORK.data(), &LWORK, &INFO );
#ifdef PDBG
std::printf("return %i\n",INFO);
#endif
std::copy( X.data(), X.data() + nparam, x_param );
}
else
{
std::fill( x_param, x_param + nparam, 0. );
};
return INFO;
}
int
Simplex::solve(std::vector<double>& rhs) const {
// save the input matrix and rhs vector so we get a chance to
// recover in case of a singular matrix.
const double residualTol = 1.e-8;
std::vector<double> mat(mnpdims * mndims);
// build the matrix system
for (size_t jcol = 0; jcol < mnpdims; ++jcol) {
for (size_t irow = 0; irow < mndims; ++irow) {
mat[irow + jcol*mndims] = mvertices[jcol + 1][irow] - mvertices[0][irow];
}
}
std::vector<double> matCopy(mnpdims * mndims);
std::vector<double> bCopy(rhs.size());
std::copy(mat.begin(), mat.end(), matCopy.begin());
std::copy(rhs.begin(), rhs.end(), bCopy.begin());
int nrow = (int) mndims;
int ncol = (int) mnpdims;
char t = 'n';
int one = 1;
int mn = ncol;
int nb = 1; // optimal block size
int lwork = mn + mn*nb;
std::vector<double> work((size_t) lwork);
int errCode = 0;
_GELS_(&t, &nrow, &ncol, &one,
&matCopy.front(), &nrow,
&rhs.front(), &nrow,
&work.front(), &lwork, &errCode);
if (!errCode) {
// merrCode == 0 indicates everything was fine
// merrCode < 0 indicates bad entry
// in either case return
return errCode;
}
else if (errCode > 0) {
if (nrow <= 1) {
return errCode;
}
for (size_t i = 0; i < mndims; ++i) {
rhs[i] = bCopy[i];
}
errCode = 0;
// relative accuracy in the matrix data
double rcond = std::numeric_limits<double>::epsilon();
int rank;
std::vector<int> jpvt(ncol);
lwork = mn + 3*ncol + 1 > 2*mn + nb*1? mn + 3*ncol + 1: 2*mn + nb*1;
work.resize(lwork);
_GELSY_(&nrow, &ncol, &one,
&matCopy.front(), &nrow,
&rhs.front(), &nrow,
&jpvt.front(), &rcond, &rank, &work.front(), &lwork, &errCode);
// check if this is a good solution
double residualError = 0.0;
for (size_t i = 0; i < mndims; ++i) {
double rowSum = 0.0;
for (size_t j = 0; j < mnpdims; ++j) {
rowSum += mat[i + nrow*j]*rhs[j];
}
residualError += std::abs(rowSum - bCopy[i]);
}
if (residualError < residualTol) {
// good enough
errCode = 1;
return errCode;
}
// some error
errCode = 2;
return errCode;
}
// we should never reach that point
errCode = 0;
return errCode;
}
