static std::list<ast::MatrixLineExp*>* get_MatrixLines(void)
{
int nitems = get_uint32();
std::list<ast::MatrixLineExp*> *list = new std::list<ast::MatrixLineExp*>;
for(int i = 0; i < nitems; i++){
Location *line_loc = get_location();
std::list<ast::Exp*>* columns = get_exps();
ast::MatrixLineExp* line = new ast::MatrixLineExp(*line_loc,* columns);
list->push_back(line);
}
return list;
}
// Evaluate difference from identity
double eval_difference(const gsl_vector *v, void *params) {
// Parameters
sto_params_t *p=(sto_params_t *)params;
// Form vector of exponents
std::vector<double> exps=get_exps(v,p);
// Compute difference
double d=compute_difference(exps,p->zeta,p->l);
// printf("Computed difference %e.\n",d);
return d;
}
// Evaluate derivative
void eval_difference_df(const gsl_vector *v, void *params, gsl_vector *g) {
// Parameters
sto_params_t *p=(sto_params_t *)params;
// Helper
gsl_vector *vt=gsl_vector_alloc(v->size);
// Step size
double step=1e-4;
// Loop over parameters
for(size_t i=0;i<v->size;i++) {
// Copy vector
gsl_vector_memcpy(vt,v);
// Current value
double x=gsl_vector_get(vt,i);
// Right trial
gsl_vector_set(vt,i,x+step);
double rval=compute_difference(get_exps(vt,p),p->zeta,p->l);
// Left trial
gsl_vector_set(vt,i,x-step);
double lval=compute_difference(get_exps(vt,p),p->zeta,p->l);
// Set gradient
gsl_vector_set(g,i,(rval-lval)/(2*step));
}
/*
printf("Gradient:\n");
for(size_t i=0;i<v->size;i++)
printf("g(%2i) = % e\n",(int) i, gsl_vector_get(g,i));
*/
}
static ast::Exp* get_exp(void)
{
ast::Exp* exp;
// std::cerr << "get_exp at pos " << (buf - initial_buf) << std::endl;
int code = get_uint8();
// std::cerr << " code = " << code << std::endl;
Location *loc = get_location();
int is_verbose = get_bool();
int is_break = get_bool();
int is_breakable = get_bool();
int is_return = get_bool();
int is_returnable = get_bool();
int is_continue = get_bool();
int is_continuable = get_bool();
switch(code){
case 1: {
std::list<ast::Exp *>* l_body = get_exps();
exp = new ast::SeqExp(*loc, *l_body);
break;
}
case 2: {
std::wstring* s = get_wstring();
exp = new ast::StringExp(*loc, *s);
break;
}
case 3: {
std::wstring* s = get_wstring();
exp = new ast::CommentExp(*loc, s);
break;
}
case 4: {
ast::IntExp::Prec prec = get_IntExp_Prec();
int value = get_int32();
exp = new ast::IntExp(*loc, prec, value);
break;
}
case 5: {
double d = get_double();
exp = new ast::FloatExp(*loc, d);
break;
}
case 6: {
double d = get_double();
exp = new ast::DoubleExp(*loc,d);
break;
}
case 7: {
bool b = get_bool();
exp = new ast::BoolExp(*loc, b);
break;
}
case 8: {
exp = new ast::NilExp(*loc);
break;
}
case 9: {
symbol::Symbol *name = get_Symbol();
exp = new ast::SimpleVar(*loc, *name);
break;
}
case 10: {
exp = new ast::ColonVar(*loc);
break;
}
case 11: {
exp = new ast::DollarVar(*loc);
break;
}
case 12: {
std::list<ast::Var*>* vars = get_vars();
exp = new ast::ArrayListVar(*loc, *vars);
break;
}
case 13: {
ast::Exp *head = get_exp();
ast::Exp *tail = get_exp();
exp = new ast::FieldExp(*loc, *head, *tail);
break;
}
case 14: {
ast::IfExp::Kind kind = get_IfExp_Kind();
bool has_else = get_bool();
ast::Exp* test = get_exp();
ast::Exp* _then = get_exp();
ast::IfExp* ifexp;
if( has_else ){
ast::Exp* _else = get_exp();
ifexp = new ast::IfExp(*loc, *test, *_then, *_else);
} else {
ifexp = new ast::IfExp(*loc, *test, *_then);
}
ifexp->kind_set(kind);
exp = ifexp;
break;
}
case 15: {
Location *try_location = get_location();
Location *catch_location = get_location();
std::list<ast::Exp *>* try_exps = get_exps();
std::list<ast::Exp *>* catch_exps = get_exps();
ast::SeqExp *_try = new ast::SeqExp(*try_location, *try_exps);
ast::SeqExp *_catch = new ast::SeqExp(*catch_location, *catch_exps);
exp = new ast::TryCatchExp(*loc, *_try, *_catch);
break;
}
case 16: {
ast::Exp* test = get_exp();
ast::Exp* body = get_exp();
exp = new ast::WhileExp(*loc, *test, *body);
break;
}
case 17: {
Location *vardec_location = get_location();
ast::VarDec* vardec = get_VarDec(vardec_location);
ast::Exp* body = get_exp();
exp = new ast::ForExp(*loc, *vardec, *body);
break;
}
case 18: {
exp = new ast::BreakExp(*loc);
break;
}
case 19: {
exp = new ast::ContinueExp(*loc);
break;
}
case 20: {
bool is_global = get_bool();
if( is_global ){
exp = new ast::ReturnExp(*loc);
} else {
ast::Exp* returnExp_exp = get_exp();
exp = new ast::ReturnExp(*loc, returnExp_exp);
}
break;
}
case 21: {
bool has_default = get_bool();
ast::SeqExp * default_case = NULL;
if( has_default ){
Location *default_case_location = get_location();
std::list<ast::Exp *>* default_case_exps = get_exps();
default_case = new ast::SeqExp(*default_case_location,
*default_case_exps);
}
ast::Exp* select = get_exp();
int nitems = get_uint32();
std::list<ast::CaseExp*> *cases = new std::list<ast::CaseExp*>;
for(int i = 0; i < nitems; i++){
Location *case_location = get_location();
Location *body_location = get_location();
ast::Exp* test = get_exp();
std::list<ast::Exp *>* body_exps = get_exps();
ast::SeqExp *body = new ast::SeqExp(*body_location, *body_exps);
ast::CaseExp* _case = new ast::CaseExp(*case_location, *test, *body);
cases->push_back(_case);
}
if( has_default ){
exp = new ast::SelectExp(*loc, *select, *cases, *default_case);
} else {
exp = new ast::SelectExp(*loc, *select, *cases);
}
break;
}
/* SHOULD NEVER HAPPEN
case 22: {
exp = new ast::CaseExp(*loc);
break;
}
*/
case 23: {
std::list<ast::MatrixLineExp *>* lines = get_MatrixLines();
exp = new ast::CellExp(*loc, *lines);
break;
}
case 24: {
std::list<ast::Exp *>* exps = get_exps();
exp = new ast::ArrayListExp(*loc, *exps);
break;
}
case 25: {
std::list<ast::Exp *>* exps = get_exps();
exp = new ast::AssignListExp(*loc, *exps);
break;
}
case 26: {
ast::Exp* notexp = get_exp();
exp = new ast::NotExp(*loc, *notexp);
break;
}
case 27: {
ast::TransposeExp::Kind kind = get_TransposeExp_Kind();
ast::Exp* _exp = get_exp();
exp = new ast::TransposeExp(*loc, *_exp, kind);
break;
}
case 28: {
exp = get_VarDec(loc);
break;
}
case 29: {
symbol::Symbol* name = get_Symbol();
Location *args_loc = get_location();
Location *returns_loc = get_location();
ast::Exp* body = get_exp();
std::list <ast::Var*>* args_list = get_vars();
std::list <ast::Var*>* returns_list = get_vars();
ast::ArrayListVar *args = new ast::ArrayListVar(*args_loc, *args_list);
ast::ArrayListVar *returns = new ast::ArrayListVar(*returns_loc, *returns_list);
exp = new ast::FunctionDec(*loc, *name, *args, *returns, *body);
break;
}
case 30: {
ast::Exp* _start = get_exp();
ast::Exp* _step = get_exp();
ast::Exp* _end = get_exp();
exp = new ast::ListExp(*loc, *_start, *_step, *_end);
break;
}
case 31: {
ast::Exp* _left = get_exp();
ast::Exp* _right = get_exp();
exp = new ast::AssignExp(*loc, *_left, *_right);
break;
}
case 32: {
ast::OpExp::Kind kind = get_OpExp_Kind();
ast::OpExp::Oper oper = get_OpExp_Oper();
ast::Exp *left = get_exp();
ast::Exp *right = get_exp();
ast::OpExp *_opexp = new ast::OpExp(*loc, *left, oper, *right);
exp = _opexp;
_opexp->kind_set(kind);
break;
}
case 33: {
ast::OpExp::Kind kind = get_OpExp_Kind();
ast::OpExp::Oper oper = get_OpExp_Oper();
ast::Exp *left = get_exp();
ast::Exp *right = get_exp();
ast::LogicalOpExp *_opexp =
new ast::LogicalOpExp(*loc, *left, oper, *right);
exp = _opexp;
_opexp->kind_set(kind);
break;
}
case 34: {
std::list<ast::MatrixLineExp *>* lines = get_MatrixLines();
exp = new ast::MatrixExp(*loc, *lines);
break;
}
case 35: {
ast::Exp* name = get_exp();
std::list<ast::Exp *> * args = get_exps();
exp = new ast::CallExp(*loc, *name, *args);
break;
}
/* SHOULD NEVER HAPPEN
case 36: {
exp = new ast::MatrixLineExp(*loc);
break;
}
*/
case 37: {
ast::Exp* name = get_exp();
std::list<ast::Exp *>* args = get_exps();
exp = new ast::CellCallExp(*loc, *name, *args);
break;
}
default:
std::cerr << "Unknown code " << code << std::endl;
exit(2);
}
exp->set_verbose(is_verbose);
if(is_break) exp->break_set();
if(is_breakable) exp->breakable_set();
if(is_return) exp->return_set();
if(is_returnable) exp->returnable_set();
if(is_continue) exp->continue_set();
if(is_continuable) exp->continuable_set();
return exp;
}
std::vector<contr_t> slater_fit(double zeta, int am, int nf, bool verbose, int method) {
sto_params_t par;
par.zeta=zeta;
par.l=am;
par.Nf=nf;
par.method=method;
int maxiter=1000;
// Degrees of freedom
int dof;
if(par.method==0 && nf>=2)
dof=2;
else
// Full optimization
par.method=2;
if(par.method==1 && nf>=4)
dof=4;
else
// Full optimization
par.method=2;
// Full optimization
if(par.method==2)
dof=par.Nf;
gsl_multimin_function_fdf minfunc;
minfunc.n=dof;
minfunc.f=eval_difference;
minfunc.df=eval_difference_df;
minfunc.fdf=eval_difference_fdf;
minfunc.params=(void *) ∥
gsl_multimin_fdfminimizer *min;
// Allocate minimizer
// min=gsl_multimin_fdfminimizer_alloc(gsl_multimin_fdfminimizer_vector_bfgs2,dof);
min=gsl_multimin_fdfminimizer_alloc(gsl_multimin_fdfminimizer_conjugate_pr,dof);
gsl_vector *x;
x=gsl_vector_alloc(dof);
// Initialize vector
gsl_vector_set_all(x,0.0);
// Set starting point
switch(par.method) {
case(2):
// Legendre - same as for even tempered
case(1):
// Well tempered - same initialization as for even-tempered
case(0):
// Even tempered, set alpha=1.0 and beta=2.0
gsl_vector_set(x,0,1.0);
if(dof>1)
gsl_vector_set(x,1,2.0);
break;
/*
case(2):
// Free minimization, set exponents to i
for(int i=0;i<nf;i++)
gsl_vector_set(x,i,i);
break;
*/
default:
ERROR_INFO();
throw std::runtime_error("Unknown Slater fitting method.\n");
}
// Set minimizer
gsl_multimin_fdfminimizer_set(min, &minfunc, x, 0.01, 1e-4);
// Iterate
int iter=0;
int iterdelta=0;
int status;
double cost=0;
if(verbose) printf("Iteration\tDelta\n");
do {
iter++;
iterdelta++;
// Simplex
status = gsl_multimin_fdfminimizer_iterate(min);
if (status) {
// printf("Encountered GSL error \"%s\"\n",gsl_strerror(status));
break;
}
// Are we converged?
status = gsl_multimin_test_gradient (min->gradient, 1e-12);
if (verbose && status == GSL_SUCCESS)
{
printf ("converged to minimum at\n");
}
if(min->f!=cost) {
if(verbose) printf("%i\t%e\t%e\t%e\n",iter,min->f,min->f-cost,gsl_blas_dnrm2(min->gradient));
cost=min->f;
iterdelta=0;
}
} while (status == GSL_CONTINUE && iterdelta < maxiter);
// Get best exponents and coefficients
std::vector<double> optexp=get_exps(min->x,&par);
arma::vec optc=solve_coefficients(optexp,par.zeta,par.l);
// Free memory
gsl_vector_free(x);
gsl_multimin_fdfminimizer_free(min);
// Return
std::vector<contr_t> ret(nf);
for(int i=0;i<nf;i++) {
ret[i].z=optexp[i];
ret[i].c=optc[i];
}
return ret;
}
