int GMRFLib_comp_posdef_inverse(double *matrix, int dim)
{
/*
* overwrite a symmetric MATRIX with its inverse
*/
int info = 0, i, j;
switch (GMRFLib_blas_level) {
case BLAS_LEVEL2:
dpotf2_("L", &dim, matrix, &dim, &info, 1);
break;
case BLAS_LEVEL3:
dpotrf_("L", &dim, matrix, &dim, &info, 1);
break;
default:
GMRFLib_ASSERT(1 == 0, GMRFLib_ESNH);
break;
}
if (info)
GMRFLib_ERROR(GMRFLib_ESINGMAT);
dpotri_("L", &dim, matrix, &dim, &info, 1);
if (info)
GMRFLib_ERROR(GMRFLib_ESINGMAT);
for (i = 0; i < dim; i++) /* fill the U-part */
for (j = i + 1; j < dim; j++)
matrix[i + j * dim] = matrix[j + i * dim];
return GMRFLib_SUCCESS;
}
/*!
\brief Creates a \c GMRFLib_optimize_param_tp -object holding the default settings.
\param[out] optpar A pointer to a \c GMRFLib_optimize_param_tp pointer.
At output the \c GMRFLib_optimize_param_tp -object contains the default values.
\par Description of elements in \c GMRFLib_optimize_param_tp -object:
\n \em fp: A file for printing output from the optimizer. \n
<b>Default value: \c NULL</b> \n\n
\em opt_type: The type of optimizer to be used. Four methods are available.\n
<b>Default value: #GMRFLib_OPTTYPE_SAFENR</b> \n\n
\em nsearch_dir: Indicates the number of previously search gradient directions
on which the current search direction should be orthogonal (using the conjugate
gradient (CG) method). \n
<b>Default value: 1</b> \n\n
\em restart_interval: If <em>restart_interval = r </em>,
the CG search will be restarted every <em>r</em>'th iteration. \n
<b>Default value: 10</b> \n\n
\em max_iter: The maximum number of iterations. \n
<b>Default value: 200</b> \n\n
\em fixed_iter: If > 0, then this fix the number of iterations, whatever
all other stopping-options. \n
<b>Default value: 0</b> \n\n
\em max_linesearch_iter: The maximum number of iterations within each search
direction (CG). \n
<b>Default value: 200</b> \n\n
\em step_len: Step length in the computation of a Taylor expansion or second
order approximation of the log-likelihood around a point
<em> \b x_0</em> (CG and NR). \n
<b>Default value: 1.0e-4</b> \n\n
\em abserr_func: The absolute error tolerance for the value of the function
to be optimized (CG and NR). \n
<b>Default value: 0.5e-3</b> \n\n
\em abserr_step: The absolute error tolerance, relative to the number of nodes,
for the size of one step of the optimizer (CG and NR). \n
<b>Default value: 0.5e-3</b> \n
*/
int GMRFLib_default_optimize_param(GMRFLib_optimize_param_tp **optpar)
{
/*
define default values for the optimizer.
methods are
GMRFLib_OPTTYPE_NR : newton-raphson O(n^1.5) - O(n^2)
GMRFLib_OPTTYPE_CG : conjugate gradient method O(n log(n)) or so
*/
GMRFLib_ASSERT(optpar, GMRFLib_EINVARG);
*optpar = Calloc(1, GMRFLib_optimize_param_tp); MEMCHK(*optpar);
(*optpar)->fp = NULL;
(*optpar)->opt_type = GMRFLib_OPTTYPE_SAFENR;
(*optpar)->nsearch_dir = 1;
(*optpar)->restart_interval = 10;
(*optpar)->max_iter = 200;
(*optpar)->fixed_iter = 0; /* default: do not use */
(*optpar)->max_linesearch_iter = 200;
(*optpar)->step_len = 1.0e-4;
(*optpar)->abserr_func = 0.5e-3;
(*optpar)->abserr_step = 0.5e-3;
return GMRFLib_SUCCESS;
}
/*!
\brief The inverse cummulative distribution function for the Chi-square distribution
\param[in] p The value such that \f$\mbox{Prob}(X \le x) = p\f$.
\param[in] dof The degrees of freedom
The returned value is \f$x\f$ such that \f$\mbox{Prob}(X \le x) = p\f$.
*/
double GMRFLib_invChiSquare(double p, double dof)
{
int which = 2, status = 0;
double q = 1.0 - p, bound = 0.0, x;
cdfchi_(&which, &p, &q, &x, &dof, &status, &bound);
GMRFLib_ASSERT(status == 0, GMRFLib_EDCDFLIB);
return x;
}
int GMRFLib_comp_chol_general(double **chol, double *matrix, int dim, double *logdet, int ecode)
{
/*
* return a malloc'ed cholesky factorisation of MATRIX in *chol and optional the log(determinant). if fail return
* `ecode'
*
*/
int info = 0, i, j;
double *a = NULL, det;
if (dim == 0) {
*chol = NULL;
return GMRFLib_SUCCESS;
}
a = Calloc(ISQR(dim), double);
memcpy(a, matrix, ISQR(dim) * sizeof(double));
switch (GMRFLib_blas_level) {
case BLAS_LEVEL2:
dpotf2_("L", &dim, a, &dim, &info, 1);
break;
case BLAS_LEVEL3:
dpotrf_("L", &dim, a, &dim, &info, 1);
break;
default:
GMRFLib_ASSERT(1 == 0, GMRFLib_ESNH);
break;
}
if (info) {
Free(a);
*chol = NULL;
return ecode;
}
if (logdet) {
for (det = 0.0, i = 0; i < dim; i++) {
det += log(a[i + i * dim]);
}
*logdet = 2.0 * det;
}
for (i = 0; i < dim; i++) { /* set to zero the upper part */
for (j = i + 1; j < dim; j++) {
a[i + j * dim] = 0.0;
}
}
*chol = a;
return GMRFLib_SUCCESS;
}
int GMRFLib_qsorts(void *x, size_t nmemb, size_t size_x, void *y, size_t size_y, void *z, size_t size_z, int (*compar) (const void *, const void *))
{
/*
* sort x and optionally sort y and z along
*
* if z is non-NULL, then y must be so as well.
*/
char *xyz = NULL, *xx = NULL, *yy = NULL, *zz = NULL;
size_t siz, i, offset;
if (nmemb == 0) {
return GMRFLib_SUCCESS;
}
if (z) {
GMRFLib_ASSERT(y, GMRFLib_EINVARG);
}
xx = (char *) x;
yy = (char *) y;
zz = (char *) z;
siz = size_x;
if (y) {
siz += size_y;
if (z) {
siz += size_z;
}
}
xyz = Calloc(nmemb * siz, char);
for (i = 0; i < nmemb; i++) {
memcpy((void *) &xyz[i * siz], (void *) &xx[i * size_x], size_x);
}
if (y) {
offset = size_x;
for (i = 0; i < nmemb; i++) {
memcpy((void *) &xyz[i * siz + offset], (void *) &yy[i * size_y], size_y);
}
if (z) {
offset = size_x + size_y;
for (i = 0; i < nmemb; i++) {
memcpy((void *) &xyz[i * siz + offset], (void *) &zz[i * size_z], size_z);
}
}
}
qsort((void *) xyz, nmemb, siz, compar);
for (i = 0; i < nmemb; i++) {
memcpy((void *) &xx[i * size_x], (void *) &xyz[i * siz], size_x);
}
if (y) {
offset = size_x;
for (i = 0; i < nmemb; i++) {
memcpy((void *) &yy[i * size_y], (void *) &xyz[i * siz + offset], size_y);
}
if (z) {
offset = size_x + size_y;
for (i = 0; i < nmemb; i++) {
memcpy((void *) &zz[i * size_z], (void *) &xyz[i * siz + offset], size_z);
}
}
}
Free(xyz);
return GMRFLib_SUCCESS;
}
int GMRFLib_optimize_store(double *mode, double *b, double *c, double *mean,
GMRFLib_graph_tp *graph, GMRFLib_Qfunc_tp *Qfunc, char *Qfunc_args,
char *fixed_value, GMRFLib_constr_tp *constr,
double *d, GMRFLib_logl_tp *loglFunc, char *loglFunc_arg,
GMRFLib_optimize_param_tp *optpar,
GMRFLib_store_tp *store)
{
/*
locate the mode starting in 'mode' using a conjugate gradient algorithm where the search
direction is Q-ortogonal to the m previous ones.
exp(-0.5(x-mean)'Q(x-mean)+b'x + \sum_i d_i loglFunc(x_i,i,logl_arg)) && fixed-flags
and linear deterministic and stochastic constaints
*/
int sub_n, i, j, node, nnode, free_optpar, fail;
double *cc = NULL, *initial_value = NULL;
GMRFLib_store_tp *store_ptr;
GMRFLib_optimize_problem_tp *opt_problem = NULL;
GMRFLib_ENTER_ROUTINE;
GMRFLib_ASSERT(graph, GMRFLib_EINVARG);
GMRFLib_ASSERT(Qfunc, GMRFLib_EINVARG);
GMRFLib_optimize_set_store_flags(store);
/*
our first task, is to convert the opt_problem so we get rid of the fixed_values and then write
the function in the canonical form
large parts here is adapted from `problem-setup.c'!!!
*/
/*
create new opt_problem
*/
opt_problem = Calloc(1, GMRFLib_optimize_problem_tp); MEMCHK(opt_problem);
/*
get the options
*/
if (optpar)
{
opt_problem->optpar = optpar;
free_optpar = 0;
}
else
{
GMRFLib_default_optimize_param(&(opt_problem->optpar));
free_optpar = 1;
}
/*
first, find the new graph.
*/
if (store_use_sub_graph)
{
/*
copy from store
*/
GMRFLib_copy_graph(&(opt_problem->sub_graph), store->sub_graph);
}
else
{
/*
compute it
*/
GMRFLib_compute_subgraph(&(opt_problem->sub_graph), graph, fixed_value);
/*
store it in store if requested
*/
if (store_store_sub_graph)
GMRFLib_copy_graph(&(store->sub_graph), opt_problem->sub_graph);
}
sub_n = opt_problem->sub_graph->n;
if (sub_n == 0) /* fast return if there is nothing todo */
{
GMRFLib_free_graph(opt_problem->sub_graph);
FREE(opt_problem);
GMRFLib_LEAVE_ROUTINE;
return GMRFLib_SUCCESS;
}
/*
the mapping is there in the graph, make a new pointer in the opt_problem-definition
*/
opt_problem->map = opt_problem->sub_graph->mothergraph_idx;
/*
setup space & misc
*/
opt_problem->mode = Calloc(sub_n, double); MEMCHK(opt_problem->mode);
opt_problem->b = Calloc(sub_n, double); MEMCHK(opt_problem->b);
opt_problem->d = Calloc(sub_n, double); MEMCHK(opt_problem->d);
for(i=0;i<sub_n;i++) opt_problem->mode[i] = mode[opt_problem->map[i]];
if (b) for(i=0;i<sub_n;i++) opt_problem->b[i] = b[opt_problem->map[i]];
if (d) for(i=0;i<sub_n;i++) opt_problem->d[i] = d[opt_problem->map[i]];
cc = Calloc(sub_n, double); MEMCHK(cc);
if (c) for(i=0;i<sub_n;i++) cc[i] = c[opt_problem->map[i]];
opt_problem->x_vec = Calloc(graph->n, double); MEMCHK(opt_problem->x_vec);
memcpy(opt_problem->x_vec, mode, graph->n*sizeof(double));
/*
FIXME: i might want to make a wrapper of this one, then REMEMBER TO CHANGE ->map[i] in all
calls to GMRFLib_2order_approx to i, or what it should be.!!!
*/
opt_problem->loglFunc = loglFunc; /* i might want to make a wrapper of this one! */
opt_problem->loglFunc_arg = loglFunc_arg;
/*
make the arguments to the wrapper function
*/
opt_problem->sub_Qfunc = GMRFLib_Qfunc_wrapper;
opt_problem->sub_Qfunc_arg = Calloc(1, GMRFLib_Qfunc_arg_tp); MEMCHK(opt_problem->sub_Qfunc_arg);
opt_problem->sub_Qfunc_arg->map = opt_problem->map; /* yes, this ptr is needed */
opt_problem->sub_Qfunc_arg->diagonal_adds = cc;
opt_problem->sub_Qfunc_arg->user_Qfunc = Qfunc;
opt_problem->sub_Qfunc_arg->user_Qfunc_args = Qfunc_args;
/*
now compute the new 'effective' b, and then the mean. recall to add the 'c' term manually,
since we're using the original Qfunc.
*/
if (!fixed_value) /* then sub_graph = graph and map=I*/
{
if (mean)
{
double *tmp = NULL;
tmp = Calloc(graph->n, double); MEMCHK(tmp);
GMRFLib_Qx(tmp, mean, graph, Qfunc, Qfunc_args);
for(i=0;i<graph->n;i++) opt_problem->b[i] += tmp[i] + cc[i]*mean[i];
FREE(tmp);
}
}
else
{
/*
x=(x1,x2), then x1|x2 has b = Q11 \mu1 - Q12(x2-\mu2)
*/
for(i=0;i<sub_n;i++) /* loop over all sub_nodes */
