Esempio n. 1
0
void plot_add_points(plot *p, const mat *x, const mat *y, const strbuf title,\
                     const strbuf color, const strbuf style)
{
    FILE* tmpf;
    strbuf tmpfname, plotcmd, colorcmd;
    size_t i;
    
    sprintf(tmpfname,".latan_tmp_plot_%lu.dat",(long unsigned)ntmpf);
    ntmpf++;
    FOPEN_NOERRET(tmpf,tmpfname,"w");
    for (i=0;i<nrow(y);i++)
    {
        fprintf(tmpf,"%.10e %.10e\n",mat_get(x,i,0),mat_get(y,i,0));
    }
    fclose(tmpf);
    if (strlen(color) == 0)
    {
        strbufcpy(colorcmd,"");
    }
    else
    {
        sprintf(colorcmd,"lc %s",color);
    }
    sprintf(plotcmd,"u 1:2 t '%s' lt -1 %s w %s",title,\
            colorcmd,style);
    plot_add_plot(p,plotcmd,tmpfname);
}
Esempio n. 2
0
double a_error_chi2_ext(const mat *p, void *vd)
{
    size_t i,s;
    double a,a_err,res;
    fit_param *param;
    fit_data *d;
    
    res   = 0.0;
    d     = (fit_data *)(vd);
    param = (fit_param *)(d->model_param); 
    s     = fit_data_get_sample_counter(d);
    
    for (i=0;i<param->nbeta;i++)
    {
        if (s == 0)
        {
            a = mat_get(rs_sample_pt_cent_val(param->s_a),i,0);
        }
        else
        {
            a = mat_get(rs_sample_pt_sample(param->s_a,s-1),i,0);
        }
        a_err = mat_get(param->a_err,i,0);
        res  += SQ(mat_get(p,I_a_val(i),0) - a)/SQ(a_err);
        d->matperf += 5.0;
    }
    
    return res;
}
Esempio n. 3
0
extern inline void mat_exchange(Matrix dest,int i,int j){
  int k;
  double s;
  for(k=0;k<dest.column;k++){
    s=mat_get(dest,i,k);
    mat_set(dest,i,k,mat_get(dest,j,k));
    mat_set(dest,j,k,s);
  }
}
Esempio n. 4
0
double fm_scaleset_taylor_func(const mat *X, const mat *p, void *vparam)
{
    double res,a,M_ud,M_s,umd,M_scale,a2mud,a2ms;
    fit_param *param;
    size_t bind;
    
    param   = (fit_param *)vparam;
    res     = 0.0;
    bind    = (size_t)(mat_get(X,i_bind,0));
    M_scale = param->M_scale;
    a       = mat_get(p,bind,0);
    a2ms    = mat_get(X,i_s,0)/M_scale;
    a2mud   = mat_get(X,i_ud,0)/M_scale;
    M_ud    = mat_get(X,i_ud,0)/SQ(a*M_scale)-SQ(param->M_ud)/SQ(M_scale);
    M_s     = mat_get(X,i_s,0)/SQ(a*M_scale)-SQ(param->M_s)/SQ(M_scale);
    umd     = mat_get(X,i_umd,0)/SQ(a*M_scale)-param->M_umd_val/SQ(M_scale);
    
    res += 1.0;
    polynom(&res,p,I_ud(0),M_ud,param->s_M_ud_deg);
    polynom(&res,p,I_s(0),M_s,param->s_M_s_deg);
    polynom(&res,p,I_umd(0),umd,param->s_umd_deg);
    if (param->s_with_a2ud)
    {
        res += mat_get(p,I_a2ud(0),0)*a2mud;
    }
    if (param->s_with_a2s)
    {
        res += mat_get(p,I_a2s(0),0)*a2ms;
    }
    res *= a*M_scale;
    
    return res;
}
double mat_elsum(const mat *m, const mat *w)
{
    size_t i,j;
    double sum,w_ij;
    bool have_w;
    
    sum    = 0.0;
    have_w = (w != NULL);
    
    FOR_VAL(m,i,j)
    {
        w_ij = (have_w) ? mat_get(w,i,j) : 1.0;
        sum += w_ij*mat_get(m,i,j);
    }
Esempio n. 6
0
latan_errno finite_diff(mat *ddat, const mat *dat)
{
    size_t i,j;
    double ddat_ij;
    
    if (nrow(ddat) != nrow(dat) - 2)
    {
        LATAN_ERROR("derivative matrix have wrong dimensions",LATAN_EBADLEN);
    }
    
    FOR_VAL(ddat,i,j)
    {
        ddat_ij = 0.5*(mat_get(dat,i+2,j) - mat_get(dat,i,j));
        mat_set(ddat,i,j,ddat_ij);
    }
Esempio n. 7
0
static void polynom(double *res, const mat *par, const size_t i0,\
                    const double x, const int deg)
{
    int d;
    size_t i;
    
    if ((deg) > 0)
    {
        *res += mat_get(par,i0,0)*(x);
        for (d=2;d<=(deg);d++)
        {
            i    = (size_t)(d) - 1;
            *res += mat_get(par,(i0)+i,0)*pow(x,(double)(d));
        }
    }
}
double calcMMscore(char *seqData, int base, List *MarkovMatrices, int conservative) {
  int i, baseAsNum, j;
  double val;
  int mmOrder = lst_size(MarkovMatrices)-1;
  Matrix *mm;
  int previousMMbases[mmOrder];
    
  //If there aren't mmOrder previous bases @ base, then adjust mmOrder to take advantage of however many we have
  if (base < mmOrder)
    mmOrder = base;
      
  //If we run into any unknown "N" characters, adjust the mmOrder accordingly
  for(i=mmOrder; i>0; i--)
    {
      baseAsNum = basetocol(seqData[base-i]);
      if (baseAsNum < 0)
        mmOrder = i-1;
      else
        previousMMbases[mmOrder-i] = baseAsNum;
    }
   	
  //Get score from Markov Matrix
  mm =  lst_get_ptr(MarkovMatrices, mmOrder);
  j = basesToRow(previousMMbases, mmOrder, mm->ncols);
  if (j >= 0)
    val = log(mat_get(mm, j, basetocol(seqData[base])));
  else
	{
      if (conservative == 1)
        val = log(0);	//If it is an unknown base, probability is 0, in log space =inf
      else
        val = 0; //If it is an unknown base probability is 1, in log space log(1)=0
	}
  return val;
}
Esempio n. 9
0
extern inline int mat_mul(Matrix dest,Matrix a,Matrix b){
  int i,j,k;
  double s;
  if(dest.raw==a.raw&&dest.column==b.column&&a.column==b.raw){
    for(i=0;i<dest.raw;i++){
      for(j=0;j<dest.column;j++){
	s=0;
	for(k=0;k<a.column;k++){
	  s+=mat_get(a,i,k)*mat_get(b,k,j);
	}
	mat_set(dest,i,j,s);
      }
    }
    return 0;
  }else{
    fprintf(stderr,"Error:乗法を行おうとしている行列の大きさが合っていません\n");
    return -1;
  }
}
Esempio n. 10
0
File: hess.c Progetto: psi4/libefp
static void get_inertia_factor(const double *inertia, const mat_t *rotmat,
					mat_t *inertia_fact)
{
	double fact[3];

	for (size_t i = 0; i < 3; i++)
		fact[i] = inertia[i] < EPSILON ? 0.0 : 1.0 / sqrt(inertia[i]);

	for (size_t i = 0; i < 3; i++) {
		for (size_t j = 0; j < 3; j++) {
			double sum = 0.0;

			for (size_t k = 0; k < 3; k++)
				sum += fact[k] * mat_get(rotmat, i, k) * mat_get(rotmat, j, k);

			mat_set(inertia_fact, i, j, sum);
		}
	}
}
Esempio n. 11
0
extern inline void mat_cp_rt(Matrix dest,Matrix src){
  int i,j;
  int r_max=MIN(dest.raw,src.raw);
  int c_max=MIN(dest.column,src.column);
  for(i=0;i<r_max;i++){
    for(j=0;j<c_max;j++){
      mat_set(dest,i,dest.column-j-1,mat_get(src,i,src.column-j-1));
    }
  }
}
Esempio n. 12
0
static void correct_range(size_t range[2], const mat *prop, const mat *err,\
                          const qcd_options *opt)
{
    size_t inrange[2],nt;
    strbuf buf;
    double rerr;
    
    inrange[0] = range[0];
    inrange[1] = range[1];
    nt         = nrow(prop);
    
    if (inrange[0] <= nt/2)
    {
        strbufcpy(buf,"");
        for (range[1]=range[0];range[1]<=inrange[1];range[1]++)
        {
            rerr = mat_get(err,range[1],0)/fabs(mat_get(prop,range[1],0));
            if (rerr > MAX_REL_ERR)
            {
                strbufcpy(buf," (rcut)");
                break;
            }
        }
        range[1]--;
    }
    else if (inrange[0] >= nt/2)
    {
        range[1] = inrange[1];
        strbufcpy(buf,"");
        for (range[0]=range[1];range[0]>=inrange[0];range[0]--)
        {
            rerr = mat_get(err,range[0],0)/fabs(mat_get(prop,range[0],0));
            if (rerr > MAX_REL_ERR)
            {
                strbufcpy(buf," (lcut)");
                break;
            }
        }
        range[0]++;
    }
    qcd_printf(opt,"[%d,%d]%s ",(int)range[0],(int)range[1],buf);
}
Esempio n. 13
0
void plot_add_fit_predband(plot *p, const fit_data *d, const size_t ky,\
                           const mat *x_ex, const size_t kx,           \
                           const rs_sample *par, const double xmin,    \
                           const double xmax, const size_t npt,        \
                           const strbuf color)
{
    mat *x,*yp,*ym,*y_i_err,*X;
    rs_sample *s_y_i;
    size_t i;
    double x_i,yp_i,ym_i;
    
    x       = mat_create(npt,1);
    yp      = mat_create(npt,1);
    ym      = mat_create(npt,1);
    y_i_err = mat_create(1,1);
    s_y_i   = rs_sample_create(1,1,rs_sample_get_nsample(par));
    X       = mat_create_from_mat(x_ex);
    
    for (i=0;i<npt;i++)
    {
        x_i = xmin + (xmax-xmin)*DRATIO(i,npt-1);
        mat_set(X,kx,0,x_i);
        fit_data_model_rs_xeval(s_y_i,d,ky,X,par);
        rs_sample_var(y_i_err,s_y_i);
        mat_eqsqrt(y_i_err);
        yp_i = mat_get(rs_sample_pt_cent_val(s_y_i),0,0) + mat_get(y_i_err,0,0);
        ym_i = mat_get(rs_sample_pt_cent_val(s_y_i),0,0) - mat_get(y_i_err,0,0);
        mat_set(yp,i,0,yp_i);
        mat_set(ym,i,0,ym_i);
        mat_set(x,i,0,x_i);
    }
    
    plot_add_line(p,x,yp,"",color);
    plot_add_line(p,x,ym,"",color);
    
    mat_destroy(x);
    mat_destroy(yp);
    mat_destroy(ym);
    mat_destroy(y_i_err);
    rs_sample_destroy(s_y_i);
    mat_destroy(X);
}
Esempio n. 14
0
MAT	*m_inverse(const MAT *A, MAT *out)
{
  unsigned int	i;
  char MatrixTempBuffer[ 4000 ];
  VEC	*tmp = VNULL, *tmp2 = VNULL;
  MAT	*A_cp = MNULL;
  PERM	*pivot = PNULL;

  if ( ! A )
    error(E_NULL,"m_inverse");
  if ( A->m != A->n )
    error(E_SQUARE,"m_inverse");
  if ( ! out || out->m < A->m || out->n < A->n )
    out = m_resize(out,A->m,A->n);

  if( SET_MAT_SIZE( A->m, A->n ) < 1000 )
    mat_get( &A_cp, (void *)( MatrixTempBuffer + 2000 ), A->m, A->n );
  else
    A_cp = matrix_get( A->m, A->n  );

  A_cp = m_copy( A, A_cp );
  if( SET_VEC_SIZE( A->m ) < 1000 ) {
    vec_get( &tmp, (void *)MatrixTempBuffer, A->m );
    vec_get( &tmp2, (void *)(MatrixTempBuffer + 1000), A->m );
  } else {
    tmp   = v_get( A->m );
    tmp2  = v_get( A->m );
  }

  if( SET_PERM_SIZE( A->m ) < 1000 ) {
    perm_get( &pivot, (void *)( MatrixTempBuffer + 3000 ), A->m );
  } else {
    pivot   = px_get( A->m );
  }

  LUfactor(A_cp,pivot);
  //tracecatch_matrix(LUfactor(A_cp,pivot),"m_inverse");
  for ( i = 0; i < A->n; i++ ){
    v_zero(tmp);
    tmp->ve[i] = 1.0;
    LUsolve(A_cp,pivot,tmp,tmp2);
    //tracecatch_matrix(LUsolve(A_cp,pivot,tmp,tmp2),"m_inverse");
    set_col(out,i,tmp2);
  }
  if( tmp != (VEC *)(MatrixTempBuffer ) ) // память выделялась, надо освободить
    V_FREE(tmp);
  if( tmp2 != (VEC *)(MatrixTempBuffer + 1000) ) // память выделялась, надо освободить
    V_FREE(tmp2);
  if( A_cp != (MAT *)(MatrixTempBuffer + 2000) ) // память выделялась, надо освободить
    M_FREE(A_cp);
  if( pivot != (PERM *)(MatrixTempBuffer + 3000) ) // память выделялась, надо освободить
    PX_FREE( pivot );
  return out;
}
Esempio n. 15
0
File: hess.c Progetto: psi4/libefp
static void w_rot_rot(const mat_t *fact1, const mat_t *fact2, size_t stride,
			const double *in, double *out)
{
	for (size_t i = 0; i < 3; i++) {
		for (size_t j = 0; j < 3; j++) {
			double w1 = 0.0;

			for (size_t ii = 0; ii < 3; ii++) {
				double w2 = 0.0;

				for (size_t jj = 0; jj < 3; jj++)
					w2 += mat_get(fact2, j, jj) * in[stride * ii + jj];

				w1 += w2 * mat_get(fact1, i, ii);
			}

			out[i * stride + j] = w1;
		}
	}
}
Esempio n. 16
0
static double fm_AA_func(const mat *x, const mat *p, void *vnt)
{
    double res,m,f,t;
    size_t nt;
    
    t = mat_get(x,0,0);
    m = mat_get(p,0,0);
    f = mat_get(p,1,0);
    
    if (vnt)
    {
        nt = *((size_t *)(vnt));
    }
    else
    {
        nt = 0;
    }
    res = 0.5*SQ(f)*m*(exp(-m*t)+exp(-m*(nt-t)));
    
    return res;
}
Esempio n. 17
0
static double fm_PP_func(const mat *x, const mat *p, void *vnt)
{
    double res,m,t,z;
    size_t nt;
    
    t = mat_get(x,0,0);
    m = mat_get(p,0,0);
    z = mat_get(p,2,0);
    
    if (vnt)
    {
        nt = *((size_t *)(vnt));
    }
    else
    {
        nt = 0;
    }
    res = 0.5*z*z/m*(exp(-m*t)+exp(-m*(nt-t)));
    
    return res;
}
Esempio n. 18
0
void plot_chi2_comp(const fit_data *d, const fit_param *param, const size_t k,\
                    const strbuf title)
{
    strbuf *tmpfname,plotcmd;
    size_t nbeta,nens,nydim,bind;
    size_t i;
    FILE **tmpf;
    plot *p;
    
    nbeta    = param->nbeta;
    nens     = param->nens;
    nydim    = fit_data_get_nydim(d);
    
    tmpf     = (FILE **)malloc(nbeta*nydim*sizeof(FILE *));
    tmpfname = (strbuf *)malloc(nbeta*nydim*sizeof(strbuf));
    p        = plot_create();
    
    for (i=0;i<nbeta;i++)
    {
        sprintf(tmpfname[i],".qcd_phyfit_tmp_%d",(int)i);
        tmpf[i] = fopen(tmpfname[i],"w");
    }
    for (i=0;i<nens;i++)
    {
        bind = (size_t)ind_beta(param->point[i].beta,param);
        fprintf(tmpf[bind],"%s %e %e\n",param->point[i].dir,(double)(i),\
                mat_get(d->chi2_comp,i+k*nens,0));
    }
    for (i=0;i<nbeta;i++)
    {
        fclose(tmpf[i]);
        sprintf(plotcmd,"u 2:3:xtic(1) t '%s' w impulse",param->beta[i]);
        plot_add_plot(p,plotcmd,tmpfname[i]);
    }
    plot_add_head(p,"set xtics rotate by -90 font 'courier, 10'");
    plot_set_scale_manual(p,-1.0,(double)(param->nens+1),-5.0,5.0);
    plot_add_plot(p,"0.0 lt -1 lc rgb 'black' notitle","");
    plot_add_plot(p,"1.0 lt -1 lc rgb 'black' notitle","");
    plot_add_plot(p,"-1.0 lt -1 lc rgb 'black' notitle","");
    plot_add_plot(p,"2.0 lt -1 lc rgb 'dark-gray' notitle","");
    plot_add_plot(p,"-2.0 lt -1 lc rgb 'dark-gray' notitle","");
    plot_add_plot(p,"3.0 lt -1 lc rgb 'gray' notitle","");
    plot_add_plot(p,"-3.0 lt -1 lc rgb 'gray' notitle","");
    plot_add_plot(p,"4.0 lt -1 lc rgb 'light-gray' notitle","");
    plot_add_plot(p,"-4.0 lt -1 lc rgb 'light-gray' notitle","");
    plot_set_ylabel(p,"standard deviations");
    plot_set_title(p,title);
    plot_disp(p);
    
    free(tmpf);
    free(tmpfname);
    plot_destroy(p);
}
Esempio n. 19
0
static double fm_AP_func(const mat *x, const mat *p, void *vnt)
{
    double res,m,f,t,z;
    size_t nt;
    
    t = mat_get(x,0,0);
    m = mat_get(p,0,0);
    f = mat_get(p,1,0);
    z = mat_get(p,2,0);
    
    if (vnt)
    {
        nt = *((size_t *)(vnt));
    }
    else
    {
        nt = 0;
    }
    res = fabs(0.5*f*z*(exp(-m*t)-exp(-m*(nt-t))));
    
    return res;
}
Esempio n. 20
0
File: hess.c Progetto: psi4/libefp
static void w_rot_tr(const mat_t *fact1, double fact2, size_t stride,
			const double *in, double *out)
{
	for (size_t i = 0; i < 3; i++) {
		for (size_t j = 0; j < 3; j++) {
			double w = 0.0;

			for (size_t k = 0; k < 3; k++)
				w += mat_get(fact1, i, k) * in[stride * k + j];

			out[stride * i + j] = w * fact2;
		}
	}
}
Esempio n. 21
0
/* Invert square, real, nonsymmetric matrix.  Uses LU decomposition
   (LAPACK routines dgetrf and dgetri).  Returns 0 on success, 1 on
   failure. */
int mat_invert(Matrix *M_inv, Matrix *M) {
#ifdef SKIP_LAPACK
  die("ERROR: LAPACK required for matrix inversion.\n");
#else
  int i, j;
  LAPACK_INT info, n = (LAPACK_INT)M->nrows, ipiv[n], lwork=(LAPACK_INT)n;
  LAPACK_DOUBLE tmp[n][n], work[lwork];

  if (!(M->nrows == M->ncols && M_inv->nrows == M_inv->ncols && 
	M->nrows == M_inv->nrows))
    die("ERROR mat_invert: bad dimensions\n");

  for (i = 0; i < n; i++) 
    for (j = 0; j < n; j++) 
      tmp[i][j] = (LAPACK_DOUBLE)mat_get(M, j, i);

#ifdef R_LAPACK
  F77_CALL(dgetrf)(&n, &n, (LAPACK_DOUBLE*)tmp, &n, ipiv, &info);
#else
  dgetrf_(&n, &n, (LAPACK_DOUBLE*)tmp, &n, ipiv, &info);
#endif

  if (info != 0) {
    fprintf(stderr, "ERROR: unable to compute LU factorization of matrix (for matrix inversion); dgetrf returned value of %d.\n", (int)info); 
    return 1;
  }
#ifdef R_LAPACK
  F77_CALL(dgetri)(&n, (LAPACK_DOUBLE*)tmp, &n, ipiv, work, &lwork, &info);
#else
  dgetri_(&n, (LAPACK_DOUBLE*)tmp, &n, ipiv, work, &lwork, &info);
#endif

  if (info != 0) {
    if (info > 0)
      fprintf(stderr, "ERROR: matrix is singular -- cannot invert.\n");
    else
      fprintf(stderr, "ERROR: unable to invert matrix.  Element %d had an illegal value (according to dgetri).\n", (int)info); 
    return 1;
  }

  for (i = 0; i < M->nrows; i++) 
    for (j = 0; j < M->nrows; j++) 
      mat_set(M_inv, i, j, (double)tmp[j][i]);

#endif
  return 0;
}
char *ms_simulate(List *mModel, int norder, int alph_size, int length) {
  if (norder < 0) //Must have positive order of Markov Matrices
    die("Order of Markov Model must be zero or greater");
  if(alph_size < 1) //Must have at least one character in alphabet
    die("Alphabet size must be at least 1");
  if (length <= 0) //The length of the sequence to generate must be positive
    die("Length of sequence to generate must be at least 1");
  //printf("Called mm_simulate_seq\n");
  int currentMMorder, i, j, k, base, a = 0, t = 0, g = 0, c = 0;
  char *result = (char*)smalloc((length + 1) * sizeof(char));
  int *previousBases = smalloc((norder +1) * sizeof(int));
  double probability, r;
  Matrix *mm;


  //For length of the simulated sequence
  for (base = 0; base < length; base++) {
    checkInterruptN(base, 1000);
    if (base >= norder) 	//If at a site with less than norder previous bases, use a lower order Markov Matrix
      currentMMorder = norder;
    else
      currentMMorder = base;

    mm = (Matrix*)lst_get_ptr(mModel, currentMMorder);

    j = basesToRow(previousBases, currentMMorder, alph_size); //Map previous bases to row i.e. "AAA"->0, "AAG"->2, "TCA"->53

    r = unif_rand();  //Get random double 0..1

    //Using frequencies of Markov Matrix as weights, determine which base is next in the sequence
    for (i = 0; i < mm->ncols; i++) {
      probability = mat_get(mm, j, i);
      if ((probability < 0) || (probability > 1)) //Probabilities should be between 0 and 1
        die("ERROR: Simulating sequence, probability must be between 0 and 1");
      r = r - probability;
      if (r <= 0)
        break;
    }
		
    if (i >= mm->ncols)  //Counters the final increment of i in previous for loop if it chooses 'T'
      i = mm->ncols - 1;

    //Shift characters in sliding window of previous bases left by 1 and append newly picked base to list
    if( currentMMorder == norder) {
      for (k = 0; k < norder; k++)
        previousBases[k] = previousBases[k + 1];
      previousBases[norder-1] = i;
    }
    else{
      previousBases[currentMMorder] = i;
    }
    switch (i) {  //Convert the number we picked to its alpha equivilent
    case 0: result[base] = 'A'; break;
    case 1: result[base] = 'C'; break;
    case 2: result[base] = 'G'; break;
    case 3: result[base] = 'T'; break;
		
    }
    switch (i) {
    case 0: a++; break;
    case 1: c++; break;
    case 2: g++; break;
    case 3: t++; break;
    }
  }
  //printf("a=%d, c=%d, g=%d, t=%d\n", a, c, g, t);
  //printf("\n");
  result[base] = '\0'; //Add an end to the newly generated sequence string
  return result;
}
Esempio n. 23
0
void plot_fit(const rs_sample *s_fit, fit_data *d, fit_param *param, const plot_flag f)
{
    plot *p[N_EX_VAR];
    double *xb[N_EX_VAR] = {NULL,NULL,NULL,NULL,NULL,NULL,NULL};
    double x_range[N_EX_VAR][2],b_int[2],dbind,a;
    size_t bind,vind,eind,k,phy_ind,s;
    strbuf color,gtitle,title,xlabel,ylabel;
    mat *phy_pt,*x_k,*fit,*cordat,**vol_av_corr,*yerrtmp;
    ens *ept;
    
    phy_pt     = mat_create(N_EX_VAR,1);
    x_k        = mat_create(param->nens,1);
    cordat     = mat_create(param->nens,1);
    MALLOC(vol_av_corr,mat **,param->nbeta);
    for (bind=0;bind<param->nbeta;bind++)
    {
        vol_av_corr[bind] = mat_create(param->nvol[bind],1);
    }

    for (k=0;k<N_EX_VAR;k++)
    {
        p[k] = plot_create();
    }
    
    param->scale_model = 1;
    fit = rs_sample_pt_cent_val(s_fit);
    if (IS_AN(param,AN_PHYPT)&&IS_AN(param,AN_SCALE))
    {
        phy_ind = 1;
        s       = fm_scaleset_taylor_npar(param);
    }
    else
    {
        phy_ind = 0;
        s       = 0;
    }
    for (k=0;k<N_EX_VAR;k++)
    {
        if (k == i_vind)
        {
            fit_data_get_x_k(x_k,d,i_Linv);
        }
        else
        {
            fit_data_get_x_k(x_k,d,k);
        }
        if ((k == i_a)||(k == i_ud)||(k == i_Linv)||(k == i_alpha)\
            ||(k == i_vind))
        {
            x_range[k][0] = 0.0;
        }
        else
        {
            x_range[k][0] = mat_get_min(x_k)-0.15*fabs(mat_get_min(x_k));
        }
        x_range[k][1] = mat_get_max(x_k)+0.15*fabs(mat_get_min(x_k));
        plot_set_scale_xmanual(p[k],x_range[k][0],x_range[k][1]);
    }
    if (f == Q)
    {
        sprintf(gtitle,"quantity: %s -- scale: %s -- datasets: %s -- ensembles: %s",\
                param->q_name,param->scale_part,param->dataset_cat,param->manifest);
        mat_set(phy_pt,i_ud,0,SQ(param->M_ud));
        mat_set(phy_pt,i_s,0,SQ(param->M_s));
        mat_set(phy_pt,i_umd,0,param->M_umd_val);
        mat_set(phy_pt,i_alpha,0,param->alpha);
        mat_set(phy_pt,i_bind,0,0.0);
        mat_set(phy_pt,i_vind,0,0.0);
        mat_set(phy_pt,i_a,0,0.0);
        mat_set(phy_pt,i_Linv,0,0.0);
        mat_set(phy_pt,i_fvM,0,param->qed_fvol_mass);
        /* regular plots */
        PLOT_ADD_FIT(PF_FIT,i_ud,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_ud,phy_ind,"rgb 'black'");
        PLOT_ADD_FIT(PF_FIT,i_s,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_s,phy_ind,"rgb 'black'");
        PLOT_ADD_FIT(PF_FIT,i_umd,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_umd,phy_ind,"rgb 'black'");
        PLOT_ADD_FIT(PF_FIT,i_alpha,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_alpha,phy_ind,"rgb 'black'");
        PLOT_ADD_FIT(PF_FIT,i_a,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_a,phy_ind,"rgb 'black'");
        PLOT_ADD_FIT(PF_FIT,i_Linv,phy_ind,"","rgb 'black'");
        PLOT_ADD_PB(i_Linv,phy_ind,"rgb 'black'");
        for (bind=0;bind<param->nbeta;bind++)
        {
            dbind      = (double)(bind);
            b_int[0]   = dbind - 0.1;
            b_int[1]   = dbind + 0.1;
            xb[i_bind] = b_int;
            fit_data_fit_region(d,xb);
            sprintf(color,"%d",1+(int)bind);
            sprintf(title,"beta = %s",param->beta[bind]);
            PLOT_ADD_FIT(PF_DATA,i_ud,phy_ind,title,color);
            PLOT_ADD_FIT(PF_DATA,i_s,phy_ind,title,color);
            PLOT_ADD_FIT(PF_DATA,i_umd,phy_ind,title,color);
            PLOT_ADD_FIT(PF_DATA,i_alpha,phy_ind,title,color);
            PLOT_ADD_FIT(PF_DATA,i_a,phy_ind,title,color);
            PLOT_ADD_FIT(PF_DATA,i_Linv,phy_ind,title,color);
            fit_data_fit_all_points(d,true);
        }
        /* volume averages plot */
        plot_add_fit(p[i_vind],d,phy_ind,phy_pt,i_Linv,fit,x_range[i_Linv][0],\
                     x_range[i_Linv][1],MOD_PLOT_NPT,true,PF_FIT,"","",       \
                     "rgb 'black'","rgb 'black'");
        plot_add_fit_predband(p[i_vind],d,phy_ind,phy_pt,i_Linv,s_fit,\
                              x_range[i_Linv][0],x_range[i_Linv][1],  \
                              MOD_PLOT_NPT/4,"rgb 'black'");
        fit_partresidual(cordat,d,phy_ind,phy_pt,i_Linv,fit);
        for(bind=0;bind<param->nbeta;bind++)
        {
            mat_zero(vol_av_corr[bind]);
        }
        for(eind=0;eind<param->nens;eind++)
        {
            ept  = param->point + eind;
            bind = (size_t)ind_beta(ept->beta,param);
            vind = (size_t)ind_volume((unsigned int)ept->L,(int)bind,param);
            mat_inc(vol_av_corr[bind],vind,0,mat_get(cordat,eind,0));
        }
        for (bind=0;bind<param->nbeta;bind++)
        for (vind=0;vind<param->nvol[bind];vind++)
        {
            mat_set(vol_av_corr[bind],vind,0,               \
                    mat_get(vol_av_corr[bind],vind,0)       \
                    /((double)(param->nenspvol[bind][vind])));
        }
        for(bind=0;bind<param->nbeta;bind++)
        {
            yerrtmp = mat_create(param->nvol[bind],1);
            
            rs_sample_varp(yerrtmp,param->s_vol_av[bind]);
            mat_eqsqrt(yerrtmp);
            sprintf(color,"%d",1+(int)bind);
            sprintf(title,"beta = %s",param->beta[bind]);
            plot_add_dat_yerr(p[i_vind],                                     \
                              rs_sample_pt_cent_val(param->s_vol_Linv[bind]),\
                              vol_av_corr[bind],yerrtmp,title,color);
            
            mat_destroy(yerrtmp);
        }

        /* display plots */
        switch (param->q_dim)
        {
            case 0:
                strbufcpy(ylabel,param->q_name);
                break;
            case 1:
                sprintf(ylabel,"%s (MeV)",param->q_name);
                break;
            default:
                sprintf(ylabel,"%s^%d (MeV^%d)",param->q_name,param->q_dim,\
                        param->q_dim);
                break;
        }
        
        sprintf(xlabel,"M_%s^2 (MeV^2)",param->ud_name);
        PLOT_ADD_EX(i_ud,s);
        PLOT_DISP(i_ud,"ud");
        sprintf(xlabel,"M_%s^2 (MeV^2)",param->s_name);
        PLOT_ADD_EX(i_s,s);
        PLOT_DISP(i_s,"s");
        strbufcpy(xlabel,"a (MeV^-1)");
        PLOT_ADD_EX(i_a,s);
        PLOT_DISP(i_a,"a");
        if (param->have_umd)
        {
            sprintf(xlabel,"%s (MeV^2)",param->umd_name);
            PLOT_ADD_EX(i_umd,s);
            PLOT_DISP(i_umd,"umd");
        }
        if (param->have_alpha)
        {
            strbufcpy(xlabel,"alpha");
            PLOT_ADD_EX(i_alpha,s);
            PLOT_DISP(i_alpha,"alpha");
        }
        strbufcpy(xlabel,"1/L (MeV)");
        PLOT_ADD_EX(i_Linv,s);
        PLOT_DISP(i_Linv,"Linv");
        PLOT_ADD_EX(i_vind,s);
        PLOT_DISP(i_vind,"Linv_av");
    }
    else if (f == SCALE)
    {
        sprintf(gtitle,"scale setting: %s -- datasets: %s -- ensembles: %s",
                param->scale_part,param->dataset_cat,param->manifest);
        for (bind=0;bind<param->nbeta;bind++)
        {
            dbind      = (double)(bind);
            b_int[0]   = dbind - 0.1;
            b_int[1]   = dbind + 0.1;
            xb[i_bind] = b_int;
            a          = mat_get(fit,bind,0);
            fit_data_fit_region(d,xb);
            mat_set(phy_pt,i_ud,0,SQ(a*param->M_ud));
            mat_set(phy_pt,i_s,0,SQ(a*param->M_s));
            mat_set(phy_pt,i_umd,0,SQ(a)*param->M_umd_val);
            mat_set(phy_pt,i_bind,0,bind);
            mat_set(phy_pt,i_a,0,a);
            mat_set(phy_pt,i_Linv,0,0.0);
            sprintf(color,"%d",1+(int)bind);
            sprintf(title,"beta = %s",param->beta[bind]);
            PLOT_ADD_FIT(PF_DATA|PF_FIT,i_ud,0,title,color);
            PLOT_ADD_FIT(PF_DATA|PF_FIT,i_s,0,title,color);
            PLOT_ADD_FIT(PF_DATA|PF_FIT,i_umd,0,title,color);
            PLOT_ADD_FIT(PF_DATA|PF_FIT,i_Linv,0,title,color);
            fit_data_fit_all_points(d,true);
        }
        sprintf(ylabel,"(a*M_%s)^2",param->scale_part);
        sprintf(xlabel,"(a*M_%s)^2",param->ud_name);
        PLOT_DISP(i_ud,"ud");
        sprintf(xlabel,"(a*M_%s)^2",param->s_name);
        PLOT_DISP(i_s,"s");
        if (param->have_umd)
        {
            sprintf(xlabel,"a^2*%s",param->umd_name);
            PLOT_DISP(i_umd,"umd");
        }
        strbufcpy(xlabel,"a/L");
        PLOT_DISP(i_Linv,"Linv");
    }
    param->scale_model = 0;
    
    mat_destroy(phy_pt);
    mat_destroy(x_k);
    mat_destroy(cordat);
    for (bind=0;bind<param->nbeta;bind++)
    {
        mat_destroy(vol_av_corr[bind]);
    }
    free(vol_av_corr);
    for (k=0;k<N_EX_VAR;k++)
    {
        plot_destroy(p[k]);
    }
}
Esempio n. 24
0
double fm_phypt_taylor_func(const mat *X, const mat *p, void *vparam)
{
    double res,lo,ex,buf,M_ud,M_s,M_fvol,a,dimfac,umd,Linv,ToL,a2mud,a2ms,\
           alpha,alpha_sa,d,Lambda;
    size_t s,bind;
    fit_param *param;
    
    param = (fit_param *)vparam;
    bind  = (size_t)(mat_get(X,i_bind,0));
    
    /* what is the lattice spacing ? */
    if (IS_AN(param,AN_PHYPT))
    {
        if (IS_AN(param,AN_SCALE))
        {
            /** a fit parameter from the scale setting model **/
            a = (!param->scale_model) ? mat_get(p,bind,0) : mat_get(X,i_a,0);
            s = fm_scaleset_taylor_npar(param);
        }
        else
        {
            /** a global parameter with error (with external scale samples) **/
            if (strbufcmp(param->with_ext_a,"") != 0)
            {
                a = (!param->scale_model) ? mat_get(p,I_a_val(bind),0) :\
                                            mat_get(X,i_a,0);
            }
            /** a x coordinate (with the ratio method) **/
            else
            {
                a = mat_get(X,i_a,0);
            }
            s = 0;
        }
    }
    else
    {
        fprintf(stderr,"error: this model should not ne used in program %s\n",\
                param->analyze);
        exit(EXIT_FAILURE);
    }
    /* x values */
    dimfac   = (!param->scale_model) ? a : 1.0;
    Lambda   = LAMBDA_MSBAR_2500MEV;
    M_ud     = mat_get(X,i_ud,0)/SQ(dimfac);
    M_s      = mat_get(X,i_s,0)/SQ(dimfac);
    umd      = mat_get(X,i_umd,0)/SQ(dimfac);
    Linv     = mat_get(X,i_Linv,0)/dimfac;
    ToL      = mat_get(X,i_ToL,0);
    a2mud    = SQ(a)*mat_get(X,i_ud,0)/SQ(dimfac);
    a2ms     = SQ(a)*mat_get(X,i_s,0)/SQ(dimfac);
    alpha    = mat_get(X,i_alpha,0);
    alpha_sa = alpha_s_msbar(1.0/a,Lambda,3,4)*a;
    M_fvol   = mat_get(X,i_fvM,0)/dimfac;
    d        = (double)param->q_dim;
    
    res = 0.0;
    /* Taylor/Pade isospin symmetric expansion */
    lo   = (param->with_const) ? mat_get(p,s,0) : 0.0;
    ex   = 0.0;
    polynom(&ex,p,I_ud(0)+s,M_ud-SQ(param->M_ud),param->M_ud_deg);
    polynom(&ex,p,I_s(0)+s,M_s-SQ(param->M_s),param->M_s_deg);
    ex  += (param->with_a2)       ? mat_get(p,I_a2(0)+s,0)*SQ(a)          : 0.0;
    ex  += (param->with_alpha_sa) ? mat_get(p,I_alpha_sa(0)+s,0)*alpha_sa : 0.0;
    ex  += (param->with_a2ud)     ? mat_get(p,I_a2ud(0)+s,0)*a2mud        : 0.0;
    ex  += (param->with_a2s)      ? mat_get(p,I_a2s(0)+s,0)*a2ms          : 0.0;
    res += (param->with_pade) ? lo/(1.0-ex/lo) : lo+ex;
    
    /* Taylor/Pade m_u-m_d expansion */
    lo = (param->umd_deg) ? mat_get(p,I_umd(0)+s,0) : 0.0;
    ex = 0.0;
    polynom(&ex,p,I_udumd(0)+s,M_ud-SQ(param->M_ud),param->with_udumd);
    polynom(&ex,p,I_sumd(0)+s,M_s-SQ(param->M_s),param->with_sumd);
    ex  += (param->with_a2umd) ? mat_get(p,I_a2umd(0)+s,0)*SQ(a) : 0.0;
    ex  += (param->with_alpha_saumd) ?                    \
           mat_get(p,I_alpha_saumd(0)+s,0)*alpha_sa : 0.0;
    res += (param->with_umd_pade) ? umd*lo/(1.0-ex/lo) : umd*lo+umd*ex;
    /* Taylor/Pade alpha expansion */
    lo = (param->alpha_deg) ? mat_get(p,I_alpha(0)+s,0) : 0.0;
    ex = 0.0;
    polynom(&ex,p,I_udalpha(0)+s,M_ud-SQ(param->M_ud),param->with_udalpha);
    polynom(&ex,p,I_salpha(0)+s,M_s-SQ(param->M_s),param->with_salpha);
    ex  += (param->with_aalpha) ? mat_get(p,I_aalpha(0)+s,0)*a : 0.0;
    res += (param->with_alpha_pade) ? alpha*lo/(1.0-ex/lo) : alpha*lo+alpha*ex;
    /** QED finite volume effects **/
    if (param->have_alpha)
    {
        buf  = 0.0;
        if (param->with_qed_fvol_monopmod)
        {
            if (param->with_qed_fvol >= 1)
            {
                buf += -0.5*QED_FVOL_KAPPA*Linv*d*pow(M_fvol,d-1.0);
            }
            if (param->with_qed_fvol >= 2)
            {
                buf += mat_get(p,I_qedfv(0)+s,0)*SQ(Linv)*pow(M_fvol,d-2.0);
            }
            buf *= (double)param->qed_fvol_monopmod_sign;
        }
        else if (param->with_qed_fvol_qedtl)
        {
            
            buf += -QED_FVOL_KAPPA*Linv*M_fvol*\
                   (1.0 + 2.0*Linv/M_fvol*(1.0-0.5*C_PI*ToL/QED_FVOL_KAPPA));
            buf += mat_get(p,I_qedfv(0)+s,0)*pow(Linv, 3.0);
        }
        else
        {
            if (param->with_qed_fvol)
            {
                buf += mat_get(p,I_qedfv(0)+s,0);
            }
            if (param->with_qed_fvol >= 2)
            {
                polynom(&buf,p,I_qedfv(1)+s,Linv/Lambda,param->with_qed_fvol-1);
            }
            buf *= Linv*pow(M_fvol,d-1.0);
        }
        res += alpha*buf;
    }
    
    /* dimensional factor */
    res *= pow(dimfac,param->q_dim);
    
    return res;
}
int main(int argc, char* argv[]) {
  FILE* F;
  TreeModel *model;
  int i, j, k, alph_size, nstates, do_eqfreqs = 0, exch_mode = 0, 
    list_mode = 0, latex_mode = 0, suppress_diag = 0, ti_tv = 0, 
    scientific_mode = 0,
    induced_aa = 0, do_stop_codons = 0, do_zeroes = 0, symmetric = 0, 
    context_ti_tv = 0, all_branches = 0;
  int startcol, endcol, ncols, branch_no = 0, matrix_idx = 0;
/*   int aa_inv[256]; */
  double t = -1, total_ti = 0, total_tv = 0, rho_s = 0, cpg_ti = 0, 
    cpg_tv = 0, non_cpg_ti = 0, non_cpg_tv = 0, cpg_eqfreq = 0;
  char *rate_format_string = "%8.6f";
  MarkovMatrix *M;
  char c;
  char tuple[5], tuple2[5]; /* , aa_alph[50]; */
  char *subst_mat_fname = NULL, *subst_score_fname = NULL, 
    *subst_mat_fname_paml = NULL, *order1_mod_fname = NULL;
  Matrix *subst_mat = NULL;
  List *matrix_list = lst_new_ptr(20), *traversal = NULL;

  while ((c = (char)getopt(argc, argv, "t:fedlLiM:N:A:B:aszSECh")) != -1) {
   switch(c) {
    case 't':
      if (optarg[0] == 'A') all_branches = 1;
      else t = get_arg_dbl_bounds(optarg, 0, INFTY);
      break;
    case 'f':
      do_eqfreqs = 1;
      break;
    case 'e':
      exch_mode = 1;
      break;
    case 'd':
      suppress_diag = 1;
      break;
    case 'l':
      list_mode = 1;
      break;
    case 'L':
      latex_mode = 1;
      break;
    case 'i':
      ti_tv = 1;
      break;
    case 'M':
      subst_mat_fname = optarg;
      induced_aa = 1;
      break;
    case 'N':
      subst_mat_fname_paml = optarg;
      induced_aa = 1;
      break;
    case 'A':
      subst_score_fname = optarg;
      break;
    case 'B':
      order1_mod_fname = optarg;
      break;
    case 'a':
      induced_aa = 1;
      do_zeroes = 1;
      break;
    case 's':
      do_stop_codons = 1;
      break;
    case 'z':
      do_zeroes = 1;
      break;
    case 'S':
      symmetric = 1;
      break;
    case 'E':
      scientific_mode = 1;
      rate_format_string = "%13.6e";
      break;
    case 'C':
      context_ti_tv = 1;
      break;
    case 'h':
      print_usage();
      exit(0);
    case '?':
      die("Unrecognized option.  Try \"display_rate_matrix -h\" for help.\n");
    }
  }

  set_seed(-1);

  if ((t >= 0 && exch_mode) || (latex_mode && list_mode) || 
      ((ti_tv || subst_mat_fname != NULL || subst_score_fname != NULL || 
        subst_mat_fname_paml != NULL || scientific_mode) && !list_mode) || 
      (subst_mat_fname != NULL && subst_score_fname != NULL) || 
      (subst_score_fname != NULL && subst_mat_fname_paml != NULL) || 
      (subst_mat_fname != NULL && subst_mat_fname_paml != NULL) || 
      optind != argc - 1) {
    die("ERROR: missing required arguments or illegal combination of arguments.\nTry \"display_rate_matrix -h\" for help.\n");
  }

  F = phast_fopen(argv[optind], "r");
  model = tm_new_from_file(F, 1);

  if (context_ti_tv) {
    /* this option requires completely different handling from the others */
    if (model->order != 2) { 
      die("ERROR: -C requires a model of order 3.\n");
    }
    do_context_dependent_ti_tv(model);
    exit(0);
  }

  if (induced_aa) {
    TreeModel *aa_model = tm_induced_aa(model);
    char *codon_to_aa = get_codon_mapping(model->rate_matrix->states);

    /* before freeing model, grab the expected rate of synonymous
       subst, rho_s */
    for (i = 0; i < model->rate_matrix->size; i++)
      for (j = 0; j < model->rate_matrix->size; j++)
        if (i != j && codon_to_aa[i] == codon_to_aa[j])
          rho_s += mm_get(model->rate_matrix, i, j) * 
            vec_get(model->backgd_freqs, i);

    sfree(codon_to_aa);

    tm_free(model);
    model = aa_model;
  }

  if (all_branches) {
    traversal = tr_inorder(model->tree);
    for (matrix_idx = 0; matrix_idx < lst_size(traversal); matrix_idx++) {
      TreeNode *n = lst_get_ptr(traversal, matrix_idx);
      if (n->parent == NULL) { lst_push_ptr(matrix_list, NULL); continue; }
      M = mm_new(model->rate_matrix->size, model->rate_matrix->states, DISCRETE);
      mm_exp(M, model->rate_matrix, n->dparent);
      lst_push_ptr(matrix_list, M);      
    }
  }
  else if (t >= 0) {
    M = mm_new(model->rate_matrix->size, model->rate_matrix->states, DISCRETE);
    mm_exp(M, model->rate_matrix, t);
    lst_push_ptr(matrix_list, M);
  }
  else 
    lst_push_ptr(matrix_list, model->rate_matrix);

  alph_size = (int)strlen(model->rate_matrix->states);
  nstates = model->rate_matrix->size;

  if (subst_mat_fname != NULL) {
    if ((F = fopen(subst_mat_fname, "r")) == NULL) {
      die("ERROR: Can't open %s.\n", subst_mat_fname);
    }    
    subst_mat = read_subst_mat(F, AA_ALPHABET); 
  }
  else if (subst_mat_fname_paml != NULL) {
    if ((F = fopen(subst_mat_fname_paml, "r")) == NULL) {
      die("ERROR: Can't open %s.\n", subst_mat_fname_paml);
    }    
    subst_mat = read_paml_matrix(F, AA_ALPHABET); 
  }
  else if (subst_score_fname != NULL) {
    if ((F = fopen(subst_score_fname, "r")) == NULL) {
      die("ERROR: Can't open %s.\n", subst_score_fname);
    }    
    subst_mat = read_subst_scores(model, F);
  }
  else if (order1_mod_fname != NULL) {
    if ((F = fopen(order1_mod_fname, "r")) == NULL) {
      die("ERROR: Can't open %s.\n", order1_mod_fname);
    }    
    subst_mat = unproject_rates(model, tm_new_from_file(F, 1));
  }

  /* loop through matrices to print */
  for (matrix_idx = 0; matrix_idx < lst_size(matrix_list); matrix_idx++) {
    M = lst_get_ptr(matrix_list, matrix_idx);

    if (all_branches) {
      if (M == NULL) continue;  /* root */
      printf("BRANCH %d (t = %.6f)\n", ++branch_no,
             ((TreeNode*)lst_get_ptr(traversal, matrix_idx))->dparent);
    }

  /* print no more than 16 columns at a time (except with -a) */
  ncols = (induced_aa ? nstates : 16);
  for (startcol = 0; startcol < nstates; startcol += ncols) {
    endcol = min(nstates, startcol+ncols);

    /* table header */
    if (! list_mode) {
      if (latex_mode) {
        printf("\\begin{tabular}{|c|");
        for (i = startcol; i < endcol; i++) printf("r");
        printf("|}\n\\hline\n");
      }
      printf("%-5s ", "");
      if (latex_mode) printf("& ");
      for (i = startcol; i < endcol; i++) {
        get_state_tuple(model, tuple, i);
        if (latex_mode) {
          printf("{\\bf %s}", tuple);
          if (i < endcol-1) printf("& ");
        }
        else printf("%8s ", tuple);
    }
      if (latex_mode) printf("\\\\\n\\hline\n");
      else printf("\n");
    }

    /* table or list contents */
    for (i = 0; i < nstates; i++) {
      if (induced_aa && AA_ALPHABET[i] == '$' && !do_stop_codons) continue;
      get_state_tuple(model, tuple, i);

      /* get total eq freq of tuples containing CpG dinucs */
      for (k = 0; k < model->order; k++) {
        if (tuple[k] == 'C' && tuple[k+1] == 'G') {
          cpg_eqfreq += vec_get(model->backgd_freqs, i);
/*           printf("***CPG***"); */
          break;
        }
      }

      if (latex_mode) printf("{\\bf %s}& ", tuple);
      else if (!list_mode) printf("%-5s ", tuple);
      for (j = startcol; j < endcol; j++) {
        if (induced_aa && AA_ALPHABET[j] == '$' && !do_stop_codons) continue;
        if (latex_mode) printf("$");
        if (list_mode) {
          if (symmetric && j <= i) continue;
          else if ((t < 0 && ! all_branches) 
		   && (i == j || (!do_zeroes && mm_get(M, i, j) == 0))) 
            continue;
          get_state_tuple(model, tuple2, j);
          printf("%-5s %-5s ", tuple, tuple2);
        }
        if (i == j && suppress_diag && !list_mode) printf("%-7s", "-");
        else { 
	  /* get rate or probability */
	  double val = exch_mode == 0 ? mm_get(M, i, j) : 
	    safediv(mm_get(M, i, j), vec_get(model->backgd_freqs,j));
	  /* print value in format %8.6f or %13.6e */
	  printf(rate_format_string, val); 
	  printf(" ");
	}
        if (latex_mode) {
          printf("$");
          if (j < endcol-1) printf("& ");
        }
        else if (list_mode) {
          int ti, is_cpg;
          if (ti_tv) {
            ti = -1;
            is_cpg = 0;
            for (k = 0; k <= model->order; k++) {
              int dig_i = (i % int_pow(alph_size, k+1)) / int_pow(alph_size, k);
              int dig_j = (j % int_pow(alph_size, k+1)) / int_pow(alph_size, k);
              char next_char = '\0', prev_char = '\0';
              if (dig_i != dig_j) {
                ti = is_transition(M->states[dig_i], M->states[dig_j]);
                if (k != model->order)
                  prev_char = M->states[(i % int_pow(alph_size, k+2)) / 
                                        int_pow(alph_size, k+1)];
                if (k != 0)
                  next_char = M->states[(i % int_pow(alph_size, k)) / 
                                        int_pow(alph_size, k-1)];
                if ((M->states[dig_i] == 'C' && next_char == 'G') || 
                    (M->states[dig_i] == 'G' && prev_char == 'C')) 
                  is_cpg = 1;
              }
            }
	    if (ti == -1)
	      die("ERROR ti=-1\n");
            printf("%5s ", ti ? "ti" : "tv");
/*             printf("%5s ", is_cpg ? "CPG" : "-"); */
            if (ti) {
              total_ti += mm_get(M, i, j) * 
                vec_get(model->backgd_freqs, i);
              if (is_cpg) 
                cpg_ti += mm_get(M, i, j) * 
                  vec_get(model->backgd_freqs, i);
              else non_cpg_ti += mm_get(M, i, j) * 
                     vec_get(model->backgd_freqs, i);
            }
            else {
              total_tv += mm_get(M, i, j) * 
                vec_get(model->backgd_freqs, i);
              if (is_cpg)
                cpg_tv += mm_get(M, i, j) * 
                  vec_get(model->backgd_freqs, i);
              else non_cpg_tv += mm_get(M, i, j) * 
                     vec_get(model->backgd_freqs, i);
            }
          }
          if (subst_mat != NULL) {
            if (mat_get(subst_mat, i, j) == NEGINFTY) 
              printf("%8s", "-"); 
            else printf("%8.4f", mat_get(subst_mat, i, j)); 
          }
          printf("\n");
        }
      }
      if (latex_mode) printf("\\\\\n");
      else if (!list_mode) printf("\n");
    }
    
    /* equilibrium freqs (table case only) */
    if (do_eqfreqs && ! list_mode) {
      if (latex_mode) 
        printf("\\hline\n$\\boldsymbol{\\mathbf{\\pi}}$&");
      else 
        printf("%-5s ", "pi");
      for (i = startcol; i < endcol; i++) {
        if (latex_mode) 
          printf("$%8.4f$ ", vec_get(model->backgd_freqs, i));      
        else 
          printf("%8.4f ", vec_get(model->backgd_freqs, i));      
        if (latex_mode && i < endcol-1) printf("& ");
      }
      if (latex_mode) printf("\\\\\n");
      else printf("\n");
    }

    if (latex_mode) printf("\\hline\n\\end{tabular}\n\n");
  }

  /* equilibrium freqs (list case only) */
  if (do_eqfreqs &&  list_mode) {
    for (i = 0; i < nstates; i++) {
      get_state_tuple(model, tuple, i);
      printf("%-5s %-5s ", "-", tuple); //!!
      printf(rate_format_string, vec_get(model->backgd_freqs, i)); 
      printf("\n");
    }
  }
  
  if (ti_tv && list_mode) {
    printf("\n#Total ti/tv = %.4f\n", total_ti/total_tv);
    printf("#CpG ti ratio = %.4f, CpG tv ratio = %.4f\n", 
           cpg_ti/non_cpg_ti /* * (1 - cpg_eqfreq) */ / cpg_eqfreq, 
           cpg_tv/non_cpg_tv /* * (1 - cpg_eqfreq) */ / cpg_eqfreq);
  }
  else if (induced_aa) 
    printf("\n#Total rho_s/rho_v = %.4f\n", rho_s/(3-rho_s));

  if (all_branches == 1) printf("\n\n");
  }

  tm_free(model);
  lst_free(matrix_list);

  return 0;
}
GFF_Set *ms_score(char *seqName, char *seqData, int seqLen, int seqIdxOff, int seqAlphLen, List *MarkovMatrices, Matrix *pwm, Matrix *reverseCmpPWM, int conservative, double threshold, char *strand) { 
  int i, k,j,l,col;
  double MMprob, PWMprob=0, ReversePWMprob=0;
  GFF_Set *scores = gff_new_set();
  double *MMprobs = (double*)smalloc((pwm->nrows+1) * sizeof(double));    //Sliding window of mmOrder previous MM probabilities
		
  if ((conservative != 0) && (conservative != 1))
    die("ERROR: Conserverative (boolean) value must be 0 or 1");
	
  if (seqLen < pwm->nrows)  //Check to see if the sequence is shorter than the pwm
    return scores;

  for (i = 0; i <= pwm->nrows; i++)							//Calculate MM scores from sites 0 to pwm->nrows
    if (i < seqLen)
      MMprobs[i] = calcMMscore(seqData, i, MarkovMatrices, conservative);
		
  for (i = 0; i <= seqLen-(pwm->nrows); i++) {				//For each base in the sequence
    PWMprob = 0; MMprob = 0; ReversePWMprob = 0;
		
    for (k = 0, j = i; k < pwm->nrows; k++, j++) {		//Sum PWM, ReversePWM, MM probabilities for score calculation
      col = basetocol(seqData[j]);
      if (col >= 0)
        {
          PWMprob += mat_get(pwm, k, col);
          ReversePWMprob += mat_get(reverseCmpPWM, k, col);
          MMprob += MMprobs[k];
        }
      else {		
        if (conservative)	
          {		
            PWMprob = log(0);			//If we get something other than the expected language (i.e. A,C,T,G) i.e. N, then our probability is -Inf
            ReversePWMprob = log(0);
            break;
          }
        else
          {
            PWMprob = 0;										
            ReversePWMprob = 0;
          }
      }
    }
	
    if (i < (seqLen - pwm->nrows)) { //Only if there are more bases in this sequence to test
      for (l = 0; l < pwm->nrows; l++)		//Shift probs left to make room for next
	MMprobs[l] = MMprobs[l + 1];

      MMprobs[pwm->nrows-1] = calcMMscore(seqData, i+pwm->nrows,  //Calculate MM probability for site at (i+pwm->nrows)
                                          MarkovMatrices, conservative);
    }

    if (((PWMprob - MMprob) > threshold) && ((strcmp(strand, "+") == 0) || (strcmp(strand, "both") == 0) || ((strcmp(strand, "best") == 0) && ((PWMprob - MMprob) >= (ReversePWMprob - MMprob))))) {			//If we have a positive score add it to the list of scores
      GFF_Feature *feat = gff_new_feature(str_new_charstr(seqName), str_new_charstr(""), 
                                          str_new_charstr(""), seqIdxOff+i+1, 
                                          seqIdxOff+i+pwm->nrows, (PWMprob - MMprob), '+', 
                                          0, str_new_charstr(""), 0);
      lst_push_ptr(scores->features, feat);
    }

    if (((ReversePWMprob - MMprob) > threshold) && ((strcmp(strand, "-") == 0) || (strcmp(strand, "both") == 0) || ((strcmp(strand, "best") == 0) && ((ReversePWMprob - MMprob) > (PWMprob - MMprob))))) {
      GFF_Feature *feat = gff_new_feature(str_new_charstr(seqName), str_new_charstr(""), 
                                          str_new_charstr(""), seqIdxOff+i+1, 
                                          seqIdxOff+i+pwm->nrows, (ReversePWMprob - MMprob), '-', 
                                          0, str_new_charstr(""), 0);
      lst_push_ptr(scores->features, feat);
    }
  }
  sfree(MMprobs);
  return scores; 
}
Esempio n. 27
0
int main(int argc, char* argv[])
{
    /*              parsing arguments           */
    /********************************************/
    double latspac_nu;
    qcd_options *opt;
    strbuf name[3],manf_name,unit,sink[3],source[3];
    size_t binsize,nboot,propdim[2],nt;
    char *cpt1,*cpt2;
    corr_no lastc;
    fit_model *fm_pt;
    
    opt = qcd_arg_parse(argc,argv,A_PLOT|A_SAVE_RS|A_LOAD_RG|A_PROP_NAME\
                        |A_PROP_LOAD|A_LATSPAC|A_QCOMP|A_FIT,2,0);
    cpt1 = strtok(opt->ss,"/");
    printf("%s\n",cpt1);
    if (cpt1)
    {
        cpt2 = strchr(cpt1,':');
        if (cpt2 == NULL)
        {
            fprintf(stderr,"error: sink/source option %s is invalid\n",\
                    cpt1);
            exit(EXIT_FAILURE);
        }
        strbufcpy(source[PP],cpt2+1);
        *cpt2 = '\0';
        strbufcpy(sink[PP],cpt1);
    }
    else
    {
        fprintf(stderr,"error: sink/source option %s is invalid\n",\
                opt->ss);
        exit(EXIT_FAILURE);
    }
    cpt1 = strtok(NULL,"/");
    if (cpt1)
    {
        cpt2 = strchr(cpt1,':');
        if (cpt2 == NULL)
        {
            fprintf(stderr,"error: sink/source option %s is invalid\n",\
                    cpt1);
            exit(EXIT_FAILURE);
        }
        strbufcpy(source[AP],cpt2+1);
        *cpt2 = '\0';
        strbufcpy(sink[AP],cpt1);
    }
    else
    {
        strbufcpy(sink[AP],sink[PP]);
        strbufcpy(source[AP],source[PP]);
    }
    cpt1 = strtok(NULL,"/");
    if (cpt1)
    {
        cpt2 = strchr(cpt1,':');
        if (cpt2 == NULL)
        {
            fprintf(stderr,"error: sink/source option %s is invalid\n",\
                    cpt1);
            exit(EXIT_FAILURE);
        }
        strbufcpy(source[AA],cpt2+1);
        *cpt2 = '\0';
        strbufcpy(sink[AA],cpt1);
    }
    else
    {
        strbufcpy(sink[AA],sink[PP]);
        strbufcpy(source[AA],source[PP]);
    }
    cpt1 = strtok(opt->channel[0],"/");
    if (cpt1)
    {
        sprintf(name[PP],"%s_%s_%s_%s",cpt1,opt->quark[0],sink[PP],source[PP]);
    }
    else
    {
        fprintf(stderr,"error: channel option %s is invalid\n",\
                opt->channel[0]);
        exit(EXIT_FAILURE);
    }
    cpt1 = strtok(NULL,"/");
    if (cpt1)
    {
        sprintf(name[AP],"%s_%s_%s_%s",cpt1,opt->quark[0],sink[AP],source[AP]);
    }
    else
    {
        fprintf(stderr,"error: channel option %s is invalid\n",\
                opt->channel[0]);
        exit(EXIT_FAILURE);
    }
    cpt1 = strtok(NULL,"/");
    if (cpt1)
    {
        sprintf(name[AA],"%s_%s_%s_%s",cpt1,opt->quark[0],sink[AA],source[AA]);
        lastc = AA;
        fm_pt = &fm_pseudosc3;
    }
    else
    {
        lastc = AP;
        fm_pt = &fm_pseudosc2;
    }
    strbufcpy(manf_name,opt->manf_name);
    binsize    = opt->binsize;
    nboot      = opt->nboot;
    latspac_nu = opt->latspac_nu;
    if (opt->have_latspac)
    {
        strbufcpy(unit," (MeV)");
    }
    else
    {
        strbufcpy(unit,"");
    }
    latan_set_verb(opt->latan_verb);
    minimizer_set_alg(opt->minimizer);
    mat_ar_loadbin(NULL,propdim,manf_name,name[PP],1);
    nt = propdim[0];
    io_set_fmt(opt->latan_fmt);
    io_init();
    
    /*              loading datas               */
    /********************************************/
    size_t ndat,nbdat;
    mat **prop[3];
    corr_no c;

    ndat    = (size_t)get_nfile(manf_name);
    nbdat   = ndat/binsize + ((ndat%binsize == 0) ? 0 : 1);
    
    for (c=PP;c<=lastc;c++)
    {
        prop[c] = mat_ar_create(nbdat,propdim[0],propdim[1]);
        qcd_printf(opt,"-- loading %s datas from %s...\n",name[c],manf_name);
        mat_ar_loadbin(prop[c],NULL,manf_name,name[c],binsize);
    }
    
    /*                propagator                */
    /********************************************/
    rs_sample *s_mprop[3];
    mat *mprop[3],*sigmprop[3];
    
    for (c=PP;c<=lastc;c++)
    {
        s_mprop[c]  = rs_sample_create(propdim[0],propdim[1],nboot);
        sigmprop[c] = mat_create(propdim[0],propdim[1]);
        qcd_printf(opt,"-- resampling %s mean propagator...\n",name[c]);
        randgen_set_state(opt->state);
        resample(s_mprop[c],prop[c],nbdat,&rs_mean,BOOT,NULL);
        mprop[c] = rs_sample_pt_cent_val(s_mprop[c]);
        rs_sample_varp(sigmprop[c],s_mprop[c]);
        mat_eqsqrt(sigmprop[c]);
    }
    
    /*           effective mass                 */
    /********************************************/
    rs_sample *s_effmass[3];
    mat *tem,*em[3],*sigem[3];
    size_t emdim[2];
    
    get_effmass_size(emdim,mprop[PP],1,EM_ACOSH);
    
    tem = mat_create(emdim[0],1);
    
    for (c=PP;c<=lastc;c++)
    {
        s_effmass[c] = rs_sample_create(emdim[0],emdim[1],nboot);
        sigem[c]     = mat_create(emdim[0],emdim[1]);
        qcd_printf(opt,"-- resampling %s effective mass...\n",name[c]);
        rs_sample_effmass(s_effmass[c],tem,s_mprop[c],1,EM_ACOSH);
        em[c] = rs_sample_pt_cent_val(s_effmass[c]);
        rs_sample_varp(sigem[c],s_effmass[c]);
        mat_eqsqrt(sigem[c]);
    }
    
    /*                  fit mass                */
    /********************************************/
    fit_data *d;
    rs_sample *s_fit;
    mat *fit,*limit,*sigfit,*scanres_t,*scanres_chi2,*scanres_mass,\
    *scanres_masserr;
    size_t npar,nti,tibeg,range[2],ta;
    size_t i,j;
    strbuf buf,range_info,latan_path;
    double pref_i,mass_i;
    
    d        = fit_data_create(nt,1,(size_t)(lastc+1));
    tibeg    = (size_t)(opt->range[0][0]);
    range[0] = 0;
    range[1] = 0;
    npar     = fit_model_get_npar(fm_pt,&nt);
    
    s_fit    = rs_sample_create(npar,1,nboot);
    fit      = rs_sample_pt_cent_val(s_fit);
    limit    = mat_create(npar,2);
    sigfit   = mat_create(npar,1);
    
    /** print operation **/
    if (!opt->do_range_scan)
    {
        qcd_printf(opt,"-- fitting and resampling...\n");
    }
    else
    {
        qcd_printf(opt,"-- scanning ranges [ti,%u] from ti= %u\n",\
                   opt->range[0][1],opt->range[0][0]);
        opt->nmanrange   = 1;
    }
    
    /** check ranges **/
    strbufcpy(range_info,"");
    qcd_printf(opt,"%-20s: ","corrected range(s)");
    fit_data_fit_all_points(d,false);
    for (i=0;i<opt->nmanrange;i++)
    {
        sprintf(buf,"_%u_%u",opt->range[i][0],opt->range[i][1]);
        strbufcat(range_info,buf);
        range[0] = (size_t)(opt->range[i][0]);
        range[1] = (size_t)(opt->range[i][1]);
        correct_range(range,mprop[PP],sigmprop[PP],opt);
        fit_data_fit_range(d,range[0],range[1],true);
    }
    qcd_printf(opt,"\n");
    
    nti             = MAX(range[1] - 1 - tibeg,1);
    scanres_t       = mat_create(nti,1);
    scanres_chi2    = mat_create(nti,1);
    scanres_mass    = mat_create(nti,1);
    scanres_masserr = mat_create(nti,1);
    
    /** set model **/
    fit_data_set_model(d,fm_pt,&nt);
    
    /** set correlation filter **/
    if (opt->corr == NO_COR)
    {
        for (i=0;i<nt;i++)
            for (j=0;j<nt;j++)
            {
                if (i != j)
                {
                    fit_data_set_data_cor(d,i,j,false);
                }
            }
    }
    
    /** set initial parameter values **/
    ta     = nt/8-(size_t)(mat_get(tem,0,0));
    mass_i = mat_get(em[PP],ta,0);
    if (latan_isnan(mass_i))
    {
        mass_i = 0.3;
    }
    mat_set(fit,0,0,mass_i);
    pref_i = mat_get(mprop[PP],ta,0)/(exp(-mass_i*ta)+exp(-mass_i*(nt-ta)));
    if (latan_isnan(pref_i))
    {
        pref_i = 1.0;
    }
    mat_set(fit,1,0,sqrt(pref_i));
    mat_set(fit,2,0,sqrt(pref_i));
    qcd_printf(opt,"%-22smass= %e -- prefactor_0= %e\n","initial parameters: ",\
               mat_get(fit,0,0),pref_i);
    
    /** set parameter limits **/
    mat_cst(limit,latan_nan());
    mat_set(limit,0,0,0.0);
    mat_set(limit,1,0,0.0);
    mat_set(limit,2,0,0.0);
    
    /** positive AP correlator **/
    rs_sample_eqabs(s_mprop[AP]);
    
    /** set x **/
    for (i=0;i<nt;i++)
    {
        fit_data_set_x(d,i,0,(double)(i)-opt->tshift);
    }
    
    /** regular correlator fit... **/
    if (!opt->do_range_scan)
    {
        latan_set_warn(false);
        rs_data_fit(s_fit,limit,NULL,s_mprop,d,NO_COR,NULL);
        latan_set_warn(true);
        rs_data_fit(s_fit,limit,NULL,s_mprop,d,opt->corr,NULL);
        rs_sample_varp(sigfit,s_fit);
        mat_eqsqrt(sigfit);
        if (fit_data_get_chi2pdof(d) > 2.0)
        {
            fprintf(stderr,"warning: bad final fit (chi^2/dof= %.2e)\n",\
                    fit_data_get_chi2pdof(d));
        }
        qcd_printf(opt,"-- results:\n");
        qcd_printf(opt,"%-10s= %.8f +/- %.8e %s\n","mass",\
                   mat_get(fit,0,0)/latspac_nu,       \
                   mat_get(sigfit,0,0)/latspac_nu,unit);
        qcd_printf(opt,"%-10s= %.8f +/- %.8e %s\n","decay",\
                   mat_get(fit,1,0)/latspac_nu,       \
                   mat_get(sigfit,1,0)/latspac_nu,unit);
        qcd_printf(opt,"%-10s= %.8f +/- %.8e %s\n","norm",\
                   mat_get(fit,2,0)/latspac_nu,       \
                   mat_get(sigfit,2,0)/latspac_nu,unit);
        qcd_printf(opt,"%-10s= %d\n","dof",fit_data_get_dof(d));
        qcd_printf(opt,"%-10s= %e\n","chi^2/dof",fit_data_get_chi2pdof(d));
        if (opt->do_save_rs_sample)
        {
            sprintf(latan_path,"%s_pseudosc_fit%s_%s.boot:%s_pseudosc_fit%s_%s",\
                    opt->quark[0],range_info,manf_name,opt->quark[0],\
                    range_info,manf_name);
            rs_sample_save_subsamp(latan_path,'w',s_fit,0,0,1,0);
        }
    }
    /** ...or fit range scanning **/
    else
    {
        qcd_printf(opt,"\n%-5s %-12s a*M_%-8s %-12s","ti/a","chi^2/dof",\
                   opt->quark[0],"error");
        for (i=tibeg;i<range[1]-1;i++)
        {
            latan_set_warn(false);
            rs_data_fit(s_fit,limit,NULL,s_mprop,d,NO_COR,NULL);
            latan_set_warn(true);
            rs_data_fit(s_fit,limit,NULL,s_mprop,d,opt->corr,NULL);
            rs_sample_varp(sigfit,s_fit);
            mat_eqsqrt(sigfit);
            mat_set(scanres_t,i-tibeg,0,(double)(i));
            mat_set(scanres_chi2,i-tibeg,0,fit_data_get_chi2pdof(d));
            mat_set(scanres_mass,i-tibeg,0,mat_get(fit,0,0));
            mat_set(scanres_masserr,i-tibeg,0,mat_get(sigfit,0,0));
            qcd_printf(opt,"\n% -4d % -.5e % -.5e % -.5e",(int)(i),\
                       fit_data_get_chi2pdof(d),mat_get(fit,0,0), \
                       mat_get(sigfit,0,0));
            fit_data_fit_point(d,i,false);
        }
        qcd_printf(opt,"\n\n");
    }
    
    /*                  plot                    */
    /********************************************/
    if (opt->do_plot)
    {
        mat *mbuf,*em_i,*sigem_i,*par,*ft[3],*comp[3];
        plot *p;
        strbuf key,dirname,color;
        size_t maxt,t,npoint;
        double dmaxt,nmass;
        
        mbuf    = mat_create(1,1);
        em_i    = mat_create(nrow(em[PP]),1);
        sigem_i = mat_create(nrow(em[PP]),1);
        par     = mat_create(2,1);
        
        if (!opt->do_range_scan)
        {
            maxt   = nt;
            dmaxt  = (double)maxt;
            npoint = fit_data_fit_point_num(d);
            
            /** chi^2 plot **/
            p = plot_create();
            i = 0;
            for (c=PP;c<=lastc;c++)
            {
                ft[c]   = mat_create(npoint,1);
                comp[c] = mat_create(npoint,1);
                for (t=0;t<nt;t++)
                {
                    if (fit_data_is_fit_point(d,t))
                    {
                        mat_set(ft[c],i%npoint,0,(double)(t)+0.33*(double)(c));
                        mat_set(comp[c],i%npoint,0,mat_get(d->chi2_comp,i,0));
                        i++;
                    }
                }
            }
            plot_set_scale_manual(p,-1.0,dmaxt,-5.0,5.0);
            plot_add_plot(p,"0.0 lt -1 lc rgb 'black' notitle","");
            plot_add_plot(p,"1.0 lt -1 lc rgb 'black' notitle","");
            plot_add_plot(p,"-1.0 lt -1 lc rgb 'black' notitle","");
            plot_add_plot(p,"2.0 lt -1 lc rgb 'dark-gray' notitle","");
            plot_add_plot(p,"-2.0 lt -1 lc rgb 'dark-gray' notitle","");
            plot_add_plot(p,"3.0 lt -1 lc rgb 'gray' notitle","");
            plot_add_plot(p,"-3.0 lt -1 lc rgb 'gray' notitle","");
            plot_add_plot(p,"4.0 lt -1 lc rgb 'light-gray' notitle","");
            plot_add_plot(p,"-4.0 lt -1 lc rgb 'light-gray' notitle","");
            plot_set_ylabel(p,"standard deviations");
            for (c=PP;c<=lastc;c++)
            {
                sprintf(color,"%d",(int)(c)+1);
                plot_add_points(p,ft[c],comp[c],c_name[c],color,"impulses");
            }
            plot_disp(p);
            if (opt->do_save_plot)
            {
                sprintf(dirname,"%s_dev",opt->save_plot_dir);
                plot_save(dirname,p);
            }
            plot_destroy(p);
        
            for (c=PP;c<=lastc;c++)
            {
                /** propagator plot **/
                p = plot_create();
                fit_data_fit_all_points(d,true);
                plot_set_scale_ylog(p);
                plot_set_scale_xmanual(p,0,dmaxt);
                sprintf(key,"%s %s propagator",opt->quark[0],c_name[c]);
                mat_eqabs(mprop[c]);
                plot_add_fit(p,d,c,mbuf,0,fit,0,dmaxt,1000,false,\
                             PF_FIT|PF_DATA,key,"","rgb 'red'","rgb 'red'");
                plot_disp(p);
                if (opt->do_save_plot)
                {
                    sprintf(dirname,"%s_prop_%s",opt->save_plot_dir,c_name[c]);
                    plot_save(dirname,p);
                }
                plot_destroy(p);
                
                /** effective mass plot **/
                p = plot_create();
                mat_eqmuls(em[c],1.0/latspac_nu);
                mat_eqmuls(sigem[c],1.0/latspac_nu);
                nmass = mat_get(fit,0,0)/latspac_nu;
                plot_add_hlineerr(p,nmass, mat_get(sigfit,0,0)/latspac_nu,\
                                  "rgb 'red'");
                sprintf(key,"%s %s effective mass",opt->quark[0],c_name[c]);
                plot_add_dat(p,tem,em[c],NULL,sigem[c],key,"rgb 'blue'");
                plot_disp(p);
                if (opt->do_save_plot)
                {
                    sprintf(dirname,"%s_em_%s",opt->save_plot_dir,c_name[c]);
                    plot_save(dirname,p);
                }
                plot_destroy(p);
            }
        }
        else
        {
            /* chi^2 plot */
            p = plot_create();
            plot_set_scale_manual(p,0,(double)(nt/2),0,5.0);
            plot_add_hline(p,1.0,"rgb 'black'");
            plot_add_dat(p,scanres_t,scanres_chi2,NULL,NULL,"chi^2/dof",\
                         "rgb 'blue'");
            plot_disp(p);
            if (opt->do_save_plot)
            {
                sprintf(dirname,"%s_chi2",opt->save_plot_dir);
                plot_save(dirname,p);
            }
            plot_destroy(p);
            
            /* mass plot */
            p = plot_create();
            plot_set_scale_xmanual(p,0,(double)(nt/2));
            sprintf(key,"a*M_%s",opt->quark[0]);
            plot_add_dat(p,scanres_t,scanres_mass,NULL,scanres_masserr,key,\
                         "rgb 'red'");
            plot_disp(p);
            if (opt->do_save_plot)
            {
                sprintf(dirname,"%s_mass",opt->save_plot_dir);
                plot_save(dirname,p);
            }
            plot_destroy(p);
        }
        
        mat_destroy(em_i);
        mat_destroy(sigem_i);
        mat_destroy(mbuf);
        mat_destroy(par);
        for (c=PP;c<=lastc;c++)
        {
            mat_destroy(ft[c]);
            mat_destroy(comp[c]);
        }
    }
    
    /*              desallocation               */
    /********************************************/
    free(opt);
    io_finish();
    mat_ar_destroy(prop[0],nbdat);
    mat_ar_destroy(prop[1],nbdat);
    for (c=PP;c<=lastc;c++)
    {
        rs_sample_destroy(s_mprop[c]);
        mat_destroy(sigmprop[c]);
        rs_sample_destroy(s_effmass[c]);
        mat_destroy(sigem[c]);
    }
    mat_destroy(tem);
    fit_data_destroy(d);
    rs_sample_destroy(s_fit);
    mat_destroy(limit);
    mat_destroy(sigfit);
    mat_destroy(scanres_t);
    mat_destroy(scanres_chi2);
    mat_destroy(scanres_mass);
    mat_destroy(scanres_masserr);
    
    return EXIT_SUCCESS;
}
Esempio n. 28
0
void plot_add_dat(plot *p, const mat *x, const mat *dat, const mat *xerr,\
                  const mat *yerr, const strbuf title, const strbuf color)
{
    FILE* tmpf;
    strbuf tmpfname, ucmd, errcmd, plotcmd, colorcmd;
    unsigned int err_flag;
    size_t i;
    
    err_flag = NO_ERR;
    
    err_flag |= (xerr != NULL) ? X_ERR : NO_ERR;
    err_flag |= (yerr != NULL) ? Y_ERR : NO_ERR;
    sprintf(tmpfname,".latan_tmp_plot_%lu.dat",(long unsigned)ntmpf);
    ntmpf++;
    FOPEN_NOERRET(tmpf,tmpfname,"w");
    if ((err_flag & X_ERR)&&(err_flag & Y_ERR))
    {
        strbufcpy(ucmd,"1:2:3:4");
        strbufcpy(errcmd,"w xyerr");
        for (i=0;i<nrow(dat);i++)
        {
            fprintf(tmpf,"%.10e %.10e %.10e %.10e\n",mat_get(x,i,0),\
                    mat_get(dat,i,0),mat_get(xerr,i,0),             \
                    mat_get(yerr,i,0));
        }
    }
    else if (err_flag & X_ERR)
    {
        strbufcpy(ucmd,"1:2:3");
        strbufcpy(errcmd,"w xerr");
        for (i=0;i<nrow(dat);i++)
        {
            fprintf(tmpf,"%.10e %.10e %.10e\n",mat_get(x,i,0),mat_get(dat,i,0),\
                    mat_get(xerr,i,0));
        }
    }
    else if (err_flag & Y_ERR)
    {
        strbufcpy(ucmd,"1:2:3");
        strbufcpy(errcmd,"w yerr");
        for (i=0;i<nrow(dat);i++)
        {
            fprintf(tmpf,"%.10e %.10e %.10e\n",mat_get(x,i,0),mat_get(dat,i,0),\
                    mat_get(yerr,i,0));
        }
    }
    else
    {
        strbufcpy(ucmd,"1:2");
        strbufcpy(errcmd,"");
        for (i=0;i<nrow(dat);i++)
        {
            fprintf(tmpf,"%.10e %.10e\n",mat_get(x,i,0),mat_get(dat,i,0));
        }
    }
    fclose(tmpf);
    if (strlen(color) == 0)
    {
        strbufcpy(colorcmd,"");
    }
    else
    {
        sprintf(colorcmd,"lc %s",color);
    }
    sprintf(plotcmd,"u %s %s t '%s' lt -1 pt 1 %s",ucmd,errcmd,title,\
            colorcmd);
    plot_add_plot(p,plotcmd,tmpfname);
}
Esempio n. 29
0
void fprint_table(FILE* stream, rs_sample *s_x[N_EX_VAR], rs_sample *s_q[2],\
                  const mat *res, const fit_param *param, const plot_flag f)
{
    mat **x_err,*q_err;
    const rs_sample *s_q_pt;
    size_t nens,ydim;
    size_t ens_ind;
    
    nens     = param->nens;
    ydim     = (f == SCALE) ? 0   : 1;
    s_q_pt   = s_q[ydim];
    
    x_err = mat_ar_create(N_EX_VAR,nens,1);
    q_err = mat_create(nens,1);
    
    /* computing errors */
    rs_sample_varp(x_err[i_ud],s_x[i_ud]);
    mat_eqsqrt(x_err[i_ud]);
    rs_sample_varp(x_err[i_s],s_x[i_s]);
    mat_eqsqrt(x_err[i_s]);
    rs_sample_varp(x_err[i_a],s_x[i_a]);
    mat_eqsqrt(x_err[i_a]);
    rs_sample_varp(x_err[i_umd],s_x[i_umd]);
    mat_eqsqrt(x_err[i_umd]);
    rs_sample_varp(x_err[i_Linv],s_x[i_Linv]);
    mat_eqsqrt(x_err[i_Linv]);
    rs_sample_varp(q_err,s_q_pt);
    mat_eqsqrt(q_err);
    
    /* display */
    fprintf(stream,"#%49s  ","ensemble");
    PRINT_DLABEL_WERR(param->ud_name);
    PRINT_DLABEL_WERR(param->s_name);
    if (f == Q)
    {
        PRINT_DLABEL_WERR("a");
    }
    if (param->have_umd)
    {
        PRINT_DLABEL_WERR(param->umd_name);
    }
    if (param->have_alpha)
    {
        PRINT_DLABEL("alpha");
    }
    PRINT_DLABEL_WERR("1/L");
    if (f == Q)
    {
        PRINT_DLABEL_WERR(param->q_name);
    }
    else if (f == SCALE)
    {
        PRINT_DLABEL_WERR(param->scale_part);
    }
    PRINT_DLABEL("residuals");
    fprintf(stream,"\n");
    for(ens_ind=0;ens_ind<nens;ens_ind++)
    {
        fprintf(stream,"%50s  ",param->point[ens_ind].dir);
        PRINT_X_WERR(i_ud);
        PRINT_X_WERR(i_s);
        if (f == Q)
        {
            PRINT_X_WERR(i_a);
        }
        if (param->have_umd)
        {
            PRINT_X_WERR(i_umd);
        }
        if (param->have_alpha)
        {
            PRINT_X(i_alpha);
        }
        PRINT_X_WERR(i_Linv);
        PRINT_CV_WERR(s_q_pt,q_err);
        PRINT_D(mat_get(res,ens_ind,0));
        fprintf(stream,"\n");
    }
    fprintf(stream,"\n");

    mat_ar_destroy(x_err,N_EX_VAR);
    mat_destroy(q_err);
}
Esempio n. 30
0
void plot_add_fit(plot *p, const fit_data *d, const size_t ky, const mat *x_ex,\
                  const size_t kx, const mat *par, const double xmin,          \
                  const double xmax, const size_t npt, const bool do_sub,      \
                  const unsigned int obj,  const strbuf dat_title,             \
                  const strbuf fit_title, const strbuf dat_color,              \
                  const strbuf fit_color)
{
    mat *x,*x_err,*y,*y_err,*cor_data;
    bool have_x_err;
    size_t nfitpt,ndata;
    size_t i,j;
    
    nfitpt        = fit_data_fit_point_num(d);
    ndata      = fit_data_get_ndata(d);
    j          = 0;
    have_x_err = fit_data_have_x_covar(d,kx);
    
    x          = mat_create(nfitpt,1);
    y          = mat_create(nfitpt,1);
    x_err      = mat_create(nfitpt,1);
    y_err      = mat_create(nfitpt,1);
    cor_data   = mat_create(ndata,1);

    if (par != NULL)
    {
        if (obj & PF_FIT)
        {
            plot_add_model(p,d->model->func[ky],x_ex,kx,par,d->model_param,\
                           xmin,xmax,npt,fit_title,fit_color);
        }
        if ((obj & PF_DATA)&&(do_sub))
        {
            fit_partresidual(cor_data,d,ky,x_ex,kx,par);
        }
        else
        {
            fit_data_get_y_k(cor_data,d,ky);
        }
    }
    else
    {
        fit_data_get_y_k(cor_data,d,ky);
    }
    if (obj & PF_DATA)
    {
        for (i=0;i<ndata;i++)
        {
            if (fit_data_is_fit_point(d,i))
            {
                mat_set(x,j,0,fit_data_get_x(d,i,kx));
                if (have_x_err)
                {
                    mat_set(x_err,j,0,                                       \
                            sqrt(mat_get(fit_data_pt_x_covar(d,kx,kx),i,i)));
                }
                mat_set(y,j,0,mat_get(cor_data,i,0));
                mat_set(y_err,j,0,                                       \
                        sqrt(mat_get(fit_data_pt_y_covar(d,ky,ky),i,i)));
                j++;
            }
        }
        if (have_x_err)
        {
            plot_add_dat(p,x,y,x_err,y_err,dat_title,dat_color);
        }
        else
        {
            plot_add_dat(p,x,y,NULL,y_err,dat_title,dat_color);
        }
    }
    
    mat_destroy(x);
    mat_destroy(x_err);
    mat_destroy(y);
    mat_destroy(y_err);
    mat_destroy(cor_data);
}