void ccl_mat_min(const double * mat,const int i,const int j,const int axis,double* val,int* indx){
int k;
gsl_matrix * mat_ = gsl_matrix_alloc(i,j);
memcpy(mat_->data,mat,i*j*sizeof(double));
if (axis == 0){// x axis min
gsl_vector * vec = gsl_vector_alloc(j);
for (k=0;k<i;k++){
gsl_matrix_get_row(vec,mat_,k);
val[k] = gsl_vector_min(vec);
indx[k] = gsl_vector_min_index(vec);
}
gsl_vector_free(vec);
}
else{ // y axis min
gsl_vector * vec = gsl_vector_alloc(i);
for (k=0;k<j;k++){
gsl_matrix_get_col(vec,mat_,k);
val[k] = gsl_vector_min(vec);
indx[k] = gsl_vector_min_index(vec);
}
gsl_vector_free(vec);
}
gsl_matrix_free(mat_);
}
// Get the centroid, i.e., the site that has the lowest
// distance to other sites. This is done by computing the
// L2 norm (using the GLS BLAS interface) of the columns of
// the distance matrix. This is effectively the distance of
// a given sequence to all other sequences. The minimum
// value of the L2 norms gives corresponds to the centroid
pair<int,double> shapeAlign::getCentroid(void){
gsl_vector * dists = gsl_vector_alloc(nSites);
gsl_matrix_add_constant(D,-1.0);
for (size_t i = 0; i < nSites; i++){
gsl_vector_view column = gsl_matrix_column(D,i);
gsl_vector_set(dists,i,gsl_blas_dnrm2(&column.vector));
}
gsl_matrix_add_constant(D,1.0);
int minIdx = gsl_vector_min_index(dists);
double dist = gsl_vector_get(dists,minIdx);
gsl_vector_free(dists);
return make_pair(minIdx,dist);
}
/* Run PAM */
static void pam_run(pam_partition p, size_t max_iters)
{
if (p->k == p->M->size1) {
/* Simple case */
return;
}
size_t i, j, k, m, n, trimmed_size = p->M->size1 - p->k,
any_swaps = 0,
iter = 0;
size_t *medoids, *trimmed;
double c, current_cost;
gsl_vector *cost = gsl_vector_alloc(trimmed_size);
gsl_vector_ulong *cl_index = gsl_vector_ulong_alloc(p->cl_index->size);
gsl_vector *cl_dist = gsl_vector_alloc(p->cl_dist->size);
medoids = malloc(sizeof(size_t) * p->k);
trimmed = malloc(sizeof(size_t) * (p->M->size1 - p->k));
j = 0;
k = 0;
for (i = 0; i < p->M->size1; i++) {
if (gsl_vector_uchar_get(p->in_set, i))
medoids[j++] = i;
else {
assert(!pam_always_select(p, i));
trimmed[k++] = i;
}
}
assert(j == p->k);
assert(k == p->M->size1 - p->k);
do {
if (PAM_VERBOSE)
fprintf(stderr, "Iteration %lu\n", iter);
any_swaps = 0;
/* For every medoid, m, swap with every non-medoid, compute cost */
for (i = 0; i < p->k; i++) {
m = medoids[i];
/* If medoid is in the always_select set, no action. */
if (pam_always_select(p, m))
continue;
current_cost = pam_total_cost(p);
/* Try every non-medoid */
gsl_vector_set_all(cost, FLT_MAX);
for (j = 0; j < trimmed_size; j++) {
n = trimmed[j];
c = pam_swap_update_cost(p, m, n, cl_index, cl_dist);
gsl_vector_set(cost, j, c);
}
/* Find the minimum cost from all swaps */
j = gsl_vector_min_index(cost);
if (gsl_vector_get(cost, j) < current_cost) {
/* Current cost beaten */
any_swaps = 1;
n = trimmed[j];
assert(n != m);
assert(!gsl_vector_uchar_get(p->in_set, n));
assert(gsl_vector_uchar_get(p->in_set, m));
if (PAM_VERBOSE)
fprintf(stderr, "SWAP: %lu->%lu [%f -> %f]\n", m, n,
current_cost, gsl_vector_get(cost, j));
gsl_vector_uchar_swap_elements(p->in_set, m, n);
/* Move n to medoids, m to trimmed */
trimmed[j] = m;
medoids[i] = n;
/* Recalculate cached values */
pam_swap_cost(p, m, n);
}
}
}
while (any_swaps && ++iter < max_iters);
if (PAM_VERBOSE) {
fprintf(stderr, "Done in %lu iterations. Final config:\n", iter);
gsl_vector_uchar_fprintf(stderr, p->in_set, "%d");
fprintf(stderr, "Final cost: %f\n", pam_total_cost(p));
}
gsl_vector_free(cost);
gsl_vector_ulong_free(cl_index);
gsl_vector_free(cl_dist);
free(medoids);
free(trimmed);
}
static int
nmsimplex_iterate (void *vstate, gsl_multimin_function * f,
gsl_vector * x, double *size, double *fval)
{
/* Simplex iteration tries to minimize function f value */
/* Includes corrections from Ivo Alxneit <*****@*****.**> */
nmsimplex_state_t *state = (nmsimplex_state_t *) vstate;
/* xc and xc2 vectors store tried corner point coordinates */
gsl_vector *xc = state->ws1;
gsl_vector *xc2 = state->ws2;
gsl_vector *y1 = state->y1;
gsl_matrix *x1 = state->x1;
size_t n = y1->size;
size_t i;
size_t hi = 0, s_hi = 0, lo = 0;
double dhi, ds_hi, dlo;
int status;
double val, val2;
/* get index of highest, second highest and lowest point */
dhi = ds_hi = dlo = gsl_vector_get (y1, 0);
for (i = 1; i < n; i++)
{
val = (gsl_vector_get (y1, i));
if (val < dlo)
{
dlo = val;
lo = i;
}
else if (val > dhi)
{
ds_hi = dhi;
s_hi = hi;
dhi = val;
hi = i;
}
else if (val > ds_hi)
{
ds_hi = val;
s_hi = i;
}
}
/* reflect the highest value */
val = nmsimplex_move_corner (-1.0, state, hi, xc, f);
if (val < gsl_vector_get (y1, lo))
{
/* reflected point becomes lowest point, try expansion */
val2 = nmsimplex_move_corner (-2.0, state, hi, xc2, f);
if (val2 < gsl_vector_get (y1, lo))
{
gsl_matrix_set_row (x1, hi, xc2);
gsl_vector_set (y1, hi, val2);
}
else
{
gsl_matrix_set_row (x1, hi, xc);
gsl_vector_set (y1, hi, val);
}
}
/* reflection does not improve things enough */
else if (val > gsl_vector_get (y1, s_hi))
{
if (val <= gsl_vector_get (y1, hi))
{
/* if trial point is better than highest point, replace
highest point */
gsl_matrix_set_row (x1, hi, xc);
gsl_vector_set (y1, hi, val);
}
/* try one dimensional contraction */
val2 = nmsimplex_move_corner (0.5, state, hi, xc2, f);
if (val2 <= gsl_vector_get (y1, hi))
{
gsl_matrix_set_row (state->x1, hi, xc2);
gsl_vector_set (y1, hi, val2);
}
else
{
/* contract the whole simplex in respect to the best point */
status = nmsimplex_contract_by_best (state, lo, xc, f);
if (status != 0)
{
GSL_ERROR ("nmsimplex_contract_by_best failed", GSL_EFAILED);
}
}
}
else
{
/* trial point is better than second highest point.
Replace highest point by it */
gsl_matrix_set_row (x1, hi, xc);
gsl_vector_set (y1, hi, val);
}
/* return lowest point of simplex as x */
lo = gsl_vector_min_index (y1);
gsl_matrix_get_row (x, x1, lo);
*fval = gsl_vector_get (y1, lo);
/* Update simplex size */
*size = nmsimplex_size (state);
return GSL_SUCCESS;
}
// Given a vector of steer values, calculate the lean values associated with
// static equilibrium. Also, return the indices of the steer/lean vectors
// which most nearly cause the u5^2 coefficient to go to zero.
static int staticEq(gsl_vector * lean, gsl_vector * pitch,
const gsl_vector * steer, Whipple * bike)
{
int i, N = lean->size, iter, iter_max = ITER_MAX, status;
double ftol = FTOL;
gsl_vector * x = gsl_vector_alloc(2); // vector to store the solution
gsl_vector * u5s_coefs = zeros(steer->size);
const gsl_multiroot_fdfsolver_type * T = gsl_multiroot_fdfsolver_newton;
gsl_multiroot_fdfsolver *s = gsl_multiroot_fdfsolver_alloc(T, 2);
gsl_multiroot_function_fdf f = {&static_f, &static_df, &static_fdf, 2, bike};
bike->q1 = bike->q3 = 0.0;
bike->calcPitch();
gsl_vector_set(x, 0, bike->q1);
gsl_vector_set(x, 1, bike->q2);
gsl_multiroot_fdfsolver_set(s, &f, x);
// for loop to loop over all values of steer
for (i = 0; i < N; ++i) {
bike->q3 = gsl_vector_get(steer, i); // steer as a parameter
iter = 0;
do
{
++iter;
status = gsl_multiroot_fdfsolver_iterate(s);
if (status)
iterateError(status, "staticEq()", gsl_vector_get(steer, i));
status = gsl_multiroot_test_residual(s->f, ftol);
} while (status == GSL_CONTINUE && iter < iter_max);
// Increase the tolerance by an order of magnitude to improve convergence
if (iter == iter_max) {
gsl_vector_set(x, 0, gsl_vector_get(lean, i-1));
gsl_vector_set(x, 1, gsl_vector_get(pitch, i-1));
gsl_multiroot_fdfsolver_set(s, &f, x);
increaseftol(&ftol, &i, iter_max, "staticEq()", bike->q3);
continue;
} // if
// Store the lean into the lean vector
gsl_vector_set(lean, i, gsl_vector_get(s->x, 0));
gsl_vector_set(pitch, i, gsl_vector_get(s->x, 1));
// Store the square of the coefficient of the u5^2 term;
gsl_vector_set(u5s_coefs, i, bike->F[10] * bike->F[10]);
ftol = FTOL; // reset the error tolerance
} // for
// Assign a large value to the u5s_coefs vector near steer = 0 and steer = PI
// This ensure the minimum will be near PI/2 where the two boudary curves
// cross
for (i = 0; i < 5; ++i) {
gsl_vector_set(u5s_coefs, i, 10000.0);
gsl_vector_set(u5s_coefs, u5s_coefs->size - 1 - i, 10000.0);
}
// Free dynamically allocated variables
gsl_multiroot_fdfsolver_free(s);
gsl_vector_free(x);
i = gsl_vector_min_index(u5s_coefs);
gsl_vector_free(u5s_coefs);
return i;
} // staticEq()