#include "gsl-aux.h" #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include #define MACRO(B) do {B} while (0) #define ERROR(CODE) MACRO(return CODE;) #define REQUIRES(COND, CODE) MACRO(if(!(COND)) {ERROR(CODE);}) #define OK return 0; #define MIN(A,B) ((A)<(B)?(A):(B)) #define MAX(A,B) ((A)>(B)?(A):(B)) #ifdef DBG #define DEBUGMSG(M) printf("*** calling aux C function: %s\n",M); #else #define DEBUGMSG(M) #endif #define CHECK(RES,CODE) MACRO(if(RES) return CODE;) #ifdef DBG #define DEBUGMAT(MSG,X) printf(MSG" = \n"); gsl_matrix_fprintf(stdout,X,"%f"); printf("\n"); #else #define DEBUGMAT(MSG,X) #endif #ifdef DBG #define DEBUGVEC(MSG,X) printf(MSG" = \n"); gsl_vector_fprintf(stdout,X,"%f"); printf("\n"); #else #define DEBUGVEC(MSG,X) #endif #define DVVIEW(A) gsl_vector_view A = gsl_vector_view_array(A##p,A##n) #define DMVIEW(A) gsl_matrix_view A = gsl_matrix_view_array(A##p,A##r,A##c) #define CVVIEW(A) gsl_vector_complex_view A = gsl_vector_complex_view_array((double*)A##p,A##n) #define CMVIEW(A) gsl_matrix_complex_view A = gsl_matrix_complex_view_array((double*)A##p,A##r,A##c) #define KDVVIEW(A) gsl_vector_const_view A = gsl_vector_const_view_array(A##p,A##n) #define KDMVIEW(A) gsl_matrix_const_view A = gsl_matrix_const_view_array(A##p,A##r,A##c) #define KCVVIEW(A) gsl_vector_complex_const_view A = gsl_vector_complex_const_view_array((double*)A##p,A##n) #define KCMVIEW(A) gsl_matrix_complex_const_view A = gsl_matrix_complex_const_view_array((double*)A##p,A##r,A##c) #define V(a) (&a.vector) #define M(a) (&a.matrix) #define GCVEC(A) int A##n, gsl_complex*A##p #define KGCVEC(A) int A##n, const gsl_complex*A##p #define BAD_SIZE 2000 #define BAD_CODE 2001 #define MEM 2002 #define BAD_FILE 2003 void no_abort_on_error() { gsl_set_error_handler_off(); } int toScalarR(int code, KRVEC(x), RVEC(r)) { REQUIRES(rn==1,BAD_SIZE); DEBUGMSG("toScalarR"); KDVVIEW(x); double res; switch(code) { case 0: { res = gsl_blas_dnrm2(V(x)); break; } case 1: { res = gsl_blas_dasum(V(x)); break; } case 2: { res = gsl_vector_max_index(V(x)); break; } case 3: { res = gsl_vector_max(V(x)); break; } case 4: { res = gsl_vector_min_index(V(x)); break; } case 5: { res = gsl_vector_min(V(x)); break; } default: ERROR(BAD_CODE); } rp[0] = res; OK } inline double sign(double x) { if(x>0) { return +1.0; } else if (x<0) { return -1.0; } else { return 0.0; } } #define OP(C,F) case C: { for(k=0;k1,BAD_SIZE); gsl_poly_complex_workspace * w = gsl_poly_complex_workspace_alloc (an); int res = gsl_poly_complex_solve ((double*)ap, an, w, (double*)zp); CHECK(res,res); gsl_poly_complex_workspace_free (w); OK; } int matrix_fscanf(char*filename, RMAT(a)) { DEBUGMSG("gsl_matrix_fscanf"); //printf(filename); printf("\n"); DMVIEW(a); FILE * f = fopen(filename,"r"); CHECK(!f,BAD_FILE); int res = gsl_matrix_fscanf(f, M(a)); CHECK(res,res); fclose (f); OK } //--------------------------------------------------------------- typedef double Trawfun(int, double*); double only_f_aux_min(const gsl_vector*x, void *pars) { Trawfun * f = (Trawfun*) pars; double* p = (double*)calloc(x->size,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } double res = f(x->size,p); free(p); return res; } // this version returns info about intermediate steps int minimize(double f(int, double*), double tolsize, int maxit, KRVEC(xi), KRVEC(sz), RMAT(sol)) { REQUIRES(xin==szn && solr == maxit && solc == 3+xin,BAD_SIZE); DEBUGMSG("minimizeList (nmsimplex)"); gsl_multimin_function my_func; // extract function from pars my_func.f = only_f_aux_min; my_func.n = xin; my_func.params = f; size_t iter = 0; int status; double size; const gsl_multimin_fminimizer_type *T; gsl_multimin_fminimizer *s = NULL; // Initial vertex size vector KDVVIEW(sz); // Starting point KDVVIEW(xi); // Minimizer nmsimplex, without derivatives T = gsl_multimin_fminimizer_nmsimplex; s = gsl_multimin_fminimizer_alloc (T, my_func.n); gsl_multimin_fminimizer_set (s, &my_func, V(xi), V(sz)); do { status = gsl_multimin_fminimizer_iterate (s); size = gsl_multimin_fminimizer_size (s); solp[iter*solc+0] = iter; solp[iter*solc+1] = s->fval; solp[iter*solc+2] = size; int k; for(k=0;kx,k); } status = gsl_multimin_test_size (size, tolsize); iter++; } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; isize,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } double res = fdf->f(x->size,p); free(p); return res; } void df_aux_min(const gsl_vector * x, void * pars, gsl_vector * g) { Tfdf * fdf = ((Tfdf*) pars); double* p = (double*)calloc(x->size,sizeof(double)); double* q = (double*)calloc(x->size,sizeof(double)); int k; for(k=0;ksize;k++) { p[k] = gsl_vector_get(x,k); } fdf->df(x->size,p,q); for(k=0;ksize;k++) { gsl_vector_set(g,k,q[k]); } free(p); free(q); } void fdf_aux_min(const gsl_vector * x, void * pars, double * f, gsl_vector * g) { *f = f_aux_min(x,pars); df_aux_min(x,pars,g); } // conjugate gradient int minimizeWithDeriv(double f(int, double*), void df(int, double*, double*), double initstep, double minimpar, double tolgrad, int maxit, KRVEC(xi), RMAT(sol)) { REQUIRES(solr == maxit && solc == 2+xin,BAD_SIZE); DEBUGMSG("minimizeWithDeriv (conjugate_fr)"); gsl_multimin_function_fdf my_func; // extract function from pars my_func.f = f_aux_min; my_func.df = df_aux_min; my_func.fdf = fdf_aux_min; my_func.n = xin; Tfdf stfdf; stfdf.f = f; stfdf.df = df; my_func.params = &stfdf; size_t iter = 0; int status; const gsl_multimin_fdfminimizer_type *T; gsl_multimin_fdfminimizer *s = NULL; // Starting point KDVVIEW(xi); // conjugate gradient fr T = gsl_multimin_fdfminimizer_conjugate_fr; s = gsl_multimin_fdfminimizer_alloc (T, my_func.n); gsl_multimin_fdfminimizer_set (s, &my_func, V(xi), initstep, minimpar); do { status = gsl_multimin_fdfminimizer_iterate (s); solp[iter*solc+0] = iter; solp[iter*solc+1] = s->f; int k; for(k=0;kx,k); } status = gsl_multimin_test_gradient (s->gradient, tolgrad); iter++; } while (status == GSL_CONTINUE && iter < maxit); int i,j; for (i=iter; i