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);
}
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;
}
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);
}
}
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);
}
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);
}
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;
}
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;
}
}
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);
}
}
}
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));
}
}
}
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);
}
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);
}
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;
}
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;
}
}
}
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;
}
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;
}
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);
}
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;
}
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;
}
}
}
/* 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;
}
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]);
}
}
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;
}
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;
}
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);
}
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);
}
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);
}
