void softmax(gsl_vector* x){
// takes vector x, computes softmax(x) and stores IN PLACE of x
int len = (*x).size;
double max_score = gsl_vector_max(x);
double temp_probs[len];
double total = 0;
for (int i = 0; i < len; i++){
temp_probs[i] = exp(gsl_vector_get(x,i)-max_score);
total += temp_probs[i];
}
for (int i = 0; i < len; i++){
gsl_vector_set(x,i,temp_probs[i]/total);
}
}
gsl_vector* gaussian_product_center(const double a, const gsl_vector *A,
const double b, const gsl_vector *B, int flags)
{
// Gaussian函数乘积定理计算双中心
// 关于此部分不甚明白
int i;
double gamma = a + b;
//double x1, x2, tmp;
gsl_vector *center = gsl_vector_alloc(3);
for (i = 0; i < 3; i++)
center->data[i] = (a * A->data[i] + b * B->data[i]) / gamma;
// FOR DEBUG
if (flags == 1) {
gsl_vector * test = gsl_vector_alloc(3);
gsl_vector * test2 = gsl_vector_alloc(3);
gsl_vector_set(test, 0, 0);
gsl_vector_set(test, 1, 0);
gsl_vector_set(test, 2, 2.175);
gsl_vector_memcpy(test2, test);
gsl_vector_sub(test, B);
gsl_vector_sub(test2, A);
if (gsl_vector_max(test) < 1.0E-10 || gsl_vector_max(test2) < 1.0E-10) {
//printf("----------------------------------------\n");
vector_output(A, 3, "用于计算中心的第一个坐标:");
vector_output(B, 3, "用于计算中心的第二个坐标:");
printf("alpha1 =%10.6lf\talpha2 =%10.6lf\n", a, b);
vector_output(center, 3, "中心为:");
}
gsl_vector_free(test);
gsl_vector_free(test2);
}
return center;
}
double log_sum_exp(const gsl_vector* v) {
double m = -gsl_vector_max(v);
assert(!isnan(m));
if (isinf(m)) {
// m = +inf OR -inf
// both cases the result should be equal to m
return m;
}
gsl_vector* w = gsl_vector_alloc(v->size);
gsl_vector_memcpy(w, v);
gsl_vector_add_constant(w, m);
double s = 0.0;
size_t i;
for (i = 0; i < w->size; i++) {
s += DEBUG_EXP(gsl_vector_get(w, i));
}
gsl_vector_free(w);
return -m + DEBUG_LOG(s);
}
/** 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;
}
//MCMCMC algorithm
double MC3 (int N,
gsl_matrix_short * Adj,
int Steps,
int nChains,
gsl_vector_short * BestSolution,
gsl_rng * r,
gsl_vector * lgammaLookup,
gsl_vector * logLookup){
// create the chains
gsl_vector_short * Chains[nChains];
//create copies for use by Gibbs and marginal functions
gsl_vector_short * ChainCopy = gsl_vector_short_calloc(N);
gsl_vector_short * ChainCopy2 = gsl_vector_short_calloc(N);
// create the fitness vector
gsl_vector * Marginals = gsl_vector_calloc(nChains);
//initialize swapping vector for RGF
gsl_vector_short * RGFswap = gsl_vector_short_calloc(N+1);
int i,j,k;
double BestMarginal;
BestMarginal = -1000000000.0;
//initialize chains
for(i=0; i<nChains; i++){
// allocate memory
Chains[i] = gsl_vector_short_calloc(N);
// initialize the population
Partition_Initialize(Chains[i], N, r);
}
//generate temperatures assuming uniform spacing
gsl_vector * Temps = gsl_vector_calloc(nChains);
//step size for incrementing temperatures
double StepSize;
StepSize = (COLDTEMP - HOTTEMP)/((double)nChains - 1);
gsl_vector_set(Temps, 0, HOTTEMP);
for(i=1; i<(nChains-1); i++){
gsl_vector_set(Temps, i, gsl_vector_get(Temps, i-1)+StepSize);
}
gsl_vector_set(Temps, nChains-1, COLDTEMP);
//for convenience, we want a copy of the Temps vector that doesn't
//get swapped around
gsl_vector * TempsCopy = gsl_vector_calloc(nChains);
gsl_vector_memcpy(TempsCopy, Temps);
//RGF all of the chains to start with
for(i=0; i<nChains; i++){
RGF(N, Chains[i], RGFswap);
}
int chInd1, chInd2;
double dtmp;
int itmp;
int swapFlag;
for(i=0; i<Steps; i++){
//print the best likelihood we've found so far every so often
if(i % 1000 == 0){
fprintf(stderr, "Step %d Best solution %1.4f\n", i, BestMarginal);
}
//if enough steps have passed, swap temperatures
if(i % SWAPSTEPS == 0){
//try to swap using "bucket brigade"
for(j=0; j<(nChains-1); j++){
//find which chains have adjacent temperatures
chInd1 = -1;
chInd2 = -1;
for(k=0; k<nChains; k++){
if(gsl_vector_get(TempsCopy, j) == gsl_vector_get(Temps, k)){
chInd1 = k;
}
if(gsl_vector_get(TempsCopy, j+1) == gsl_vector_get(Temps, k)){
chInd2 = k;
}
if(chInd1 >= 0 && chInd2 >=0){
break;
}
}
//try to swap them
swapFlag = TrySwap(N, Adj,
Chains[chInd1], Chains[chInd2],
ChainCopy, RGFswap,
gsl_vector_get(Temps, chInd1),
gsl_vector_get(Temps, chInd2),
r, lgammaLookup, logLookup);
if(swapFlag == 1){
dtmp = gsl_vector_get(Temps, chInd1);
gsl_vector_set(Temps, chInd1, gsl_vector_get(Temps, chInd2));
gsl_vector_set(Temps, chInd2, dtmp);
}
}
}
//take a step
for(j=0; j<nChains; j++){
dtmp = Gibbs(N, Chains[j], ChainCopy,
ChainCopy2, Adj,
gsl_vector_get(Temps, j), RGFswap,
r, lgammaLookup, logLookup);
gsl_vector_set(Marginals, j, dtmp);
}
//update the best solution, if appropriate
if(gsl_vector_max(Marginals) > BestMarginal){
itmp = gsl_vector_max_index(Marginals);
BestMarginal = gsl_vector_get(Marginals, itmp);
gsl_vector_short_memcpy(BestSolution, Chains[itmp]);
fprintf(stderr, "Steps %d Best solution %.4f\n", i, BestMarginal);
}
}
//free memory
gsl_vector_short_free(RGFswap);
gsl_vector_free(Temps);
gsl_vector_free(TempsCopy);
gsl_vector_free(Marginals);
gsl_vector_short_free(ChainCopy);
gsl_vector_short_free(ChainCopy2);
for(i=0; i<nChains; i++){
gsl_vector_short_free(Chains[i]);
}
return BestMarginal;
}
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);
}
void CrossVal(const gsl_matrix* XTrainData, const gsl_matrix* YTrainData, const gsl_matrix* XTestData,
const gsl_matrix* YTestData, const int FOLD, const double* Lambda, const int sizelambda, int* layer_sizes, int num_layers,
const int num_iterations, const int batch_size, const double step_size)
{
int N_obs = XTrainData->size1;
int YFeatures = YTrainData->size2;
int XFeatures = XTrainData->size2;
int GroupSize = N_obs/FOLD;
int Nlambda = sizelambda;
printf("________");
int* seq_fold;
seq_fold = rand_fold(N_obs,FOLD);
for (int i = 0; i < N_obs; i++){
printf("%d\n",seq_fold[i]);
}
gsl_matrix* Xfolds[FOLD];
for (int d = 0; d < FOLD; d++)
Xfolds[d] = gsl_matrix_alloc(GroupSize,XFeatures);
gsl_matrix* Yfolds[FOLD];
for (int d = 0; d < FOLD; d++)
Yfolds[d] = gsl_matrix_alloc(GroupSize,YFeatures);
SplitFoldfunc(XTrainData, FOLD, seq_fold, Xfolds);
SplitFoldfunc(YTrainData, FOLD, seq_fold, Yfolds);
gsl_matrix* CvTrainX[FOLD];
for (int d = 0; d < FOLD; d++)
CvTrainX[d] = gsl_matrix_calloc(GroupSize*(FOLD-1), XFeatures);
gsl_matrix* CvTrainY[FOLD];
for (int d = 0; d < FOLD; d++)
CvTrainY[d] = gsl_matrix_calloc(GroupSize*(FOLD-1), YFeatures);
combinefold(Xfolds, Yfolds, N_obs, FOLD, GroupSize, XFeatures, YFeatures, CvTrainX, CvTrainY);
gsl_vector* results_lambda;
results_lambda = gsl_vector_alloc((size_t) Nlambda);
double results[Nlambda][FOLD];
#pragma omp parallel for collapse(2)
for (int i = 0; i < Nlambda; i++){
for (int j = 0; j < FOLD; j++){
printf("Lambda=%G\n", Lambda[i]);
printf("fold not included = %d\n", j);
gsl_vector* vec_cv_trainX[N_obs-GroupSize];
for (int u = 0; u < (N_obs-GroupSize); u++ ){
vec_cv_trainX[u] = gsl_vector_alloc(XFeatures);
}
for (int c = 0; c < (N_obs-GroupSize); c++){
gsl_matrix_get_row(vec_cv_trainX[c], CvTrainX[j], c);
}
//for (int a = 0; a < (N_obs-GroupSize); a++){
//printf("%G %G\n",gsl_vector_get(vec_cv_trainX[a],0), gsl_vector_get(vec_cv_trainX[a],1));
//printf("%d\n", a);
//}
gsl_vector* vec_cv_trainY;
vec_cv_trainY = gsl_vector_alloc(N_obs-GroupSize);
gsl_matrix_get_col(vec_cv_trainY, CvTrainY[j], 0);
//for (int y = 0; y < (N_obs-GroupSize); y++){
//printf("%G\n",gsl_vector_get(vec_cv_trainY,y));
//printf("%d\n",y);
//}
//Note that always Y will be 1 column, so well defined.
gsl_matrix* output_weights[num_layers-1];
gsl_vector* output_biases[num_layers-1];
init_bias_object(output_biases, (layer_sizes+1), num_layers-1);
init_weight_object(output_weights, layer_sizes, num_layers);
printf("Lambda = %G\n",Lambda[i]);
NeuralNets(layer_sizes, num_layers, vec_cv_trainX, vec_cv_trainY, num_iterations, batch_size,
step_size, output_weights, output_biases, (N_obs-GroupSize), XFeatures, Lambda[i]);
gsl_vector* vec_cv_valX[GroupSize];
for (int u = 0; u < (GroupSize); u++){
vec_cv_valX[u] = gsl_vector_alloc(XFeatures);
}
for (int c = 0; c < GroupSize; c++){
gsl_matrix_get_row(vec_cv_valX[c], Xfolds[j], c);
}
gsl_vector* vec_cv_valY;
vec_cv_valY = gsl_vector_alloc(GroupSize);
gsl_matrix_get_col(vec_cv_valY, Yfolds[j], 0);
results[i][j] = correct_guesses(vec_cv_valX, vec_cv_valY, output_biases, output_weights, GroupSize, num_layers, layer_sizes);
printf("Result=%G\n thread = %d\n",results[i][j],omp_get_thread_num());
gsl_vector_free(vec_cv_valY);
for (int u = 0; u < (GroupSize); u++){
gsl_vector_free(vec_cv_valX[u]);
}
gsl_vector_free(vec_cv_trainY);
for (int u = 0; u < (GroupSize); u++){
gsl_vector_free(vec_cv_trainX[u]);
}
printf("i=%d,j=%d,Fold=%d,Nlambda=%d\n",i , j, FOLD, Nlambda);
}
}
//gsl_vector* results_lambda;
//results_lambda = gsl_vector_alloc((size_t) Nlambda);
double results_mean_fold[Nlambda];
for (int w = 0; w < Nlambda; w++)
results_mean_fold[w] = 0;
for (int s = 0; s < Nlambda ; s++){
for (int m = 0; m < FOLD ; m++){
printf("Result = %G\n", results[s][m]);
}
}
for (int s = 0; s < Nlambda ; s++){
for (int m = 0; m < FOLD ; m++){
results_mean_fold[s] = results[s][m]+ results_mean_fold[s];
}
gsl_vector_set(results_lambda, s, results_mean_fold[s]/(FOLD));
}
for (int s = 0; s < Nlambda ; s++){
printf("Lambda = %G, Success = %G\n", Lambda[s], gsl_vector_get(results_lambda, s));
}
double OptimalLambda = gsl_vector_max(results_lambda);
printf("Optimal Lambda = %G\n", OptimalLambda);
gsl_matrix* output_weights_all[num_layers-1];
gsl_vector* output_biases_all[num_layers-1];
init_bias_object(output_biases_all, (layer_sizes+1), num_layers-1);
init_weight_object(output_weights_all, layer_sizes, num_layers);
gsl_vector* vec_cv_trainX_all[N_obs];
for (int u = 0; u < (N_obs); u++){
vec_cv_trainX_all[u] = gsl_vector_alloc(XFeatures);
}
for (int c = 0; c < N_obs; c++){
gsl_matrix_get_row(vec_cv_trainX_all[c], XTrainData, c);
}
gsl_vector* vec_cv_trainY_all;
vec_cv_trainY_all = gsl_vector_alloc(N_obs);
gsl_matrix_get_col(vec_cv_trainY_all, YTrainData, 0);
NeuralNets(layer_sizes, num_layers, vec_cv_trainX_all, vec_cv_trainY_all, num_iterations, batch_size,
step_size, output_weights_all, output_biases_all, N_obs, XFeatures, OptimalLambda);
int N_obs_test = XTestData->size1;
gsl_vector* vec_cv_testX[N_obs_test];
for (int u = 0; u < (N_obs_test); u++){
vec_cv_testX[u] = gsl_vector_alloc(XFeatures);
}
for (int c = 0; c < N_obs_test; c++){
gsl_matrix_get_row(vec_cv_testX[c], XTestData, c);
}
gsl_vector* vec_cv_testY;
vec_cv_testY = gsl_vector_alloc(N_obs_test);
gsl_matrix_get_col(vec_cv_testY, YTestData, 0);
//Note that always Y will be 1 column, so well defined.
double Test_error = correct_guesses(vec_cv_testX, vec_cv_testY, output_biases_all, output_weights_all, N_obs_test, num_layers, layer_sizes);
printf("Test Error =%G\n",1.0-Test_error);
}
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;
}
void ccl_MP_pinv(const double *A_in, int row, int col,double *invA) {
gsl_matrix *V, *Sigma_pinv, *U, *A_pinv,*A;
gsl_matrix *_tmp_mat = NULL;
gsl_vector *_tmp_vec;
gsl_vector *u;
double x, cutoff;
size_t i, j;
int n = row;
int m = col;
bool was_swapped = false;
double rcond = 1E-15;
if (m > n) {
/* libgsl SVD can only handle the case m <= n - transpose matrix */
was_swapped = true;
A = gsl_matrix_alloc(col,row);
_tmp_mat = gsl_matrix_alloc(n, m);
memcpy(_tmp_mat->data,A_in,m*n*sizeof(double));
gsl_matrix_transpose_memcpy(A,_tmp_mat);
i = m;
m = n;
n = i;
}
else{
A = gsl_matrix_alloc(row,col);
memcpy(A->data,A_in,row*col*sizeof(double));
}
/* do SVD */
V = gsl_matrix_alloc(m, m);
u = gsl_vector_alloc(m);
_tmp_vec = gsl_vector_alloc(m);
gsl_linalg_SV_decomp(A, V, u, _tmp_vec);
gsl_vector_free(_tmp_vec);
/* compute Σ⁻¹ */
Sigma_pinv = gsl_matrix_alloc(m, n);
gsl_matrix_set_zero(Sigma_pinv);
cutoff = rcond * gsl_vector_max(u);
for (i = 0; i < m; ++i) {
if (gsl_vector_get(u, i) > cutoff) {
x = 1. / gsl_vector_get(u, i);
}
else {
x = 0.;
}
gsl_matrix_set(Sigma_pinv, i, i, x);
}
/* libgsl SVD yields "thin" SVD - pad to full matrix by adding zeros */
U = gsl_matrix_alloc(n, n);
gsl_matrix_set_zero(U);
for (i = 0; i < n; ++i) {
for (j = 0; j < m; ++j) {
gsl_matrix_set(U, i, j, gsl_matrix_get(A, i, j));
}
}
if (_tmp_mat != NULL) {
gsl_matrix_free(_tmp_mat);
}
/* two dot products to obtain pseudoinverse */
_tmp_mat = gsl_matrix_alloc(m, n);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1., V, Sigma_pinv, 0., _tmp_mat);
if (was_swapped) {
A_pinv = gsl_matrix_alloc(n, m);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1., U, _tmp_mat, 0., A_pinv);
}
else {
A_pinv = gsl_matrix_alloc(m, n);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1., _tmp_mat, U, 0., A_pinv);
}
memcpy(invA,A_pinv->data,row*col*sizeof(double));
gsl_matrix_free(A);
gsl_matrix_free(A_pinv);
gsl_matrix_free(_tmp_mat);
gsl_matrix_free(U);
gsl_matrix_free(Sigma_pinv);
gsl_vector_free(u);
gsl_matrix_free(V);
}
/* 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 */
}
void computePhysics(struct chain * chain, struct point a[])
{
int n = chain->number;
double mass = chain->totalMass/(chain->number+1.0);
gsl_matrix *U = gsl_matrix_alloc (n*3+1, n*3+1);
gsl_matrix_set_zero(U);
gsl_matrix_view M = gsl_matrix_submatrix(U, 0, 0, n*2, n*2);
gsl_matrix_view nC = gsl_matrix_submatrix(U, n*2, 0, n+1, n*2);
gsl_matrix_view nCt = gsl_matrix_submatrix(U, 0, n*2, n*2, n+1);
//Set Matrix M
for(int i = 0; i < n*2; i++)
gsl_matrix_set(&M.matrix, i, i, mass/n);
//Set Matrix NablaC
gsl_matrix_set(&nC.matrix, 0, 0, chain->p[1].x*2.0);
gsl_matrix_set(&nC.matrix, 0, 1, chain->p[1].y*2.0);
for(int i = 1; i < n; i++)
{
gsl_matrix_set(&nC.matrix, i, i*2-2, (chain->p[i].x - chain->p[i+1].x)*2.0);
gsl_matrix_set(&nC.matrix, i, i*2-1, (chain->p[i].y - chain->p[i+1].y)*2.0);
gsl_matrix_set(&nC.matrix, i, i*2, (chain->p[i+1].x - chain->p[i].x)*2.0);
gsl_matrix_set(&nC.matrix, i, i*2+1, (chain->p[i+1].y - chain->p[i].y)*2.0);
}
if(isConstraint)
{
gsl_matrix_set(&nC.matrix, n, n*2-2, chain->p[n].x*2.0);
gsl_matrix_set(&nC.matrix, n, n*2-1, chain->p[n].y*2.0 + 1.0);
}else
{
gsl_matrix_set(&nC.matrix, n, n*2-2, 0.0);
gsl_matrix_set(&nC.matrix, n, n*2-1, 0.0);
}
//Set Matrix NablaCt
gsl_matrix_set(&nCt.matrix, 0, 0, chain->p[1].x*2.0);
gsl_matrix_set(&nCt.matrix, 1, 0, chain->p[1].y*2.0);
for(int i = 1; i < n; i++)
{
gsl_matrix_set(&nCt.matrix, i*2-2, i, (chain->p[i].x - chain->p[i+1].x)*2.0);
gsl_matrix_set(&nCt.matrix, i*2-1, i, (chain->p[i].y - chain->p[i+1].y)*2.0);
gsl_matrix_set(&nCt.matrix, i*2, i, (chain->p[i+1].x - chain->p[i].x)*2.0);
gsl_matrix_set(&nCt.matrix, i*2+1, i, (chain->p[i+1].y - chain->p[i].y)*2.0);
}
if(isConstraint)
{
gsl_matrix_set(&nCt.matrix, n*2-2, n, chain->p[n].x*2.0);
gsl_matrix_set(&nCt.matrix, n*2-1, n, chain->p[n].y*2.0 + 1.0);
}else
{
gsl_matrix_set(&nCt.matrix, n*2-2, n, 0.0);
gsl_matrix_set(&nCt.matrix, n*2-1, n, 0.0);
}
gsl_matrix *V = gsl_matrix_alloc(n*3+1, n*3+1);
gsl_vector *s = gsl_vector_alloc(n*3+1);
gsl_vector *workvec = gsl_vector_alloc(n*3+1);
// for (int i = 0; i < n*2+n+1; i++)
// {
// for (int j = 0; j < n*2+n+1; j++)
// printf ("%.1f ", gsl_matrix_get (U, i, j));
// printf ("\n");
// }
gsl_linalg_SV_decomp(U, V, s, workvec);
//Filter
double max = gsl_vector_max(s);
for(int i=0; i<n*3+1; i++)
if(gsl_vector_get(s, i) < max * 0.000001)
gsl_vector_set(s, i, 0.0);
gsl_vector *b = gsl_vector_alloc(n*3+1);
gsl_vector *b1 = gsl_vector_alloc(n+1);
gsl_vector *x = gsl_vector_alloc(n*3+1);
gsl_vector_set_zero(b);
gsl_vector_set_zero(b1);
gsl_vector_view fext = gsl_vector_subvector(b, 0, n*2);
gsl_vector_view bs = gsl_vector_subvector(b, n*2, n+1);
//Set Vector fext
for(int i = 0; i < n; i++)
{
gsl_vector_set(&fext.vector, i*2, chain->f[i+1].x);
gsl_vector_set(&fext.vector, i*2+1, chain->f[i+1].y);
}
//Set Vector bs
gsl_vector_set(&bs.vector, 0, - chain->v[1].x*chain->v[1].x*2.0 - chain->v[1].y*chain->v[1].y*2.0);
for(int i = 1; i < n; i++)
gsl_vector_set(&bs.vector, i,
- (chain->v[i].x-chain->v[i+1].x)*chain->v[i].x*2.0 -
(chain->v[i].y-chain->v[i+1].y)*chain->v[i].y*2.0 -
(chain->v[i+1].x-chain->v[i].x)*chain->v[i+1].x*2.0 -
(chain->v[i+1].y-chain->v[i].y)*chain->v[i+1].y*2.0
);
if(isConstraint)
gsl_vector_set(&bs.vector, n, -chain->v[n].x*chain->v[n].x*2.0 - (chain->v[n].y*2.0+1.0)* chain->v[n].y);
else gsl_vector_set(&bs.vector, n, 0.0);
//Compute Baumgarte stabilization
gsl_vector_set(b1, 0, - chain->p[1].x*chain->v[1].x*2.0 - chain->p[1].y*chain->v[1].y*2.0);
for(int i = 1; i < n; i++)
gsl_vector_set(b1, i,
- (chain->p[i].x-chain->p[i+1].x)*chain->v[i].x*2.0 -
(chain->p[i].y-chain->p[i+1].y)*chain->v[i].y*2.0 -
(chain->p[i+1].x-chain->p[i].x)*chain->v[i+1].x*2.0 -
(chain->p[i+1].y-chain->p[i].y)*chain->v[i+1].y*2.0
);
if(isConstraint)
gsl_vector_set(b1, n, -chain->p[n].x*chain->v[n].x*2.0 - (chain->p[n].y*2.0+1.0)* chain->v[n].y);
else gsl_vector_set(b1, n, 0.0);
gsl_vector_scale(b1, BSALPHA * 2.0);
gsl_vector_add(&bs.vector, b1);
gsl_vector_set_zero(b1);
gsl_vector_set(b1, 0, - chain->p[1].x*chain->p[1].x - chain->p[1].y*chain->p[1].y + 0.01);
for(int i = 1; i < n; i++)
gsl_vector_set(b1, i,
- (chain->p[i+1].x-chain->p[i].x) * (chain->p[i+1].x-chain->p[i].x)
- (chain->p[i+1].y-chain->p[i].y) * (chain->p[i+1].y-chain->p[i].y) + 0.01
);
if(isConstraint)
gsl_vector_set(b1, n, - chain->p[n].x*chain->p[n].x - (chain->p[n].y+0.5) * (chain->p[n].y+0.5) + 0.25);
else gsl_vector_set(b1, n, 0.0);
gsl_vector_scale(b1, BSALPHA * BSALPHA);
gsl_vector_add(&bs.vector, b1);
//Solve The Equation
gsl_linalg_SV_solve(U, V, s, b, x);
for(int i=0; i<chain->number; i++)
{
a[i].x = gsl_vector_get(x, i*2);
a[i].y = gsl_vector_get(x, i*2+1);
}
// for (int i = n*2; i < n*3+1; i++)
// {
// printf ("%g ", gsl_vector_get(b, i));
// printf ("\n");
// }
// printf ("\n");
gsl_vector_free(x);
gsl_vector_free(b1);
gsl_vector_free(b);
gsl_vector_free(workvec);
gsl_vector_free(s);
gsl_matrix_free(V);
gsl_matrix_free(U);
}
static int
lmniel_iterate(void *vstate, const gsl_vector *swts,
gsl_multifit_function_fdf *fdf, gsl_vector *x,
gsl_vector *f, gsl_vector *dx)
{
int status;
lmniel_state_t *state = (lmniel_state_t *) vstate;
gsl_matrix *J = state->J; /* Jacobian J(x) */
gsl_matrix *A = state->A; /* J^T J */
gsl_vector *rhs = state->rhs; /* -g = -J^T f */
gsl_vector *x_trial = state->x_trial; /* trial x + dx */
gsl_vector *f_trial = state->f_trial; /* trial f(x + dx) */
gsl_vector *diag = state->diag; /* diag(D) */
double dF; /* F(x) - F(x + dx) */
double dL; /* L(0) - L(dx) */
int foundstep = 0; /* found step dx */
/* compute A = J^T J */
status = gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, J, J, 0.0, A);
if (status)
return status;
#if SCALE
lmniel_update_diag(J, diag);
#endif
/* loop until we find an acceptable step dx */
while (!foundstep)
{
/* solve (A + mu*I) dx = g */
status = lmniel_calc_dx(state->mu, A, rhs, dx, state);
if (status)
return status;
/* compute x_trial = x + dx */
lmniel_trial_step(x, dx, x_trial);
/* compute f(x + dx) */
status = gsl_multifit_eval_wf(fdf, x_trial, swts, f_trial);
if (status)
return status;
/* compute dF = F(x) - F(x + dx) */
dF = lmniel_calc_dF(f, f_trial);
/* compute dL = L(0) - L(dx) = dx^T (mu*dx - g) */
dL = lmniel_calc_dL(state->mu, diag, dx, rhs);
/* check that rho = dF/dL > 0 */
if ((dL > 0.0) && (dF >= 0.0))
{
/* reduction in error, step acceptable */
double tmp;
/* update LM parameter mu */
tmp = 2.0 * (dF / dL) - 1.0;
tmp = 1.0 - tmp*tmp*tmp;
state->mu *= GSL_MAX(LM_ONE_THIRD, tmp);
state->nu = 2;
/* compute J <- J(x + dx) */
if (fdf->df)
status = gsl_multifit_eval_wdf(fdf, x_trial, swts, J);
else
status = gsl_multifit_fdfsolver_dif_df(x_trial, swts, fdf, f_trial, J);
if (status)
return status;
/* update x <- x + dx */
gsl_vector_memcpy(x, x_trial);
/* update f <- f(x + dx) */
gsl_vector_memcpy(f, f_trial);
/* compute new rhs = -J^T f */
gsl_blas_dgemv(CblasTrans, -1.0, J, f, 0.0, rhs);
foundstep = 1;
}
else
{
long nu2;
/* step did not reduce error, reject step */
state->mu *= state->nu;
nu2 = state->nu << 1; /* 2*nu */
if (nu2 <= state->nu)
{
gsl_vector_view d = gsl_matrix_diagonal(A);
/*
* nu has wrapped around / overflown, reset mu and nu
* to original values and break to force another iteration
*/
/*GSL_ERROR("nu parameter has overflown", GSL_EOVRFLW);*/
state->nu = 2;
state->mu = state->tau * gsl_vector_max(&d.vector);
break;
}
state->nu = nu2;
}
} /* while (!foundstep) */
return GSL_SUCCESS;
} /* lmniel_iterate() */
int FC_FUNC_(oct_minimize, OCT_MINIMIZE)
(const int *method, const int *dim, double *point, const double *step, const double *line_tol,
const double *tolgrad, const double *toldr, const int *maxiter, func_d f,
const print_f_ptr write_info, double *minimum)
{
int iter = 0;
int status;
double maxgrad, maxdr;
int i;
double * oldpoint;
double * grad;
const gsl_multimin_fdfminimizer_type *T = NULL;
gsl_multimin_fdfminimizer *s;
gsl_vector *x;
gsl_vector *absgrad, *absdr;
gsl_multimin_function_fdf my_func;
param_fdf_t p;
p.func = f;
oldpoint = (double *) malloc(*dim * sizeof(double));
grad = (double *) malloc(*dim * sizeof(double));
my_func.f = &my_f;
my_func.df = &my_df;
my_func.fdf = &my_fdf;
my_func.n = *dim;
my_func.params = (void *) &p;
/* Starting point */
x = gsl_vector_alloc (*dim);
for(i=0; i<*dim; i++) gsl_vector_set (x, i, point[i]);
/* Allocate space for the gradient */
absgrad = gsl_vector_alloc (*dim);
absdr = gsl_vector_alloc (*dim);
//GSL recommends line_tol = 0.1;
switch(*method){
case 1:
T = gsl_multimin_fdfminimizer_steepest_descent;
break;
case 2:
T = gsl_multimin_fdfminimizer_conjugate_fr;
break;
case 3:
T = gsl_multimin_fdfminimizer_conjugate_pr;
break;
case 4:
T = gsl_multimin_fdfminimizer_vector_bfgs;
break;
case 5:
T = gsl_multimin_fdfminimizer_vector_bfgs2;
break;
}
s = gsl_multimin_fdfminimizer_alloc (T, *dim);
gsl_multimin_fdfminimizer_set (s, &my_func, x, *step, *line_tol);
do
{
iter++;
for(i=0; i<*dim; i++) oldpoint[i] = point[i];
/* Iterate */
status = gsl_multimin_fdfminimizer_iterate (s);
/* Get current minimum, point and gradient */
*minimum = gsl_multimin_fdfminimizer_minimum(s);
for(i=0; i<*dim; i++) point[i] = gsl_vector_get(gsl_multimin_fdfminimizer_x(s), i);
for(i=0; i<*dim; i++) grad[i] = gsl_vector_get(gsl_multimin_fdfminimizer_gradient(s), i);
/* Compute convergence criteria */
for(i=0; i<*dim; i++) gsl_vector_set(absdr, i, fabs(point[i]-oldpoint[i]));
maxdr = gsl_vector_max(absdr);
for(i=0; i<*dim; i++) gsl_vector_set(absgrad, i, fabs(grad[i]));
maxgrad = gsl_vector_max(absgrad);
/* Print information */
write_info(&iter, dim, minimum, &maxdr, &maxgrad, point);
/* Store infomation for next iteration */
for(i=0; i<*dim; i++) oldpoint[i] = point[i];
if (status)
break;
if ( (maxgrad <= *tolgrad) || (maxdr <= *toldr) ) status = GSL_SUCCESS;
else status = GSL_CONTINUE;
}
while (status == GSL_CONTINUE && iter <= *maxiter);
if(status == GSL_CONTINUE) status = 1025;
gsl_multimin_fdfminimizer_free (s);
gsl_vector_free (x); gsl_vector_free(absgrad); gsl_vector_free(absdr);
free(oldpoint);
free(grad);
return 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;
}
