int 
main(void)
{
  double par[5] = {1.0, 2.0, 10.0, 20.0, 30.0};

  const gsl_multimin_fminimizer_type *T = 
    gsl_multimin_fminimizer_nmsimplex2;
  gsl_multimin_fminimizer *s = NULL;
  gsl_vector *ss, *x;
  gsl_multimin_function minex_func;

  size_t iter = 0;
  int status;
  double size;

  /* Starting point */
  x = gsl_vector_alloc (2);
  gsl_vector_set (x, 0, 5.0);
  gsl_vector_set (x, 1, 7.0);

  /* Set initial step sizes to 1 */
  ss = gsl_vector_alloc (2);
  gsl_vector_set_all (ss, 1.0);

  /* Initialize method and iterate */
  minex_func.n = 2;
  minex_func.f = my_f;
  minex_func.params = par;

  s = gsl_multimin_fminimizer_alloc (T, 2);
  gsl_multimin_fminimizer_set (s, &minex_func, x, ss);

  do
    {
      iter++;
      status = gsl_multimin_fminimizer_iterate(s);
      
      if (status) 
        break;

      size = gsl_multimin_fminimizer_size (s);
      status = gsl_multimin_test_size (size, 1e-2);

      if (status == GSL_SUCCESS)
        {
          printf ("converged to minimum at\n");
        }

      printf ("%5d %10.3e %10.3e f() = %7.3f size = %.3f\n", 
              iter,
              gsl_vector_get (s->x, 0), 
              gsl_vector_get (s->x, 1), 
              s->fval, size);
    }
  while (status == GSL_CONTINUE && iter < 100);
  
  gsl_vector_free(x);
  gsl_vector_free(ss);
  gsl_multimin_fminimizer_free (s);

  return status;
}
Exemple #2
0
void GSL_vector::set_all(double value) noexcept
{
   if (vec)
      gsl_vector_set_all(vec, value);
}
Exemple #3
0
/* Run PAM */
static void pam_run(pam_partition p, size_t max_iters)
{
  if (p->k == p->M->size1) {
    /* Simple case */
    return;
  }

  size_t i, j, k, m, n, trimmed_size = p->M->size1 - p->k,
         any_swaps = 0,
         iter = 0;
  size_t *medoids, *trimmed;
  double c, current_cost;
  gsl_vector *cost = gsl_vector_alloc(trimmed_size);
  gsl_vector_ulong *cl_index = gsl_vector_ulong_alloc(p->cl_index->size);
  gsl_vector *cl_dist = gsl_vector_alloc(p->cl_dist->size);

  medoids = malloc(sizeof(size_t) * p->k);
  trimmed = malloc(sizeof(size_t) * (p->M->size1 - p->k));

  j = 0;
  k = 0;
  for (i = 0; i < p->M->size1; i++) {
    if (gsl_vector_uchar_get(p->in_set, i))
      medoids[j++] = i;
    else {
      assert(!pam_always_select(p, i));
      trimmed[k++] = i;
    }
  }

  assert(j == p->k);
  assert(k == p->M->size1 - p->k);

  do {
    if (PAM_VERBOSE)
      fprintf(stderr, "Iteration %lu\n", iter);

    any_swaps = 0;

    /* For every medoid, m, swap with every non-medoid, compute cost */
    for (i = 0; i < p->k; i++) {
      m = medoids[i];

      /* If medoid is in the always_select set, no action. */
      if (pam_always_select(p, m))
        continue;

      current_cost = pam_total_cost(p);

      /* Try every non-medoid */
      gsl_vector_set_all(cost, FLT_MAX);

      for (j = 0; j < trimmed_size; j++) {
        n = trimmed[j];
        c = pam_swap_update_cost(p, m, n, cl_index, cl_dist);
        gsl_vector_set(cost, j, c);
      }

      /* Find the minimum cost from all swaps */
      j = gsl_vector_min_index(cost);
      if (gsl_vector_get(cost, j) < current_cost) {
        /* Current cost beaten */
        any_swaps = 1;
        n = trimmed[j];
        assert(n != m);
        assert(!gsl_vector_uchar_get(p->in_set, n));
        assert(gsl_vector_uchar_get(p->in_set, m));
        if (PAM_VERBOSE)
          fprintf(stderr, "SWAP: %lu->%lu [%f -> %f]\n", m, n,
                  current_cost, gsl_vector_get(cost, j));
        gsl_vector_uchar_swap_elements(p->in_set, m, n);

        /* Move n to medoids, m to trimmed */
        trimmed[j] = m;
        medoids[i] = n;

        /* Recalculate cached values */
        pam_swap_cost(p, m, n);
      }
    }
  }
  while (any_swaps && ++iter < max_iters);

  if (PAM_VERBOSE) {
    fprintf(stderr, "Done in %lu iterations. Final config:\n", iter);
    gsl_vector_uchar_fprintf(stderr, p->in_set, "%d");
    fprintf(stderr, "Final cost: %f\n", pam_total_cost(p));
  }

  gsl_vector_free(cost);
  gsl_vector_ulong_free(cl_index);
  gsl_vector_free(cl_dist);
  free(medoids);
  free(trimmed);
}
Exemple #4
0
static gsl_vector *gsl_vector_new(int ndim, double init){
  gsl_vector *p = gsl_vector_alloc(ndim);
  gsl_vector_set_all(p, init);
  return p;
}
Exemple #5
0
/** **************************************************************************************************************/
double g_outer_R (int Rn, double *betaincTauDBL, void *params) /*typedef double optimfn(int n, double *par, void *ex);*/
{
  int i,j;
  double term1=0.0,singlegrp=0.0;
  const datamatrix *designdata = ((struct fnparams *) params)->designdata;/** all design data inc Y and priors **/

const gsl_vector *priormean = designdata->priormean;
  const gsl_vector *priorsd   = designdata->priorsd;
  const gsl_vector *priorgamshape   = designdata->priorgamshape;
  const gsl_vector *priorgamscale   = designdata->priorgamscale;
   gsl_vector *beta   = ((struct fnparams *) params)->beta;/** does not include precision */
  gsl_vector *vectmp1= ((struct fnparams *) params)->vectmp1;/** numparams long*/
  gsl_vector *vectmp2 =((struct fnparams *) params)->vectmp2;/** numparams long*/
  gsl_vector *betaincTau=((struct fnparams *) params)->betaincTau;/** to copy betaincTauDBL into **/
  double epsabs_inner=((struct fnparams *) params)->epsabs_inner;/** absolute error in internal laplace est */
  int maxiters_inner=((struct fnparams *) params)->maxiters_inner;/** number of steps for inner root finder */
  int verbose=((struct fnparams *) params)->verbose;/**  */
  
  int n_betas= (designdata->datamatrix_noRV)->size2;/** number of mean terms excl rv and precision **/
  int n=(designdata->datamatrix_noRV)->size1;/** total number of obs **/
  
  double term2=0.0,term3=0.0,term4=0.0,gval=0.0;
  /*Rprintf("%d %d\n",n_betas,betaincTau->size);*/
  double tau;
  
  for(i=0;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betaincTauDBL[i]);} /** copy R double array into gsl vect **/
  
  /*Rprintf("got = %f %f %f\n",gsl_vector_get(betaincTau,0),gsl_vector_get(betaincTau,1),gsl_vector_get(betaincTau,2));*/
    
  tau=gsl_vector_get(betaincTau,n_betas);/** extract the tau-precision from *beta - last entry */
  /*Rprintf("g_outer_ tau=%f\n",tau);*/
 
  if(tau<0.0){Rprintf("tau negative in g_outer!\n");error("");}
  
  /** beta are the parameters values at which the function is to be evaluated **/
       /** gvalue is the return value - a single double */
       /** STOP - NEED TO copy betaincTau into shorter beta since last entry is tau = precision */
       for(i=0;i<n_betas;i++){gsl_vector_set(beta,i,gsl_vector_get(betaincTau,i));/*Rprintf("passed beta=%f\n",gsl_vector_get(beta,i));*/
       }
     
  /** part 1 - the integrals over each group of observations - use laplace for this and that is taken care of in g_inner */ 
  /** first we want to evaluate each of the integrals for each data group **/ 
       for(j=0;j<designdata->numUnqGrps;j++){/** for each data group **/
	/*j=0;*/
	/* Rprintf("processing group %d\n",j+1);
	 Rprintf("tau in loop=%f\n",gsl_vector_get(betaincTau,n_betas));*/
	  singlegrp=g_inner(betaincTau,designdata,j, epsabs_inner,maxiters_inner,verbose);
	 
	 if(gsl_isnan(singlegrp)){error("nan in g_inner\n");}
	  term1+= singlegrp;
      }
 /** NOTE: uncomment next line as useful for debugging as this should be the same as logLik value from lme4 */
  /*  Rprintf("total loglike=%e\n",term1);*/
    
/*Rprintf("term1 in g_outer=%f\n",term1);*/	
  /** part 2 the priors for the means **/
  term2=0; for(i=0;i<n_betas;i++){term2+=-log(sqrt(2.0*M_PI)*gsl_vector_get(priorsd,i));}
  /** Calc this in parts: R code "term3<- sum( (-1/(2*sd.loc*sd.loc))*(mybeta-mean.loc)*(mybeta-mean.loc) );" **/
  gsl_vector_memcpy(vectmp1,beta);/** copy beta to temp vec */
  gsl_vector_memcpy(vectmp2,priormean);
  gsl_vector_scale(vectmp2,-1.0);
  gsl_vector_add(vectmp1,vectmp2);/** vectmp1= beta-mean**/
  gsl_vector_memcpy(vectmp2,vectmp1);/** copy vectmp1 to vectmp2 **/
  gsl_vector_mul(vectmp2,vectmp1);/** square all elements in vectmp1 and store in vectmp2 */
  gsl_vector_memcpy(vectmp1,priorsd);
  gsl_vector_mul(vectmp1,priorsd);/** square all elements in priorsd and store in vectmp1 */
  gsl_vector_div(vectmp2,vectmp1);/** vectmp2/vectmp1 and store in vectmp2 **/
  gsl_vector_scale(vectmp2,-0.5); /** scale by -1/2 */
  gsl_vector_set_all(vectmp1,1.0); /** ones vector */
  gsl_blas_ddot (vectmp2, vectmp1, &term3);/** DOT product simply to calcu sum value */
  
  
  /** part 3 the prior for the precision tau **/
  term4=  -gsl_vector_get(priorgamshape,0)*log(gsl_vector_get(priorgamscale,0))
             -gsl_sf_lngamma(gsl_vector_get(priorgamshape,0)) 
	     +(gsl_vector_get(priorgamshape,0)-1)*log(tau)
	     -(tau/gsl_vector_get(priorgamscale,0));
   
	     
   gval=(-1.0/n)*(term1+term2+term3+term4);
   /** NO PRIOR */
  /* Rprintf("WARNING - NO PRIOR\n");*/
  #ifdef NOPRIOR
  gval=(-1.0/n)*(term1);
  #endif
   if(gsl_isnan(gval)){error("g_outer_R\n");}
/*Rprintf("g_outer_final=%f term1=%f term2=%f term3=%f term4=%f total=%f %d\n",gval,term1,term2,term3,term4,term1+term2+term3+term4,n);	*/
	return(gval);/** negative since its a minimiser */
}	
Exemple #6
0
static void
test_fdf(const gsl_multilarge_nlinear_type * T,
         const gsl_multilarge_nlinear_parameters * params,
         const double xtol, const double gtol, const double ftol,
         const double epsrel, const double x0_scale,
         test_fdf_problem *problem,
         const double *wts)
{
  gsl_multilarge_nlinear_fdf *fdf = problem->fdf;
  const size_t n = fdf->n;
  const size_t p = fdf->p;
  const size_t max_iter = 2500;
  gsl_vector *x0 = gsl_vector_alloc(p);
  gsl_vector_view x0v = gsl_vector_view_array(problem->x0, p);
  gsl_multilarge_nlinear_workspace *w =
    gsl_multilarge_nlinear_alloc (T, params, n, p);
  const char *pname = problem->name;
  char buf[2048];
  char sname[2048];
  int status, info;

  sprintf(buf, "%s/%s/solver=%s/scale=%s%s%s",
    gsl_multilarge_nlinear_name(w),
    params->trs->name,
    params->solver->name,
    params->scale->name,
    problem->fdf->df ? "" : "/fdjac",
    problem->fdf->fvv ? "" : "/fdfvv");

  strcpy(sname, buf);

  /* scale starting point x0 */
  gsl_vector_memcpy(x0, &x0v.vector);
  test_scale_x0(x0, x0_scale);

  if (wts)
    {
      gsl_vector_const_view wv = gsl_vector_const_view_array(wts, n);
      gsl_multilarge_nlinear_winit(x0, &wv.vector, fdf, w);
    }
  else
    gsl_multilarge_nlinear_init(x0, fdf, w);

  status = gsl_multilarge_nlinear_driver(max_iter, xtol, gtol, ftol,
                                       NULL, NULL, &info, w);
  gsl_test(status, "%s/%s did not converge, status=%s",
           sname, pname, gsl_strerror(status));

  /* check solution */
  test_fdf_checksol(sname, pname, epsrel, w, problem);

  if (wts == NULL)
    {
      /* test again with weighting matrix W = I */
      gsl_vector *wv = gsl_vector_alloc(n);

      sprintf(sname, "%s/weighted", buf);

      gsl_vector_memcpy(x0, &x0v.vector);
      test_scale_x0(x0, x0_scale);

      gsl_vector_set_all(wv, 1.0);
      gsl_multilarge_nlinear_winit(x0, wv, fdf, w);
  
      status = gsl_multilarge_nlinear_driver(max_iter, xtol, gtol, ftol,
                                           NULL, NULL, &info, w);
      gsl_test(status, "%s/%s did not converge, status=%s",
               sname, pname, gsl_strerror(status));

      test_fdf_checksol(sname, pname, epsrel, w, problem);

      gsl_vector_free(wv);
    }

  gsl_multilarge_nlinear_free(w);
  gsl_vector_free(x0);
}
Exemple #7
0
int FC_FUNC_(oct_minimize_direct, OCT_MINIMIZE_DIRECT)
     (const int *method, const int *dim, double *point, const double *step, 
      const double *toldr, const int *maxiter, funcn f, 
      const print_f_fn_ptr write_info, double *minimum)
{
  int iter = 0, status, i;
  double size;

  const gsl_multimin_fminimizer_type *T = NULL;
  gsl_multimin_fminimizer *s = NULL;
  gsl_vector *x, *ss;
  gsl_multimin_function my_func;

  param_fn_t p;
  p.func = f;

  my_func.f = &fn;
  my_func.n = *dim;
  my_func.params = (void *) &p;

  /* Set the initial vertex size vector */
  ss = gsl_vector_alloc (*dim);
  gsl_vector_set_all (ss, *step);

  /* Starting point */
  x = gsl_vector_alloc (*dim);
  for(i=0; i<*dim; i++) gsl_vector_set (x, i, point[i]);

  switch(*method){
  case 6:
    T = gsl_multimin_fminimizer_nmsimplex;
    break;
  }

  s = gsl_multimin_fminimizer_alloc (T, *dim);
  gsl_multimin_fminimizer_set (s, &my_func, x, ss);

  do
    {
      iter++;
      status = gsl_multimin_fminimizer_iterate(s);

      if(status) break;

      *minimum = gsl_multimin_fminimizer_minimum(s);
      for(i=0; i<*dim; i++) point[i] = gsl_vector_get(gsl_multimin_fminimizer_x(s), i);

      size = gsl_multimin_fminimizer_size (s);
      status = gsl_multimin_test_size (size, *toldr);

      write_info(&iter, dim, minimum, &size, point);

    }
  while (status == GSL_CONTINUE && iter < *maxiter);

  if(status == GSL_CONTINUE) status = 1025;

  gsl_vector_free(x); 
  gsl_vector_free(ss);
  gsl_multimin_fminimizer_free(s);
  return status;
}
void Spectrometer::countDispersion_BS(Medium &Osrodek, QString DataName, QProgressBar *Progress, int factor) {
    //lsfgerhla

    double a=Osrodek.itsBasis.getLatticeConstant();
    double thickness=Osrodek.itsStructure.getThickness();

    int RecVec=itsRecVectors;
    int k_prec=itsK_Precision;
    double wi=itsFrequencies[0];
    double w_prec=itsFrequencies[1];
    double wf=itsFrequencies[2];

    int half=3*(2*RecVec+1)*(2*RecVec+1);
    int dimension=6*(2*RecVec+1)*(2*RecVec+1);
    int EigValStrNumber=6*(2*RecVec+1)*(2*RecVec+1);
    int EigValNumber=9*(2*RecVec+1)*(2*RecVec+1);

    std::ofstream plik;
    DataName="results/"+ DataName + ".dat";
    QByteArray   bytes  = DataName.toAscii();
    const char * CDataName = bytes.data();
    plik.open(CDataName);

    //inicjalizacje wektorów i macierzy

    gsl_matrix *gammaA=gsl_matrix_calloc(dimension, dimension);
    gsl_matrix *gammaB=gsl_matrix_calloc(dimension, dimension);

    gsl_matrix *gammaC=gsl_matrix_calloc(dimension, dimension);
    gsl_matrix *gammaD=gsl_matrix_calloc(dimension, dimension);

    gsl_eigen_genv_workspace *wspce=gsl_eigen_genv_alloc(dimension);
    gsl_eigen_genv_workspace *wspce2=gsl_eigen_genv_alloc(dimension);

    gsl_vector_complex *StrAlpha =gsl_vector_complex_alloc(dimension);
    gsl_vector *StrBeta = gsl_vector_alloc(dimension);
    gsl_matrix_complex *StrEigenVec=gsl_matrix_complex_calloc(dimension, dimension);

    gsl_vector_complex *BAlpha =gsl_vector_complex_alloc(dimension);
    gsl_vector *BBeta = gsl_vector_alloc(dimension);
    gsl_matrix_complex *BasisEigenVec=gsl_matrix_complex_calloc(dimension, dimension);

    gsl_matrix_complex *ChosenVectors = gsl_matrix_complex_calloc(half, EigValNumber);
    gsl_vector_complex *ChosenValues = gsl_vector_complex_calloc(EigValNumber);
    gsl_matrix_complex *Boundaries=gsl_matrix_complex_calloc(EigValNumber, EigValNumber);

    double kx, ky, krokx, kroky, boundary_x, boundary_y;
    double k_zred, k_zred0;

    double krok = M_PI/(k_prec*a);

    for (int droga=0; droga<3; droga++) {
    //int droga = 1;
        if (droga==0)           //droga M->Gamma
        {
            kx=-M_PI/a;
            krokx=krok;
            boundary_x=0;
            ky=-M_PI/a;
            kroky=krok;
            boundary_y=0;

            k_zred0=-1*sqrt(pow(kx/(2*M_PI/a), 2)+pow(ky/(2*M_PI/a), 2));
        }
        else if (droga==1)
        {
            kx=0;               //droga Gamma->X
            krokx=krok;
            boundary_x=M_PI/a;
            ky=0;
            kroky=0;
            boundary_y=0;

            k_zred0=sqrt(2)/2;
            //k_zred0=0;
        }
        else if (droga==2)
        {
            kx=M_PI/a;          //Droga X->M
            krokx=0;
            boundary_x=M_PI/a;
            ky=0;
            kroky=krok;
            boundary_y=M_PI/a;

            k_zred0=sqrt(2)/2;
        }

       //petla dla wektorów falowych
       for (; kx <= boundary_x && ky <= boundary_y; kx=kx+krokx, ky=ky+kroky)
       {
           if (droga==0) {
               k_zred = abs(k_zred0 + sqrt( pow(kx/(2*M_PI/a), 2)+pow(ky/(2*M_PI/a), 2)));
           } else {
               k_zred = k_zred0 + kx/(2*M_PI/a) + ky/(2*M_PI/a);
           }


           int postep=int(100*k_zred/1.7);
           Progress->setValue(postep);
           Progress->update();
           QApplication::processEvents();

            //pętla dla częstości w
           for (double w=wi; w<wf; w=w+w_prec)
            {

                gsl_matrix_complex_set_all(Boundaries, gsl_complex_rect (0,0)); //ustawienie wartosci wyznacznika na 0
                gsl_matrix_set_all(gammaA, 0);
                gsl_matrix_set_all(gammaB, 0);
                gsl_matrix_set_all(gammaC, 0);
                gsl_matrix_set_all(gammaD, 0);
                gsl_vector_complex_set_all(StrAlpha, gsl_complex_rect (0,0));
                gsl_vector_set_all(BBeta, 0);
                gsl_vector_complex_set_all(BAlpha, gsl_complex_rect (0,0));
                gsl_vector_set_all(StrBeta, 0);
                gsl_matrix_complex_set_all(BasisEigenVec, gsl_complex_rect (0,0));
                gsl_matrix_complex_set_all(StrEigenVec, gsl_complex_rect (0,0));
                gsl_matrix_complex_set_all(ChosenVectors, gsl_complex_rect (0,0));
                gsl_vector_complex_set_all(ChosenValues, gsl_complex_rect (0,0));

                //gammaA,B dla struktury
                            //gammaA,B dla struktury
                /*
                S - numeruje transformaty tensora sprężystoœci i gestosci
                i - numeruje wiersze macierzy
                j - numeruje kolumny macierzy
                half - druga polowa macierzy
                */
                for(int Nx=-RecVec, i=0, S=0; Nx<=RecVec; Nx++) {
                    for(int Ny=-RecVec; Ny<=RecVec; Ny++, i=i+3) {
                        for(int Nx_prim=-RecVec, j=0; Nx_prim<=RecVec; Nx_prim++) {
                            for(int Ny_prim=-RecVec; Ny_prim<=RecVec; Ny_prim++, j=j+3, S++) {

                                double Elasticity[6][6];
                                itsRecStructureSubstance[S].getElasticity(Elasticity);
                                double Density=itsRecStructureSubstance[S].getDensity();
                                double gx=2*M_PI*Nx/a;
                                double gy=2*M_PI*Ny/a;
                                double gx_prim=2*M_PI*Nx_prim/a;
                                double gy_prim=2*M_PI*Ny_prim/a;

                                gsl_matrix_set(gammaA, i, j, Elasticity[3][3]);
                                gsl_matrix_set(gammaA, i+1, j+1, Elasticity[3][3]);
                                gsl_matrix_set(gammaA, i+2, j+2, Elasticity[0][0]);

                                gsl_matrix_set(gammaB, i+2, j, -Elasticity[0][1]*(kx+gx_prim)-Elasticity[3][3]*(kx+gx));
                                gsl_matrix_set(gammaB, i+2, j+1, -Elasticity[0][1]*(ky+gy_prim)-Elasticity[3][3]*(ky+gy));
                                gsl_matrix_set(gammaB, i, j+2, -Elasticity[0][1]*(kx+gx)-Elasticity[3][3]*(kx+gx_prim));
                                gsl_matrix_set(gammaB, i+1, j+2, -Elasticity[0][1]*(ky+gy)-Elasticity[3][3]*(ky+gy_prim));

                                gsl_matrix_set(gammaB, i, j+half, -Elasticity[0][0]*(kx+gx)*(kx+gx_prim)-Elasticity[3][3]*(ky+gy)*(ky+gy_prim)+Density*w*w);
                                gsl_matrix_set(gammaB, i+1, j+half, -Elasticity[0][1]*(kx+gx_prim)*(ky+gy)-Elasticity[3][3]*(ky+gy_prim)*(kx+gx));
                                gsl_matrix_set(gammaB, i, j+half+1, -Elasticity[0][1]*(ky+gy_prim)*(kx+gx)-Elasticity[3][3]*(kx+gx_prim)*(ky+gy));
                                gsl_matrix_set(gammaB, i+1, j+half+1, -Elasticity[0][0]*(ky+gy_prim)*(ky+gy)-Elasticity[3][3]*(kx+gx_prim)*(kx+gx)+Density*w*w);
                                gsl_matrix_set(gammaB, i+2, j+half+2, -Elasticity[3][3]*(ky+gy_prim)*(ky+gy)-Elasticity[3][3]*(kx+gx_prim)*(kx+gx)+Density*w*w);

                                if (i==j) {
                                    gsl_matrix_set(gammaA, i+half, j+half, 1);
                                    gsl_matrix_set(gammaA, i+half+1, j+half+1, 1);
                                    gsl_matrix_set(gammaA, i+half+2, j+half+2, 1);

                                    gsl_matrix_set(gammaB, i+half, j, 1);
                                    gsl_matrix_set(gammaB, i+half+1, j+1, 1);
                                    gsl_matrix_set(gammaB, i+half+2, j+2, 1);
                                }


                            }
                        }
                    }
                }

                //rozwiazanie zagadnienienia własnego
                gsl_eigen_genv(gammaB, gammaA, StrAlpha, StrBeta, StrEigenVec, wspce);


                //gammaC,D dla Podłoża
                for(int Nx=-RecVec, i=0, S=0; Nx<=RecVec; Nx++) {
                    for(int Ny=-RecVec; Ny<=RecVec; Ny++, i=i+3) {
                        for(int Nx_prim=-RecVec, j=0; Nx_prim<=RecVec; Nx_prim++) {
                            for(int Ny_prim=-RecVec; Ny_prim<=RecVec; Ny_prim++, j=j+3, S++) {

                                double Elasticity[6][6];
                                itsRecBasisSubstance[S].getElasticity(Elasticity);
                                double Density=itsRecBasisSubstance[S].getDensity();
                                double gx=2*M_PI*Nx/a;
                                double gy=2*M_PI*Ny/a;
                                double gx_prim=2*M_PI*Nx_prim/a;
                                double gy_prim=2*M_PI*Ny_prim/a;

                                gsl_matrix_set(gammaC, i, j, Elasticity[3][3]);
                                gsl_matrix_set(gammaC, i+1, j+1, Elasticity[3][3]);
                                gsl_matrix_set(gammaC, i+2, j+2, Elasticity[0][0]);

                                gsl_matrix_set(gammaD, i+2, j, -Elasticity[0][1]*(kx+gx_prim)-Elasticity[3][3]*(kx+gx));
                                gsl_matrix_set(gammaD, i+2, j+1, -Elasticity[0][1]*(ky+gy_prim)-Elasticity[3][3]*(ky+gy));
                                gsl_matrix_set(gammaD, i, j+2, -Elasticity[0][1]*(kx+gx)-Elasticity[3][3]*(kx+gx_prim));
                                gsl_matrix_set(gammaD, i+1, j+2, -Elasticity[0][1]*(ky+gy)-Elasticity[3][3]*(ky+gy_prim));

                                gsl_matrix_set(gammaD, i, j+half, -Elasticity[0][0]*(kx+gx)*(kx+gx_prim)-Elasticity[3][3]*(ky+gy)*(ky+gy_prim)+Density*w*w);
                                gsl_matrix_set(gammaD, i+1, j+half, -Elasticity[0][1]*(kx+gx_prim)*(ky+gy)-Elasticity[3][3]*(ky+gy_prim)*(kx+gx));
                                gsl_matrix_set(gammaD, i, j+half+1, -Elasticity[0][1]*(ky+gy_prim)*(kx+gx)-Elasticity[3][3]*(kx+gx_prim)*(ky+gy));
                                gsl_matrix_set(gammaD, i+1, j+half+1, -Elasticity[0][0]*(ky+gy_prim)*(ky+gy)-Elasticity[3][3]*(kx+gx_prim)*(kx+gx)+Density*w*w);
                                gsl_matrix_set(gammaD, i+2, j+half+2, -Elasticity[3][3]*(ky+gy_prim)*(ky+gy)-Elasticity[3][3]*(kx+gx_prim)*(kx+gx)+Density*w*w);

                                if (i==j) {
                                    gsl_matrix_set(gammaC, i+half, j+half, 1);
                                    gsl_matrix_set(gammaC, i+half+1, j+half+1, 1);
                                    gsl_matrix_set(gammaC, i+half+2, j+half+2, 1);

                                    gsl_matrix_set(gammaD, i+half, j, 1);
                                    gsl_matrix_set(gammaD, i+half+1, j+1, 1);
                                    gsl_matrix_set(gammaD, i+half+2, j+2, 1);
                                }


                            }
                        }
                    }
                }

                //rozwiazanie zagadnienienia własnego
                gsl_eigen_genv(gammaD, gammaC, BAlpha, BBeta, BasisEigenVec, wspce2);

                double imagL, realL; //części Re i Im wartości własnych

                int n=0;
                for (int i = 0; i<dimension; i++)
                {
                    //przepisanie wartości i wektorów własnych struktury do macierzy Chosen*
                    gsl_complex StrValue;
                    StrValue= gsl_complex_div_real(gsl_vector_complex_get(StrAlpha, i), gsl_vector_get(StrBeta,i));
                    gsl_vector_complex_set(ChosenValues, i, StrValue);
                    for (int j = half, m=0; j < dimension; j++, m++)
                    {
                        gsl_matrix_complex_set(ChosenVectors, m, i, gsl_matrix_complex_get(StrEigenVec, j, i));
                    }

                    //wybieranie odpowiednich wartości i wektorów własnych dla podłoża i przepisanie do macierzy Chosen*
                    gsl_complex BValue;
                    BValue= gsl_complex_div_real(gsl_vector_complex_get(BAlpha, i), gsl_vector_get(BBeta,i));
                    imagL=GSL_IMAG(BValue);
                    realL=GSL_REAL(BValue);

                    if (imagL > 0.00001 && n+EigValStrNumber<EigValNumber) //warunek na wartości własne && żeby nie było ich więcej niż połowa
                    {
                        gsl_vector_complex_set(ChosenValues, n+EigValStrNumber, BValue); //wybranie wartości własnej

                        for (int j = half, m=0; j < dimension; j++, m++)
                        {
                           gsl_matrix_complex_set(ChosenVectors, m, n+EigValStrNumber, gsl_complex_mul_real(gsl_matrix_complex_get(BasisEigenVec, j, i), -1));  //wybranie drugiej połowy wektora własnego
                        }

                        n++;
                    }

                }

                if (n+EigValStrNumber<EigValNumber)
                {
                    for (int i = 0; i<dimension; i++)
                    {
                        gsl_complex BValue;
                        BValue= gsl_complex_div_real(gsl_vector_complex_get(BAlpha, i), gsl_vector_get(BBeta,i));
                        imagL=GSL_IMAG(BValue);
                        realL=GSL_REAL(BValue);

                        if (imagL < 0.00001 && imagL > -0.00001 && realL < -0.00001 && n+EigValStrNumber<EigValNumber) //warunek na wartości własne && żeby nie było ich więcej niż połowa
                        {
                            gsl_vector_complex_set(ChosenValues, n+EigValStrNumber, BValue); //wybranie wartości własnej

                            for (int j = half, m=0; j < dimension; j++, m++)
                            {
                               gsl_matrix_complex_set(ChosenVectors, m, n+EigValStrNumber, gsl_complex_mul_real(gsl_matrix_complex_get(BasisEigenVec, j, i), -1));  //wybranie drugiej połowy wektora własnego
                            }

                            n++;
                        }
                    }
                }


                //wyznacznik warunków brzegowych - konstrukcja
                /*
                S, S' - numerujš transformaty tensora sprężystoœci
                i - numeruje wektory własne A w pętli dla G
                j - numeruje warunki brzegowe dla kolejnych wektorow odwrotnych G
                k - numeruje wektory własne A w pętli dla G'
                L - numeruje wartoœci własne
                */
                for (int Nx=-RecVec, S=0, S_prim=0, i=0, j=0; Nx <= RecVec; Nx++) {
                    for (int Ny=-RecVec; Ny <= RecVec; Ny++, j=j+9, i=i+3) {

                        for (int L=0; L < EigValNumber; L++) {

                            S_prim = S;
                            for (int Nx_prim=-RecVec, k=0; Nx_prim <= RecVec; Nx_prim++) {
                                for (int Ny_prim=-RecVec; Ny_prim <= RecVec; Ny_prim++, S_prim++, k=k+3) {

                                    double StrElasticity[6][6];
                                    itsRecStructureSubstance[S_prim].getElasticity(StrElasticity);
                                    double BasisElasticity[6][6];
                                    itsRecBasisSubstance[S_prim].getElasticity(BasisElasticity);

                                    double gx_prim=2*M_PI*Nx_prim/a;
                                    double gy_prim=2*M_PI*Ny_prim/a;

                                    if (L < EigValStrNumber)
                                    {

                                        //eksponens
                                        gsl_complex exponent = gsl_complex_polar(exp(GSL_IMAG(gsl_vector_complex_get(ChosenValues, L))*thickness), -1*GSL_REAL(gsl_vector_complex_get(ChosenValues, L))*thickness);

                                        //warunki zerowania się naprężenia na powierzchni
                                        gsl_complex w1 = gsl_complex_mul_real(exponent, StrElasticity[3][3]);
                                        gsl_complex w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (kx+gx_prim));
                                        gsl_complex w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k, L));
                                        gsl_complex BCjL = gsl_complex_add(gsl_complex_mul(gsl_complex_add(w2, w3), w1), gsl_matrix_complex_get(Boundaries, j, L));
                                        gsl_matrix_complex_set(Boundaries, j, L, BCjL);

                                        w1 = gsl_complex_mul_real(exponent, StrElasticity[3][3]);
                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+1, L));
                                        BCjL = gsl_complex_add(gsl_complex_mul(gsl_complex_add(w2, w3), w1), gsl_matrix_complex_get(Boundaries, j+1, L));
                                        gsl_matrix_complex_set(Boundaries, j+1, L, BCjL);

                                        w1 = gsl_complex_mul_real(exponent, StrElasticity[0][0]);
                                        gsl_complex w11 = gsl_complex_mul_real(exponent, StrElasticity[0][1]);
                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k, L), (kx+gx_prim));
                                        gsl_complex w22 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+1, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+2, L));
                                        gsl_complex w4 = gsl_complex_add(gsl_complex_mul(gsl_complex_add(w2, w22), w11), gsl_complex_mul(w3, w1));
                                        BCjL = gsl_complex_add(w4, gsl_matrix_complex_get(Boundaries, j+2, L));
                                        gsl_matrix_complex_set(Boundaries, j+2, L, BCjL);

                                        //warunki równości naprężeń na granicy ośrodków - część dla struktury
                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (kx+gx_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k, L));
                                        BCjL = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w3), StrElasticity[3][3]), gsl_matrix_complex_get(Boundaries, j+3, L));
                                        gsl_matrix_complex_set(Boundaries, j+3, L, BCjL);

                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+1, L));
                                        BCjL = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w3), StrElasticity[3][3]), gsl_matrix_complex_get(Boundaries, j+4, L));
                                        gsl_matrix_complex_set(Boundaries, j+4, L, BCjL);

                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k, L), (kx+gx_prim));
                                        w22 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+1, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+2, L));
                                        w4 = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w22), StrElasticity[0][1]), gsl_complex_mul_real(w3, StrElasticity[0][0]));
                                        BCjL = gsl_complex_add(w4, gsl_matrix_complex_get(Boundaries, j+5, L));
                                        gsl_matrix_complex_set(Boundaries, j+5, L, BCjL);

                                    } else {

                                        //warunki równości naprężeń na granicy ośrodków - część dla podłoża
                                        gsl_complex w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (kx+gx_prim));
                                        gsl_complex w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k, L));
                                        gsl_complex BCjL = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w3), BasisElasticity[3][3]), gsl_matrix_complex_get(Boundaries, j+3, L));
                                        gsl_matrix_complex_set(Boundaries, j+3, L, BCjL);

                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+2, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+1, L));
                                        BCjL = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w3), BasisElasticity[3][3]), gsl_matrix_complex_get(Boundaries, j+4, L));
                                        gsl_matrix_complex_set(Boundaries, j+4, L, BCjL);

                                        w2 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k, L), (kx+gx_prim));
                                        gsl_complex w22 = gsl_complex_mul_real(gsl_matrix_complex_get(ChosenVectors, k+1, L), (ky+gy_prim));
                                        w3 = gsl_complex_mul(gsl_vector_complex_get(ChosenValues, L), gsl_matrix_complex_get(ChosenVectors, k+2, L));
                                        gsl_complex w4 = gsl_complex_add(gsl_complex_mul_real(gsl_complex_add(w2, w22), BasisElasticity[0][1]), gsl_complex_mul_real(w3, BasisElasticity[0][0]));
                                        BCjL = gsl_complex_add(w4, gsl_matrix_complex_get(Boundaries, j+5, L));
                                        gsl_matrix_complex_set(Boundaries, j+5, L, BCjL);

                                    }
                                }
                            }

                            // warunek równości wychyleń na granicy ośrodków
                            gsl_matrix_complex_set(Boundaries, j+6, L, gsl_matrix_complex_get(ChosenVectors, i, L));
                            gsl_matrix_complex_set(Boundaries, j+7, L, gsl_matrix_complex_get(ChosenVectors, i+1, L));
                            gsl_matrix_complex_set(Boundaries, j+8, L, gsl_matrix_complex_get(ChosenVectors, i+2, L));

                        }
                        S=S_prim;
                    }
                }

                //skalowanie macierzy Boundaries
                gsl_complex scale=gsl_complex_rect(pow(10, factor), 0);
                gsl_matrix_complex_scale(Boundaries, scale);

                //obliczenie wyznacznika z Boundaries
                gsl_permutation *Bpermutation = gsl_permutation_alloc(EigValNumber);
                int Bsignum;
                gsl_linalg_complex_LU_decomp(Boundaries, Bpermutation, &Bsignum);
                double DetVal = gsl_linalg_complex_LU_lndet(Boundaries);

                //usuwanie NaN
                if(DetVal != DetVal) DetVal = 0;

                //zapisanie wartości do pliku
                plik << k_zred << "\t" << w << "\t" << DetVal << "\n";

            }
            plik << "\n";
        }

    }

    plik.close();
    gsl_matrix_free(gammaA);
    gsl_matrix_free(gammaB);
    gsl_vector_free(BBeta);
    gsl_vector_free(StrBeta);
    gsl_matrix_free(gammaC);
    gsl_matrix_free(gammaD);
    gsl_vector_complex_free(StrAlpha);
    gsl_vector_complex_free(BAlpha);
    gsl_eigen_genv_free(wspce);
        gsl_eigen_genv_free(wspce2);
    gsl_matrix_complex_free(Boundaries);
    gsl_matrix_complex_free(ChosenVectors);
    gsl_vector_complex_free(ChosenValues);

}
/*******************************************************************************
 * fit_gaussian
 * Fit data to a guassian and return the results. Ideally, this should give the
 * same results as scipy.optimize.curve_fit.
 * Input:
 *      hist:           Histogram to fit the gaussian to
 * Output:
 *      chisq:          Chi^2 of the histogram
 *      ndf:            Number of degrees of freedom of the fit
 *      fit_params:     Fit parameters
 ******************************************************************************/
gsl_vector *fit_gaussian(gsl_histogram *hist,
        double *chisq, long *ndf, gsl_matrix *covar){
    double tol;
    double *hbin, *hrange, bin_width, xdata, min, max;
    double magnitude, mean, sigma;
    double error, ythr;
    int status;
    long gpars, nonzero, nbins;
    long i;
    gsl_vector *pars, *fit_params;
    gsl_multifit_fdfsolver *gfit;
    gsl_multifit_function_fdf gaus;
    const gsl_multifit_fdfsolver_type *ftype;

    /* Allowed relative error is what scipy uses */
    /* tol = 1.49012e-8; scipy least squares default */
    tol = 1e-14;

    /* get number of bins containing data */
    nbins = hist -> n;
    hbin = hist -> bin;
    hrange = hist -> range;
    nonzero = 0;
    for (i=0; i<nbins; i++){
        if (hbin[i]) nonzero++;
    }

    /* Set the function */
    gaus.f = &gaus_f;
    gaus.df = &gaus_df;
    gaus.fdf = &gaus_fdf;
    gaus.n = nonzero;
    gaus.p = 3;
    gaus.params = hist;

    /* Initialize the solver */
    gpars = 3;
    pars = gsl_vector_alloc(gpars);
    gsl_vector_set_all(pars, 1.0);
    ftype = gsl_multifit_fdfsolver_lmsder;
    gfit = gsl_multifit_fdfsolver_alloc(ftype, nonzero, gpars);
    gsl_multifit_fdfsolver_set(gfit, &gaus, pars);

    /* loop the solver and solve this thing */
    do {
        status = gsl_multifit_fdfsolver_iterate(gfit);
        status = gsl_multifit_test_delta(gfit -> dx, gfit -> x, 0, tol);
    } while (status == GSL_CONTINUE);

    magnitude = gsl_vector_get(gfit -> x, 0);
    mean = gsl_vector_get(gfit -> x, 1);
    /* The fitted sigma might be negative, but it is squared when computing the
     * gaussian, so taking the absolute value of sigma is ok */
    sigma = fabs(gsl_vector_get(gfit -> x, 2));

    /* Compute the chi^2 */
    min = hrange[0];
    max = hrange[nbins];
    bin_width = (max - min) / nbins;
    *chisq = 0;
    for (i = 0; i<nbins; i++){
        if (hbin[i]){
            xdata = hrange[i] + bin_width/2.0;
            error = sqrt(hbin[i]);
            ythr = gaussian(xdata, magnitude, mean, sigma);
            *chisq += pow((hbin[i] - ythr)/error, 2);
        }
    }
    *ndf = nonzero - gpars;

    /* Copy results to return vector */
    fit_params = gsl_vector_alloc(gpars);
    gsl_vector_memcpy(fit_params, gfit -> x);

    /* Compute the covariance matrix */
    gsl_multifit_covar(gfit -> J, 0.0, covar);

    /* Free the solver's memory */
    gsl_vector_free(pars);
    gsl_multifit_fdfsolver_free(gfit);

    /* Return the results of the fit */
    return fit_params;
}
Exemple #10
0
int main(int argc, char *argv[])
{
	int all; /*Number of atoms in the initial PDB*/
	int atom; /*Number of initial CAs*/
	int all_t; /*Number of atoms in the target PDB*/
	int atom_t; /*Number of target CAs*/
	
 	int help_flag = 1;
 	char file_name[500];
	char matrix_name[500];
 	char check_name[500];
	int print_inter = 0;
	int print_inter_t = 0;
 	char out_name[500];
	char out_name_t[500];
	char out_movie[500];
	int print_movie = 0;
 	int verbose = 0;
	float vinit = 1; // Valeur de base
	float bond_factor = 1;		// Facteur pour poid des bond strechcing
	float angle_factor = 1;		// Facteur pour poid des angles
	double K_phi1 = 1;				// Facteurs pour angles dièdres
	double K_phi3 = 0.5;
	float init_templaate = 1;
	float kp_factor = 1;					// Facteur pour poid des angles dièdres
	char inputname[500] ="none";
	double beta = 0.000005;
	int morph = 0;
	char morph_name[500];
	
	int change_density = 0;
	
	int i,j,k,l;
	
	int lig = 0;
	int ligt = 0;
	int nconn;
	int print_flag = 0;
	float ligalign = 0; // Flag/valeur pour aligner seulement les résidus dans un cutoff du ligand, 0, one le fait pas... > 0... le cutoff
 	for (i = 1;i < argc;i++) {
 		if (strcmp("-i",argv[i]) == 0) {strcpy(file_name,argv[i+1]);--help_flag;}
 		
 		if (strcmp("-h",argv[i]) == 0) {help_flag = 1;}
 		if (strcmp("-v",argv[i]) == 0) {verbose = 1;}
 		if (strcmp("-lig",argv[i]) == 0) {lig= 1;}
 		if (strcmp("-ligt",argv[i]) == 0) {ligt= 1;}
 		
 		if (strcmp("-init",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp);vinit = temp;}
 		if (strcmp("-kr",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp);bond_factor = temp;}
 		if (strcmp("-kt",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp);angle_factor = temp;}
 		if (strcmp("-kpf",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp); kp_factor = temp;}
 		
 		if (strcmp("-b",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp);beta = temp;}
 		
 		if (strcmp("-t",argv[i]) == 0) {strcpy(check_name,argv[i+1]);help_flag = 0;}
 		
 		if (strcmp("-m",argv[i]) == 0) {strcpy(matrix_name,argv[i+1]);help_flag = 0;}
 		
 		if (strcmp("-o",argv[i]) == 0) {strcpy(out_name,argv[i+1]); print_inter = 1;}
 		if (strcmp("-ot",argv[i]) == 0) {strcpy(out_name_t,argv[i+1]); print_inter_t = 1;}
 		if (strcmp("-om",argv[i]) == 0) {strcpy(out_movie,argv[i+1]); print_movie = 1;}
 		
 		if (strcmp("-ligc",argv[i]) == 0) {float temp;sscanf(argv[i+1],"%f",&temp);ligalign = temp;}
 		
 		if (strcmp("-conf",argv[i]) == 0) {change_density = 1;}
 		
 		if (strcmp("-morph",argv[i]) == 0) {strcpy(morph_name,argv[i+1]); morph = 1;}
 	}
	
 	if (help_flag == 1)
	{
 		printf("****************************\nHelp Section\n-i\tFile Input (PDB)\n-v\tVerbose\n-w\tWeight Vector\n-t\tInitial Value of template (negative value for random)\n\tIf Load Template, multiply the template\n-lt\tLoad input template\n-sp\tSuper Node Mode (CA, N, C)\n-kt\tPoid de l'angle entre les nodes (1)\n-kr\tPoid de la distance entre les nodes (1)\n-f\tFile to fit\n****************************\n");
 		return(0); 
 	} 

 	//***************************************************
 	//*													*
 	//*Builds a structure contaning information on the initial pdb structure
 	//*													*
 	//***************************************************
 	
 	all = count_atom(file_name);
	
 	nconn = count_connect(file_name);
 	
 	if (verbose == 1) {printf("Connect:%d\n",nconn);}
 	
	if (verbose == 1) {printf("Assigning Structure\n\tAll Atom\n");}
	
	// Array with all connects
	
	int **connect_h=(int **)malloc(nconn*sizeof(int *)); 
	
	for(i=0;i<nconn;i++) { connect_h[i]=(int *)malloc(6*sizeof(int));}
	
	assign_connect(file_name,connect_h);
	
	// Assigns all the atoms
	
	struct pdb_atom strc_all[all];
	
	atom = build_all_strc(file_name,strc_all); // Retourne le nombre de Node
	
	if (atom > 800) {printf("Too much nodes .... To fix, ask [email protected]\n");return(1);}
	
	if (verbose == 1) {printf("	Atom:%d\n",all);}
	
	check_lig(strc_all,connect_h,nconn,all);
	
	// Assigns all Nodes
	
	if (verbose == 1) {printf("	CA Structure\n");}
	
	if (verbose == 1) {printf("	Node:%d\n",atom);}
	
	struct pdb_atom strc_node[atom];
	
	atom = build_cord_CA(strc_all, strc_node,all,lig,connect_h,nconn);
	
	if (verbose == 1) {printf("	Assign Node:%d\n",atom);}
	
	// Free Connect
		
	//for(i=0;i<nconn;i++) {printf("I:%d\n",i);free(connect_h[i]);}
	//free(connect_h);
	
	//***************************************************
	//*													*
	//*Builds a structure contaning information on the target pdb structure
	//*													*
	//***************************************************
	
 	nconn = 0;
	
 	all_t = count_atom(check_name);
	
 	nconn = count_connect(check_name);
 	
 	if (verbose == 1) {printf("Connect:%d\n",nconn);}
 	
	if (verbose == 1) {printf("Assigning Structure\n\tAll Atom\n");}
	
	// Array with all connects
	
	int **connect_t=(int **)malloc(nconn*sizeof(int *));
	
	for(i=0;i<nconn;i++) { connect_t[i]=(int *)malloc(6*sizeof(int));}
	
	assign_connect(check_name,connect_t);
	
	// Assigns all the atoms
	
	struct pdb_atom strc_all_t[all_t];
	
	atom_t = build_all_strc(check_name,strc_all_t); // Retourne le nombre de Node
	
	if (atom_t > 800) {printf("Too much node.... To fix, ask [email protected]\n");return(1);}
	
	if (verbose == 1) {printf("	Atom:%d\n",all_t);}
	
	check_lig(strc_all_t,connect_t,nconn,all_t);
	
	// Assigns all Nodes
	
	if (verbose == 1) {printf("	CA Structure\n");}
	
	if (verbose == 1) {printf("	Node:%d\n",atom_t);}
	
	struct pdb_atom strc_node_t[atom_t];

	atom_t = build_cord_CA(strc_all_t, strc_node_t,all_t,ligt,connect_t,nconn);
	
	if (verbose == 1) {printf("	Assign Node:%d\n",atom_t);}
	
	//***************************************************
	//*													*
	//*Aligns both structures
	//*													*
	//***************************************************
	
 	int align[atom];
	
 	int score = node_align(strc_node,atom,strc_node_t,atom_t,align);
	
 	printf("RMSD:%8.5f Score: %d/%d\n",sqrt(rmsd_no(strc_node,strc_node_t,atom, align)),score,atom);
	
	if ((float)score/(float)atom < 0.8)
	{
		printf("Low Score... Will try an homemade alignement !!!\n");
		
		score = node_align_onechain(strc_node,atom,strc_node_t,atom_t,align);
		
		printf("RMSD:%8.5f Score: %d/%d\n",sqrt(rmsd_no(strc_node,strc_node_t,atom, align)),score,atom);
	}
	
 	if ((float)score/(float)atom < 0.8)
	{
 		printf("Low Score... Will try an homemade alignement !!!\n");
		
 		score = node_align_low(strc_node,atom,strc_node_t,atom_t,align);
		
 		printf("RMSD:%8.5f Score: %d/%d\n",sqrt(rmsd_no(strc_node,strc_node_t,atom, align)),score,atom);
 	}
 	
 	if (ligalign > 0)
	{
		score = node_align_lig(strc_node,atom,strc_node_t,atom_t,align,strc_all,all,strc_all_t,all_t,ligalign);
		
		printf("RMSD:%8.5f Score: %d/%d\n",sqrt(rmsd_no(strc_node,strc_node_t,atom, align)),score,atom);
	}
	
	printf("RMSD:%8.5f Score: %d/%d\n",sqrt(rmsd_yes(strc_node,strc_node_t,atom, align,strc_all,all)),score,atom);
	
	// Build hessians
	
	double **hessian=(double **)malloc(3*atom*sizeof(double *)); // Matrix of the Hessian 1 2 3 (bond, angle, dihedral)
	for(i=0;i<3*atom;i++) { hessian[i]=(double *)malloc(3*atom*sizeof(double));}
	for(i=0;i<3*atom;i++)for(j=0;j<(3*atom);j++){hessian[i][j]=0;}
	
	gsl_matrix *hess = gsl_matrix_alloc(3*atom,3*atom);
	gsl_matrix_set_all(hess, 0);
	gsl_matrix *hess_t = gsl_matrix_alloc(3*atom_t,3*atom_t);
	gsl_matrix_set_all(hess_t, 0);
	
	assign_atom_type(strc_all, all);
	if (strcmp(inputname,"none") == 0) {} else {assign_lig_type(strc_all, all, inputname);}
	gsl_matrix *vcon = gsl_matrix_alloc(all,all);
	gsl_matrix *inter_m = gsl_matrix_alloc(8,8);
	gsl_matrix *templaate = gsl_matrix_alloc(atom*3, atom*3);
	gsl_matrix_set_all(templaate,vinit);
	gsl_matrix_set_all(vcon,0);
	
	if (verbose == 1) {printf("Do Vcon !!!\n");}
	
	vcon_file_dom(strc_all,vcon,all);
	
	if (verbose == 1) {printf("Reading Interaction Matrix %s\n",matrix_name);}
	load_matrix(inter_m,matrix_name);
	//write_matrix("vcon_vince.dat", vcon,all,all);
	if (verbose == 1) {printf("Building templaate\n");}
	all_interaction(strc_all,all, atom, templaate,lig,vcon,inter_m,strc_node);
	gsl_matrix_scale (templaate, init_templaate);
	
	if (verbose == 1) {printf("Building Hessian\n");}
	
	if (verbose == 1) {printf("\tCovalent Bond Potential\n");}		
	build_1st_matrix(strc_node,hessian,atom,bond_factor);
	
	if (verbose == 1) {printf("\tAngle Potential\n");}	
	build_2_matrix(strc_node,hessian,atom,angle_factor);
	
	if (verbose == 1) {printf("\tDihedral Potential\n");}	
	build_3_matrix(strc_node, hessian,atom,K_phi1/2+K_phi3*9/2,kp_factor);
	
	if (verbose == 1) {printf("\tNon Local Interaction Potential\n");}	
	build_4h_matrix(strc_node,hessian,atom,1.0,templaate);
	
	if (verbose == 1) {printf("\tAssigning Array\n");}	
	assignArray(hess,hessian,3*atom,3*atom);
	
	gsl_matrix_free(vcon);
	gsl_matrix_free(templaate);
	
	double **hessian_t=(double **)malloc(3*atom_t*sizeof(double *)); // Matrix of the Hessian 1 2 3 (bond, angle, dihedral)
	for(i=0;i<3*atom_t;i++) { hessian_t[i]=(double *)malloc(3*atom_t*sizeof(double));}
	for(i=0;i<3*atom_t;i++)for(j=0;j<(3*atom_t);j++){hessian_t[i][j]=0;}
	
	assign_atom_type(strc_all_t, all_t);
	
	if (strcmp(inputname,"none") == 0) {} else {assign_lig_type(strc_all_t, all_t, inputname);}
	
	gsl_matrix *vcon_t = gsl_matrix_alloc(all_t,all_t);
	gsl_matrix *templaate_t = gsl_matrix_alloc(atom_t*3, atom_t*3);
	gsl_matrix_set_all(templaate_t,vinit);
	gsl_matrix_set_all(vcon_t,0);
	
	if (verbose == 1) {printf("Do Vcon !!!\n");}
	
	vcon_file_dom(strc_all_t,vcon_t,all_t);
	
	//write_matrix("vcon_vince.dat", vcon,all,all);
	if (verbose == 1) {printf("Building templaate\n");}
	all_interaction(strc_all_t,all_t, atom_t, templaate_t,lig,vcon_t,inter_m,strc_node_t);
	
	gsl_matrix_scale (templaate_t, init_templaate);
	
	if (verbose == 1) {printf("Building Hessian\n");}
	
	if (verbose == 1) {printf("\tCovalent Bond Potential\n");}
	build_1st_matrix(strc_node_t,hessian_t,atom_t,bond_factor);
	
	if (verbose == 1) {printf("\tAngle Potential\n");}
	build_2_matrix(strc_node_t,hessian_t,atom_t,angle_factor);
	
	if (verbose == 1) {printf("\tDihedral Potential\n");}	
	build_3_matrix(strc_node_t, hessian_t,atom_t,K_phi1/2+K_phi3*9/2,kp_factor);
	
	if (verbose == 1) {printf("\tNon Local Interaction Potential\n");}	
	build_4h_matrix(strc_node_t,hessian_t,atom_t,1.0,templaate_t);
	
	if (verbose == 1) {printf("\tAssigning Array\n");}
	assignArray(hess_t,hessian_t,3*atom_t,3*atom_t);
	
	gsl_matrix_free(vcon_t);
	gsl_matrix_free(templaate_t);
	
	printf("Check 1\n");
	
	// Build mini-hessians (calculated mini_hess object is equal to mini_hess + mini_hess_t
	
	gsl_matrix *mini_hess = gsl_matrix_alloc(3*score, 3*score);
	gsl_matrix_set_all(mini_hess, 0);
	gsl_matrix *mini_hess_i = gsl_matrix_alloc(3*score, 3*score);
	gsl_matrix_set_all(mini_hess_i, 0);
	gsl_matrix *mini_hess_t = gsl_matrix_alloc(3*score, 3*score);
	gsl_matrix_set_all(mini_hess_t, 0);
	
	int sup_line = 0;
	
	int sup_to_node[score];
	
	for(i = 0; i < atom; i++)
	{
		if(align[i] == -1) {continue;}
		
		sup_to_node[sup_line] = i;
		
		int sup_col = 0;
		
		for(j = 0; j < atom; j++)
		{
			if(align[j] == -1) {continue;}
			
			for(k = 0; k < 3; k++)
			{
				for(l = 0; l < 3; l++)
				{
					gsl_matrix_set(mini_hess_i, 3*sup_line + k, 3*sup_col + l, gsl_matrix_get(hess, 3*i + k, 3*j + l));
					gsl_matrix_set(mini_hess, 3*sup_line + k, 3*sup_col + l, gsl_matrix_get(hess, 3*i + k, 3*j + l) + gsl_matrix_get(hess_t, 3*align[i] + k, 3*align[j] + l));
					gsl_matrix_set(mini_hess_t, 3*sup_line + k, 3*sup_col + l, gsl_matrix_get(hess_t, 3*align[i] + k, 3*align[j] + l));
				}
			}
			
			sup_col ++;
		}
		
		sup_line++;
	}
	
	gsl_matrix_free(hess);
	gsl_matrix_free(hess_t);
	
	printf("Check 2\n");
	
	// Invert mini_hess
	
	gsl_vector *eval2 = gsl_vector_alloc(3*score);
	
	gsl_matrix *evec2 = gsl_matrix_alloc (3*score,3*score);
	
	diagonalyse_matrix(mini_hess, 3*score, eval2, evec2);
	
	gsl_matrix_set_all(mini_hess, 0);
	
	for(i = 0; i < 3*score; i++)
	{
		if(gsl_vector_get(eval2, i) > 0.00001)
		{
			for(j = 0; j < 3*score; j++)
			{
				for(k = 0; k < 3*score; k++)
				{
					gsl_matrix_set(mini_hess, j, k, gsl_matrix_get(mini_hess, j, k) + gsl_matrix_get(evec2, j, i)*gsl_matrix_get(evec2, k, i)/gsl_vector_get(eval2, i));
				}
			}
		}
	}
	
	gsl_matrix_free(evec2);
	gsl_vector_free(eval2);
	
	printf("Check 3\n");
	
	// Evaluate delta-conf of init to most stable transitionnal conformer and store delta-conf of init to target.
	
	gsl_vector *del_conf = gsl_vector_alloc(3*score);
	gsl_vector_set_all(del_conf, 0);
	gsl_vector *copy_conf = gsl_vector_alloc(3*score);
	
	for(i = 0; i < score; i++)
	{
		gsl_vector_set(copy_conf, 3*i, strc_node_t[align[i]].x_cord - strc_node[i].x_cord);
		gsl_vector_set(copy_conf, 3*i + 1, strc_node_t[align[i]].y_cord - strc_node[i].y_cord);
		gsl_vector_set(copy_conf, 3*i + 2, strc_node_t[align[i]].z_cord - strc_node[i].z_cord);
	}
	
	for(i = 0; i < 3*score; i++)
	{
		for(j = 0; j < 3*score; j++)
		{
			gsl_vector_set(del_conf, i, gsl_vector_get(del_conf, i) + gsl_matrix_get(mini_hess_t, i, j)*gsl_vector_get(copy_conf, j));
		}
	}
	
	for(i = 0; i < 3*score; i++)
	{
		gsl_vector_set(copy_conf, i, gsl_vector_get(del_conf, i));
	}
	
	gsl_vector_set_all(del_conf, 0);
	
	for(i = 0; i < 3*score; i++)
	{
		for(j = 0; j < 3*score; j++)
		{
			gsl_vector_set(del_conf, i, gsl_vector_get(del_conf, i) + gsl_matrix_get(mini_hess, i, j)*gsl_vector_get(copy_conf, j));
		}
	}
	
	for(i = 0; i < score; i++)
	{
		gsl_vector_set(copy_conf, 3*i, strc_node_t[align[i]].x_cord - strc_node[i].x_cord);
		gsl_vector_set(copy_conf, 3*i + 1, strc_node_t[align[i]].y_cord - strc_node[i].y_cord);
		gsl_vector_set(copy_conf, 3*i + 2, strc_node_t[align[i]].z_cord - strc_node[i].z_cord);
	}
	
	printf("Check 4\n");
	
	// Translate all the nodes (and all its atoms) of both structures to delta-conf of most stable conformer.
	
	for(i = 0; i < score; i++)
	{
		for(j = 0; j < all; j++)
		{
			if(strc_all[j].node == sup_to_node[i])
			{
				strc_all[j].x_cord += gsl_vector_get(del_conf, 3*i);
				strc_all[j].y_cord += gsl_vector_get(del_conf, 3*i + 1);
				strc_all[j].z_cord += gsl_vector_get(del_conf, 3*i + 2);
			}
		}
		
		for(j = 0; j < all_t; j++)
		{
			if(strc_all_t[j].node == align[sup_to_node[i]])
			{
				strc_all_t[j].x_cord += gsl_vector_get(del_conf, 3*i) - gsl_vector_get(copy_conf, 3*i);
				strc_all_t[j].y_cord += gsl_vector_get(del_conf, 3*i + 1) - gsl_vector_get(copy_conf, 3*i + 1);
				strc_all_t[j].z_cord += gsl_vector_get(del_conf, 3*i + 2) - gsl_vector_get(copy_conf, 3*i + 2);
			}
		}
	}
	
	gsl_matrix_free(mini_hess);
	
	printf("Check 5\n");
	
	int aligned[atom_t];
	
	for(i = 0; i < atom_t; i++)
	{
		aligned[i] = -1;
	}
	
	for(i = 0; i < atom; i++)
	{
		if(align[i] != -1)
		{
			aligned[align[i]] = 1;
		}
	}
	
	// Print transition from init
	
	if(print_inter == 1)
	{
		FILE *out_file;
		
		out_file = fopen(out_name, "w");
		
		for (i = 0; i < all; i++)
		{
			if(align[strc_all[i].node] != -1)
			{
				if (strc_all[i].atom_type == 1) {fprintf(out_file,"ATOM  ");}
				if (strc_all[i].atom_type == 2) {fprintf(out_file,"HETATM");}
				if (strc_all[i].atom_type == 3) {fprintf(out_file,"HETATM");}
				fprintf(out_file,"%5.d %s%s %s%4.d%12.3f%8.3f%8.3f  1.00  %2.2f\n",
					strc_all[i].atom_number,
					strc_all[i].atom_prot_type,
					strc_all[i].res_type,
					strc_all[i].chain,
					strc_all[i].res_number,
					strc_all[i].x_cord,
					strc_all[i].y_cord,
					strc_all[i].z_cord,
					strc_all[i].b_factor
					);
			}
		}
		
		fclose(out_file);
	}
	
	printf("Check 6\n");
	
	// Print transition from target
	
	if(print_inter_t == 1)
	{
		FILE *out_file_t;
		
		out_file_t = fopen(out_name_t, "w");
		
		for (i = 0; i < all_t; i++)
		{
			if(aligned[strc_all_t[i].node] != -1)
			{
				if (strc_all_t[i].atom_type == 1) {fprintf(out_file_t,"ATOM  ");}
				if (strc_all_t[i].atom_type == 2) {fprintf(out_file_t,"HETATM");}
				if (strc_all_t[i].atom_type == 3) {fprintf(out_file_t,"HETATM");}
				fprintf(out_file_t,"%5.d %s%s %s%4.d%12.3f%8.3f%8.3f  1.00  %2.2f\n",
					strc_all_t[i].atom_number,
					strc_all_t[i].atom_prot_type,
					strc_all_t[i].res_type,
					strc_all_t[i].chain,
					strc_all_t[i].res_number,
					strc_all_t[i].x_cord,
					strc_all_t[i].y_cord,
					strc_all_t[i].z_cord,
					strc_all_t[i].b_factor
					);
			}
		}
		
		fclose(out_file_t);
	}
	
	printf("Check 7\n");
	
	// Translate all the nodes (and all its atoms) of init structure back to its original conformation.
	
	for(i = 0; i < score; i++)
	{
		for(j = 0; j < all; j++)
		{
			if(strc_all[j].node == sup_to_node[i])
			{
				strc_all[j].x_cord -= gsl_vector_get(del_conf, 3*i);
				strc_all[j].y_cord -= gsl_vector_get(del_conf, 3*i + 1);
				strc_all[j].z_cord -= gsl_vector_get(del_conf, 3*i + 2);
			}
		}
	}
	
	// Print transition from init to target passing by inter
	
	if(print_movie == 1)
	{
		FILE *out_file_m;
		
		out_file_m = fopen(out_movie, "w");
		
		for(j = 0; j < 30; j++)
		{
			fprintf(out_file_m, "Model %1i\n", j + 1);
			
			for (i = 0; i < all; i++)
			{
				if(align[strc_all[i].node] != -1)
				{
					if (strc_all[i].atom_type == 1) {fprintf(out_file_m,"ATOM  ");}
					if (strc_all[i].atom_type == 2) {fprintf(out_file_m,"HETATM");}
					if (strc_all[i].atom_type == 3) {fprintf(out_file_m,"HETATM");}
					fprintf(out_file_m,"%5.d %s%s %s%4.d%12.3f%8.3f%8.3f  1.00  %2.2f\n",
						strc_all[i].atom_number,
						strc_all[i].atom_prot_type,
						strc_all[i].res_type,
						strc_all[i].chain,
						strc_all[i].res_number,
						strc_all[i].x_cord,
						strc_all[i].y_cord,
						strc_all[i].z_cord,
						strc_all[i].b_factor
						);
				}
			}
			
			fprintf(out_file_m, "TER\nENDMDL\n\n");
			
			for(i = 0; i < score; i++)
			{
				for(k = 0; k < all; k++)
				{
					if(strc_all[k].node == sup_to_node[i])
					{
						strc_all[k].x_cord += gsl_vector_get(del_conf, 3*i)/30.0;
						strc_all[k].y_cord += gsl_vector_get(del_conf, 3*i + 1)/30.0;
						strc_all[k].z_cord += gsl_vector_get(del_conf, 3*i + 2)/30.0;
					}
				}
			}
		}
		
		for(j = 0; j < 31; j++)
		{
			fprintf(out_file_m, "Model %1i\n", j + 31);
			
			for (i = 0; i < all_t; i++)
			{
				if(aligned[strc_all_t[i].node] != -1)
				{
					if (strc_all_t[i].atom_type == 1) {fprintf(out_file_m,"ATOM  ");}
					if (strc_all_t[i].atom_type == 2) {fprintf(out_file_m,"HETATM");}
					if (strc_all_t[i].atom_type == 3) {fprintf(out_file_m,"HETATM");}
					fprintf(out_file_m,"%5.d %s%s %s%4.d%12.3f%8.3f%8.3f  1.00  %2.2f\n",
						strc_all_t[i].atom_number,
						strc_all_t[i].atom_prot_type,
						strc_all_t[i].res_type,
						strc_all_t[i].chain,
						strc_all_t[i].res_number,
						strc_all_t[i].x_cord,
						strc_all_t[i].y_cord,
						strc_all_t[i].z_cord,
						strc_all_t[i].b_factor
						);
				}
			}
			
			fprintf(out_file_m, "TER\nENDMDL\n\n");
			
			for(i = 0; i < score; i++)
			{
				for(k = 0; k < all_t; k++)
				{
					if(strc_all_t[k].node == align[sup_to_node[i]])
					{
						strc_all_t[k].x_cord -= (gsl_vector_get(del_conf, 3*i) - gsl_vector_get(copy_conf, 3*i))/30.0;
						strc_all_t[k].y_cord -= (gsl_vector_get(del_conf, 3*i + 1) - gsl_vector_get(copy_conf, 3*i + 1))/30.0;
						strc_all_t[k].z_cord -= (gsl_vector_get(del_conf, 3*i + 2) - gsl_vector_get(copy_conf, 3*i + 2))/30.0;
					}
				}
			}
		}
		
		fclose(out_file_m);
	}
	
	printf("Check 8\n");
	
	// Translate all the nodes (and all its atoms) of init structure back to its original conformation if print_movie == 1
	
	if(print_movie == 1)
	{
		for(i = 0; i < score; i++)
		{
			for(j = 0; j < all; j++)
			{
				if(strc_all[j].node == sup_to_node[i])
				{
					strc_all[j].x_cord -= gsl_vector_get(del_conf, 3*i);
					strc_all[j].y_cord -= gsl_vector_get(del_conf, 3*i + 1);
					strc_all[j].z_cord -= gsl_vector_get(del_conf, 3*i + 2);
				}
			}
		}
	}
	
	printf("Check 8.1\n");
	
	// Print transition from init to target by morphing
	
	if(morph == 1)
	{
		FILE *out_file_morph;
		
		out_file_morph = fopen(morph_name, "w");
		
		printf("Check 8.2\n");
		
		for(j = 0; j < 60; j++)
		{
			fprintf(out_file_morph, "Model %1i\n", j + 1);
			
			for (i = 0; i < all; i++)
			{
				if(align[strc_all[i].node] != -1)
				{
					if (strc_all[i].atom_type == 1) {fprintf(out_file_morph,"ATOM  ");}
					if (strc_all[i].atom_type == 2) {fprintf(out_file_morph,"HETATM");}
					if (strc_all[i].atom_type == 3) {fprintf(out_file_morph,"HETATM");}
					fprintf(out_file_morph,"%5.d %s%s %s%4.d%12.3f%8.3f%8.3f  1.00  %2.2f\n",
						strc_all[i].atom_number,
						strc_all[i].atom_prot_type,
						strc_all[i].res_type,
						strc_all[i].chain,
						strc_all[i].res_number,
						strc_all[i].x_cord,
						strc_all[i].y_cord,
						strc_all[i].z_cord,
						strc_all[i].b_factor
						);
				}
			}
			
			fprintf(out_file_morph, "TER\nENDMDL\n\n");
			
			printf("Check 8.3\n");
			
			for(i = 0; i < score; i++)
			{
				for(k = 0; k < all; k++)
				{
					if(strc_all[k].node == sup_to_node[i])
					{
						strc_all[k].x_cord += gsl_vector_get(copy_conf, 3*i)/60.0;
						strc_all[k].y_cord += gsl_vector_get(copy_conf, 3*i + 1)/60.0;
						strc_all[k].z_cord += gsl_vector_get(copy_conf, 3*i + 2)/60.0;
					}
				}
			}
			
			printf("Check 8.4\n");
		}
		
		fclose(out_file_morph);
	}
	
	printf("Check 9\n");
	
	// Evaluate theoretical delta-G
	
	gsl_vector *dummy_conf = gsl_vector_alloc(3*score);
	gsl_vector_set_all(dummy_conf, 0);
	gsl_vector *dummy_conf_t = gsl_vector_alloc(3*score);
	gsl_vector_set_all(dummy_conf_t, 0);
	
	for(i = 0; i < 3*score; i++)
	{
		for(j = 0; j < 3*score; j++)
		{
			gsl_vector_set(dummy_conf, i, gsl_vector_get(dummy_conf, i) + gsl_vector_get(del_conf, j)*gsl_matrix_get(mini_hess_i, j, i));
			
			gsl_vector_set(dummy_conf_t, i, gsl_vector_get(dummy_conf_t, i) + (gsl_vector_get(del_conf, j) - gsl_vector_get(copy_conf, j))*gsl_matrix_get(mini_hess_t, j, i));
		}
	}
	
	double energy_ic = 0.0;
	double energy_tc = 0.0;
	
	for(i = 0; i < 3*score; i++)
	{
		energy_ic += gsl_vector_get(dummy_conf, i)*gsl_vector_get(del_conf, i);
		
		energy_tc += gsl_vector_get(dummy_conf_t, i)*(gsl_vector_get(del_conf, i) - gsl_vector_get(copy_conf, i));
	}
	
	gsl_vector_free(dummy_conf_t);
	gsl_vector_free(del_conf);
	
	printf("Check 10\n");
	
	if(change_density == 1)
	{
		gsl_vector_set_all(dummy_conf, 0);
		
		gsl_vector *eval = gsl_vector_alloc(3*score);
		gsl_vector_set_all(eval, 0);
		gsl_vector *eval_t = gsl_vector_alloc(3*score);
		gsl_vector_set_all(eval_t, 0);
		
		gsl_matrix *evec = gsl_matrix_alloc (3*score,3*score);
		gsl_matrix_set_all(evec, 0);
		gsl_matrix *evec_t = gsl_matrix_alloc (3*score,3*score);
		gsl_matrix_set_all(evec_t, 0);
		
		diagonalyse_matrix(mini_hess_i, 3*score, eval, evec);
		diagonalyse_matrix(mini_hess_t, 3*score, eval_t, evec_t);
		
		gsl_matrix_free(mini_hess_i);
		gsl_matrix_free(mini_hess_t);
		
		gsl_matrix *comb_hess = gsl_matrix_alloc(3*score, 3*score);
		gsl_matrix_set_all(comb_hess, 0);
		
		double entro = 0.0;
		
		double entro_t = 0.0;
		
		for(i = 0; i < 3*score; i++)
		{
			if(gsl_vector_get(eval, i) > 0.00001)
			{
				for(j = 0; j < 3*score; j++)
				{
					for(k = 0; k < 3*score; k++)
					{
						gsl_matrix_set(comb_hess, j, k, gsl_matrix_get(comb_hess, j, k) + gsl_matrix_get(evec, j, i)*gsl_matrix_get(evec, k, i)/gsl_vector_get(eval, i));
					}
				}
				
				entro += log(3.141592653589793238462643383279) - log(beta * gsl_vector_get(eval, i));
			}
			
			if(gsl_vector_get(eval_t, i) > 0.00001)
			{
				for(j = 0; j < 3*score; j++)
				{
					for(k = 0; k < 3*score; k++)
					{
						gsl_matrix_set(comb_hess, j, k, gsl_matrix_get(comb_hess, j, k) + gsl_matrix_get(evec_t, j, i)*gsl_matrix_get(evec_t, k, i)/gsl_vector_get(eval_t, i));
					}
				}
				
				entro_t += log(3.141592653589793238462643383279) - log(beta * gsl_vector_get(eval_t, i));
			}
		}
		
		gsl_vector_free(eval_t);
		gsl_matrix_free(evec_t);
		
		gsl_vector_set_all(eval, 0);
		gsl_matrix_set_all(evec, 0);
		
		diagonalyse_matrix(comb_hess, 3*score, eval, evec);
		gsl_matrix_set_all(comb_hess, 0);
		
// 		double comb_det = 1.0;
		
		for(i = 0; i < 3*score; i++)
		{
			if(gsl_vector_get(eval, i) > 0.00001)
			{
				for(j = 0; j < 3*score; j++)
				{
					for(k = 0; k < 3*score; k++)
					{
						gsl_matrix_set(comb_hess, j, k, gsl_matrix_get(comb_hess, j, k) + gsl_matrix_get(evec, j, i)*gsl_matrix_get(evec, k, i)/gsl_vector_get(eval, i));
					}
				}
				
// 				comb_det *= beta / (3.141592653589793238462643383279 * gsl_vector_get(eval, i));
			}
		}
		
		for(i = 0; i < 3*score; i++)
		{
			for(j = 0; j < 3*score; j++)
			{
				gsl_vector_set(dummy_conf, i, gsl_vector_get(dummy_conf, i) + gsl_vector_get(copy_conf, j)*gsl_matrix_get(comb_hess, j, i));
			}
		}
		
		double energy_conf = 0.0;
		
		for(i = 0; i < 3*score; i++)
		{
			energy_conf += gsl_vector_get(dummy_conf, i)*gsl_vector_get(copy_conf, i);
		}
		
		double dummy_energy = 0.0;
		
		double prob_conf = 0.0;
		
		dummy_energy = -1.0 * beta * energy_conf;
		
		prob_conf = exp(dummy_energy);
		
		printf("Weighted probability density of exact conformational change at beta = %1.10f : %1.100f\n", beta, prob_conf);
		
		printf("Delta-S (target - init) : %1.10f\n", entro_t - entro);
		
		printf("Delta-H (target - init) : %1.10f\n", energy_ic - energy_tc);
		
		dummy_energy = -310.25 * (entro_t - entro) + energy_ic - energy_tc;
		
		printf("Delta-G (target - init) : %1.10f\n", dummy_energy);
		
		double K_eq = exp(-1.0 * dummy_energy / (310.25 * 8.3145));
		
		printf("Equilibrium constant (target / init) : %1.10f\n", K_eq);
	}
	else
	{
		printf("Energy from init to inter : %1.10f\nEnergy from target to inter : %1.10f\nDelta-H (target - init) : %1.10f\n", energy_ic, energy_tc, energy_ic - energy_tc);
	}
	
	gsl_vector_free(copy_conf);
	gsl_vector_free(dummy_conf);
}
Exemple #11
0
int
gsl_multifit_linear_lcurve (const gsl_vector * y,
                            gsl_vector * reg_param,
                            gsl_vector * rho, gsl_vector * eta,
                            gsl_multifit_linear_workspace * work)
{
  const size_t n = y->size;
  const size_t N = rho->size; /* number of points on L-curve */

  if (n != work->n)
    {
      GSL_ERROR("y vector does not match workspace", GSL_EBADLEN);
    }
  else if (N < 3)
    {
      GSL_ERROR ("at least 3 points are needed for L-curve analysis",
                 GSL_EBADLEN);
    }
  else if (N != eta->size)
    {
      GSL_ERROR ("size of rho and eta vectors do not match",
                 GSL_EBADLEN);
    }
  else if (reg_param->size != eta->size)
    {
      GSL_ERROR ("size of reg_param and eta vectors do not match",
                 GSL_EBADLEN);
    }
  else
    {
      int status = GSL_SUCCESS;
      const size_t p = work->p;

      size_t i, j;

      gsl_matrix_view A = gsl_matrix_submatrix(work->A, 0, 0, n, p);
      gsl_vector_view S = gsl_vector_subvector(work->S, 0, p);
      gsl_vector_view xt = gsl_vector_subvector(work->xt, 0, p);
      gsl_vector_view workp = gsl_matrix_subcolumn(work->QSI, 0, 0, p);
      gsl_vector_view workp2 = gsl_vector_subvector(work->D, 0, p); /* D isn't used for regularized problems */

      const double smax = gsl_vector_get(&S.vector, 0);
      const double smin = gsl_vector_get(&S.vector, p - 1);

      double dr; /* residual error from projection */
      double normy = gsl_blas_dnrm2(y);
      double normUTy;

      /* compute projection xt = U^T y */
      gsl_blas_dgemv (CblasTrans, 1.0, &A.matrix, y, 0.0, &xt.vector);

      normUTy = gsl_blas_dnrm2(&xt.vector);
      dr = normy*normy - normUTy*normUTy;

      /* calculate regularization parameters */
      gsl_multifit_linear_lreg(smin, smax, reg_param);

      for (i = 0; i < N; ++i)
        {
          double lambda = gsl_vector_get(reg_param, i);
          double lambda_sq = lambda * lambda;

          for (j = 0; j < p; ++j)
            {
              double sj = gsl_vector_get(&S.vector, j);
              double xtj = gsl_vector_get(&xt.vector, j);
              double f = sj / (sj*sj + lambda_sq);

              gsl_vector_set(&workp.vector, j, f * xtj);
              gsl_vector_set(&workp2.vector, j, (1.0 - sj*f) * xtj);
            }

          gsl_vector_set(eta, i, gsl_blas_dnrm2(&workp.vector));
          gsl_vector_set(rho, i, gsl_blas_dnrm2(&workp2.vector));
        }

      if (n > p && dr > 0.0)
        {
          /* add correction to residual norm (see eqs 6-7 of [1]) */
          for (i = 0; i < N; ++i)
            {
              double rhoi = gsl_vector_get(rho, i);
              double *ptr = gsl_vector_ptr(rho, i);

              *ptr = sqrt(rhoi*rhoi + dr);
            }
        }

      /* restore D to identity matrix */
      gsl_vector_set_all(work->D, 1.0);

      return status;
    }
} /* gsl_multifit_linear_lcurve() */
Exemple #12
0
      void fill(gsl_matrix* Phi, gsl_vector* Y,
		gsl_vector* mean_features, gsl_vector* sigma_features,
		double& mean_y,
		const DataIter& begin,
		const DataIter& end,
		const fctPhi& phi_of_input,
		const InputOf& input_of,
		const LabelOf& label_of,
		bool normalize_data) {

	if(normalize_data) {
	  unsigned int i = 0;
	  mean_y = 0;
	  for(auto it = begin; it != end; ++it, ++i) {
	    auto& d = *it;
	    gsl_vector_view row = gsl_matrix_row(Phi,i);
	    phi_of_input(&(row.vector),input_of(d));

	    auto y = label_of(d);
	    gsl_vector_set(Y,i,y);
	    mean_y += y;
	  }
	  mean_y /= double(Phi->size1);

	  // We now normalize the inputs
	  // computing the mean
	  gsl_vector_set_zero(mean_features);
	  for(unsigned int i = 0 ; i < Phi->size1; ++i) 
	    for(unsigned int j = 0 ; j < Phi->size2; ++j) 
	      gsl_vector_set(mean_features, j, 
			     gsl_vector_get(mean_features, j) +
			     gsl_matrix_get(Phi, i, j));
	  gsl_vector_scale(mean_features, 1.0 / Phi->size1);
	  // the variance
	  gsl_vector_set_zero(sigma_features);
	  for(unsigned int i = 0 ; i < Phi->size1; ++i)
	    for(unsigned int j = 0 ; j < Phi->size2; ++j) {
	      double tmp = gsl_matrix_get(Phi, i, j) - gsl_vector_get(mean_features,j);
	      gsl_vector_set(sigma_features, j,
			     gsl_vector_get(sigma_features, j) +
			     tmp * tmp);
	    }
	  for(unsigned int j = 0 ; j < sigma_features->size ; ++j) {
	    double sigma = gsl_vector_get(sigma_features, j);
	    gsl_vector_set(sigma_features, j, sqrt(sigma));
	  }

	  for(unsigned int i = 0 ; i < Phi->size1; ++i)
	    for(unsigned int j = 0 ; j < Phi->size2; ++j) {
	      double mu = gsl_vector_get(mean_features, j);
	      double sigma = gsl_vector_get(sigma_features, j);
	      if(sigma == 0) {
		// Don't touch Phi[i,j]
		gsl_vector_set(mean_features, j, 0.0);
		gsl_vector_set(sigma_features, j, 1.0);
	      }
	      else {
		gsl_matrix_set(Phi, i, j,
			       (gsl_matrix_get(Phi, i, j) - mu)/sigma);
	      }
	    }
	
	  // Center the output
	  for(unsigned int i = 0 ; i < Y->size; ++i)
	    gsl_vector_set(Y, i, gsl_vector_get(Y, i) - mean_y);
	}
	else {
	  unsigned int i = 0;
	  for(auto it = begin; it != end; ++it, ++i) {
	    auto& d = *it;
	    gsl_vector_view row = gsl_matrix_row(Phi,i);
	    phi_of_input(&(row.vector),input_of(d));
	    gsl_vector_set(Y,i,label_of(d));
	  }

	  // We now fill in the mean and sigma matrices
	  gsl_vector_set_zero(mean_features);
	  gsl_vector_set_all(sigma_features, 1.0);
	  mean_y = 0;


	}
      }
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 */
}
Exemple #14
0
static int
set (void *vstate, gsl_multiroot_function * func, gsl_vector * x,
     gsl_vector * f, gsl_vector * dx, int scale)
{
  hybrid_state_t *state = (hybrid_state_t *) vstate;

  gsl_matrix *J = state->J;
  gsl_matrix *q = state->q;
  gsl_matrix *r = state->r;
  gsl_vector *tau = state->tau;
  gsl_vector *diag = state->diag;

  int status;

  status = GSL_MULTIROOT_FN_EVAL (func, x, f);

  if (status)
    {
      return status;
    }

  status = gsl_multiroot_fdjacobian (func, x, f, GSL_SQRT_DBL_EPSILON, J);

  if (status)
    {
      return status;
    }

  state->iter = 1;
  state->fnorm = enorm (f);
  state->ncfail = 0;
  state->ncsuc = 0;
  state->nslow1 = 0;
  state->nslow2 = 0;

  gsl_vector_set_all (dx, 0.0);

  /* Store column norms in diag */

  if (scale)
    compute_diag (J, diag);
  else
    gsl_vector_set_all (diag, 1.0);

  /* Set delta to factor |D x| or to factor if |D x| is zero */

  state->delta = compute_delta (diag, x);

  /* Factorize J into QR decomposition */

  status = gsl_linalg_QR_decomp (J, tau);

  if (status)
    {
      return status;
    }

  status = gsl_linalg_QR_unpack (J, tau, q, r);

  return status;
}
Exemple #15
0
/** ****************************************************************************************************
 ***** calc an individual logistic regression model 
 *******************************************************************************************************/
void calc_poisson_marginal_rv_R(network *dag, datamatrix *obsdata, int nodeid,  int errverbose,
                                datamatrix *designmatrix, const double priormean, const double priorsd, const double priorgamshape, const double priorgamscale,
                                const int maxiters, const double epsabs, double epsabs_inner, int maxiters_inner, double finitestepsize, int verbose,
				double h_guess, double h_epsabs, int maxiters_hessian,
			       double *denom_modes, int paramid, double betafixed, double mlik, double *posterior,
				double max_hessian_error,double myfactor_brent, int maxiters_hessian_brent, double num_intervals_brent){

 int i,j,status,sss,haveprecision,iter=0;
  gsl_vector *myBeta,*vectmp1,*vectmp2,*vectmp1long,*vectmp2long,*localbeta,*localbeta2,/* *dgvalues,*/ *betafull,*finitefactors,*finitestepsize_vec,*nmstepsize;/** this will hold the parameter point estimates + 1 is for precision of rv's */
  struct fnparams gparams;/** for passing to the gsl zero finding functions */
  double gvalue;
  gsl_matrix *mattmp2,*mattmp3,*mattmp4,*hessgvalues,*hessgvaluesfull,*hessgvalues3pt,*hessgvaluesfull3pt;
  double mydet=0.0,logscore=0.0;
  gsl_permutation *initsperm;
  gsl_permutation *perm=0;
  int n,m;
  double val=0.0;double nm_size=0.0;
  const gsl_multimin_fminimizer_type *T;
       gsl_multimin_fminimizer *s;
     gsl_multimin_function F;
     double lower,upper,lower_f,upper_f;int found=0; double delta=0.0,new_f_min=0.0;
   double increLogscale=0.0, best_Error=0.0,best_h=0.0, hessian_Error=0.0;
  const gsl_min_fminimizer_type *T1;
  gsl_min_fminimizer *s1;  
 /*const gsl_min_fminimizer_type *T;
  gsl_min_fminimizer *s;
  gsl_function F;*/
  int nDim;/** dimension of optim problem */
  int *nbd;/** nbd is an integer array of dimension nDim.
	                                      On entry nbd represents the type of bounds imposed on the variables, and must be specified as follows:
	                                      nbd(i)=0 if x(i) is unbounded,
		                              1 if x(i) has only a lower bound,
		                              2 if x(i) has both lower and upper bounds, and
		                              3 if x(i) has only an upper bound.
	                                      On exit nbd is unchanged.*/
  
  double *lowerbounds,*upperbounds;
  int failcode;/** check code see R ?optim - if non-zero the a problem **/
  double factr=1e-07;/** error size scaler - this is the default value*/
  double pgtol=1e-07;/** again default value */
  int fncount,grcount;/** hold number of evaluations */
  char msg[60];/** error message */
  int trace=0;/** like verbose */
  int nREPORT=1000;/** report freq*/
  int lmm=5;/** see R ?optim - number of function evals to store - default */
  /** want to find the modes of the function g(betas) where betas=b_0,b_1,,...,tau, the latter being precision */
  /** g(betas) is not differentiable as it contains integrals (which themselves need Laplace estimates **/
  
  /** SETUP things which are the same across all data chunks - groups  */
  /** build design matrix which is designmatrix->datamatrix=X, designmatrix->Y=Y plus priors designmatrix->priorsd, designmatrix->priormean **/
  /** NOTE: design matrix here does include the random effect term **/
  /** note - numparams does NOT include precision term - numpars +1 */
  

  build_designmatrix_pois_rv(dag,obsdata,priormean, priorsd,priorgamshape,priorgamscale,designmatrix,nodeid,0);
  
  nDim=designmatrix->numparams+1-1;/** +1 for prec -1 for marginal */ 
  lowerbounds=(double *)R_alloc(nDim,sizeof(double*));
  upperbounds=(double *)R_alloc(nDim,sizeof(double*));
  nbd=(int *)R_alloc(nDim,sizeof(int*));
  for(i=0;i<nDim;i++){lowerbounds[i]=-DBL_MAX;
                        upperbounds[i]=DBL_MAX;
			nbd[i]=0;}
  /** unbounded - by default */
  
  if(paramid==(designmatrix->numparams+1)-1){haveprecision=1;} else {haveprecision=0;}
  
  if(!haveprecision){/** we are NOT marginalising over the precision parameter and so need a contrained optimiser where the LAST term is the precision term
                         and so we set a bound for this */
    nbd[nDim-1]=1;/** enforce a lower bound */
    lowerbounds[nDim-1]=0.001;/** a hard lower bound - set to zero would cause a problem */
  }
   
  finitefactors = gsl_vector_alloc(7);/** used to change stepsize in hessian estimate **/			
  gsl_vector_set(finitefactors,0,1.0E-03);gsl_vector_set(finitefactors,1,1.0E-02);gsl_vector_set(finitefactors,2,1.0E-01);
  gsl_vector_set(finitefactors,3,1.0);gsl_vector_set(finitefactors,4,1.0E+01);gsl_vector_set(finitefactors,5,1.0E+02);
  gsl_vector_set(finitefactors,6,1.0E+03);
  
  /*Rprintf("nDim=%d paramID=%d\n",nDim,paramid);
  for(i=0;i<nDim;i++){Rprintf("lower=%d ",lowerbounds[i]);}Rprintf("\n");*/
  vectmp1 = gsl_vector_alloc (designmatrix->numparams);/** scratch space **/
  vectmp2 = gsl_vector_alloc (designmatrix->numparams);/** scratch space **/
  mattmp2 = gsl_matrix_alloc (obsdata->numDataPts,designmatrix->numparams);
  mattmp3 = gsl_matrix_alloc (designmatrix->numparams,designmatrix->numparams);
  mattmp4 = gsl_matrix_alloc (designmatrix->numparams,designmatrix->numparams);
  initsperm = gsl_permutation_alloc (designmatrix->numparams);/** for use with initial guesses */
  vectmp1long = gsl_vector_alloc (obsdata->numDataPts);/** scratch space **/
  vectmp2long = gsl_vector_alloc (obsdata->numDataPts);
  localbeta = gsl_vector_alloc (designmatrix->numparams);/** scratch space in later functions - excl. precision **/
  localbeta2 = gsl_vector_alloc (designmatrix->numparams+1);/** scratch space in later functions - excl. precision **/
  betafull = gsl_vector_alloc (designmatrix->numparams+1);/** */
  hessgvaluesfull = gsl_matrix_alloc (designmatrix->numparams+1,designmatrix->numparams+1); /**  */ 
  hessgvaluesfull3pt = gsl_matrix_alloc (designmatrix->numparams+1,designmatrix->numparams+1);
 
  myBeta = gsl_vector_alloc (designmatrix->numparams+1-1);/** inc rv precision : -1 as marginal calc */
  hessgvalues = gsl_matrix_alloc (designmatrix->numparams+1-1,designmatrix->numparams+1-1); /** -1 as marginal calc */ 
  hessgvalues3pt = gsl_matrix_alloc (designmatrix->numparams+1-1,designmatrix->numparams+1-1);
  /*dgvalues = gsl_vector_alloc (designmatrix->numparams+1-1);*//** inc rv precision : -1 as marginal calc */
  
  gparams.designdata=designmatrix;
  
   gparams.vectmp1=vectmp1;
   gparams.vectmp2=vectmp2;
   gparams.mattmp2=mattmp2;
   gparams.mattmp3=mattmp3;
   gparams.mattmp4=mattmp4;
   gparams.perm=initsperm;
   gparams.vectmp1long=vectmp1long;
   gparams.vectmp2long=vectmp2long;
   gparams.beta=localbeta;/** beta without precision */
   gparams.hessgvalues=hessgvaluesfull;
   gparams.hessgvalues3pt=hessgvaluesfull3pt;
   gparams.betafull=betafull;/** will hold the full beta inc. precision not just marginal */
   gparams.epsabs_inner=epsabs_inner;
   gparams.maxiters_inner=maxiters_inner;
   gparams.verbose=verbose;
   gparams.finitestepsize=finitestepsize;
   
   gparams.betafixed=0.0;/** these will be changed in loop below*/
   gparams.betaindex=paramid;/** this is fixed - the variable for which the posterior is calculated **/
   
   n=obsdata->numDataPts;
   m=designmatrix->numparams+1-1;/** inc precision, -1 marginal */
   
   perm = gsl_permutation_alloc (m);
   j=0;
      for(i=0;i<designmatrix->numparams+1;i++){if(i!= paramid){gsl_vector_set(myBeta,j++,denom_modes[i]);}} /** use modes as initial values **/     
  
   /*Rprintf("MODES: ");for(i=0;i<designmatrix->numparams;i++){Rprintf("= %f\n",gsl_vector_get(myBeta,i));}Rprintf("\nEND\n");*/
   
   status=GSL_SUCCESS;
   gparams.betafixed=betafixed;
  
     /*Rprintf("evaluating marginal at %f\n",gparams.betafixed);*/
     for(i=0;i<finitefactors->size;i++){/** go forwards through the factors so start with SMALLEST STEPSIZE */
   /*Rprintf("step size iteration %d\n",i);*/
     failcode=0;/** reset*/
    gparams.finitestepsize=gsl_vector_get(finitefactors,i)*finitestepsize;
    
      lbfgsb(nDim, lmm, myBeta->data, lowerbounds, upperbounds, nbd, &gvalue, &g_pois_outer_marg_R,
                      &rv_dg_pois_outer_marg_R, &failcode, 
	              &gparams,
	              factr,
                      pgtol, &fncount, &grcount,
                      maxiters, msg, trace, nREPORT);
		      
    if(!failcode){dag->nodeScoresErrCode[nodeid]=0;/*bestsize=gparams.finitestepsize;*/break;}
     }	    

if(failcode){Rprintf("%s at node %d\n",msg,nodeid+1);/** notify if there is an error and set final error code **/
		   } 		
/*Rprintf("MARGINAL gvalue=%f nodeid=%d\n",gvalue,nodeid+1);*/		
gparams.finitestepsize=finitestepsize;/** reset */
/*for(i=0;i<myBeta->size;i++){Rprintf("%f ",gsl_vector_get(myBeta,i));}Rprintf("\n");*/
/** just re-use as much of existing gparams as possible - so names are meaningless e.g. betafixed is actually gvalue */
   /*gparams.betaincTau=betafull;*/
   gparams.betastatic=myBeta;/** this is important as we are passing the addres of myBeta and so don't want any other function changing this! **/
   gparams.nDim=n;
   gparams.mDim=m;
   gparams.perm=perm;
   gparams.mattmp2=hessgvalues;
   gparams.mattmp3=hessgvalues3pt;
   gparams.betafixed=betafixed;
   gparams.gvalue=gvalue;
   
    F.f = &compute_mlik_pois_marg_nm;
    F.params = &gparams;
    F.n = 1;
   
    T = gsl_multimin_fminimizer_nmsimplex2;
    s = gsl_multimin_fminimizer_alloc (T, 1);
   
    finitestepsize_vec = gsl_vector_alloc (1);
    gsl_vector_set (finitestepsize_vec, 0, h_guess);
    nmstepsize = gsl_vector_alloc (1);
    gsl_vector_set_all (nmstepsize, h_guess); 
    gsl_multimin_fminimizer_set (s, &F, finitestepsize_vec, nmstepsize);
    status = GSL_SUCCESS;
    
     iter=0;
   
    do
         {
           iter++;
           status = gsl_multimin_fminimizer_iterate (s);
     
           if (status) 
             break;
	   
	   nm_size = gsl_multimin_fminimizer_size (s);
           status = gsl_multimin_test_size (nm_size, h_epsabs);
     /*
           if (status == GSL_SUCCESS)
             {
               Rprintf ("converged to minimum at\n");
             }
     
           Rprintf ("iter=%5d error in mlik=%10.10e using fin.diff step= %10.10e\n", iter,s->fval,gsl_vector_get (s->x, 0));
    */
         }
       while (status == GSL_CONTINUE && iter < maxiters_hessian);
       if( (status != GSL_SUCCESS)){/*actual_status=status;*//** copy for use later **/
                                    status=GSL_FAILURE;} /** solution failed to achieve a value below h_epsabs **/                                                               
	 
    finitestepsize=gsl_vector_get(s->x,0);/** get best fin.diff stepsize **/
    
    /*dag->hessianError[nodeid]= s->fval;*//** get fin.diff error **/
    hessian_Error=s->fval;
    gsl_multimin_fminimizer_free (s);
    
 if(hessian_Error>max_hessian_error){Rprintf("Error in mlik = %e > tolerance of %e so continuing optimisation using Brent\n",hessian_Error,max_hessian_error); 
   
     /* Rprintf("stepsize after NM= %e\n",finitestepsize);*/
  
     T1 = gsl_min_fminimizer_brent;
     s1 = gsl_min_fminimizer_alloc (T1);
	 
      /** must find lower and upper such that f(lower)<f(finitestepsize)<f(upper) **/ 
      /** use an interval of lower=finitestepsize/FACTOR, upper=finitestepsize*FACTOR and then start at the lower end and travel up until
      find suitable endpoints - seems to work but not exactly fast!**/
      best_Error=hessian_Error;/** original error from nelder */
      best_h=finitestepsize;               /** original stepsize from nelder */
      found=0;/** flag for found good result */
      lower=finitestepsize/myfactor_brent;
      upper=myfactor_brent*finitestepsize;
      lower_f=compute_mlik_pois_marg_brent(lower, &gparams);/** value at lower point **/
      upper_f=compute_mlik_pois_marg_brent(upper, &gparams);/** value at higher point **/
      increLogscale=(gsl_sf_log(upper)-gsl_sf_log(lower))/num_intervals_brent;/** on a log scale */
      for(delta=gsl_sf_log(lower)+increLogscale;delta<gsl_sf_log(upper);delta+=increLogscale){/** linear increments on a log scale **/
	R_CheckUserInterrupt();/** allow an interupt from R console */ 
	/** find a point which has f(x) lower than f(lower) and f(upper) **/
	 new_f_min=compute_mlik_pois_marg_brent(gsl_sf_exp(delta), &gparams); 
	 Rprintf("lower=%e, delta=%e, upper=%e\n",lower,gsl_sf_exp(delta),upper);
        if(lower_f>new_f_min && new_f_min<upper_f  && get_best_stepsize_pois_marg(gsl_sf_exp(delta),lower,upper,maxiters_hessian_brent,&gparams, &compute_mlik_pois_marg_brent,
	                                                               s1,&finitestepsize,&hessian_Error)<=max_hessian_error){/** have an interval suitable for bracketing **/
	                                                           /** above is address so can store error withouth rerunning function */
	  /*finitestepsize=delta;*/
	  found=1;
	  status=GSL_SUCCESS;
	  break;/** break out of delta - so have found new x_min **/
	} else {/** have not got a good enough error but save the best error and stepsize so far found **/
	        if(hessian_Error<best_Error){best_Error=hessian_Error;
	                                                best_h=finitestepsize;}
	        }
      } /** end of search for interval and good error **/
         
      if(!found){/** have not found a suitably small error but may have found a better error than nelder mead **/
        
       /** best_Error will either be the original nelder mean value or better, and best_h is the corresponding stepsize**/
	                                 hessian_Error=best_Error;
					 finitestepsize=best_h;
        /** reset back to nelder-mead estimate **/
	status=GSL_FAILURE;/** set to failure since we did not achieve the lower error asked for */
      Rprintf("failed to meet tolerance of %e and using best error estimate found of %e\n",max_hessian_error,hessian_Error);}

    gsl_min_fminimizer_free (s1);
   
   } /** end of error being too large **/
   
       switch(status){  /** choose which type of node we have */
                     case GSL_SUCCESS:{    
		                     /** successful finite diff so now do final computation with the optimal step size **/
                                     /*Rprintf("search for optimal step size : status = %s at nodeid %d\n", gsl_strerror (status),nodeid+1);*/
                                     rv_hessg_pois_outer_marg(myBeta,&gparams, hessgvalues,finitestepsize,hessgvalues3pt);/**  start with LARGEST STEPSIZE **/
                                    /* Rprintf("HESSIAN MARGINAL using stepsize =%e\n",finitestepsize);
				     for(i1=0;i1<hessgvalues->size1;i1++){
				        for(i2=0;i2<hessgvalues->size2;i2++){Rprintf("%e ",gsl_matrix_get(hessgvalues,i1,i2));}Rprintf("\n");}*/
				        
				     status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss);
                                     mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
                                     logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
                                     val=exp(logscore-mlik); /*Rprintf("f(node)=%f %f %f %f\n",val, mydet,logscore,mlik);  */ 
                                       *posterior=val;
		                      break;  
		     }
       
		     
		     case GSL_FAILURE: {/** the minimiser did not find a minimum meeting the accuracy requirements and so may be unreliable **/
		                       Rprintf ("-- ERROR! -- search for optimal step size error: status = %s at nodeid %d\n", gsl_strerror (status),nodeid+1);
                                       rv_hessg_pois_outer_marg(myBeta,&gparams, hessgvalues,finitestepsize,hessgvalues3pt);/** start with LARGEST STEPSIZE **/
                                       /*Rprintf("HESSIAN MARGINAL using stepsize =%e\n",finitestepsize);
				       for(i1=0;i1<hessgvalues->size1;i1++){
				        for(i2=0;i2<hessgvalues->size2;i2++){Rprintf("%e ",gsl_matrix_get(hessgvalues,i1,i2));}Rprintf("\n");}*/
				        
				        status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss);
                                       mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
                                       logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
				       val=exp(logscore-mlik); /*Rprintf("f(node)=%f %f %f %f\n",val, mydet,logscore,mlik); */  
                                       *posterior=val;
		                       
				       break; 
		     }
		     
		     default:{Rprintf("got case %s\n",gsl_strerror (status)); error("in default switch in calc_node_Score_binary_rv_R() - should never get here!");}  
		     
          }

        
	
 /** now free up allocated memory **/
   for(i=0;i<designmatrix->numUnqGrps;i++){gsl_matrix_free(designmatrix->array_of_designs[i]);
                                           gsl_vector_free(designmatrix->array_of_Y[i]);}
   gsl_vector_free(designmatrix->priormean);
   gsl_vector_free(designmatrix->priorsd);
   gsl_vector_free(designmatrix->priorgamshape);
   gsl_vector_free(designmatrix->priorgamscale);
   gsl_vector_free(designmatrix->Y);
   gsl_matrix_free(designmatrix->datamatrix_noRV);
   /*gsl_vector_free(dgvalues);*/
   gsl_vector_free(myBeta); 
   gsl_vector_free(vectmp1);
   gsl_vector_free(vectmp2);
   gsl_matrix_free(mattmp2);
   gsl_matrix_free(mattmp3);
   gsl_matrix_free(mattmp4);
   gsl_permutation_free(initsperm);
   gsl_vector_free(vectmp1long);
   gsl_vector_free(vectmp2long);
   gsl_vector_free(localbeta);
   gsl_vector_free(localbeta2);
   gsl_vector_free(betafull);
   gsl_matrix_free(hessgvalues); 
   gsl_matrix_free(hessgvalues3pt);
   gsl_matrix_free(hessgvaluesfull);
   gsl_matrix_free(hessgvaluesfull3pt);
   gsl_permutation_free(perm);
   gsl_vector_free(finitefactors);
   gsl_vector_free(finitestepsize_vec);
   gsl_vector_free(nmstepsize);



}
/** Fit peaks' offset by minimize the fitting function
  */
void GetDetOffsetsMultiPeaks::fitPeaksOffset(
    const size_t inpnparams, const double minD, const double maxD,
    const std::vector<double> &vec_peakPosRef,
    const std::vector<double> &vec_peakPosFitted,
    const std::vector<double> &vec_peakHeights,
    FitPeakOffsetResult &fitresult) {
  // Set up array for minimization/optimization by GSL library
  size_t nparams = inpnparams;
  if (nparams > 50)
    nparams = 50;

  double params[153];
  params[0] = static_cast<double>(nparams);
  params[1] = minD;
  params[2] = maxD;
  for (size_t i = 0; i < nparams; i++) {
    params[i + 3] = vec_peakPosRef[i];
  }
  for (size_t i = 0; i < nparams; i++) {
    params[i + 3 + nparams] = vec_peakPosFitted[i];
  }

  // the reason to put these codes here is that nparams may be altered in this
  // method
  fitresult.peakPosFittedSize = static_cast<double>(vec_peakPosFitted.size());
  for (size_t i = 0; i < nparams; i++) {
    params[i + 3 + 2 * nparams] =
        (vec_peakHeights[i] * vec_peakHeights[i]); // vec_fitChi2[i];
    fitresult.chisqSum +=
        1. / (vec_peakHeights[i] * vec_peakHeights[i]); // vec_fitChi2[i];
  }

  // Set up GSL minimzer
  const gsl_multimin_fminimizer_type *T = gsl_multimin_fminimizer_nmsimplex;
  gsl_multimin_fminimizer *s = NULL;
  gsl_vector *ss, *x;
  gsl_multimin_function minex_func;

  // Finally do the fitting
  size_t nopt = 1;
  size_t iter = 0;
  int status = 0;
  double size;

  /* Starting point */
  x = gsl_vector_alloc(nopt);
  gsl_vector_set_all(x, 0.0);

  /* Set initial step sizes to 0.001 */
  ss = gsl_vector_alloc(nopt);
  gsl_vector_set_all(ss, 0.001);

  /* Initialize method and iterate */
  minex_func.n = nopt;
  minex_func.f = &gsl_costFunction;
  minex_func.params = &params;

  s = gsl_multimin_fminimizer_alloc(T, nopt);
  gsl_multimin_fminimizer_set(s, &minex_func, x, ss);

  do {
    iter++;
    status = gsl_multimin_fminimizer_iterate(s);
    if (status)
      break;

    size = gsl_multimin_fminimizer_size(s);
    status = gsl_multimin_test_size(size, 1e-4);

  } while (status == GSL_CONTINUE && iter < 50);

  // Output summary to log file
  std::string reportOfDiffractionEventCalibrateDetectors = gsl_strerror(status);
  /*
  g_log.debug() << " Workspace Index = " << wi <<
                   " Method used = " << " Simplex" <<
                   " Iteration = " << iter <<
                   " Status = " << reportOfDiffractionEventCalibrateDetectors <<
                   " Minimize Sum = " << s->fval <<
                   " Offset   = " << gsl_vector_get (s->x, 0) << "  \n";
  */
  fitresult.offset = gsl_vector_get(s->x, 0);
  fitresult.fitSum = s->fval;

  fitresult.fitoffsetstatus = reportOfDiffractionEventCalibrateDetectors;
  fitresult.chi2 = s->fval;

  gsl_vector_free(x);
  gsl_vector_free(ss);
  gsl_multimin_fminimizer_free(s);
  return;
}
Exemple #17
0
void
test_filip ()
{
  size_t i, j;
  {
    gsl_multifit_linear_workspace * work = 
      gsl_multifit_linear_alloc (filip_n, filip_p);

    gsl_matrix * X = gsl_matrix_alloc (filip_n, filip_p);
    gsl_vector_view y = gsl_vector_view_array (filip_y, filip_n);
    gsl_vector * c = gsl_vector_alloc (filip_p);
    gsl_matrix * cov = gsl_matrix_alloc (filip_p, filip_p);
    gsl_vector_view diag;

    double chisq;

    double expected_c[11] = { -1467.48961422980,      
                              -2772.17959193342,      
                              -2316.37108160893,      
                              -1127.97394098372,      
                              -354.478233703349,      
                              -75.1242017393757,      
                              -10.8753180355343,      
                              -1.06221498588947,      
                              -0.670191154593408E-01, 
                              -0.246781078275479E-02, 
                              -0.402962525080404E-04 };

    double expected_sd[11]  = { 298.084530995537,     
                               559.779865474950,     
                               466.477572127796,     
                               227.204274477751,     
                               71.6478660875927,     
                               15.2897178747400,     
                               2.23691159816033,     
                               0.221624321934227,    
                               0.142363763154724E-01,
                               0.535617408889821E-03,
                               0.896632837373868E-05 };

    double expected_chisq = 0.795851382172941E-03;

    for (i = 0 ; i < filip_n; i++) 
      {
        for (j = 0; j < filip_p; j++) 
          {
            gsl_matrix_set(X, i, j, pow(filip_x[i], j));
          }
      }

    gsl_multifit_linear (X, &y.vector, c, cov, &chisq, work);

    gsl_test_rel (gsl_vector_get(c,0), expected_c[0], 1e-7, "filip gsl_fit_multilinear c0") ;
    gsl_test_rel (gsl_vector_get(c,1), expected_c[1], 1e-7, "filip gsl_fit_multilinear c1") ;
    gsl_test_rel (gsl_vector_get(c,2), expected_c[2], 1e-7, "filip gsl_fit_multilinear c2") ;
    gsl_test_rel (gsl_vector_get(c,3), expected_c[3], 1e-7, "filip gsl_fit_multilinear c3") ;
    gsl_test_rel (gsl_vector_get(c,4), expected_c[4], 1e-7, "filip gsl_fit_multilinear c4") ;
    gsl_test_rel (gsl_vector_get(c,5), expected_c[5], 1e-7, "filip gsl_fit_multilinear c5") ;
    gsl_test_rel (gsl_vector_get(c,6), expected_c[6], 1e-7, "filip gsl_fit_multilinear c6") ;
    gsl_test_rel (gsl_vector_get(c,7), expected_c[7], 1e-7, "filip gsl_fit_multilinear c7") ;
    gsl_test_rel (gsl_vector_get(c,8), expected_c[8], 1e-7, "filip gsl_fit_multilinear c8") ;
    gsl_test_rel (gsl_vector_get(c,9), expected_c[9], 1e-7, "filip gsl_fit_multilinear c9") ;
    gsl_test_rel (gsl_vector_get(c,10), expected_c[10], 1e-7, "filip gsl_fit_multilinear c10") ;

    diag = gsl_matrix_diagonal (cov);

    gsl_test_rel (gsl_vector_get(&diag.vector,0), pow(expected_sd[0],2.0), 1e-6, "filip gsl_fit_multilinear cov00") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,1), pow(expected_sd[1],2.0), 1e-6, "filip gsl_fit_multilinear cov11") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,2), pow(expected_sd[2],2.0), 1e-6, "filip gsl_fit_multilinear cov22") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,3), pow(expected_sd[3],2.0), 1e-6, "filip gsl_fit_multilinear cov33") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,4), pow(expected_sd[4],2.0), 1e-6, "filip gsl_fit_multilinear cov44") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,5), pow(expected_sd[5],2.0), 1e-6, "filip gsl_fit_multilinear cov55") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,6), pow(expected_sd[6],2.0), 1e-6, "filip gsl_fit_multilinear cov66") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,7), pow(expected_sd[7],2.0), 1e-6, "filip gsl_fit_multilinear cov77") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,8), pow(expected_sd[8],2.0), 1e-6, "filip gsl_fit_multilinear cov88") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,9), pow(expected_sd[9],2.0), 1e-6, "filip gsl_fit_multilinear cov99") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,10), pow(expected_sd[10],2.0), 1e-6, "filip gsl_fit_multilinear cov1010") ;

    gsl_test_rel (chisq, expected_chisq, 1e-7, "filip gsl_fit_multilinear chisq") ;

    gsl_vector_free(c);
    gsl_matrix_free(cov);
    gsl_matrix_free(X);
    gsl_multifit_linear_free (work);
  }

  {
    gsl_multifit_linear_workspace * work = 
      gsl_multifit_linear_alloc (filip_n, filip_p);

    gsl_matrix * X = gsl_matrix_alloc (filip_n, filip_p);
    gsl_vector_view y = gsl_vector_view_array (filip_y, filip_n);
    gsl_vector * w = gsl_vector_alloc (filip_n);
    gsl_vector * c = gsl_vector_alloc (filip_p);
    gsl_matrix * cov = gsl_matrix_alloc (filip_p, filip_p);

    double chisq;

    double expected_c[11] = { -1467.48961422980,      
                              -2772.17959193342,      
                              -2316.37108160893,      
                              -1127.97394098372,      
                              -354.478233703349,      
                              -75.1242017393757,      
                              -10.8753180355343,      
                              -1.06221498588947,      
                              -0.670191154593408E-01, 
                              -0.246781078275479E-02, 
                              -0.402962525080404E-04 };

    /* computed using GNU Calc */

    double expected_cov[11][11] ={ {  7.9269341767252183262588583867942e9,  1.4880416622254098343441063389706e10, 1.2385811858111487905481427591107e10, 6.0210784406215266653697715794241e9, 1.8936652526181982747116667336389e9, 4.0274900618493109653998118587093e8, 5.8685468011819735806180092394606e7, 5.7873451475721689084330083708901e6,  3.6982719848703747920663262917032e5,  1.3834818802741350637527054170891e4,   2.301758578713219280719633494302e2  },
      { 1.4880416622254098334697515488559e10, 2.7955091668548290835529555438088e10, 2.3286604504243362691678565997033e10, 1.132895006796272983689297219686e10, 3.5657281653312473123348357644683e9, 7.5893300392314445528176646366087e8, 1.1066654886143524811964131660002e8, 1.0921285448484575110763947787775e7,  6.9838139975394769253353547606971e5,  2.6143091775349597218939272614126e4,  4.3523386330348588614289505633539e2  },
      { 1.2385811858111487890788272968677e10, 2.3286604504243362677757802422747e10, 1.9412787917766676553608636489674e10, 9.4516246492862131849077729250098e9, 2.9771226694709917550143152097252e9, 6.3413035086730038062129508949859e8, 9.2536164488309401636559552742339e7, 9.1386304643423333815338760248027e6,  5.8479478338916429826337004060941e5,  2.1905933113294737443808429764554e4,  3.6493161325305557266196635180155e2  },
      { 6.0210784406215266545770691532365e9,  1.1328950067962729823273441573365e10, 9.4516246492862131792040001429636e9,  4.6053152992000107509329772255094e9, 1.4517147860312147098138030287038e9, 3.0944988323328589376402579060072e8, 4.5190223822292688669369522708712e7, 4.4660958693678497534529855690752e6,  2.8599340736122198213681258676423e5,  1.0720394998549386596165641244705e4,  1.7870937745661967319298031044424e2  },
      { 1.8936652526181982701620450132636e9,  3.5657281653312473058825073094524e9,  2.9771226694709917514149924058297e9,  1.451714786031214708936087401632e9,  4.5796563896564815123074920050827e8, 9.7693972414561515534525103622773e7, 1.427717861635658545863942948444e7,  1.4120161287735817621354292900338e6,  9.0484361228623960006818614875557e4,   3.394106783764852373199087455398e3,  5.6617406468519495376287407526295e1  },
    { 4.0274900618493109532650887473599e8,   7.589330039231444534478894935778e8,  6.3413035086730037947153564986653e8,   3.09449883233285893390542947998e8,  9.7693972414561515475770399055121e7, 2.0855726248311948992114244257719e7, 3.0501263034740400533872858749566e6, 3.0187475839310308153394428784224e5,  1.9358204633534233524477930175632e4,  7.2662989867560017077361942813911e2,  1.2129002231061036467607394277965e1  },
      {  5.868546801181973559370854830868e7,  1.1066654886143524778548044386795e8,  9.2536164488309401413296494869777e7,  4.5190223822292688587853853162072e7, 1.4277178616356585441556046753562e7, 3.050126303474040051574715592746e6,  4.4639982579046340884744460329946e5, 4.4212093985989836047285007760238e4,  2.8371395028774486687625333589972e3,  1.0656694507620102300567296504381e2,  1.7799982046359973175080475654123e0  },
      { 5.7873451475721688839974153925406e6,  1.0921285448484575071271480643397e7,  9.1386304643423333540728480344578e6,  4.4660958693678497427674903565664e6, 1.4120161287735817596182229182587e6, 3.0187475839310308117812257613082e5, 4.4212093985989836021482392757677e4, 4.3818874017028389517560906916315e3,   2.813828775753142855163154605027e2,  1.0576188138416671883232607188969e1,  1.7676976288918295012452853715408e-1 },
      { 3.6982719848703747742568351456818e5,  6.9838139975394768959780068745979e5,  5.8479478338916429616547638954781e5,  2.8599340736122198128717796825489e5, 9.0484361228623959793493985226792e4, 1.9358204633534233490579641064343e4, 2.8371395028774486654873647731797e3, 2.8138287757531428535592907878017e2,  1.8081118503579798222896804627964e1,  6.8005074291434681866415478598732e-1, 1.1373581557749643543869665860719e-2 },
      { 1.3834818802741350562839757244708e4,   2.614309177534959709397445440919e4,  2.1905933113294737352721470167247e4,  1.0720394998549386558251721913182e4, 3.3941067837648523632905604575131e3, 7.2662989867560016909534954790835e2, 1.0656694507620102282337905013451e2, 1.0576188138416671871337685672492e1,  6.8005074291434681828743281967838e-1, 2.5593857187900736057022477529078e-2, 4.2831487599116264442963102045936e-4 },
      { 2.3017585787132192669801658674163e2,  4.3523386330348588381716460685124e2,  3.6493161325305557094116270974735e2,  1.7870937745661967246233792737255e2, 5.6617406468519495180024059284629e1, 1.2129002231061036433003571679329e1, 1.7799982046359973135014027410646e0, 1.7676976288918294983059118597214e-1, 1.137358155774964353146460100337e-2,  4.283148759911626442000316269063e-4,  7.172253875245080423800933453952e-6  } };

    double expected_chisq = 0.795851382172941E-03;

    for (i = 0 ; i < filip_n; i++) 
      {
        for (j = 0; j < filip_p; j++) 
          {
            gsl_matrix_set(X, i, j, pow(filip_x[i], j));
          }
      }

    gsl_vector_set_all (w, 1.0);

    gsl_multifit_wlinear (X, w, &y.vector, c, cov, &chisq, work);

    gsl_test_rel (gsl_vector_get(c,0), expected_c[0], 1e-7, "filip gsl_fit_multilinear c0") ;
    gsl_test_rel (gsl_vector_get(c,1), expected_c[1], 1e-7, "filip gsl_fit_multilinear c1") ;
    gsl_test_rel (gsl_vector_get(c,2), expected_c[2], 1e-7, "filip gsl_fit_multilinear c2") ;
    gsl_test_rel (gsl_vector_get(c,3), expected_c[3], 1e-7, "filip gsl_fit_multilinear c3") ;
    gsl_test_rel (gsl_vector_get(c,4), expected_c[4], 1e-7, "filip gsl_fit_multilinear c4") ;
    gsl_test_rel (gsl_vector_get(c,5), expected_c[5], 1e-7, "filip gsl_fit_multilinear c5") ;
    gsl_test_rel (gsl_vector_get(c,6), expected_c[6], 1e-7, "filip gsl_fit_multilinear c6") ;
    gsl_test_rel (gsl_vector_get(c,7), expected_c[7], 1e-7, "filip gsl_fit_multilinear c7") ;
    gsl_test_rel (gsl_vector_get(c,8), expected_c[8], 1e-7, "filip gsl_fit_multilinear c8") ;
    gsl_test_rel (gsl_vector_get(c,9), expected_c[9], 1e-7, "filip gsl_fit_multilinear c9") ;
    gsl_test_rel (gsl_vector_get(c,10), expected_c[10], 1e-7, "filip gsl_fit_multilinear c10") ;


    for (i = 0; i < filip_p; i++) 
      {
        for (j = 0; j < filip_p; j++)
          {
            gsl_test_rel (gsl_matrix_get(cov,i,j), expected_cov[i][j], 1e-6,
                          "filip gsl_fit_wmultilinear cov(%d,%d)", i, j) ;
          }
      }

    gsl_test_rel (chisq, expected_chisq, 1e-7, "filip gsl_fit_multilinear chisq") ;

    gsl_vector_free(w);
    gsl_vector_free(c);
    gsl_matrix_free(cov);
    gsl_matrix_free(X);
    gsl_multifit_linear_free (work);
  }
}
/* 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));
		}
	}
}
Exemple #19
0
void uniform(gsl_vector* v) {
        gsl_vector_set_all(v, 1.0 / (double)v->size);
}
/* 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;
}
Exemple #21
0
void 
test_longley ()
{     
  size_t i, j;
  {
    gsl_multifit_linear_workspace * work = 
      gsl_multifit_linear_alloc (longley_n, longley_p);

    gsl_matrix_view X = gsl_matrix_view_array (longley_x, longley_n, longley_p);
    gsl_vector_view y = gsl_vector_view_array (longley_y, longley_n);
    gsl_vector * c = gsl_vector_alloc (longley_p);
    gsl_matrix * cov = gsl_matrix_alloc (longley_p, longley_p);
    gsl_vector_view diag;

    double chisq;

    double expected_c[7] = {  -3482258.63459582,
                              15.0618722713733,
                              -0.358191792925910E-01,
                              -2.02022980381683,
                              -1.03322686717359,
                              -0.511041056535807E-01,
                              1829.15146461355 };

    double expected_sd[7]  = {  890420.383607373,      
                                84.9149257747669,      
                                0.334910077722432E-01, 
                                0.488399681651699,     
                                0.214274163161675,     
                                0.226073200069370,     
                                455.478499142212 } ;  

    double expected_chisq = 836424.055505915;

    gsl_multifit_linear (&X.matrix, &y.vector, c, cov, &chisq, work);

    gsl_test_rel (gsl_vector_get(c,0), expected_c[0], 1e-10, "longley gsl_fit_multilinear c0") ;
    gsl_test_rel (gsl_vector_get(c,1), expected_c[1], 1e-10, "longley gsl_fit_multilinear c1") ;
    gsl_test_rel (gsl_vector_get(c,2), expected_c[2], 1e-10, "longley gsl_fit_multilinear c2") ;
    gsl_test_rel (gsl_vector_get(c,3), expected_c[3], 1e-10, "longley gsl_fit_multilinear c3") ;
    gsl_test_rel (gsl_vector_get(c,4), expected_c[4], 1e-10, "longley gsl_fit_multilinear c4") ;
    gsl_test_rel (gsl_vector_get(c,5), expected_c[5], 1e-10, "longley gsl_fit_multilinear c5") ;
    gsl_test_rel (gsl_vector_get(c,6), expected_c[6], 1e-10, "longley gsl_fit_multilinear c6") ;

    diag = gsl_matrix_diagonal (cov);

    gsl_test_rel (gsl_vector_get(&diag.vector,0), pow(expected_sd[0],2.0), 1e-10, "longley gsl_fit_multilinear cov00") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,1), pow(expected_sd[1],2.0), 1e-10, "longley gsl_fit_multilinear cov11") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,2), pow(expected_sd[2],2.0), 1e-10, "longley gsl_fit_multilinear cov22") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,3), pow(expected_sd[3],2.0), 1e-10, "longley gsl_fit_multilinear cov33") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,4), pow(expected_sd[4],2.0), 1e-10, "longley gsl_fit_multilinear cov44") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,5), pow(expected_sd[5],2.0), 1e-10, "longley gsl_fit_multilinear cov55") ;
    gsl_test_rel (gsl_vector_get(&diag.vector,6), pow(expected_sd[6],2.0), 1e-10, "longley gsl_fit_multilinear cov66") ;

    gsl_test_rel (chisq, expected_chisq, 1e-10, "longley gsl_fit_multilinear chisq") ;

    gsl_vector_free(c);
    gsl_matrix_free(cov);
    gsl_multifit_linear_free (work);
  }


  {
    gsl_multifit_linear_workspace * work = 
      gsl_multifit_linear_alloc (longley_n, longley_p);

    gsl_matrix_view X = gsl_matrix_view_array (longley_x, longley_n, longley_p);
    gsl_vector_view y = gsl_vector_view_array (longley_y, longley_n);
    gsl_vector * w = gsl_vector_alloc (longley_n);
    gsl_vector * c = gsl_vector_alloc (longley_p);
    gsl_matrix * cov = gsl_matrix_alloc (longley_p, longley_p);

    double chisq;

    double expected_c[7] = {  -3482258.63459582,
                              15.0618722713733,
                              -0.358191792925910E-01,
                              -2.02022980381683,
                              -1.03322686717359,
                              -0.511041056535807E-01,
                              1829.15146461355 };

    double expected_cov[7][7] = { { 8531122.56783558,
-166.727799925578, 0.261873708176346, 3.91188317230983,
1.1285582054705, -0.889550869422687, -4362.58709870581},

{-166.727799925578, 0.0775861253030891, -1.98725210399982e-05,
-0.000247667096727256, -6.82911920718824e-05, 0.000136160797527761,
0.0775255245956248},

{0.261873708176346, -1.98725210399982e-05, 1.20690316701888e-08,
1.66429546772984e-07, 3.61843600487847e-08, -6.78805814483582e-08,
-0.00013158719037715},

{3.91188317230983, -0.000247667096727256, 1.66429546772984e-07,
2.56665052544717e-06, 6.96541409215597e-07, -9.00858307771567e-07,
-0.00197260370663974},

{1.1285582054705, -6.82911920718824e-05, 3.61843600487847e-08,
6.96541409215597e-07, 4.94032602583969e-07, -9.8469143760973e-08,
-0.000576921112208274},

{-0.889550869422687, 0.000136160797527761, -6.78805814483582e-08,
-9.00858307771567e-07, -9.8469143760973e-08, 5.49938542664952e-07,
0.000430074434198215},

{-4362.58709870581, 0.0775255245956248, -0.00013158719037715,
-0.00197260370663974, -0.000576921112208274, 0.000430074434198215,
2.23229587481535 }} ;

    double expected_chisq = 836424.055505915;

    gsl_vector_set_all (w, 1.0);

    gsl_multifit_wlinear (&X.matrix, w, &y.vector, c, cov, &chisq, work);

    gsl_test_rel (gsl_vector_get(c,0), expected_c[0], 1e-10, "longley gsl_fit_wmultilinear c0") ;
    gsl_test_rel (gsl_vector_get(c,1), expected_c[1], 1e-10, "longley gsl_fit_wmultilinear c1") ;
    gsl_test_rel (gsl_vector_get(c,2), expected_c[2], 1e-10, "longley gsl_fit_wmultilinear c2") ;
    gsl_test_rel (gsl_vector_get(c,3), expected_c[3], 1e-10, "longley gsl_fit_wmultilinear c3") ;
    gsl_test_rel (gsl_vector_get(c,4), expected_c[4], 1e-10, "longley gsl_fit_wmultilinear c4") ;
    gsl_test_rel (gsl_vector_get(c,5), expected_c[5], 1e-10, "longley gsl_fit_wmultilinear c5") ;
    gsl_test_rel (gsl_vector_get(c,6), expected_c[6], 1e-10, "longley gsl_fit_wmultilinear c6") ;

    for (i = 0; i < longley_p; i++) 
      {
        for (j = 0; j < longley_p; j++)
          {
            gsl_test_rel (gsl_matrix_get(cov,i,j), expected_cov[i][j], 1e-7, 
                          "longley gsl_fit_wmultilinear cov(%d,%d)", i, j) ;
          }
      }

    gsl_test_rel (chisq, expected_chisq, 1e-10, "longley gsl_fit_wmultilinear chisq") ;

    gsl_vector_free(w);
    gsl_vector_free(c);
    gsl_matrix_free(cov);
    gsl_multifit_linear_free (work);
  }
}
QFFitAlgorithm::FitResult QFFitAlgorithmGSLSimplex::intFit(double* paramsOut, double* paramErrorsOut, const double* initialParams, QFFitAlgorithm::Functor* model, const double* paramsMin, const double* paramsMax) {
    QFFitAlgorithm::FitResult result;

    int paramCount=model->get_paramcount(); // number of parameters


    if (paramCount<=0) {
        result.fitOK=false;
        result.message=QObject::tr("no parameters to optimize");
        result.messageSimple=result.message;
        return result;
    }
    QFFItAlgorithmGSL_evalData d;
    d.model=model;
    d.paramsMin=paramsMin;
    d.paramsMax=paramsMax;
    d.pcount=paramCount;
    d.out=gsl_vector_alloc(model->get_evalout());
    d.out_ast=gsl_vector_alloc(model->get_evalout());
    d.params=gsl_vector_alloc(paramCount);
    d.params_ast=gsl_vector_alloc(paramCount);

    int iter = 0;
    int maxIter = getParameter("max_iterations").toInt();
    int status;

    //const gsl_multimin_fdfminimizer_type *T;
    //gsl_multimin_fdfminimizer *s;

    gsl_multimin_fminimizer *s;

    // set starting value to initial parameters
    gsl_vector *x=QFFitAlgorithmGSL_transformParams(initialParams, paramCount, paramsMin, paramsMax);

    //gsl_multimin_function_fdf my_func;
    gsl_multimin_function my_func;
    my_func.n = paramCount;
    my_func.f = QFFitAlgorithmGSL_f;
    //my_func.df = QFFitAlgorithmGSL_df;
    //my_func.fdf = QFFitAlgorithmGSL_fdf;
    my_func.params = &d;


    // initialize minimizer

    //s = gsl_multimin_fdfminimizer_alloc (T, paramCount);
    s = gsl_multimin_fminimizer_alloc (T, paramCount);

    /* Set initial step sizes to 1 */
    gsl_vector *ss = gsl_vector_alloc(paramCount);
    gsl_vector_set_all (ss, getParameter("stepsize").toDouble());


    //gsl_multimin_fdfminimizer_set(s, &my_func, x, getParameter("stepsize").toDouble(), getParameter("tol").toDouble());
    gsl_multimin_fminimizer_set(s, &my_func, x, ss);

    do {
        iter++;
        //status = gsl_multimin_fdfminimizer_iterate (s);
        status = gsl_multimin_fminimizer_iterate (s);
        //qDebug()<<"it "<<iter<<": "<<arrayToString(gsl_vector_ptr(s->x, 0), paramCount);
        //qDebug()<<"       f = "<<s->fval;
        //qDebug()<<"       status = "<<status;

        if (status) break;

        //status = gsl_multimin_test_gradient (s->gradient, 1e-3);
        double size = gsl_multimin_fminimizer_size (s);
        status = gsl_multimin_test_size (size, 1e-2);

        //if (status == GSL_SUCCESS) qDebug()<<"       Minimum found !!!";



    } while (status == GSL_CONTINUE && iter < maxIter);


    /*for (int i=0; i<paramCount; i++) {
        const double par=gsl_vector_get(s->x, i);
        paramsOut[i]=par;
        if (par>paramsMax[i]) paramsOut[i]=paramsMax[i];
        if (par<paramsMin[i]) paramsOut[i]=paramsMin[i];
    }*/
    QFFitAlgorithmGSL_backTransformParams(paramsOut, paramCount, s->x, paramsMin, paramsMax);

    QVector<double> J(model->get_evalout()*model->get_paramcount());
    QVector<double> COV(model->get_paramcount()*model->get_paramcount());
    model->evaluateJacobian(J.data(), paramsOut);
    double chi2=s->fval;
    if (QFFitAlgorithm::functorHasWeights(model) && !QFFitAlgorithm::functorAllWeightsOne(model)) statisticsGetFitProblemCovMatrix(COV.data(), J.data(), model->get_evalout(), model->get_paramcount());
    else statisticsGetFitProblemVarCovMatrix(COV.data(), J.data(), model->get_evalout(), model->get_paramcount(), chi2);

    result.addNumberMatrix("covariance_matrix", COV.data(), model->get_paramcount(), model->get_paramcount());

    for (int i=0; i<model->get_paramcount(); i++) {
        paramErrorsOut[i]=statisticsGetFitProblemParamErrors(i, COV.data(), model->get_paramcount());
    }


    result.addNumber("error_sum", s->fval);
    result.addNumber("iterations", iter);

    result.fitOK=false;
    result.message=QObject::tr("error during optimization");
    result.messageSimple=result.message;
    if (status == GSL_SUCCESS) {
        result.fitOK=true;
        result.message=QObject::tr("success after %1 iterations").arg(iter);
        result.messageSimple=result.message;
    } else if (status == GSL_ENOPROG) {
        result.fitOK=true;
        result.message=QObject::tr("no more optimization progress after %1 iterations").arg(iter);
        result.messageSimple=result.message;
    }



    //gsl_multimin_fdfminimizer_free (s);
    gsl_multimin_fminimizer_free (s);
    gsl_vector_free (x);
    gsl_vector_free(d.params);
    gsl_vector_free(d.params_ast);
    gsl_vector_free(d.out);
    gsl_vector_free(d.out_ast);

    return result;
}
Exemple #23
0
void KFKSDS_steady (int *dim, double *sy, double *sZ, double *sT, double *sH, 
  double *sR, double *sV, double *sQ, double *sa0, double *sP0,
  double *tol, int *maxiter, double *ksconvfactor,
  double *mll, double *epshat, double *vareps,
  double *etahat, double *vareta, 
  double *sumepsmisc, double *sumetamisc)
{
  int i, ip1, n = dim[0], m = dim[2], ir = dim[3], convref, nmconvref, nm1 = n-1;
  int irsod = ir * sizeof(double);

  //double v[n], f[n], invf[n], vof[n];
  std::vector<double> v(n), f(n), invf(n), vof(n);

  sumepsmisc[0] = 0.0;

  gsl_vector * sum_eta_misc = gsl_vector_calloc(ir);
  gsl_vector * etahat_sq = gsl_vector_alloc(ir);
  gsl_vector_view Z = gsl_vector_view_array(sZ, m);
  gsl_vector * Z_cp = gsl_vector_alloc(m);
  gsl_matrix * K = gsl_matrix_alloc(n, m);
  gsl_vector_view K_irow;
  gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m);
  gsl_matrix_view V = gsl_matrix_view_array(sV, ir, ir);  
  gsl_matrix_view R = gsl_matrix_view_array(sR, m, ir);

  gsl_matrix * r = gsl_matrix_alloc(n + 1, m);
  gsl_vector_view r_row_t;
  gsl_vector_view r_row_tp1 = gsl_matrix_row(r, n);
  gsl_vector_set_zero(&r_row_tp1.vector);

  std::vector<gsl_matrix*> L(n);
  std::vector<gsl_matrix*> N(n+1);
  N.at(n) = gsl_matrix_calloc(m, m);
  gsl_vector_view Ndiag;
  
  gsl_vector_view Qdiag = gsl_matrix_diagonal(&Q.matrix);
  gsl_vector * Qdiag_msq = gsl_vector_alloc(m);
  gsl_vector_memcpy(Qdiag_msq, &Qdiag.vector);
  gsl_vector_mul(Qdiag_msq, &Qdiag.vector);
  gsl_vector_scale(Qdiag_msq, -1.0);
  
  gsl_vector * sum_vareta = gsl_vector_calloc(m);

  KF_steady(dim, sy, sZ, sT, sH, 
    sR, sV, sQ, sa0, sP0, 
    mll, &v, &f, &invf, &vof, K, &L, tol, maxiter);

  convref = dim[5];
  if (convref == -1) {
    convref = n;    
  } else 
    convref = ceil(convref * ksconvfactor[0]);
  nmconvref = n - convref;

  gsl_vector_view vaux;

  gsl_matrix * Mmm = gsl_matrix_alloc(m, m);

  gsl_matrix * ZtZ = gsl_matrix_alloc(m, m);
  gsl_matrix_view maux1, maux2;
  maux1 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), m, 1);
  gsl_vector_memcpy(Z_cp, &Z.vector);
  maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m);
  gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, 
    &maux2.matrix, 0.0, ZtZ);

  gsl_vector * var_eps = gsl_vector_alloc(n);

  double msHsq = -1.0 * pow(*sH, 2);
  vaux = gsl_vector_view_array(&f[0], n);
  gsl_vector_set_all(var_eps, msHsq);
  gsl_vector_div(var_eps, &vaux.vector);
  gsl_vector_add_constant(var_eps, *sH);

  gsl_matrix * eta_hat = gsl_matrix_alloc(n, ir);  
  gsl_matrix * Mrm = gsl_matrix_alloc(ir, m);
  gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &V.matrix, &R.matrix, 0.0, Mrm);

  for (i = n-1; i > -1; i--)
  {
    ip1 = i + 1;
    
    if (i != n-1)  //the case i=n-1 was initialized above
      r_row_tp1 = gsl_matrix_row(r, ip1);
    r_row_t = gsl_matrix_row(r, i);

    gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &r_row_tp1.vector, 
      0.0, &r_row_t.vector);
    gsl_vector_memcpy(Z_cp, &Z.vector);
    gsl_vector_scale(Z_cp, vof[i]);
    gsl_vector_add(&r_row_t.vector, Z_cp);

    N.at(i) = gsl_matrix_alloc(m, m);
    if (i < convref || i > nmconvref)
    {
      gsl_matrix_memcpy(N.at(i), ZtZ);
      gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), N.at(ip1), 0.0, Mmm);
      gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), invf[i], N.at(i)); 
    } else {
      gsl_matrix_memcpy(N.at(i), N.at(ip1));
    }
    
    if (dim[6] == 0 || dim[6] == 1)
    {

      if (i < convref || i == nm1) {
        K_irow = gsl_matrix_row(K, i);
      }

      gsl_blas_ddot(&K_irow.vector, &r_row_tp1.vector, &epshat[i]);

      epshat[i] -= vof[i];
      epshat[i] *= -*sH;

      if (i < convref || i > nmconvref)
      {
        maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), 1, m);
        maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m);    
        gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, N.at(ip1),
          0.0, &maux2.matrix);

        vaux = gsl_vector_view_array(gsl_vector_ptr(var_eps, i), 1);
        gsl_blas_dgemv(CblasNoTrans, msHsq, &maux2.matrix, &K_irow.vector, 
          1.0, &vaux.vector);
        vareps[i] = gsl_vector_get(&vaux.vector, 0);
    } else {
        vareps[i] = vareps[ip1];
    }

    sumepsmisc[0] += epshat[i] * epshat[i] + vareps[i];
  }

  if (dim[6] == 0 || dim[6] == 2)
  {
    vaux = gsl_matrix_row(eta_hat, i);
    gsl_blas_dgemv(CblasNoTrans, 1.0, Mrm, &r_row_tp1.vector,
      0.0, &vaux.vector);

    memcpy(&etahat[i*ir], (&vaux.vector)->data, irsod);

    if (i != n-1)
    {
      gsl_vector_memcpy(etahat_sq, &vaux.vector);
      gsl_vector_mul(etahat_sq, etahat_sq);

      gsl_vector_add(sum_eta_misc, etahat_sq);
    }

    if (i != n-1)
    {
      if (i < convref || i > nmconvref)
      {
        Ndiag = gsl_matrix_diagonal(N.at(ip1));
        gsl_vector_memcpy(Z_cp, &Ndiag.vector);
        gsl_vector_mul(Z_cp, Qdiag_msq);
        gsl_vector_add(Z_cp, &Qdiag.vector);
        gsl_vector_set_zero(sum_vareta);
        gsl_vector_add(sum_vareta, Z_cp);
      }
        gsl_blas_dgemv(CblasTrans, 1.0, &R.matrix, sum_vareta, 1.0, sum_eta_misc);    
    }
  }

    gsl_matrix_free(L.at(i));    
    gsl_matrix_free(N.at(ip1));
  }

  gsl_matrix_free(N.at(0));

  if (dim[6] == 0 || dim[6] == 2)
  {
    memcpy(&sumetamisc[0], sum_eta_misc->data, irsod);
  }

  gsl_vector_free(Z_cp);
  gsl_vector_free(var_eps);
  gsl_vector_free(Qdiag_msq);
  gsl_vector_free(sum_vareta);
  gsl_vector_free(sum_eta_misc);
  gsl_vector_free(etahat_sq);
  gsl_matrix_free(eta_hat);  
  gsl_matrix_free(Mrm);
  gsl_matrix_free(r);
  gsl_matrix_free(K);
  gsl_matrix_free(ZtZ);
  gsl_matrix_free(Mmm);
}
Exemple #24
0
void mcmclib_at7_set_sf_all(mcmclib_amh* p, const double sf) {
  gsl_vector_set_all(AT7_GAMMA(p)->scaling_factors, sf);
}
Exemple #25
0
/** ****************************************************************************************************
 ***** calc an individual logistic regression model 
 *******************************************************************************************************/
void calc_node_Score_binary_rv_R(network *dag, datamatrix *obsdata, int nodeid,  int errverbose,
                                datamatrix *designmatrix, const double priormean, const double priorsd, const double priorgamshape, const double priorgamscale,
                                const int maxiters, const double epsabs,int storeModes, double epsabs_inner, int maxiters_inner, double finitestepsize, int verbose,
				 double h_guess, double h_epsabs, int maxiters_hessian, int ModesONLY,
				 double max_hessian_error,double myfactor_brent, int maxiters_hessian_brent, double num_intervals_brent)
{
#ifdef NOPRIOR
Rprintf("############ Warning - Priors turned off - use only for checking mlik value! ################\n");
#endif
  
  int i,status=GSL_SUCCESS,sss,index=0,iter;
  /*int j;*/
  gsl_vector *myBeta,*vectmp1,*vectmp2,*vectmp1long,*vectmp2long,*localbeta,*localbeta2,/* *dgvalues,*/ *finitefactors,/* *factorindexes,*/ *finitestepsize_vec=0,*nmstepsize=0;/** this will hold the parameter point estimates + 1 is for precision of rv's */
  struct fnparams gparams;/** for passing to the gsl zero finding functions */
  double gvalue;double nm_size=0.0;
  gsl_matrix *mattmp2,*mattmp3,*mattmp4,*hessgvalues,*hessgvalues3pt;
  double mydet=0.0,logscore=0.0;/*,logscore3pt=0.0;*/
  gsl_permutation *initsperm;
  gsl_permutation *perm=0; 
  const gsl_multimin_fminimizer_type *T;
       gsl_multimin_fminimizer *s;
     gsl_multimin_function F; 
 
  double lower,upper,lower_f,upper_f;int found=0; double delta=0.0,new_f_min=0.0, finitestepsize_nm=0.0, increLogscale=0.0, best_Error=0.0,best_h=0.0;
 
  const gsl_min_fminimizer_type *T1;
  gsl_min_fminimizer *s1; 
  int n,m;
 /* double min_error,cur_error,accurate_logscore=0,accurate_logscore3pt=0,bestsize=0,lowerend,upperend,h_guess,h_epsabs;*/
  /*const gsl_min_fminimizer_type *T;
  gsl_min_fminimizer *s;
  gsl_function F;*/ 
  /*double h_lowerbound[1],h_upperbound[1],h_guess_array[1];
  int h_nbd[1];*/
  int nDim;/** dimension of optim problem */
  int *nbd;/** nbd is an integer array of dimension nDim.
	                                      On entry nbd represents the type of bounds imposed on the variables, and must be specified as follows:
	                                      nbd(i)=0 if x(i) is unbounded,
		                              1 if x(i) has only a lower bound,
		                              2 if x(i) has both lower and upper bounds, and
		                              3 if x(i) has only an upper bound.
	                                      On exit nbd is unchanged.*/
  
  double *lowerbounds,*upperbounds; /* h_gvalue;*//*,lowestHesserror,beststepsize;*/
  int failcode;/** check code see R ?optim - if non-zero then a problem **/
  double factr=1e-07;/** error size scaler - this is the default value*/
  double pgtol=1e-07;/** default value is zero - this is the gradient tolerance - mmm what does that actually mean? */
  int fncount,grcount;/** hold number of evaluations */
  char msg[60];/** error message */
  int trace=errverbose;/** like verbose */
  int nREPORT=1000;/** report freq*/
  int lmm=5;/** see R ?optim - number of function evals to store - default is 5 */
  /** want to find the modes of the function g(betas) where betas=b_0,b_1,,...,tau, the latter being precision */
  /** g(betas) is not differentiable as it contains integrals (which themselves need Laplace estimates **/
  
    
  /** SETUP things which are the same across all data chunks - groups  */
  /** build design matrix which is designmatrix->datamatrix=X, designmatrix->Y=Y plus priors designmatrix->priorsd, designmatrix->priormean **/
  /** NOTE: design matrix here does include the random effect term **/
  /** note - numparams does NOT include precision term - numpars +1 */
  build_designmatrix_rv(dag,obsdata,priormean, priorsd,priorgamshape,priorgamscale,designmatrix,nodeid,storeModes);
  
  nDim=designmatrix->numparams+1; 
  lowerbounds=(double *)R_alloc(nDim,sizeof(double*));
  upperbounds=(double *)R_alloc(nDim,sizeof(double*));
  nbd=(int *)R_alloc(nDim,sizeof(int*));
  for(i=0;i<nDim-1;i++){lowerbounds[i]=-DBL_MAX;
                        upperbounds[i]=DBL_MAX;
			nbd[i]=0;}
			nbd[nDim-1]=1;lowerbounds[nDim-1]=0.001;/** lower bound for precision */
  finitefactors = gsl_vector_alloc(7);/** used to change stepsize in hessian estimate **/			
  gsl_vector_set(finitefactors,0,1.0E-03);gsl_vector_set(finitefactors,1,1.0E-02);gsl_vector_set(finitefactors,2,1.0E-01);
  gsl_vector_set(finitefactors,3,1.0);gsl_vector_set(finitefactors,4,1.0E+01);gsl_vector_set(finitefactors,5,1.0E+02);
  gsl_vector_set(finitefactors,6,1.0E+03);
  
  /*factorindexes = gsl_vector_alloc(7);*//** used to change stepsize in hessian estimate **/			
  /*for(i=0;i<7;i++){gsl_vector_set(factorindexes,i,i);}*/
  
  /** change finite.step.size by 0.1,1, and 10 factors respectively **/
  
  /*dgvalues = gsl_vector_alloc (designmatrix->numparams+1);*//** inc rv precision */
  
  myBeta = gsl_vector_alloc (designmatrix->numparams+1);/** inc rv precision */
  vectmp1 = gsl_vector_alloc (designmatrix->numparams);/** scratch space **/
  vectmp2 = gsl_vector_alloc (designmatrix->numparams);/** scratch space **/
  mattmp2 = gsl_matrix_alloc (obsdata->numDataPts,designmatrix->numparams);
  mattmp3 = gsl_matrix_alloc (designmatrix->numparams,designmatrix->numparams);
  mattmp4 = gsl_matrix_alloc (designmatrix->numparams,designmatrix->numparams);
  initsperm = gsl_permutation_alloc (designmatrix->numparams);/** for use with initial guesses */
  vectmp1long = gsl_vector_alloc (obsdata->numDataPts);/** scratch space **/
  vectmp2long = gsl_vector_alloc (obsdata->numDataPts);
  localbeta = gsl_vector_alloc (designmatrix->numparams);/** scratch space in later functions - excl. precision **/
  localbeta2 = gsl_vector_alloc (designmatrix->numparams+1);/** scratch space in later functions - inc. precision **/
  
  hessgvalues = gsl_matrix_alloc (designmatrix->numparams+1,designmatrix->numparams+1);
  hessgvalues3pt = gsl_matrix_alloc (designmatrix->numparams+1,designmatrix->numparams+1);
  
  gparams.designdata=designmatrix;
  
   gparams.vectmp1=vectmp1;
   gparams.vectmp2=vectmp2;
   gparams.mattmp2=mattmp2;
   gparams.mattmp3=mattmp3;
   gparams.mattmp4=mattmp4;
   gparams.perm=initsperm;
   gparams.vectmp1long=vectmp1long;
   gparams.vectmp2long=vectmp2long;
   gparams.beta=localbeta;
   gparams.betaincTau=localbeta2;
   gparams.epsabs_inner=epsabs_inner;
   gparams.maxiters_inner=maxiters_inner;
   gparams.verbose=verbose;
   gparams.finitestepsize=finitestepsize;
   
   dag->nodeScoresErrCode[nodeid]=0;/** reset error code to no error **/
   
   /*status=GSL_SUCCESS;*/
   generate_rv_inits(myBeta,&gparams);
   /*Rprintf("starting optimisation\n");*/
   /** run a loop over different stepsize - starting with the smallest first as this is more likely successful **/
   for(i=0;i<finitefactors->size;i++){/** go forwards through the factors so start with SMALLEST STEPSIZE */
   /*Rprintf("step size iteration %d\n",i);*/
     failcode=0;/** reset*/
    gparams.finitestepsize=gsl_vector_get(finitefactors,i)*finitestepsize;
   
     lbfgsb(nDim, lmm, myBeta->data, lowerbounds, upperbounds, nbd, &gvalue, &g_outer_R,
                      &rv_dg_outer_R, &failcode, 
	              &gparams,
	              factr,
                      pgtol, &fncount, &grcount,
                      maxiters, msg, trace, nREPORT);
		      
    if(!failcode){dag->nodeScoresErrCode[nodeid]=0;/*bestsize=gparams.finitestepsize;*/break;}/** break out of for loop if no error as we are done **/	     
   
   } /** end of for loop so now have mode estimates */
     
   if(failcode){Rprintf("%s at node %d\n",msg,nodeid+1);/** notify if there is an error and set final error code **/
		     dag->nodeScoresErrCode[nodeid]=1;
   } 
     
    gparams.finitestepsize=finitestepsize;/** reset */
    if(storeModes){/** keep a copy of the parameter modes found for use later in other function calls etc**/
	 index=0;    /*Rprintf("size of beta=%d %f %f\n",myBeta->size, gsl_vector_get(myBeta,0),gsl_vector_get(myBeta,1));*/
		     for(i=0;i<dag->numNodes+3;i++){/** roll myBeta into dag->modes into the appropriate columns**/
		       if(gsl_matrix_get(dag->modes,nodeid,i)!=DBL_MAX){
			 gsl_matrix_set(dag->modes,nodeid,i,gsl_vector_get(myBeta,index++));}} 
                   /*for(i=0;i<dag->numNodes+3;i++){Rprintf("%e ",gsl_matrix_get(dag->modes,nodeid,i));}Rprintf("\n");*/
		   
		   }     
   
   if(!ModesONLY){/** only want modes so can skip the rest **/
     
   /** now compute the hessian at the step size with lowest error **/
   /*Rprintf("starting hessian estimation\n");*/
   n=obsdata->numDataPts;
   m=designmatrix->numparams+1;/** inc precision */
   perm = gsl_permutation_alloc (m);
 
   /** just re-use as much of existing gparams as possible - so names are meaningless e.g. betafixed is actually gvalue */
   gparams.betaincTau=myBeta;
   gparams.nDim=n;
   gparams.mDim=m;
   gparams.perm=perm;
   gparams.mattmp2=hessgvalues;
   gparams.mattmp3=hessgvalues3pt;
   gparams.betafixed=gvalue;
   
   
    F.f = &compute_mlik_nm;
    F.params = &gparams;
    F.n = 1;
   
    T = gsl_multimin_fminimizer_nmsimplex2;
    s = gsl_multimin_fminimizer_alloc (T, 1);
   
    finitestepsize_vec = gsl_vector_alloc (1);
    gsl_vector_set (finitestepsize_vec, 0, h_guess);
    nmstepsize = gsl_vector_alloc (1);
    gsl_vector_set_all (nmstepsize, h_guess); 
    gsl_multimin_fminimizer_set (s, &F, finitestepsize_vec,nmstepsize);
    status = GSL_SUCCESS;
    
     iter=0;
   
    do
         {
           iter++;/*Rprintf("iter=%d\n",iter);*/
           status = gsl_multimin_fminimizer_iterate (s);
     
           if (status) 
             break;
	   
	   nm_size = gsl_multimin_fminimizer_size (s);
           status = gsl_multimin_test_size (nm_size, h_epsabs);
     /*
           if (status == GSL_SUCCESS)
             {
               Rprintf ("converged to minimum at\n");
             }
     */
           /*Rprintf ("iter=%5d error in mlik=%3.5e using fin.diff step= %3.2e nmsize=%3.2e\n", iter,s->fval,gsl_vector_get (s->x, 0),nm_size);*/
    
         }
       while (status == GSL_CONTINUE && iter < maxiters_hessian);
       if( (status != GSL_SUCCESS)){/*actual_status=status;*//** copy for use later **/
                                    status=GSL_FAILURE;} /** solution failed to achieve a value below h_epsabs **/                                                               
	 
    finitestepsize=gsl_vector_get(s->x,0);/** get best fin.diff stepsize **/
    finitestepsize_nm=finitestepsize;/** save nelder mead estimate */
    dag->hessianError[nodeid]= s->fval;/** get fin.diff error **/
    
    gsl_multimin_fminimizer_free (s);
   
   /** README - it might be possible to avoid the brent by increasing the epsabs error in nelder mead (and no. of iterations), although for hard cases
       this probably will not work but may give a little greater accuracy for easier cases, These are the hessian.params arg in R */
    
   if(dag->hessianError[nodeid]!=DBL_MAX && dag->hessianError[nodeid]>max_hessian_error){Rprintf("Error in mlik = %e > tolerance of %e so continuing optimisation using Brent initial guess h=%e\n",
                                                   dag->hessianError[nodeid],max_hessian_error,finitestepsize); 
   
     /* Rprintf("stepsize after NM= %e\n",finitestepsize);*/
  
     T1 = gsl_min_fminimizer_brent;
     s1 = gsl_min_fminimizer_alloc (T1);
	 
      /** must find lower and upper such that f(lower)<f(finitestepsize)<f(upper) **/ 
      /** use an interval of lower=finitestepsize/FACTOR, upper=finitestepsize*FACTOR and then start at the lower end and travel up until
      find suitable endpoints - seems to work but not exactly fast!**/
      best_Error=dag->hessianError[nodeid];/** original error from nelder */
      best_h=finitestepsize;               /** original stepsize from nelder */
      found=0;/** flag for found good result */
      lower=finitestepsize/myfactor_brent;
      upper=myfactor_brent*finitestepsize;
      lower_f=compute_mlik_brent(lower, &gparams);/** value at lower point **/
      upper_f=compute_mlik_brent(upper, &gparams);/** value at higher point **/
      increLogscale=(gsl_sf_log(upper)-gsl_sf_log(lower))/num_intervals_brent;/** on a log scale */
      for(delta=gsl_sf_log(lower)+increLogscale;delta<gsl_sf_log(upper);delta+=increLogscale){/** linear increments on a log scale **/
	R_CheckUserInterrupt();/** allow an interupt from R console */ 
	/** find a point which has f(x) lower than f(lower) and f(upper) **/
	 new_f_min=compute_mlik_brent(gsl_sf_exp(delta), &gparams); 
	/* Rprintf("lower=%e, delta=%e, upper=%e\n",lower,gsl_sf_exp(delta),upper);*/
        if(lower_f>new_f_min && new_f_min<upper_f  && get_best_stepsize(gsl_sf_exp(delta),lower,upper,maxiters_hessian_brent,&gparams, &compute_mlik_brent,
	                                                               s1,&finitestepsize,&(dag->hessianError[nodeid]) )<=max_hessian_error){/** have an interval suitable for bracketing **/
	                                                           /** above is address so can store error withouth rerunning function */
	  /*finitestepsize=delta;*/
	  found=1;
	  status=GSL_SUCCESS;
	  break;/** break out of delta - so have found new x_min **/
	} else {/** have not got a good enough error but save the best error and stepsize so far found **/
	        if(dag->hessianError[nodeid]<best_Error){best_Error=dag->hessianError[nodeid];
	                                                best_h=finitestepsize;
		                                        }
	        }
      } /** end of search for interval and good error **/
         
      if(!found){/** have not found a suitably small error but may have found a better error than nelder mead **/
        
       /** best_Error will either be the original nelder mean value or better, and best_h is the corresponding stepsize**/
	                                 dag->hessianError[nodeid]=best_Error;
					 finitestepsize=best_h;
        /** reset back to nelder-mead estimate **/
	status=GSL_FAILURE;/** set to failure since we did not achieve the lower error asked for */
      Rprintf("failed to meet tolerance of %e and using best error estimate found of %e\n",max_hessian_error,dag->hessianError[nodeid]);}

    gsl_min_fminimizer_free (s1);
   
   } /** end of error being too large **/
 
   if(dag->hessianError[nodeid]==DBL_MAX){/** in this case nelder mead could not estimate the hessian error so abort as something is probably
                                               very wrong here */
                                          error("");}/** use the R tryCatch rather than the switch for status below **/
                                          

       switch(status){  /** choose which type of node we have */
                     case GSL_SUCCESS:{    
		                     /** successful finite diff so now do final computation with the optimal step size **/
                                     /*Rprintf("search for optimal step size : status = %s at nodeid %d\n", gsl_strerror (status),nodeid+1);*/
                                     rv_hessg_outer(myBeta,&gparams, hessgvalues,finitestepsize,hessgvalues3pt);/** EDIT BACK to "finitestepsize" start with LARGEST STEPSIZE **/
				    /* Rprintf("HESSIAN using stepsize=%e\n",finitestepsize);
				     for(i1=0;i1<hessgvalues->size1;i1++){
				        for(i2=0;i2<hessgvalues->size2;i2++){Rprintf("%e ",gsl_matrix_get(hessgvalues,i1,i2));}Rprintf("\n");}   */
                                     status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss);
                                     mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
                                     logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
				     if(gsl_isnan(logscore)){logscore= R_NaN;dag->nodeScoresErrCode[nodeid]=2;}
				     dag->nodeScores[nodeid]=logscore;
				       
		                      break;  
		     }
       
		     case GSL_FAILURE: {/** the minimiser did not find a minimum meeting the accuracy requirements and so may be unreliable **/
		                       Rprintf ("-- ERROR! -- search for optimal step size error: status = %s at nodeid %d\n", gsl_strerror (status),nodeid+1);
                                       rv_hessg_outer(myBeta,&gparams, hessgvalues,finitestepsize,hessgvalues3pt);/** start with LARGEST STEPSIZE **/
                                       /*Rprintf("HESSIAN using stepsize=%e\n",finitestepsize);
				       for(i1=0;i1<hessgvalues->size1;i1++){
				        for(i2=0;i2<hessgvalues->size2;i2++){Rprintf("%e ",gsl_matrix_get(hessgvalues,i1,i2));}Rprintf("\n");} */
				        
				       status=gsl_linalg_LU_decomp(hessgvalues,perm,&sss);
                                       mydet=gsl_linalg_LU_lndet(hessgvalues);/** compute determinant but this might be a nan - overflow? gsl_linalg_LU_lndet*/
                                       logscore= -n*gvalue-0.5*mydet+(m/2.0)*log((2.0*M_PI)/n);/** this is the final value */
				       dag->nodeScoresErrCode[nodeid]=4;
				       if(gsl_isnan(logscore)){logscore= R_NaN;dag->nodeScoresErrCode[nodeid]=2;}
				       dag->nodeScores[nodeid]=logscore;
				       
		                       
				       break; 
		     }
		     
		     default:{Rprintf("got case %s\n",gsl_strerror (status)); error("in default switch in calc_node_Score_binary_rv_R() - should never get here!");}  
		     
          }
          
        
   /** try the bounded search for h stepsize rather than one-dim min which needs bound specified **/     
   } /** end of ModesONLY **/     
  
   /** now free up allocated memory **/
   for(i=0;i<designmatrix->numUnqGrps;i++){gsl_matrix_free(designmatrix->array_of_designs[i]);
                                           gsl_vector_free(designmatrix->array_of_Y[i]);}
   gsl_vector_free(designmatrix->priormean);
   gsl_vector_free(designmatrix->priorsd);
   gsl_vector_free(designmatrix->priorgamshape);
   gsl_vector_free(designmatrix->priorgamscale);
   gsl_vector_free(designmatrix->Y);
   gsl_matrix_free(designmatrix->datamatrix_noRV);
   /*gsl_vector_free(dgvalues);*/
   gsl_vector_free(myBeta); 
   gsl_vector_free(vectmp1);
   gsl_vector_free(vectmp2);
   gsl_matrix_free(mattmp2);
   gsl_matrix_free(mattmp3);
   gsl_matrix_free(mattmp4);
   gsl_permutation_free(initsperm);
   gsl_vector_free(vectmp1long);
   gsl_vector_free(vectmp2long);
   gsl_vector_free(localbeta);
   gsl_vector_free(localbeta2);
   gsl_matrix_free(hessgvalues);
   gsl_matrix_free(hessgvalues3pt);
   gsl_vector_free(finitefactors);
   /*gsl_vector_free(factorindexes);*/
   
   if(!ModesONLY){/** didn't allocate these so don't unallocate! */
    gsl_permutation_free(perm);
    gsl_vector_free(finitestepsize_vec);
    gsl_vector_free(nmstepsize);}
   
   /*if(!failcode){*//*}*/
   
   /*dag->nodeScores[nodeid]=logscore;*/

}
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 *) &par;

  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;
}
/** Executes the algorithm
 *
 *  @throw runtime_error Thrown if algorithm cannot execute
 */
void DiffractionEventCalibrateDetectors::exec() {
  // Try to retrieve optional properties
  const int maxIterations = getProperty("MaxIterations");
  const double peakOpt = getProperty("LocationOfPeakToOptimize");

  // Get the input workspace
  EventWorkspace_sptr inputW = getProperty("InputWorkspace");

  // retrieve the properties
  const std::string rb_params = getProperty("Params");

  // Get some stuff from the input workspace
  // We make a copy of the instrument since we will be moving detectors in
  // `inputW` but want to access original positions (etc.) via `detList` below.
  const auto &dummyW = create<EventWorkspace>(*inputW, 1, inputW->binEdges(0));
  Instrument_const_sptr inst = dummyW->getInstrument();

  // Build a list of Rectangular Detectors
  std::vector<boost::shared_ptr<RectangularDetector>> detList;
  // --------- Loading only one bank ----------------------------------
  std::string onebank = getProperty("BankName");
  bool doOneBank = (!onebank.empty());
  for (int i = 0; i < inst->nelements(); i++) {
    boost::shared_ptr<RectangularDetector> det;
    boost::shared_ptr<ICompAssembly> assem;
    boost::shared_ptr<ICompAssembly> assem2;

    det = boost::dynamic_pointer_cast<RectangularDetector>((*inst)[i]);
    if (det) {
      if (det->getName() == onebank)
        detList.push_back(det);
      if (!doOneBank)
        detList.push_back(det);
    } else {
      // Also, look in the first sub-level for RectangularDetectors (e.g. PG3).
      // We are not doing a full recursive search since that will be very long
      // for lots of pixels.
      assem = boost::dynamic_pointer_cast<ICompAssembly>((*inst)[i]);
      if (assem) {
        for (int j = 0; j < assem->nelements(); j++) {
          det = boost::dynamic_pointer_cast<RectangularDetector>((*assem)[j]);
          if (det) {
            if (det->getName() == onebank)
              detList.push_back(det);
            if (!doOneBank)
              detList.push_back(det);

          } else {
            // Also, look in the second sub-level for RectangularDetectors (e.g.
            // PG3).
            // We are not doing a full recursive search since that will be very
            // long for lots of pixels.
            assem2 = boost::dynamic_pointer_cast<ICompAssembly>((*assem)[j]);
            if (assem2) {
              for (int k = 0; k < assem2->nelements(); k++) {
                det = boost::dynamic_pointer_cast<RectangularDetector>(
                    (*assem2)[k]);
                if (det) {
                  if (det->getName() == onebank)
                    detList.push_back(det);
                  if (!doOneBank)
                    detList.push_back(det);
                }
              }
            }
          }
        }
      }
    }
  }

  // set-up minimizer

  std::string inname = getProperty("InputWorkspace");
  std::string outname = inname + "2"; // getProperty("OutputWorkspace");

  IAlgorithm_sptr algS = createChildAlgorithm("SortEvents");
  algS->setProperty("InputWorkspace", inputW);
  algS->setPropertyValue("SortBy", "X Value");
  algS->executeAsChildAlg();

  // Write DetCal File
  std::string filename = getProperty("DetCalFilename");
  std::fstream outfile;
  outfile.open(filename.c_str(), std::ios::out);

  if (detList.size() > 1) {
    outfile << "#\n";
    outfile << "#  Mantid Optimized .DetCal file for SNAP with TWO detector "
               "panels\n";
    outfile << "#  Old Panel, nominal size and distance at -90 degrees.\n";
    outfile << "#  New Panel, nominal size and distance at +90 degrees.\n";
    outfile << "#\n";
    outfile << "# Lengths are in centimeters.\n";
    outfile << "# Base and up give directions of unit vectors for a local\n";
    outfile << "# x,y coordinate system on the face of the detector.\n";
    outfile << "#\n";
    outfile << "# " << DateAndTime::getCurrentTime().toFormattedString("%c")
            << "\n";
    outfile << "#\n";
    outfile << "6         L1     T0_SHIFT\n";
    IComponent_const_sptr source = inst->getSource();
    IComponent_const_sptr sample = inst->getSample();
    outfile << "7  " << source->getDistance(*sample) * 100 << "            0\n";
    outfile << "4 DETNUM  NROWS  NCOLS  WIDTH   HEIGHT   DEPTH   DETD   "
               "CenterX   CenterY   CenterZ    BaseX    BaseY    BaseZ      "
               "UpX      UpY      UpZ\n";
  }

  Progress prog(this, 0.0, 1.0, detList.size());
  for (int det = 0; det < static_cast<int>(detList.size()); det++) {
    std::string par[6];
    par[0] = detList[det]->getName();
    par[1] = inname;
    par[2] = outname;
    std::ostringstream strpeakOpt;
    strpeakOpt << peakOpt;
    par[3] = strpeakOpt.str();
    par[4] = rb_params;

    // --- Create a GroupingWorkspace for this detector name ------
    CPUTimer tim;
    IAlgorithm_sptr alg2 =
        AlgorithmFactory::Instance().create("CreateGroupingWorkspace", 1);
    alg2->initialize();
    alg2->setProperty("InputWorkspace", inputW);
    alg2->setPropertyValue("GroupNames", detList[det]->getName());
    std::string groupWSName = "group_" + detList[det]->getName();
    alg2->setPropertyValue("OutputWorkspace", groupWSName);
    alg2->executeAsChildAlg();
    par[5] = groupWSName;
    std::cout << tim << " to CreateGroupingWorkspace\n";

    const gsl_multimin_fminimizer_type *T = gsl_multimin_fminimizer_nmsimplex;
    gsl_vector *ss, *x;
    gsl_multimin_function minex_func;

    // finally do the fitting

    int nopt = 6;
    int iter = 0;
    int status = 0;

    /* Starting point */
    x = gsl_vector_alloc(nopt);
    gsl_vector_set(x, 0, 0.0);
    gsl_vector_set(x, 1, 0.0);
    gsl_vector_set(x, 2, 0.0);
    gsl_vector_set(x, 3, 0.0);
    gsl_vector_set(x, 4, 0.0);
    gsl_vector_set(x, 5, 0.0);

    /* Set initial step sizes to 0.1 */
    ss = gsl_vector_alloc(nopt);
    gsl_vector_set_all(ss, 0.1);

    /* Initialize method and iterate */
    minex_func.n = nopt;
    minex_func.f = &Mantid::Algorithms::gsl_costFunction;
    minex_func.params = &par;

    gsl_multimin_fminimizer *s = gsl_multimin_fminimizer_alloc(T, nopt);
    gsl_multimin_fminimizer_set(s, &minex_func, x, ss);

    do {
      iter++;
      status = gsl_multimin_fminimizer_iterate(s);

      if (status)
        break;

      double size = gsl_multimin_fminimizer_size(s);
      status = gsl_multimin_test_size(size, 1e-2);

    } while (status == GSL_CONTINUE && iter < maxIterations &&
             s->fval != -0.000);

    // Output summary to log file
    if (s->fval != -0.000)
      movedetector(gsl_vector_get(s->x, 0), gsl_vector_get(s->x, 1),
                   gsl_vector_get(s->x, 2), gsl_vector_get(s->x, 3),
                   gsl_vector_get(s->x, 4), gsl_vector_get(s->x, 5), par[0],
                   getProperty("InputWorkspace"));
    else {
      gsl_vector_set(s->x, 0, 0.0);
      gsl_vector_set(s->x, 1, 0.0);
      gsl_vector_set(s->x, 2, 0.0);
      gsl_vector_set(s->x, 3, 0.0);
      gsl_vector_set(s->x, 4, 0.0);
      gsl_vector_set(s->x, 5, 0.0);
    }

    std::string reportOfDiffractionEventCalibrateDetectors =
        gsl_strerror(status);
    if (s->fval == -0.000)
      reportOfDiffractionEventCalibrateDetectors = "No events";

    g_log.information() << "Detector = " << det << "\n"
                        << "Method used = "
                        << "Simplex"
                        << "\n"
                        << "Iteration = " << iter << "\n"
                        << "Status = "
                        << reportOfDiffractionEventCalibrateDetectors << "\n"
                        << "Minimize PeakLoc-" << peakOpt << " = " << s->fval
                        << "\n";
    // Move in cm for small shifts
    g_log.information() << "Move (X)   = " << gsl_vector_get(s->x, 0) * 0.01
                        << "  \n";
    g_log.information() << "Move (Y)   = " << gsl_vector_get(s->x, 1) * 0.01
                        << "  \n";
    g_log.information() << "Move (Z)   = " << gsl_vector_get(s->x, 2) * 0.01
                        << "  \n";
    g_log.information() << "Rotate (X) = " << gsl_vector_get(s->x, 3) << "  \n";
    g_log.information() << "Rotate (Y) = " << gsl_vector_get(s->x, 4) << "  \n";
    g_log.information() << "Rotate (Z) = " << gsl_vector_get(s->x, 5) << "  \n";

    Kernel::V3D CalCenter =
        V3D(gsl_vector_get(s->x, 0) * 0.01, gsl_vector_get(s->x, 1) * 0.01,
            gsl_vector_get(s->x, 2) * 0.01);
    Kernel::V3D Center = detList[det]->getPos() + CalCenter;
    int pixmax = detList[det]->xpixels() - 1;
    int pixmid = (detList[det]->ypixels() - 1) / 2;
    BoundingBox box;
    detList[det]->getAtXY(pixmax, pixmid)->getBoundingBox(box);
    double baseX = box.xMax();
    double baseY = box.yMax();
    double baseZ = box.zMax();
    Kernel::V3D Base = V3D(baseX, baseY, baseZ) + CalCenter;
    pixmid = (detList[det]->xpixels() - 1) / 2;
    pixmax = detList[det]->ypixels() - 1;
    detList[det]->getAtXY(pixmid, pixmax)->getBoundingBox(box);
    double upX = box.xMax();
    double upY = box.yMax();
    double upZ = box.zMax();
    Kernel::V3D Up = V3D(upX, upY, upZ) + CalCenter;
    Base -= Center;
    Up -= Center;
    // Rotate around x
    baseX = Base[0];
    baseY = Base[1];
    baseZ = Base[2];
    double deg2rad = M_PI / 180.0;
    double angle = gsl_vector_get(s->x, 3) * deg2rad;
    Base = V3D(baseX, baseY * cos(angle) - baseZ * sin(angle),
               baseY * sin(angle) + baseZ * cos(angle));
    upX = Up[0];
    upY = Up[1];
    upZ = Up[2];
    Up = V3D(upX, upY * cos(angle) - upZ * sin(angle),
             upY * sin(angle) + upZ * cos(angle));
    // Rotate around y
    baseX = Base[0];
    baseY = Base[1];
    baseZ = Base[2];
    angle = gsl_vector_get(s->x, 4) * deg2rad;
    Base = V3D(baseZ * sin(angle) + baseX * cos(angle), baseY,
               baseZ * cos(angle) - baseX * sin(angle));
    upX = Up[0];
    upY = Up[1];
    upZ = Up[2];
    Up = V3D(upZ * cos(angle) - upX * sin(angle), upY,
             upZ * sin(angle) + upX * cos(angle));
    // Rotate around z
    baseX = Base[0];
    baseY = Base[1];
    baseZ = Base[2];
    angle = gsl_vector_get(s->x, 5) * deg2rad;
    Base = V3D(baseX * cos(angle) - baseY * sin(angle),
               baseX * sin(angle) + baseY * cos(angle), baseZ);
    upX = Up[0];
    upY = Up[1];
    upZ = Up[2];
    Up = V3D(upX * cos(angle) - upY * sin(angle),
             upX * sin(angle) + upY * cos(angle), upZ);
    Base.normalize();
    Up.normalize();
    Center *= 100.0;
    // << det+1  << "  "
    outfile << "5  " << detList[det]->getName().substr(4) << "  "
            << detList[det]->xpixels() << "  " << detList[det]->ypixels()
            << "  " << 100.0 * detList[det]->xsize() << "  "
            << 100.0 * detList[det]->ysize() << "  "
            << "0.2000"
            << "  " << Center.norm() << "  ";
    Center.write(outfile);
    outfile << "  ";
    Base.write(outfile);
    outfile << "  ";
    Up.write(outfile);
    outfile << "\n";

    // clean up dynamically allocated gsl stuff
    gsl_vector_free(x);
    gsl_vector_free(ss);
    gsl_multimin_fminimizer_free(s);

    // Remove the now-unneeded grouping workspace
    AnalysisDataService::Instance().remove(groupWSName);
    prog.report(detList[det]->getName());
  }

  // Closing
  outfile.close();
}
Exemple #28
0
/** *************************************************************************************
*****************************************************************************************
*****************************************************************************************/ 
double g_pois_outer_marg_R (int Rn, double *betashortDBL, void *params) /** double g_outer_marg_R(int Rn, double *betaincTauDBL, void *params);*/
{
  /** betashort is full beta vector (inc precision) bu then minus one term **/
  int i,j;
  double term1=0.0,singlegrp=0.0;
  const datamatrix *designdata = ((struct fnparams *) params)->designdata;/** all design data inc Y and priors **/

const gsl_vector *priormean = designdata->priormean;
  const gsl_vector *priorsd   = designdata->priorsd;
  const gsl_vector *priorgamshape   = designdata->priorgamshape;
  const gsl_vector *priorgamscale   = designdata->priorgamscale;
   gsl_vector *beta   = ((struct fnparams *) params)->beta;/** does not include precision */
  gsl_vector *vectmp1= ((struct fnparams *) params)->vectmp1;/** numparams long*/
  gsl_vector *vectmp2 =((struct fnparams *) params)->vectmp2;/** numparams long*/
  double epsabs_inner=((struct fnparams *) params)->epsabs_inner;/** absolute error in internal laplace est */
  int maxiters_inner=((struct fnparams *) params)->maxiters_inner;/** number of steps for inner root finder */
  int verbose=((struct fnparams *) params)->verbose;/**  */
         
  int n_betas= (designdata->datamatrix_noRV)->size2;/** number of mean terms excl rv and precision **/
  int n=(designdata->datamatrix_noRV)->size1;/** total number of obs **/
  
  /** this is extra stuff to deal with the fixed beta **/
       gsl_vector *betaincTau = ((struct fnparams *) params)->betafull;/** will hold "full beta vector" inc precision **/
       double betafixed = ((struct fnparams *) params)->betafixed;/** the fixed beta value passed through**/
       int betaindex = ((struct fnparams *) params)->betaindex;
       
  double term2=0.0,term3=0.0,term4=0.0,gval=0.0;
  double tau;
  
   if(betaindex==0){gsl_vector_set(betaincTau,0,betafixed);
                     for(i=1;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betashortDBL[i-1]);}}
     if(betaindex==(betaincTau->size-1)){gsl_vector_set(betaincTau,betaincTau->size-1,betafixed);
                     for(i=0;i<betaincTau->size-1;i++){gsl_vector_set(betaincTau,i,betashortDBL[i]);}}
       
     if(betaindex>0 && betaindex<(betaincTau->size-1)){
         for(i=0;i<betaindex;i++){gsl_vector_set(betaincTau,i,betashortDBL[i]);}
         gsl_vector_set(betaincTau,betaindex,betafixed);
	 for(i=betaindex+1;i<betaincTau->size;i++){gsl_vector_set(betaincTau,i,betashortDBL[i-1]);}
     }	
  
  /*Rprintf("passed:\n");
  for(i=0;i<betaincTau->size;i++){Rprintf("%10.10f ",gsl_vector_get(betaincTau,i));}Rprintf("\n");
  */
  tau=gsl_vector_get(betaincTau,n_betas);/** extract the tau-precision from *beta - last entry */
  /*if(tau<0){Rprintf("negative tau in g_outer\n");return(DBL_MAX);}*/
  
  if(tau<0.0){Rprintf("tau negative in g_outer!\n");error("");}
  
  /** beta are the parameters values at which the function is to be evaluated **/
       /** gvalue is the return value - a single double */
       /** STOP - NEED TO copy betaincTau into shorter beta since last entry is tau = precision */
       for(i=0;i<n_betas;i++){gsl_vector_set(beta,i,gsl_vector_get(betaincTau,i));/*Rprintf("passed beta=%f\n",gsl_vector_get(beta,i));*/
       }
     
  /** part 1 - the integrals over each group of observations - use laplace for this and that is taken care of in g_inner */ 
  /** first we want to evaluate each of the integrals for each data group **/ 
       for(j=0;j<designdata->numUnqGrps;j++){/** for each data group **/
	/*j=0;*/
	 /*Rprintf("processing group %d\n",j+1);*/
	  singlegrp=g_pois_inner(betaincTau,designdata,j,epsabs_inner,maxiters_inner,verbose);
        
	if(gsl_isnan(singlegrp)){error("nan in g_inner\n");}
	  term1+= singlegrp;
      }
      
/*Rprintf("term1 in g_outer=%f\n",term1);*/	
  /** part 2 the priors for the means **/
  term2=0; for(i=0;i<n_betas;i++){term2+=-log(sqrt(2.0*M_PI)*gsl_vector_get(priorsd,i));}
  /** Calc this in parts: R code "term3<- sum( (-1/(2*sd.loc*sd.loc))*(mybeta-mean.loc)*(mybeta-mean.loc) );" **/
  gsl_vector_memcpy(vectmp1,beta);/** copy beta to temp vec */
  gsl_vector_memcpy(vectmp2,priormean);
  gsl_vector_scale(vectmp2,-1.0);
  gsl_vector_add(vectmp1,vectmp2);/** vectmp1= beta-mean**/
  gsl_vector_memcpy(vectmp2,vectmp1);/** copy vectmp1 to vectmp2 **/
  gsl_vector_mul(vectmp2,vectmp1);/** square all elements in vectmp1 and store in vectmp2 */
  gsl_vector_memcpy(vectmp1,priorsd);
  gsl_vector_mul(vectmp1,priorsd);/** square all elements in priorsd and store in vectmp1 */
  gsl_vector_div(vectmp2,vectmp1);/** vectmp2/vectmp1 and store in vectmp2 **/
  gsl_vector_scale(vectmp2,-0.5); /** scale by -1/2 */
  gsl_vector_set_all(vectmp1,1.0); /** ones vector */
  gsl_blas_ddot (vectmp2, vectmp1, &term3);/** DOT product simply to calcu sum value */
  
  
  /** part 3 the prior for the precision tau **/
  term4=  -gsl_vector_get(priorgamshape,0)*log(gsl_vector_get(priorgamscale,0))
             -gsl_sf_lngamma(gsl_vector_get(priorgamshape,0)) 
	     +(gsl_vector_get(priorgamshape,0)-1)*log(tau)
	     -(tau/gsl_vector_get(priorgamscale,0));
   
	     
   gval=(-1.0/n)*(term1+term2+term3+term4); 
   if(gsl_isnan(gval)){error("g_pois_outer_R\n");}
 /*Rprintf("gvalue=%10.10f\n",gval);*/
	return(gval);/** negative since its a minimiser */
}
Exemple #29
0
	void Vector::fill ( const double value ) {
		gsl_vector_set_all( &vector, value );
	}
Exemple #30
0
void minimd(density_t * ndft){
  int  status;
  int i;
  double stepmin, minimum, g_initial;
  char * output_string;
  gsl_vector *ss;
  const gsl_multimin_fminimizer_type *T;
  gsl_multimin_fminimizer *s;
  gsl_multimin_function my_func;
  size_t iter;
  params_gsl_multimin_function_t params;

  switch(gradient_free_mode){

  case SIMPLEX :

    output_string = (char *) malloc(25*sizeof(char));

    params.nDFT = density_get_val(ndft);
    my_func.n = ipf.npar;
    my_func.f = my_f;
    my_func.params = (void *) (&params);

    /* Initial step sizes */
    ss = gsl_vector_alloc (ipf.npar);
    gsl_vector_set_all(ss, 0.1);

    /* We use the Simplex algorithm from thee GNU Scientific Library (GSL)
       in its optimized version nmsimplex2 */
    T = gsl_multimin_fminimizer_nmsimplex2;

    messages_basic("\n\n\nStarting the optimization.\n\n\n");


    g_initial = my_f(ipf.gamma, &params);
    if(g_initial < epsilon_gvalue){
      if(myid == 0) printf("The value of G for the starting gamma is %.12lg,\n", g_initial);
      if(myid == 0) printf("which is already below the requested threshold of %.12lg\n", epsilon_gvalue);
      parallel_end(EXIT_SUCCESS);
    }
    if(myid == 0) printf("  Starting from gamma =  ");
    if(myid == 0) {for(i = 0; i < ipf.npar; i++) printf ("%.5f ", gsl_vector_get (ipf.gamma, i));}
    if(myid == 0) printf("\n  G(gamma) = %.12lg\n", g_initial);

    /* Initialization of the minimizer s for the function
       my_func starting at the x point */
    messages_basic("\n\nInitialization of the minimizer.\n\n\n");
    s = gsl_multimin_fminimizer_alloc (T, ipf.npar);
    gsl_multimin_fminimizer_set (s, &my_func, ipf.gamma, ss);


    minimum = g_initial;
    iter = 0;
    do
      {
      iter++;
      if(myid == 0) printf("  Iter = %d\n", (int)iter);
      if(myid == 0) printf("    gamma =  ");
      if(myid == 0) {for(i = 0; i < ipf.npar; i++) printf ("%.5f ", gsl_vector_get (gsl_multimin_fminimizer_x(s), i));}
      if(myid == 0) printf("\n    starting G(gamma) = %15.10lg\n", minimum);
      /* We make an iteration of the minimizer s */
      status = gsl_multimin_fminimizer_iterate (s);
      minimum = gsl_multimin_fminimizer_minimum(s);

      if (status){
        if(myid == 0) printf("  Breaking. Reason: %s\n", gsl_strerror(status));
        break;
      }

      if(myid == 0) printf("    G(gamma) = %15.10f\n", minimum);

      stepmin = gsl_multimin_fminimizer_size (s);
      status = gsl_multimin_test_size (stepmin, 1e-2);

    }
    while (status == GSL_CONTINUE && iter < 100);

    if(myid == 0) printf("\n\nFinished optimization. status = %d (%s)\n", status, gsl_strerror(status));
    if(myid == 0) printf("  Final gamma =  ");
    if(myid == 0) {for(i = 0; i < ipf.npar; i++) printf ("%.5f ", gsl_vector_get (gsl_multimin_fminimizer_x(s), i));}
    if(myid == 0) printf("\n  With value: G(gamma) = %.12lg\n\n", gsl_multimin_fminimizer_minimum(s));

    gsl_vector_memcpy(ipf.gamma, gsl_multimin_fminimizer_x(s));
    sprintf(output_string, "pot");
    ipf_write(ipf, ipf_ref, output_string);
    gsl_multimin_fminimizer_free (s);
    fflush(stdout);

    gsl_vector_free(ss);

    break;

  case GENETIC_ALGORITHM :

    output_string = (char *) malloc(75*sizeof(char));

    sprintf(output_string, "python ga.py %f %f %f %f %f %f %d %d %d",
            grid.l, grid.step, extpot.alpha, extpot.Lmin, extpot.Lmax,
            extpot.delta, extpot.npotex, ipf.npar, ipf.poten_selector);

    system(output_string);
    free(output_string);

    break;
  }
}