int DPMHC_K(struct str_DPMHC *ptr_DPMHC_data)
{
int i_K = ptr_DPMHC_data->i_K;
gsl_vector *v_u = ptr_DPMHC_data->v_u;
gsl_vector *v_v = ptr_DPMHC_data->v_v;
gsl_vector *v_w = ptr_DPMHC_data->v_w;
gsl_matrix *m_DPtheta = ptr_DPMHC_data->m_DPtheta;
double d_DPalpha = ptr_DPMHC_data->d_DPalpha;
int K_tmp, K_new,j;
double a,v_j,w_j,csum,min_u;
//gsl_vector_view theta_j;
//int k_asset_number = P -> size1; /* number of assets in model */
K_tmp = i_K;
min_u = gsl_vector_min ( v_u );
a = 1.0 - min_u;
if( a == 1.0 )
printf("**********min_u = %g *************\n",min_u);
csum = 0.0;
j=0;
while ( csum <= a ){
/* check if new v_j,w_j and theta_j should be generated */
if( j >= K_tmp ){
v_j = gsl_ran_beta ( rng , 1.0, d_DPalpha );
vset( v_v, j, v_j);
w_j = v_j * (vget( v_w, j-1 )/vget(v_v,j-1))*(1.0-vget(v_v,j-1));
vset( v_w, j, w_j);
/* generate new mu, xi, tau from prior G_0 */
mset(m_DPtheta, j, 0,
ptr_DPMHC_data->d_m0 + gsl_ran_gaussian_ziggurat(rng, sqrt(ptr_DPMHC_data->d_s2m)));
mset(m_DPtheta, j, 1,
gsl_ran_gaussian_ziggurat(rng, ptr_DPMHC_data->d_A));
mset(m_DPtheta, j, 2,
gsl_ran_gamma(rng, 0.5, 0.5) );
}
csum += vget(v_w,j);
K_new = j + 1;
j++;
}
ptr_DPMHC_data->i_K = K_new;
return 0;
}
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_);
}
/** Create a histogram from data by putting data into bins of fixed width.
\param indata The input data that will be binned. This is copied and the copy will be modified.
\param close_top_bin Normally, a bin covers the range from the point equal to its minimum to points strictly less than
the minimum plus the width. if \c 'y', then the top bin includes points less than or equal to the upper bound. This solves the problem of displaying histograms where the top bin is just one point.
\param binspec This is an \ref apop_data set with the same number of columns as \c indata.
If you want a fixed size for the bins, then the first row of the bin spec is the bin width for each column.
This allows you to specify a width for each dimension, or specify the same size for all with something like:
\param bin_count If you don't provide a bin spec, I'll provide this many evenly-sized bins. Default: \f$\sqrt(N)\f$. \code
Apop_data_row(indata, 0, firstrow);
apop_data *binspec = apop_data_copy(firstrow);
gsl_matrix_set_all(binspec->matrix, 10); //bins of size 10 for all dim.s
apop_data_to_bins(indata, binspec);
\endcode
The presumption is that the first bin starts at zero in all cases. You can add a second row to the spec to give the offset for each dimension. Default: NULL. if no binspec and no binlist, then a grid with offset equal to the min of the column, and bin size such that it takes \f$\sqrt{N}\f$ bins to cover the range to the max element.
\return A pointer to a binned \ref apop_data set. If you didn't give me a binspec, then I attach one to the output set as a page named \c \<binspec\>, so you can snap a second data set to the same grid using
\code
apop_data_to_bins(first_set, NULL);
apop_data_to_bins(second_set, apop_data_get_page(first_set, "<binspec>"));
\endcode
The text segment, if any, is not binned. I use \ref apop_data_pmf_compress as the final step in the binning,
and that does respect the text segment.
Here is a sample program highlighting the difference between \ref apop_data_to_bins and \ref apop_data_pmf_compress .
\include binning.c
*/
APOP_VAR_HEAD apop_data *apop_data_to_bins(apop_data *indata, apop_data *binspec, int bin_count, char close_top_bin){
apop_data *apop_varad_var(indata, NULL);
Apop_assert_c(indata, NULL, 1, "NULL input data set, so returning NULL output data set.");
apop_data *apop_varad_var(binspec, NULL);
char apop_varad_var(close_top_bin, 'n');
int apop_varad_var(bin_count, 0);
APOP_VAR_ENDHEAD
Get_vmsizes(indata); //firstcol, vsize, msize1, msize2
double binwidth, offset, max=0;
apop_data *out = apop_data_copy(indata);
apop_data *bs = binspec ? binspec
: apop_data_add_page(out,
apop_data_alloc(vsize? 2: 0, msize1? 2: 0, indata->matrix ? msize2: 0),
"<binspec>");
for (int j= firstcol; j< msize2; j++){
Apop_col(out, j, onecol);
if (binspec){
binwidth = apop_data_get(binspec, 0, j);
offset = ((binspec->vector && binspec->vector->size==2 )
||(binspec->matrix && binspec->matrix->size1==2)) ? apop_data_get(binspec, 1, j) : 0;
} else {
Apop_col(bs, j, abin);
max = gsl_vector_max(onecol);
offset = abin->data[1] = gsl_vector_min(onecol);
binwidth = abin->data[0] = (max - offset)/(bin_count ? bin_count : sqrt(onecol->size));
}
for (int i=0; i< onecol->size; i++){
double val = gsl_vector_get(onecol, i);
if (close_top_bin=='y' && val == max && val!=offset)
val -= 2*GSL_DBL_EPSILON;
gsl_vector_set(onecol, i, (floor((val -offset)/binwidth))*binwidth+offset);
}
}
apop_data_pmf_compress(out);
return out;
}
void posterior_summary(const gsl_matrix *theta, FILE *ofile, long M)
{
size_t T=theta->size1;
size_t npar=theta->size2;
gsl_vector *tmp=gsl_vector_alloc(T);
int i,j;
double median,lower,upper;
printf("\n Writing MCMC draws to out\n\n");
FILE *file = fopen("out","w");
for(i=0;i<T;i++){
for(j=0;j<npar;j++)
fprintf(file,"%14.6e ",mget(theta,i,j));
fprintf(file,"\n");
}
fprintf(ofile,"\n\n Posterior Summary \n");
fprintf(ofile,"\n T=%lu\n\n",T);
fprintf(ofile,"\n Mean Median Stdev 0.95 DI\n\n");
for(i=0;i<npar;i++){
gsl_matrix_get_col( tmp, theta, i);
gsl_sort_vector(tmp);
median=gsl_stats_median_from_sorted_data(tmp->data,tmp->stride,tmp->size);
lower=gsl_stats_quantile_from_sorted_data(tmp->data,tmp->stride,tmp->size,0.025);
upper=gsl_stats_quantile_from_sorted_data(tmp->data,tmp->stride,tmp->size,0.975);
fprintf(ofile,"%2d %14.7e %14.7e %14.7e (%14.7e,%14.7e)\n"
,i,mean(tmp),median,sqrt(var(tmp)),lower,upper);
}
long tau;
if( M < 0 )
tau=1000;
else
tau=M;
gsl_vector *rho=gsl_vector_alloc(tau);
fprintf(ofile,"\n ACF");
fprintf(ofile,"\n NSE Ineff 1 50 100 500\n");
for(i=0;i<npar;i++){
gsl_matrix_get_col( tmp, theta, i);
acf(tmp,tau,rho);
/* write out ACF for each parameter */
char file_name[20] = "acf.dat";
sprintf( &file_name[7],"%d",i);
FILE *fp_acf = fopen( file_name, "w");
for(j=0;j<tau;j++)
fprintf(fp_acf,"%g\n",vget(rho,j));
fclose(fp_acf);
/* get inefficiency factor using Newey-West estimate of Long-run var*/
double ineff=1.0;
for(j=0;j<tau-1;j++){
ineff += 2.0*(tau-j-1)/tau*vget(rho,j);
}
/* numerical standard error for posterior mean */
double nse=sqrt(var(tmp)*ineff/T);
fprintf(ofile,"%2d %12.5e %12.5e %12.5e %12.5e %12.5e %12.5e\n"
,i,nse,ineff,vget(rho,0),vget(rho,49),vget(rho,99),vget(rho,499));
/* produce kernel density plot for each parameter */
char file_name2[20] = "den.dat";
sprintf( &file_name2[7],"%d",i);
FILE *fp_den = fopen( file_name2, "w");
double stdev = sqrt(var(tmp));
lower = gsl_vector_min(tmp) - stdev;
upper = gsl_vector_max(tmp) + stdev;
den_est_file(tmp, lower , upper ,100, fp_den, -1.0);
}
fprintf(ofile,"\n\n");
gsl_vector_free(rho);
gsl_vector_free(tmp);
}
struct scaling gsl_vector_normalize(gsl_vector * v){
struct scaling scale = {gsl_vector_max(v) - gsl_vector_min(v), gsl_stats_mean(v->data, v->stride, v->size)};
gsl_vector_add_constant(v, -scale.center);
if(scale.scale!=0){gsl_vector_scale(v,1/scale.scale);}
return scale;
}
/* find a local maximum (climb the hill)
* one probe at a time */
int find_local_maximum_naive(unsigned int ndim, double exactness,
gsl_vector * current_x) {
unsigned int i = 0;
unsigned int last_i = 0;
unsigned int j = 0;
unsigned int count = 0;
double current_val;
gsl_vector * current_probe = gsl_vector_alloc(ndim);
gsl_vector * next_probe = gsl_vector_alloc(ndim);
gsl_vector * scales = gsl_vector_alloc(ndim);
/* did we switch direction in the last move? */
int flaps = 0;
double probe_value;
gsl_vector_set_all(scales, START_SCALE);
current_val = f(current_x);
count++;
dump_v("currently at", current_x)
dump_d("current value", current_val);
while (1) {
for (j = 0; j < ndim; j++) {
i = (last_i + j) % ndim;
gsl_vector_memcpy(current_probe, current_x);
gsl_vector_set(current_probe, i, gsl_vector_get(current_probe, i)
+ gsl_vector_get(scales, i));
limit(current_probe);
if (calc_same(current_probe, current_x) == 1) {
dump_i("we clashed a wall in", i);
gsl_vector_set(scales, i, gsl_vector_get(scales, i) * -1);
continue;
}
dump_v("will probe at", current_probe);
probe_value = f(current_probe);
count++;
if (probe_value > current_val) {
dump_i("we jump forward in", i);
current_val = probe_value;
gsl_vector_memcpy(current_x, current_probe);
dump_v("currently at", current_x)
dump_d("current value", current_val);
break;
} else {
dump_i("we turn back in", i);
gsl_vector_set(scales, i, gsl_vector_get(scales, i) * -1);
}
}
#ifndef NO_ROUNDROBIN
last_i = i;
#else
last_i = 0;
#endif
if (j == ndim) {
if (flaps == 1) {
debug("all dimensions are ready, lets refine");
dump_v("currently at", current_x)
dump_d("exactness (min)", gsl_vector_min(scales));
dump_d("exactness (max)", gsl_vector_max(scales));
dump_d("exactness (desired)", exactness);
if (gsl_vector_max(scales) < exactness
&& gsl_vector_min(scales) > -exactness) {
for (i = 0; i < ndim; i++) {
gsl_vector_memcpy(current_probe, current_x);
gsl_vector_set(current_probe, i, gsl_vector_get(
current_probe, i) + abs(gsl_vector_get(scales,
i)));
assert(f(current_probe) >= current_val);
gsl_vector_set(current_probe, i, gsl_vector_get(
current_probe, i) - 2* abs (gsl_vector_get(
scales, i)));
assert(f(current_probe) >= current_val);
}
gsl_vector_free(scales);
gsl_vector_free(current_probe);
gsl_vector_free(next_probe);
return count;
}
gsl_vector_scale(scales, ZOOM_IN_FACTOR);
flaps = 0;
dump_d("new exactness (min)", gsl_vector_min(scales));
dump_d("new exactness (max)", gsl_vector_max(scales));
} else {
flaps = 1;
}
} else {
flaps = 0;
}
}
return count;
}
/* find a local maximum (climb the hill)
* diagonals */
int find_local_maximum_multi(unsigned int ndim, double exactness,
gsl_vector * start) {
unsigned int i;
unsigned int count = 0;
int possibly_circle_jump;
double current_val;
gsl_vector * current_probe = gsl_vector_alloc(ndim);
gsl_vector * next_probe = gsl_vector_alloc(ndim);
gsl_vector * current_x = dup_vector(start);
gsl_vector * scales = gsl_vector_alloc(ndim);
/* did we switch direction in the last move? */
gsl_vector * flaps = gsl_vector_alloc(ndim);
gsl_vector * probe_values = gsl_vector_alloc(ndim);
gsl_vector_set_all(scales, START_SCALE);
gsl_vector_set_all(flaps, 0);
assert(exactness < 1);
while (1) {
dump_v("currently at", current_x)
current_val = f(current_x);
count++;
dump_d("current value", current_val);
gsl_vector_memcpy(next_probe, current_x);
gsl_vector_add(next_probe, scales);
limit(next_probe);
dump_v("will probe at", next_probe);
for (i = 0; i < ndim; i++) {
gsl_vector_memcpy(current_probe, current_x);
gsl_vector_set(current_probe, i, gsl_vector_get(next_probe, i));
gsl_vector_set(probe_values, i, f(current_probe) - current_val);
if (gsl_vector_get(probe_values, i) < 0)
gsl_vector_set(probe_values, i, 0);
count++;
}
if(gsl_vector_max(probe_values) != 0)
gsl_vector_scale(probe_values, 1 / gsl_vector_max(probe_values));
dump_v("probe results", probe_values);
gsl_vector_memcpy(start, current_x);
possibly_circle_jump = detect_circle_jump(flaps, probe_values);
for (i = 0; i < ndim; i++) {
if (gsl_vector_get(probe_values, i) > 0) {
dump_i("we jump forward in", i);
gsl_vector_set(
current_x,
i,
gsl_vector_get(current_x, i)
+ gsl_vector_get(scales, i) * JUMP_SCALE
*
#ifdef ADAPTIVE
gsl_vector_get(probe_values, i) *
#endif
(1
+ (gsl_rng_uniform(
get_rng_instance())
- 0.5) * 2
* (RANDOM_SCALE
+ possibly_circle_jump
* RANDOM_SCALE_CIRCLE_JUMP)));
limit(current_x);
if (gsl_vector_get(current_x, i) == gsl_vector_get(start, i)) {
/* we clashed against a wall. That means we are ready to
* refine */
gsl_vector_set(flaps, i, 2);
} else {
gsl_vector_set(flaps, i, 0);
}
} else {
if (gsl_vector_get(flaps, i) == 0) {
dump_i("we turn back in", i);
gsl_vector_set(flaps, i, 1);
/* TODO: should we step back a little?
* no we can't, otherwise our double-turnback is tainted */
gsl_vector_set(scales, i, gsl_vector_get(scales, i) * -1);
} else {
dump_i("we turned back twice in", i);
gsl_vector_set(flaps, i, 2);
}
}
}
if (gsl_vector_min(flaps) == 2) {
debug("all dimensions are ready, lets refine");
dump_d("exactness (min)", gsl_vector_min(scales));
dump_d("exactness (max)", gsl_vector_max(scales));
dump_d("exactness (desired)", exactness);
if (gsl_vector_max(scales) < exactness && gsl_vector_min(scales)
> -exactness) {
for (i = 0; i < ndim; i++) {
gsl_vector_memcpy(current_probe, start);
gsl_vector_set(current_probe, i, gsl_vector_get(
current_probe, i) + abs(gsl_vector_get(scales, i)));
assert(f(current_probe) >= current_val);
gsl_vector_set(current_probe, i, gsl_vector_get(
current_probe, i) - 2* abs (gsl_vector_get(scales,
i)));
assert(f(current_probe) >= current_val);
}
gsl_vector_free(scales);
gsl_vector_free(flaps);
gsl_vector_free(probe_values);
gsl_vector_free(current_probe);
gsl_vector_free(next_probe);
gsl_vector_free(current_x);
return count;
}
gsl_vector_scale(scales, ZOOM_IN_FACTOR);
gsl_vector_set_all(flaps, 0);
dump_d("new exactness (min)", gsl_vector_min(scales));
dump_d("new exactness (max)", gsl_vector_max(scales));
}
}
}
int OptimizationOptions::gslOptimize( NLSFunction *F, gsl_vector* x_vec,
gsl_matrix *v, IterationLogger *itLog ) {
const gsl_multifit_fdfsolver_type *Tlm[] =
{ gsl_multifit_fdfsolver_lmder, gsl_multifit_fdfsolver_lmsder };
const gsl_multimin_fdfminimizer_type *Tqn[] =
{ gsl_multimin_fdfminimizer_vector_bfgs,
gsl_multimin_fdfminimizer_vector_bfgs2,
gsl_multimin_fdfminimizer_conjugate_fr,
gsl_multimin_fdfminimizer_conjugate_pr };
const gsl_multimin_fminimizer_type *Tnm[] =
{ gsl_multimin_fminimizer_nmsimplex, gsl_multimin_fminimizer_nmsimplex2,
gsl_multimin_fminimizer_nmsimplex2rand };
int gsl_submethod_max[] = { sizeof(Tlm) / sizeof(Tlm[0]),
sizeof(Tqn) / sizeof(Tqn[0]),
sizeof(Tnm) / sizeof(Tnm[0]) };
int status, status_dx, status_grad, k;
double g_norm, x_norm;
/* vectorize x row-wise */
size_t max_ind, min_ind;
double max_val, min_val, abs_max_val = 0, abs_min_val;
if (this->method < 0 ||
this->method > sizeof(gsl_submethod_max)/sizeof(gsl_submethod_max[0]) ||
this->submethod < 0 ||
this->submethod > gsl_submethod_max[this->method]) {
throw new Exception("Unknown optimization method.\n");
}
if (this->maxiter < 0 || this->maxiter > 5000) {
throw new Exception("opt.maxiter should be in [0;5000].\n");
}
/* LM */
gsl_multifit_fdfsolver* solverlm;
gsl_multifit_function_fdf fdflm = { &(F->_f_ls), &(F->_df_ls), &(F->_fdf_ls),
F->getNsq(), F->getNvar(), F };
gsl_vector *g;
/* QN */
double stepqn = this->step;
gsl_multimin_fdfminimizer* solverqn;
gsl_multimin_function_fdf fdfqn = {
&(F->_f), &(F->_df), &(F->_fdf), F->getNvar(), F };
/* NM */
double size;
gsl_vector *stepnm;
gsl_multimin_fminimizer* solvernm;
gsl_multimin_function fnm = { &(F->_f), F->getNvar(), F };
/* initialize the optimization method */
switch (this->method) {
case SLRA_OPT_METHOD_LM: /* LM */
solverlm = gsl_multifit_fdfsolver_alloc(Tlm[this->submethod],
F->getNsq(), F->getNvar());
gsl_multifit_fdfsolver_set(solverlm, &fdflm, x_vec);
g = gsl_vector_alloc(F->getNvar());
break;
case SLRA_OPT_METHOD_QN: /* QN */
solverqn = gsl_multimin_fdfminimizer_alloc(Tqn[this->submethod],
F->getNvar() );
gsl_multimin_fdfminimizer_set(solverqn, &fdfqn, x_vec,
stepqn, this->tol);
status_dx = GSL_CONTINUE;
break;
case SLRA_OPT_METHOD_NM: /* NM */
solvernm = gsl_multimin_fminimizer_alloc(Tnm[this->submethod], F->getNvar());
stepnm = gsl_vector_alloc(F->getNvar());
gsl_vector_set_all(stepnm, this->step);
gsl_multimin_fminimizer_set( solvernm, &fnm, x_vec, stepnm );
break;
}
/* optimization loop */
Log::lprintf(Log::LOG_LEVEL_FINAL, "SLRA optimization:\n");
status = GSL_SUCCESS;
status_dx = GSL_CONTINUE;
status_grad = GSL_CONTINUE;
this->iter = 0;
switch (this->method) {
case SLRA_OPT_METHOD_LM:
gsl_blas_ddot(solverlm->f, solverlm->f, &this->fmin);
gsl_multifit_gradient(solverlm->J, solverlm->f, g);
gsl_vector_scale(g, 2);
{
gsl_vector *g2 = gsl_vector_alloc(g->size);
F->computeFuncAndGrad(x_vec, NULL, g2);
gsl_vector_sub(g2, g);
if (gsl_vector_max(g2) > 1e-10 || gsl_vector_min(g2) < -1e-10) {
Log::lprintf(Log::LOG_LEVEL_NOTIFY,
"Gradient error, max = %14.10f, min = %14.10f ...",
gsl_vector_max(g2), gsl_vector_min(g2));
print_vec(g2);
}
gsl_vector_free(g2);
}
if (itLog != NULL) {
itLog->reportIteration(0, solverlm->x, this->fmin, g);
}
break;
case SLRA_OPT_METHOD_QN:
this->fmin = gsl_multimin_fdfminimizer_minimum(solverqn);
if (itLog != NULL) {
itLog->reportIteration(0, solverqn->x, this->fmin, solverqn->gradient);
}
break;
case SLRA_OPT_METHOD_NM:
this->fmin = gsl_multimin_fminimizer_minimum( solvernm );
if (itLog != NULL) {
itLog->reportIteration(this->iter, solvernm->x, this->fmin, NULL);
}
break;
}
while (status_dx == GSL_CONTINUE &&
status_grad == GSL_CONTINUE &&
status == GSL_SUCCESS &&
this->iter < this->maxiter) {
if (this->method == SLRA_OPT_METHOD_LM && this->maxx > 0) {
if (gsl_vector_max(solverlm->x) > this->maxx ||
gsl_vector_min(solverlm->x) < -this->maxx ){
break;
}
}
this->iter++;
switch (this->method) {
case SLRA_OPT_METHOD_LM: /* Levenberg-Marquardt */
status = gsl_multifit_fdfsolver_iterate(solverlm);
gsl_multifit_gradient(solverlm->J, solverlm->f, g);
gsl_vector_scale(g, 2);
/* check the convergence criteria */
if (this->epsabs != 0 || this->epsrel != 0) {
status_dx = gsl_multifit_test_delta(solverlm->dx, solverlm->x,
this->epsabs, this->epsrel);
} else {
status_dx = GSL_CONTINUE;
}
status_grad = gsl_multifit_test_gradient(g, this->epsgrad);
gsl_blas_ddot(solverlm->f, solverlm->f, &this->fmin);
if (itLog != NULL) {
itLog->reportIteration(this->iter, solverlm->x, this->fmin, g);
}
break;
case SLRA_OPT_METHOD_QN:
status = gsl_multimin_fdfminimizer_iterate( solverqn );
/* check the convergence criteria */
status_grad = gsl_multimin_test_gradient(
gsl_multimin_fdfminimizer_gradient(solverqn), this->epsgrad);
status_dx = gsl_multifit_test_delta(solverqn->dx, solverqn->x,
this->epsabs, this->epsrel);
this->fmin = gsl_multimin_fdfminimizer_minimum(solverqn);
if (itLog != NULL) {
itLog->reportIteration(this->iter, solverqn->x, this->fmin, solverqn->gradient);
}
break;
case SLRA_OPT_METHOD_NM:
status = gsl_multimin_fminimizer_iterate( solvernm );
/* check the convergence criteria */
size = gsl_multimin_fminimizer_size( solvernm );
status_dx = gsl_multimin_test_size( size, this->epsx );
this->fmin = gsl_multimin_fminimizer_minimum( solvernm );
if (itLog != NULL) {
itLog->reportIteration(this->iter, solvernm->x, this->fmin, NULL);
}
break;
}
}
if (this->iter >= this->maxiter) {
status = EITER;
}
switch (this->method) {
case SLRA_OPT_METHOD_LM:
gsl_vector_memcpy(x_vec, solverlm->x);
if (v != NULL) {
gsl_multifit_covar(solverlm->J, this->epscov, v); /* ??? Different eps */
}
gsl_blas_ddot(solverlm->f, solverlm->f, &this->fmin);
break;
case SLRA_OPT_METHOD_QN:
gsl_vector_memcpy(x_vec, solverqn->x);
this->fmin = solverqn->f;
break;
case SLRA_OPT_METHOD_NM:
gsl_vector_memcpy(x_vec, solvernm->x);
this->fmin = solvernm->fval;
break;
}
/* print exit information */
if (Log::getMaxLevel() >= Log::LOG_LEVEL_FINAL) { /* unless "off" */
switch (status) {
case EITER:
Log::lprintf("SLRA optimization terminated by reaching "
"the maximum number of iterations.\n"
"The result could be far from optimal.\n");
break;
case GSL_ETOLF:
Log::lprintf("Lack of convergence: "
"progress in function value < machine EPS.\n");
break;
case GSL_ETOLX:
Log::lprintf("Lack of convergence: "
"change in parameters < machine EPS.\n");
break;
case GSL_ETOLG:
Log::lprintf("Lack of convergence: "
"change in gradient < machine EPS.\n");
break;
case GSL_ENOPROG:
Log::lprintf("Possible lack of convergence: no progress.\n");
break;
}
if (status_grad != GSL_CONTINUE && status_dx != GSL_CONTINUE) {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for both X and the gradient.\n");
} else {
if (status_grad != GSL_CONTINUE) {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for the gradient.\n");
} else {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for X.\n");
}
}
}
/* Cleanup */
switch (this->method) {
case SLRA_OPT_METHOD_LM: /* LM */
gsl_multifit_fdfsolver_free(solverlm);
gsl_vector_free(g);
break;
case SLRA_OPT_METHOD_QN: /* QN */
gsl_multimin_fdfminimizer_free(solverqn);
break;
case SLRA_OPT_METHOD_NM: /* NM */
gsl_multimin_fminimizer_free(solvernm);
gsl_vector_free(stepnm);
break;
}
return GSL_SUCCESS; /* <- correct with status */
}
int OptimizationOptions::lmpinvOptimize( NLSFunction *F, gsl_vector* x_vec,
IterationLogger *itLog ) {
int status, status_dx, status_grad, k;
double g_norm, x_norm;
if (this->maxiter < 0 || this->maxiter > 5000) {
throw new Exception("opt.maxiter should be in [0;5000].\n");
}
int scaled = 1; //this->submethod;
/* LM */
gsl_matrix *jac = gsl_matrix_alloc(F->getNsq(), F->getNvar());
gsl_vector *func = gsl_vector_alloc(F->getNsq());
gsl_vector *g = gsl_vector_alloc(F->getNvar());
gsl_vector *x_cur = gsl_vector_alloc(F->getNvar());
gsl_vector *x_new = gsl_vector_alloc(F->getNvar());
gsl_vector *dx = gsl_vector_alloc(F->getNvar());
gsl_vector *scaling = scaled ? gsl_vector_alloc(F->getNvar()) : NULL;
gsl_matrix *tempv = gsl_matrix_alloc(jac->size2, jac->size2);
gsl_vector *tempufuncsig = gsl_vector_alloc(jac->size2);
gsl_vector *templm = gsl_vector_alloc(jac->size2);
gsl_vector *sig = gsl_vector_alloc(mymin(jac->size1, jac->size2));
double lambda2 = 0, f_new;
int start_lm = 1;
/* Determine optimal work */
size_t status_svd = 0, minus1 = -1;
double tmp;
dgesvd_("A", "O", &jac->size2, &jac->size1, jac->data, &jac->tda, sig->data,
tempv->data, &tempv->size2, NULL, &jac->size1, &tmp, &minus1, &status_svd);
gsl_vector *work_vec = gsl_vector_alloc(tmp);
/* optimization loop */
Log::lprintf(Log::LOG_LEVEL_FINAL, "SLRA optimization:\n");
status = GSL_SUCCESS;
status_dx = GSL_CONTINUE;
status_grad = GSL_CONTINUE;
this->iter = 0;
gsl_vector_memcpy(x_cur, x_vec);
F->computeFuncAndJac(x_cur, func, jac);
gsl_multifit_gradient(jac, func, g);
gsl_vector_scale(g, 2);
gsl_blas_ddot(func, func, &this->fmin);
if (itLog != NULL) {
itLog->reportIteration(0, x_cur, this->fmin, g);
}
{
gsl_vector *g2 = gsl_vector_alloc(g->size);
F->computeFuncAndGrad(x_vec, NULL, g2);
gsl_vector_sub(g2, g);
if (gsl_vector_max(g2) > 1e-10 || gsl_vector_min(g2) < -1e-10) {
Log::lprintf(Log::LOG_LEVEL_NOTIFY,
"Gradient error, max = %14.10f, min = %14.10f ...",
gsl_vector_max(g2), gsl_vector_min(g2));
print_vec(g2);
}
gsl_vector_free(g2);
}
while (status_dx == GSL_CONTINUE &&
status_grad == GSL_CONTINUE &&
status == GSL_SUCCESS &&
this->iter < this->maxiter) {
/* Check convergence criteria (except dx) */
if (this->maxx > 0) {
if (gsl_vector_max(x_cur) > this->maxx || gsl_vector_min(x_cur) < -this->maxx ){
break;
}
}
this->iter++;
if (scaling != NULL) {
normalizeJacobian(jac, scaling);
}
/* Compute the SVD */
dgesvd_("A", "O", &jac->size2, &jac->size1, jac->data, &jac->tda, sig->data,
tempv->data, &tempv->size2, NULL, &jac->size1, work_vec->data,
&work_vec->size, &status_svd);
gsl_blas_dgemv(CblasTrans, -1.0, jac, func, 0.0, tempufuncsig);
gsl_vector_mul(tempufuncsig, sig);
while (1) {
moveGN(tempv, sig, tempufuncsig, lambda2, dx, F->getNEssVar(), scaling);
gsl_vector_memcpy(x_new, x_cur);
gsl_vector_add(x_new, dx);
F->computeFuncAndGrad(x_new, &f_new, NULL);
if (f_new <= this->fmin + 1e-16) {
lambda2 = 0.4 * lambda2;
break;
}
if (lambda2 > 1e100) {
status = GSL_ENOPROG;
break;
}
/* Else: update lambda */
if (start_lm) {
lambda2 = gsl_vector_get(sig, 0) * gsl_vector_get(sig, 0);
start_lm = 0;
} else {
lambda2 = 10 * lambda2;
Log::lprintf(Log::LOG_LEVEL_ITER, "lambda: %f\n", lambda2);
}
}
/* check the dx convergence criteria */
if (this->epsabs != 0 || this->epsrel != 0) {
status_dx = gsl_multifit_test_delta(dx, x_cur, this->epsabs, this->epsrel);
}
gsl_vector_memcpy(x_cur, x_new);
F->computeFuncAndJac(x_cur, func, jac);
gsl_multifit_gradient(jac, func, g);
gsl_vector_scale(g, 2);
gsl_blas_ddot(func, func, &this->fmin);
if (itLog != NULL) {
itLog->reportIteration(this->iter, x_cur, this->fmin, g);
}
status_grad = gsl_multifit_test_gradient(g, this->epsgrad);
}
if (this->iter >= this->maxiter) {
status = EITER;
}
gsl_blas_ddot(func, func, &this->fmin);
/* print exit information */
if (Log::getMaxLevel() >= Log::LOG_LEVEL_FINAL) { /* unless "off" */
switch (status) {
case EITER:
Log::lprintf("SLRA optimization terminated by reaching "
"the maximum number of iterations.\n"
"The result could be far from optimal.\n");
break;
case GSL_ETOLF:
Log::lprintf("Lack of convergence: "
"progress in function value < machine EPS.\n");
break;
case GSL_ETOLX:
Log::lprintf("Lack of convergence: "
"change in parameters < machine EPS.\n");
break;
case GSL_ETOLG:
Log::lprintf("Lack of convergence: "
"change in gradient < machine EPS.\n");
break;
case GSL_ENOPROG:
Log::lprintf("Possible lack of convergence: no progress.\n");
break;
}
if (status_grad != GSL_CONTINUE && status_dx != GSL_CONTINUE) {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for both X and the gradient.\n");
} else {
if (status_grad != GSL_CONTINUE) {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for the gradient.\n");
} else {
Log::lprintf("Optimization terminated by reaching the convergence "
"tolerance for X.\n");
}
}
}
gsl_vector_memcpy(x_vec, x_cur);
gsl_vector_free(work_vec);
gsl_matrix_free(jac);
gsl_vector_free(func);
gsl_vector_free(g);
gsl_vector_free(x_cur);
gsl_vector_free(x_new);
if (scaling != NULL) {
gsl_vector_free(scaling);
}
gsl_vector_free(dx);
gsl_matrix_free(tempv);
gsl_vector_free(tempufuncsig);
gsl_vector_free(templm);
gsl_vector_free(sig);
return GSL_SUCCESS; /* <- correct with status */
}
int main(int argc, char *argv[]){
int i,j,k,
c,
N;
int dflag=0,
eflag=0,
gflag=0,
vflag=0,
hflag=0;
float w; /* frec */
//char *lvalue=NULL;
double **M, // XYZ coordinates
dos,
lambda=0;
while((c = getopt (argc, argv, "degvhl:")) != -1){
switch (c){
case 'd':
dflag = 1;
break;
case 'e':
eflag = 1;
break;
case 'g':
gflag = 1;
break;
case 'v':
vflag = 1;
break;
case 'h':
hflag = 1;
break;
case 'l':
lambda = atof(optarg);
break;
}
}
scanf("%d",&N);
M = (double **) malloc (N*sizeof(double *)); // coordinate matrix
// read coordinates (XYZ format file)
for (int i=0; i<N; i++){
char null[5]; // discard element
double *tmp = (double *) malloc (3 * sizeof(double)); // 3 coordinates
scanf("%s%lf%lf%lf", null, &tmp[0], &tmp[1], &tmp[2]);
M[i] = tmp;
// printf("- %.2f %.2f\n",M[i][0], M[i][1]); // DEBUG
}
/* M: coordinate matrix, N: number of atoms, l: spin-orbit parameter (set to 0 to tight-binding)*/
gsl_matrix_complex * Hso = hamiltonian(M, N, lambda);
/* print hamiltonial */
if (hflag){
printComMat(Hso,N*SPIN*ORB);
return 0;
}
/* eigenvalues */
gsl_matrix_complex * evec = gsl_matrix_complex_alloc(N*SPIN*ORB, N*SPIN*ORB);
gsl_vector * eval = gsl_vector_alloc(N*SPIN*ORB);
gsl_eigen_hermv_workspace * ws = gsl_eigen_hermv_alloc(N*SPIN*ORB);
gsl_matrix_complex * A = Hso; // gsl_eigen_hermv() destroys Hso matrix, use a copy instead
gsl_eigen_hermv (A, eval, evec, ws);
gsl_eigen_hermv_sort (eval, evec, GSL_EIGEN_SORT_VAL_ASC);
gsl_eigen_hermv_free(ws);
if (eflag){
for (int i=0; i<N*SPIN*ORB; i++)
printf("%d %.4g \n", i, gsl_vector_get(eval,i));
return 0;
}
if (vflag){
printComMat(evec, N*SPIN*ORB);
return 0;
}
/* calculate DoS
* __ __
* \ \ Hij Hji
* DOS(E) = -imag /_ /_ ----------------
* i j E - En + i*eta
*
* where H is the hamiltonian, and n is the state.
* NOTE: i and j 0-indexed list. i*eta
*/
double eval_min = gsl_vector_min (eval), /* lower bound */
eval_max = gsl_vector_max (eval); /* upper bound */
if (dflag)
for (w = eval_min; w < eval_max; w += 1e-3){
dos = 0;
#pragma omp parallel num_threads(4)
{
int tid = omp_get_thread_num();
#pragma omp for private(i,k) reduction (+:dos)
for (i=0; i<N*SPIN*ORB; i++)
for (k=0; k<N*SPIN*ORB; k++){
gsl_complex h = gsl_matrix_complex_get (Hso, i, k);
double l = gsl_vector_get (eval ,k);
gsl_complex z = gsl_complex_rect(0,5e-3); /* parte imaginaria */
gsl_complex num = gsl_complex_mul(h,gsl_complex_conjugate(h)); /* numerador */
gsl_complex den = gsl_complex_add_real(z, w-l); /* denominador */
gsl_complex g = gsl_complex_div(num,den);
dos += GSL_IMAG(g);
}
if (dflag && tid==0)
printf("%.3g %g \n", w, -dos/PI);
}
}
/* Green's function
*
* <i|n> <n|j>
* Gij(E) = ----------------
* E - En + i*eta
*
* where i and j are atoms, and n is the state.
* NOTE: i and j 0-indexed list.
*/
int list[]={0,1,2,5,6,7}; /* atoms to get conductance */
int NL = (int) sizeof(list)/sizeof(list[0]);
gsl_matrix_complex * G = gsl_matrix_complex_alloc(NL*SPIN*ORB, NL*SPIN*ORB); // Green
if (gflag)
for (double E = eval_min; E < eval_max; E += 1e-3){ // energy
gsl_matrix_complex_set_all(G, GSL_COMPLEX_ZERO); // init
for (int n=0; n<N*SPIN*ORB; n++) // states
for (i=0; i<NL; i++) // atoms
for (j=0; j<NL; j++) // atoms
for (int k0=0; k0<SPIN*ORB; k0++){ // orbitals
for (int k1=0; k1<SPIN*ORB; k1++){ // orbitals
gsl_complex in = gsl_matrix_complex_get (evec, n, list[i]*SPIN*ORB+k0);
gsl_complex nj = gsl_matrix_complex_get (evec, n, list[j]*SPIN*ORB+k1);
double En = gsl_vector_get (eval ,n);
gsl_complex eta = gsl_complex_rect(0,5e-3); /* delta */
gsl_complex num = gsl_complex_mul(in, gsl_complex_conjugate(nj)); /* num */
gsl_complex den = gsl_complex_add_real(eta, E - En); /* den */
gsl_complex Gij = gsl_complex_div(num,den);
gsl_complex tmp = gsl_matrix_complex_get(G, i*SPIN*ORB+k0, j*SPIN*ORB+k1);
gsl_complex sum = gsl_complex_add(tmp, Gij);
gsl_matrix_complex_set(G, i*SPIN*ORB+k0, j*SPIN*ORB+k1, sum);
}
}
dos = 0 ;
for(int i=0; i<NL*SPIN*ORB; i++)
dos += GSL_IMAG( gsl_matrix_complex_get(G, i, i) );
printf("%.3g %g\n", E, -dos/PI);
// printComMat(G, NL*SPIN*ORB);
}
gsl_matrix_complex_free(G);
gsl_vector_free(eval);
gsl_matrix_complex_free(evec);
return 0;
}
