static VALUE rb_gsl_interp_new(int argc, VALUE *argv, VALUE klass) { rb_gsl_interp *sp = NULL; const gsl_interp_type *T = NULL; double *ptrx = NULL, *ptry = NULL; size_t sizex = 0, sizey = 0, size = 0, stride = 1; int i; for (i = 0; i < argc; i++) { switch (TYPE(argv[i])) { case T_STRING: T = get_interp_type(argv[i]); break; case T_FIXNUM: if (T) size = FIX2INT(argv[i]); else T = get_interp_type(argv[i]); break; default: if (ptrx == NULL) { ptrx = get_vector_ptr(argv[i], &stride, &sizex); } else { ptry = get_vector_ptr(argv[i], &stride, &sizey); size = GSL_MIN_INT(sizex, sizey); } break; } } if (size == 0) rb_raise(rb_eRuntimeError, "interp size is not given."); sp = ALLOC(rb_gsl_interp); if (T == NULL) T = gsl_interp_cspline; sp->p = gsl_interp_alloc(T, size); sp->a = gsl_interp_accel_alloc(); if (ptrx && ptry) gsl_interp_init(sp->p, ptrx, ptry, size); return Data_Wrap_Struct(klass, 0, rb_gsl_interp_free, sp); }
static VALUE rb_GSL_MIN_INT(VALUE obj, VALUE aa, VALUE bb) { if (TYPE(aa) != T_FIXNUM || TYPE(bb) != T_FIXNUM) return rb_GSL_MIN(obj, aa, bb); return INT2FIX(GSL_MIN_INT(FIX2INT(aa), FIX2INT(bb))); }
int str_head_grep(const char *s0, const char *s1) { int len0, len1; size_t i, len; char *p0, *p1; len0 = strlen(s0); len1 = strlen(s1); len = (size_t) GSL_MIN_INT(len0, len1); p0 = (char *) s0; p1 = (char *) s1; for (i = 0; i < len; i++) if (*p0++ != *p1++) return 1; return 0; }
static int bundle_method_iterate (void *vstate, gsl_multimin_function_fsdf * fsdf, gsl_vector * x, double * f, gsl_vector * subgradient, gsl_vector * dx, double * eps) { bundle_method_state_t *state = (bundle_method_state_t *) vstate; bundle_element *item; size_t i, debug=0; int status; double tmp_d, t_old, t_int_l; /* local variables */ gsl_vector *y; /* a trial point (the next iteration point by the serios step) */ gsl_vector *sgr_y; /* subgradient at y */ double f_y; /* the function value at y */ gsl_vector *p; /* the aggregate subgradient */ double p_norm, lin_error_p; /* norm of p, the aggregate linear. error */ gsl_vector *tmp_v; /* data for the convex quadratic problem (for the dual problem) */ gsl_vector *q; /* elements of the array are the linearization errors */ gsl_matrix *Q; /* Q=G^T*G (G is matrix which collumns are subgradients) */ gsl_vector *lambda; /* the convex combination coefficients of the subgradients (solution of the dual problem) */ lambda = gsl_vector_alloc(state->bundle_size); if(lambda == 0) { GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } q = gsl_vector_alloc(lambda->size); if(q == 0) { gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } y = gsl_vector_calloc(x->size); if(y == 0) { gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } sgr_y = gsl_vector_calloc(x->size); if(sgr_y == 0) { gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } Q = gsl_matrix_alloc(state->bundle_size, state->bundle_size); if(Q == 0) { gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } p = gsl_vector_calloc(x->size); if(p == 0) { gsl_matrix_free(Q); gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } tmp_v = gsl_vector_calloc(x->size); if(tmp_v == 0) { gsl_vector_free(p); gsl_matrix_free(Q); gsl_vector_free(sgr_y); gsl_vector_free(y); gsl_vector_free(q); gsl_vector_free(lambda); GSL_ERROR_VAL ("failed to allocate workspace", GSL_ENOMEM, 0); } /* solve the dual problem */ status = build_cqp_data(state, Q, q); status = solve_qp_pdip(Q, q, lambda); gsl_matrix_free(Q); gsl_vector_free(q); /* compute the aggregate subgradient (it is called p in the documantation)*/ /* and the appropriated linearization error */ lin_error_p = 0.0; item = state->head; for(i=0; i<lambda->size; i++) { status = gsl_blas_daxpy(gsl_vector_get(lambda,i), item->sgr, p); lin_error_p += gsl_vector_get(lambda,i)*(item->lin_error); item = item->next; } if(debug) { printf("the dual problem solution:\n"); for(i=0;i<lambda->size;i++) printf("%7.6e ",gsl_vector_get(lambda,i)); printf("\n\n"); printf("the aggregate subgradient: \n"); for(i=0;i<p->size;i++) printf("%.6e ",gsl_vector_get(p,i)); printf("\n"); printf("lin. error for aggr subgradient = %e\n",lin_error_p); } /* the norm of the aggr subgradient */ p_norm = gsl_blas_dnrm2(p); /* search direction dx=-t*p (t is the length of step) */ status = gsl_vector_memcpy(dx,p); status = gsl_vector_scale(dx,-1.0*state->t); /* v =-t*norm(p)^2-alpha_p */ state->v = -gsl_pow_2(p_norm)*(state->t)-lin_error_p; /* the subgradient is the aggegate sungradient */ status = gsl_blas_dcopy(p,subgradient); /* iteration step */ /* y=x+dx */ status = gsl_blas_dcopy(dx,y); status = gsl_blas_daxpy(1.0,x,y); /* function value at y */ f_y = GSL_MULTIMIN_FN_EVAL_F(fsdf, y); state->f_eval++; /* for t-update */ if(!state->fixed_step_length) { t_old = state->t; if(fabs(state->v-(f_y-*f)) < state->rg || state->v-(f_y-*f) > state->rg) t_int_l = state->t_max; else t_int_l = 0.5*t_old*(state->v)/(state->v-(f_y-*f)); } else { t_old = state->t; t_int_l = state->t; } if( f_y-*f <= state->m_ss*state->v ) /* Serious-Step */ { if(debug) printf("\nSerious-Step\n"); /* the relaxation step */ if(state->relaxation) { if(f_y-*f <= state->v*state->m_rel) { double f_z; gsl_vector * z = gsl_vector_alloc(y->size); /* z = y+dx = x+2*dx */ status = gsl_blas_dcopy(x,z); status = gsl_blas_daxpy(2.0,dx,z); f_z = GSL_MULTIMIN_FN_EVAL_F(fsdf, z); state->f_eval++; if(0.5*f_z-f_y+0.5*(*f) > state->rg) state->rel_parameter = GSL_MIN_DBL(-0.5*(-0.5*f_z+2.0*f_y-1.5*(*f))/(0.5*f_z-f_y+0.5*(*f)),1.999); else if (fabs(0.5*f_z-f_y+0.5*(*f)) > state->rg) state->rel_parameter = 1.999; else /* something is wrong */ state->rel_parameter = 1.0; /* save the old iteration point */ status = gsl_blas_dcopy(y,z); /* y = (1-rel_parameter)*x+rel_parameter*y */ gsl_blas_dscal(state->rel_parameter,y); status = gsl_blas_daxpy(1.0-state->rel_parameter,x,y); /* f(y) und sgr_f(y) */ tmp_d = GSL_MULTIMIN_FN_EVAL_F(fsdf, y); state->f_eval++; if(tmp_d > f_y) { /* keep y as the current point */ status = gsl_blas_dcopy(z,y); state->rel_counter++; } else { f_y = tmp_d; /* dx = y-x */ status = gsl_blas_dcopy(y,dx); status = gsl_blas_daxpy(-1.0,x,dx); /* if iteration points bevor and after the rel. step are closly, the rel_step counte will be increased */ /* |1-rel_parameter| <= 0.1*/ if( fabs(1.0-state->rel_parameter) < 0.1) state->rel_counter++; } GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; if(state->rel_counter > state->rel_counter_max) state->relaxation = 0; /* */ status = gsl_blas_daxpy(-1.0,y,z); status = gsl_blas_ddot(p, z, &tmp_d); *eps = f_y-*f-(state->v)+tmp_d; gsl_vector_free(z); } else { *eps = f_y-(state->v)-*f; GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; } } else { *eps = f_y-(state->v)-*f; GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; } /* calculate linearization errors at new iteration point */ item = state->head; for(i=0; i<state->bundle_size; i++) { status = gsl_blas_ddot(item->sgr, dx, &tmp_d); item->lin_error += f_y-*f-tmp_d; item = item->next; } /* linearization error at new iteration point */ status = gsl_blas_ddot(p, dx, &tmp_d); lin_error_p += f_y-*f-tmp_d; /* update the bundle */ status = update_bundle(state, sgr_y, 0.0, lambda, p, lin_error_p, 1); /* adapt the step length */ if(!state->fixed_step_length) { if(f_y-*f <= state->v*state->m_t && state->step_counter > 0) state->t = t_int_l; else if(state->step_counter>3) state->t=2.0*t_old; state->t = GSL_MIN_DBL(GSL_MIN_DBL(state->t,10.0*t_old),state->t_max); /*state->eps_v = GSL_MAX_DBL(state->eps_v,-2.0*state->v);*/ state->step_counter = GSL_MAX_INT(state->step_counter+1,1); if(fabs(state->t-t_old) > state->rg) state->step_counter=1; } /* x=y, f=f(y) */ status = gsl_blas_dcopy(y,x); *f = f_y; } else /* Null-Step */ { if(debug) printf("\nNull-Step\n"); GSL_MULTIMIN_FN_EVAL_SDF(fsdf, y, sgr_y); state->sgr_eval++; /* eps for the eps_subdifferential */ *eps = lin_error_p; /*calculate the liniarization error at y */ status = gsl_blas_ddot(sgr_y,dx,&tmp_d); tmp_d += *f-f_y; /* Bundle update */ status = update_bundle(state, sgr_y, tmp_d, lambda, p, lin_error_p, 0); /* adapt the step length */ if(!state->fixed_step_length) { /*state->eps_v = GSL_MIN_DBL(state->eps_v,lin_error_p);*/ if(tmp_d > GSL_MAX_DBL(p_norm,lin_error_p) && state->step_counter < -1) state->t = t_int_l; else if(state->step_counter < -3) state->t = 0.5*t_old; state->t = GSL_MAX_DBL(GSL_MAX_DBL(0.1*t_old,state->t),state->t_min); state->step_counter = GSL_MIN_INT(state->step_counter-1,-1); if(fabs(state->t-t_old) > state->rg) state->step_counter = -1; } } state->lambda_min = p_norm * state->lm_accuracy; if(debug) { printf("\nthe new bundle:\n"); bundle_out_liste(state); printf("\n\n"); printf("the curent itarationspoint (1 x %d)\n",x->size); for(i=0;i<x->size;i++) printf("%12.6f ",gsl_vector_get(x,i)); printf("\n\n"); printf("functions value at current point: f=%.8f\n",*f); printf("\nstep length t=%.5e\n",state->t); printf("\nstep_counter sc=%d\n",state->step_counter); printf("\naccuracy: v=%.5e\n",state->v); printf("\nlambda_min=%e\n",state->lambda_min); printf("\n"); } gsl_vector_free(lambda); gsl_vector_free(y); gsl_vector_free(sgr_y); gsl_vector_free(p); return GSL_SUCCESS; }