Matrix* unproject_rates(TreeModel *mod_tuples, TreeModel *mod_single) {
int dim = mod_tuples->rate_matrix->size;
int alph_size = (int)strlen(mod_tuples->rate_matrix->states);
char tuple_i[mod_tuples->order+1], tuple_j[mod_tuples->order+1];
int position, i, j;
Matrix *retval = mat_new(dim, dim);
mat_zero(retval);
for (i = 0; i < dim; i++) {
get_tuple_str(tuple_i, i, mod_tuples->order+1,
mod_tuples->rate_matrix->states);
for (j = 0; j < dim; j++) {
if (i == j || mm_get(mod_tuples->rate_matrix, i, j) == 0) continue;
/* WARNING: we'll ignore any rate matrix elements that have
*actually been estimated* to be zero */
get_tuple_str(tuple_j, j, mod_tuples->order+1,
mod_tuples->rate_matrix->states);
position = mod_tuples->order - (int)(floor(log(abs(i - j))/log(alph_size)));
mat_set(retval, i, j,
mm_get(mod_single->rate_matrix,
mod_single->rate_matrix->inv_states[(int)tuple_i[position]],
mod_single->rate_matrix->inv_states[(int)tuple_j[position]]));
}
}
return retval;
}
double bench(MatMul f, const F *A, const F *B, F *C, F *C_ref, size_t n, Cache *cache) {
double dt, time;
mat_zero(C, n);
time = common_get_nanos();
f(A, B, C, n, cache);
dt = common_get_nanos() - time;
if (C_ref != NULL)
mat_assert_eq(C, C_ref, n);
printf("%.3e ", dt);
fflush(stdout);
return dt;
}
t_mat *mat_translation(t_mat *dest, t_pt3f direction)
{
if (dest == NULL)
dest = mat_new(4, 4);
mat_zero(dest);
mat_set(dest, 0, 0, 1);
mat_set(dest, 1, 1, 1);
mat_set(dest, 2, 2, 1);
mat_set(dest, 3, 3, 1);
mat_set(dest, 3, 0, direction.x);
mat_set(dest, 3, 1, direction.y);
mat_set(dest, 3, 2, direction.z);
return (dest);
}
/* set c to the unit matrix */
void mat_one(void *_c, int cr, int cc)
{
double *c = (double *)_c;
int i;
assert(cr == cc);
mat_zero(c, cr, cc);
#define C(i,j) c[i*cc+j]
for (i = 0; i < cr; i++)
C(i,i) = 1.;
#undef C
}
/* Compute the first and (optionally) second derivatives with respect
to the scale parameters for the single-feature log likelihood
function (feat_compute_log_likelihood). This version assumes scale
parameters for the whole tree and for the subtree. Return value is
log likelihood, which is computed as a by-product. Derivs will be
stored in *gradient and *hessian. If hessian == NULL,
it will not be computed (saves some time). */
double ff_scale_derivs_subtree(FeatFitData *d, Vector *gradient,
Matrix *hessian, double ***scratch) {
double retval = 0;
Vector *d1 = vec_new(2);
Matrix *d2 = (hessian == NULL ? NULL : mat_new(2, 2));
int i;
vec_zero(gradient);
if (hessian != NULL) mat_zero(hessian);
for (i = d->feat->start-1; i < d->feat->end; i++) { /* offset of one */
d->cdata->tupleidx = d->cdata->msa->ss->tuple_idx[i];
retval += col_scale_derivs_subtree(d->cdata, d1, d2, scratch);
vec_plus_eq(gradient, d1);
if (hessian != NULL) mat_plus_eq(hessian, d2);
}
return retval;
}
/* Read an amino acid rate matrix in the format used by PAML. Reorder
the rows and columns to match 'alph'. Warning: the ordering in the
file is assumed to match that used in the files in the PAML
distribution (alphabetical order of 3-letter codes), which is also
the order of AA_ALPHABET (therefore AA_ALPHABET may not be
changed!). Equilibrium frequencies are ignored. */
Matrix *read_paml_matrix(FILE *F, char *alph) {
char *paml_alph = "ARNDCQEGHILKMFPSTWYV$";
int size = (int)strlen(paml_alph);
Matrix *retval = mat_new(size, size);
List *fields = lst_new_ptr(100);
String *line = str_new(STR_MED_LEN);
int i, j;
if (strcmp(alph, paml_alph) != 0)
die("ERROR read_paml_matrix (alph (%s) != paml_alph (%s))\n",
alph, paml_alph);
mat_zero(retval);
for (i = 1; i < size-1 && str_readline(line, F) != EOF; ) {
/* NOTE: size of matrix allows for stop, but stop not included in
file; therefore, only read size-1 lines */
str_double_trim(line);
if (line->length == 0) continue;
str_split(line, NULL, fields);
if (lst_size(fields) != i) {
die("ERROR: row %d of matrix must have %d columns.\n",
i+1, i);
}
for (j = 0; j < lst_size(fields); j++) {
double val;
if (str_as_dbl(lst_get_ptr(fields, j), &val) != 0) {
die("ERROR: non-numeric matrix element in subst. matrix ('%s')\n",
((String*)lst_get_ptr(fields, j+1))->chars);
}
str_free(lst_get_ptr(fields, j));
if (j >= size)
die("ERROR read_paml_matrix j (%i) should be < size (%i)\n", j, size);
mat_set(retval, i, j, val);
mat_set(retval, j, i, val);
}
i++;
}
if (i != size - 1) {
die("ERROR: too few rows in subst. matrix.\n");
}
lst_free(fields);
str_free(line);
return retval;
}
/* multiply two complex matrices whose product is expected to be real */
void zmat_mult_real(Matrix *prod, Zmatrix *m1, Zmatrix *m2) {
int i, j, k;
if (!(m1->ncols == m2->nrows && m1->nrows == m2->ncols &&
prod->nrows == m1->nrows && prod->ncols == m2->ncols))
die("ERROR zmat_mult_real: bad dimensions\n");
mat_zero(prod);
for (i = 0; i < prod->nrows; i++) {
for (j = 0; j < prod->ncols; j++) {
Complex z = z_set(0, 0);
for (k = 0; k < m1->ncols; k++)
z = z_add(z, z_mul(m1->data[i][k], m2->data[k][j]));
if (z.y > 1e-6)
die("ERROR in zmat_mult_real: product of complex matrices not real.\n");
mat_set(prod, i, j, z.x);
}
}
}
int
main(void)
{
int i, result;
flint_rand_t state;
printf("zero... ");
fflush(stdout);
_randinit(state);
/* Unmanaged element type (long) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A;
m = n_randint(state, 100) + 1;
n = n_randint(state, 100) + 1;
ctx_init_long(ctx);
mat_init(A, m, n, ctx);
mat_randtest(A, state, ctx);
mat_zero(A, ctx);
result = mat_is_zero(A, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
abort();
}
mat_clear(A, ctx);
ctx_clear(ctx);
}
/* Managed element type (mpq_t) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A;
m = n_randint(state, 100) + 1;
n = n_randint(state, 100) + 1;
ctx_init_mpq(ctx);
mat_init(A, m, n, ctx);
mat_randtest(A, state, ctx);
mat_zero(A, ctx);
result = mat_is_zero(A, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
abort();
}
mat_clear(A, ctx);
ctx_clear(ctx);
}
_randclear(state);
_fmpz_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
int main(int argc, char* argv[]) {
FILE* F;
MSA *msa;
int *msa_gap_patterns = NULL;
HMM *hmm = NULL;
TreeNode *tree = NULL;
int i, input_format = SS, msa_idx, quiet_mode = FALSE,
ncats, nmsas, ncats_unspooled, indel_nseqs = -1;
String *msa_fname, *gff_fname;
List *gff_fname_list = NULL, *msa_fname_list = NULL,
*msa_length_list = NULL, *model_indels_str = NULL;
Matrix *traincounts = NULL;
Vector *begcounts = NULL, *statecounts = NULL;
CategoryMap *cm = NULL;
char c;
GapPatternMap *gpm = NULL;
GFF_Set *gff;
char *reverse_groups_tag = NULL;
while ((c = getopt(argc, argv, "i:g:c:m:M:R:I:n:t:P:G:qh")) != -1) {
switch(c) {
case 'i':
input_format = msa_str_to_format(optarg);
if (input_format == -1)
die("ERROR: bad alignment format.\n");
break;
case 'g':
gff_fname_list = get_arg_list(optarg);
break;
case 'c':
cm = cm_new_string_or_file(optarg);
break;
case 'm':
msa_fname_list = get_arg_list(optarg);
break;
case 'M':
msa_length_list = str_list_as_int(get_arg_list(optarg));
break;
case 'R':
reverse_groups_tag = optarg;
break;
case 'I':
model_indels_str = get_arg_list(optarg);
break;
case 'n':
indel_nseqs = get_arg_int(optarg);
break;
case 't':
if (optarg[0] == '(') /* in this case, assume topology given
at command line */
tree = tr_new_from_string(optarg);
else
tree = tr_new_from_file(phast_fopen(optarg, "r"));
break;
case 'q':
quiet_mode = TRUE;
break;
case 'h':
print_usage();
exit(0);
case '?':
die("ERROR: unrecognized option.\n\nType 'hmm_train -h' for usage.\n");
}
}
if (msa_fname_list == NULL)
die("ERROR: -m required. Type 'hmm_train -h' for usage.\n");
if (gff_fname_list == NULL)
die("ERROR: -g required in training mode. Type 'hmm_train -h' for usage.\n");
if (msa_length_list != NULL && msa_fname_list != NULL)
die("ERROR: -m and -M are mutually exclusive. Type 'hmm_train -h' for usage.\n");
if (model_indels_str != NULL && tree == NULL)
die("ERROR: -I requires -t. Type 'hmm_train -h' for usage.\n");
if (cm == NULL)
die("ERROR: category map required.\n");
set_seed(-1);
ncats = cm->ncats + 1;
ncats_unspooled = cm->unspooler != NULL ? cm->unspooler->nstates_unspooled :
ncats;
nmsas = (msa_length_list != NULL ? lst_size(msa_length_list) :
lst_size(msa_fname_list));
if (model_indels_str != NULL) {
if (tree == NULL)
die("ERROR: tree is NULL\n"); /*FIXME: indel_ncats broken */
gpm = gp_create_gapcats(cm, model_indels_str, tree, FALSE);
ncats = cm->ncats + 1; /* numbers will change */
ncats_unspooled = cm->unspooler == NULL ? ncats :
cm->unspooler->nstates_unspooled;
}
/* allocate memory for storage of "training paths" */
traincounts = mat_new(ncats_unspooled, ncats_unspooled);
statecounts = vec_new(ncats_unspooled);
begcounts = vec_new(ncats_unspooled);
mat_zero(traincounts);
vec_zero(statecounts);
vec_zero(begcounts);
/* create skeleton of new HMM. */
hmm = hmm_new_nstates(ncats_unspooled, 0, 0);
/* Main loop: consider each MSA in turn */
for (msa_idx = 0; msa_idx < nmsas; msa_idx++) {
if (msa_fname_list != NULL) {
msa_fname = (String*)lst_get_ptr(msa_fname_list, msa_idx);
F = phast_fopen(msa_fname->chars, "r");
if (!quiet_mode)
fprintf(stderr, "Reading alignment from %s ...\n",
F == stdin ? "stdin" : msa_fname->chars);
msa = msa_new_from_file(F, NULL);
phast_fclose(F);
}
else { /* only lengths of alignments specified */
msa = msa_new(NULL, NULL, 0, lst_get_int(msa_length_list, msa_idx), NULL);
/* just a shell in this case */
}
gff_fname = (String*)lst_get_ptr(gff_fname_list, msa_idx);
if (!quiet_mode)
fprintf(stderr, "Reading annotations from %s ...\n", gff_fname->chars);
gff = gff_read_set(phast_fopen(gff_fname->chars, "r"));
/* convert GFF to coordinate frame of alignment */
if (msa_length_list == NULL) {
if (!quiet_mode)
fprintf(stderr, "Mapping annotations to alignment ...\n");
msa_map_gff_coords(msa, gff, 1, 0, 0); /* assume seq 1 is ref */
}
if (model_indels_str != NULL) {
if (!quiet_mode)
fprintf(stderr, "Obtaining gap patterns ...\n");
msa_gap_patterns = smalloc(msa->length * sizeof(int));
gp_set_phylo_patterns(gpm, msa_gap_patterns, msa);
}
/* at this point, we don't actually need the alignment anymore;
if using ordered suff stats (likely with large data sets),
can free them now, to avoid running out of memory */
if (msa->ss != NULL) {
ss_free(msa->ss);
msa->ss = NULL;
}
if (reverse_groups_tag != NULL) {
if (!quiet_mode)
fprintf(stderr, "Reverse complementing features on negative strand (group by '%s') ...\n",
reverse_groups_tag);
/* we don't need to reverse complement the whole alignment --
just the gff and possibly the gap pattern array (pass a
NULL msa) */
gff_group(gff, reverse_groups_tag);
msa_reverse_compl_feats(NULL, gff, msa_gap_patterns);
}
if (!quiet_mode)
fprintf(stderr, "Labeling sites by category ...\n");
msa_label_categories(msa, gff, cm);
gff_free_set(gff);
if (model_indels_str != NULL) {
if (!quiet_mode)
fprintf(stderr, "Remapping categories according to gap patterns ...\n");
if (indel_nseqs > 0 && indel_nseqs != msa->nseqs) {
/* in this case, we'll simply reassign non-trivial gap
patterns randomly. This will achieve the desired
effect with minimal coding, as long as the number of
sites is not too small (the indel model is probably
useless anyway if the number is small) */
int pat, newpat;
int npatterns = 4 * indel_nseqs - 5;
int complex_allowed[cm->ncats+1];
List *no_complex_names, *no_complex_nums;
if (!quiet_mode)
fprintf(stderr, "(target number of sequences: %d)\n", indel_nseqs);
/* set up index indicating by cat no. whether complex gaps
are allowed */
for (i = 0; i < ncats; i++) complex_allowed[i] = 1;
no_complex_names = lst_new_ptr(10);
str_split(str_new_charstr(NO_COMPLEX), ",", no_complex_names);
no_complex_nums = cm_get_category_list(cm, no_complex_names, 1);
for (i = 0; i < lst_size(no_complex_nums); i++)
complex_allowed[lst_get_int(no_complex_nums, i)] = 0;
lst_free(no_complex_nums);
lst_free_strings(no_complex_names);
lst_free(no_complex_names);
/* now reassign all non-null numbers */
for (i = 0; i < msa->length; ) {
if ((pat = msa_gap_patterns[i]) != 0) {
if (complex_allowed[msa->categories[i]])
newpat = 1 + ((double)npatterns * unif_rand());
/* random number in interval [1, npatterns] */
else
newpat = 1 + ((double)(npatterns-1) * unif_rand());
/* random number in interval [1,npatterns-1]
(excludes complex gap pattern) */
for (; i < msa->length && msa_gap_patterns[i] == pat; i++)
msa_gap_patterns[i] = newpat; /* change for whole sequence */
}
else i++;
}
}
/* obtain gapped category number for each site */
for (i = 0; i < msa->length; i++)
if (gpm->cat_x_pattern_to_gapcat[msa->categories[i]] != NULL)
msa->categories[i] = gpm->cat_x_pattern_to_gapcat[msa->categories[i]][msa_gap_patterns[i]];
}
if (!quiet_mode)
fprintf(stderr, "Unspooling categories ...\n");
cm_spooled_to_unspooled(cm, msa->categories, msa->length);
if (!quiet_mode)
fprintf(stderr, "Collecting training data ...\n");
hmm_train_update_counts(traincounts, statecounts, begcounts,
msa->categories, msa->length,
ncats_unspooled);
if (msa_gap_patterns != NULL) sfree(msa_gap_patterns);
msa_free(msa);
}
/* now train HMM, using cumulative data */
hmm_train_from_counts(hmm, traincounts, NULL, statecounts, NULL,
begcounts, NULL);
/* if modeling indels, adjust begin transitions so probability is
distributed among different "gap pattern" states that all
correspond to the same ungapped state (category); this helps
avoid problems that occur when training on a few large sequences
(e.g., whole chromosomes) and then testing on many shorter ones */
if (model_indels_str != NULL) {
double tprob[gpm->ncats];
int nst[gpm->ncats]; /* total prob and number of states per
spooled, ungapped category */
for (i = 0; i < gpm->ncats; i++) tprob[i] = nst[i] = 0;
for (i = 0; i < hmm->nstates; i++) {
if (vec_get(hmm->begin_transitions, i) > 0)
/* have to go from unspooled space to spooled space, then to
ungapped space (HMM states correspond to unspooled,
gapped categories). Note that states with nonzero begin
probs shouldn't be conditioned on other states. */
tprob[gpm->gapcat_to_cat[cm_unspooled_to_spooled_cat(cm, i)]] +=
vec_get(hmm->begin_transitions, i);
nst[gpm->gapcat_to_cat[cm_unspooled_to_spooled_cat(cm, i)]]++;
}
for (i = 0; i < hmm->nstates; i++)
if (tprob[gpm->gapcat_to_cat[cm_unspooled_to_spooled_cat(cm, i)]] > 0)
vec_set(hmm->begin_transitions, i,
tprob[gpm->gapcat_to_cat[cm_unspooled_to_spooled_cat(cm, i)]] /
nst[gpm->gapcat_to_cat[cm_unspooled_to_spooled_cat(cm, i)]]);
/* (uniform prior) */
}
/* write trained HMM */
hmm_print(stdout, hmm);
if (!quiet_mode) fprintf(stderr, "Done.\n");
return 0;
}
int
main(void)
{
int i, result;
flint_rand_t state;
printf("add... ");
fflush(stdout);
_randinit(state);
/* Check that addition is abelian */
/* Unmanaged element type (long) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A, B, C, D;
m = n_randint(state, 50) + 1;
n = n_randint(state, 50) + 1;
ctx_init_long(ctx);
mat_init(A, m, n, ctx);
mat_init(B, m, n, ctx);
mat_init(C, m, n, ctx);
mat_init(D, m, n, ctx);
mat_randtest(A, state, ctx);
mat_randtest(B, state, ctx);
mat_add(C, A, B, ctx);
mat_add(D, B, A, ctx);
result = mat_equal(C, D, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
printf("Matrix A\n");
mat_print(B, ctx);
printf("\n");
}
mat_clear(A, ctx);
mat_clear(B, ctx);
mat_clear(C, ctx);
mat_clear(D, ctx);
ctx_clear(ctx);
}
/* Managed element type (mpq_t) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A, B, C, D;
m = n_randint(state, 50) + 1;
n = n_randint(state, 50) + 1;
ctx_init_mpq(ctx);
mat_init(A, m, n, ctx);
mat_init(B, m, n, ctx);
mat_init(C, m, n, ctx);
mat_init(D, m, n, ctx);
mat_randtest(A, state, ctx);
mat_randtest(B, state, ctx);
mat_add(C, A, B, ctx);
mat_add(D, B, A, ctx);
result = mat_equal(C, D, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
printf("Matrix A\n");
mat_print(B, ctx);
printf("\n");
}
mat_clear(A, ctx);
mat_clear(B, ctx);
mat_clear(C, ctx);
mat_clear(D, ctx);
ctx_clear(ctx);
}
/* Check that the zero matrix does what it's supposed to do */
/* Unmanaged element type (long) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A, B, C, D;
m = n_randint(state, 50) + 1;
n = n_randint(state, 50) + 1;
ctx_init_long(ctx);
mat_init(A, m, n, ctx);
mat_init(B, m, n, ctx);
mat_init(C, m, n, ctx);
mat_init(D, m, n, ctx);
mat_randtest(A, state, ctx);
mat_zero(B, ctx);
mat_add(C, A, B, ctx);
mat_add(D, B, A, ctx);
result = mat_equal(A, C, ctx) && mat_equal(C, D, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
printf("Matrix A\n");
mat_print(B, ctx);
printf("\n");
}
mat_clear(A, ctx);
mat_clear(B, ctx);
mat_clear(C, ctx);
mat_clear(D, ctx);
ctx_clear(ctx);
}
/* Managed element type (mpq_t) */
for (i = 0; i < 100; i++)
{
long m, n;
ctx_t ctx;
mat_t A, B, C, D;
m = n_randint(state, 50) + 1;
n = n_randint(state, 50) + 1;
ctx_init_mpq(ctx);
mat_init(A, m, n, ctx);
mat_init(B, m, n, ctx);
mat_init(C, m, n, ctx);
mat_init(D, m, n, ctx);
mat_randtest(A, state, ctx);
mat_zero(B, ctx);
mat_add(C, A, B, ctx);
mat_add(D, B, A, ctx);
result = mat_equal(A, C, ctx) && mat_equal(C, D, ctx);
if (!result)
{
printf("FAIL:\n\n");
printf("Matrix A\n");
mat_print(A, ctx);
printf("\n");
printf("Matrix A\n");
mat_print(B, ctx);
printf("\n");
}
mat_clear(A, ctx);
mat_clear(B, ctx);
mat_clear(C, ctx);
mat_clear(D, ctx);
ctx_clear(ctx);
}
_randclear(state);
_fmpz_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
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]);
}
}
int main(int argc, char **argv) {
srand(time(NULL));
Cache cache;
double max_runtime;
/* Overly slow ones commented out by default. */
MatMul mat_mul_funcs[] = {
/*mat_mul_cpu,*/
mat_mul_cpu_trans,
mat_mul_cpu_trans_vec,
mat_mul_cpu_block,
mat_mul_cpu_cblas,
/*mat_mul_cl,*/
mat_mul_cl_row_priv,
mat_mul_cl_row_local,
mat_mul_cl_row_priv_col_local,
mat_mul_cl_row_priv_cols_local,
/* TODO broken for larger matrics, some cells contain trash.
* Likey some memory overflow problem. */
/*mat_mul_cl_block,*/
mat_mul_cl_clblas,
};
int first, func_done[NELEMS(mat_mul_funcs)] = {0};
size_t f, i;
size_t mat_sizeof;
/* CLI args. */
if (argc > 1) {
max_runtime = strtod(argv[1], NULL);
} else {
max_runtime = 1.0;
}
common_init(&(cache.common), NULL);
/* Unit test 2x2. */
{
const F A[] = {
1.0, 2.0,
3.0, 4.0
};
const F B[] = {
5.0, 6.0,
7.0, 8.0
};
enum N { n = 2 };
F C[n*n];
const F C_ref[] = {
19.0, 22.0,
43.0, 50.0
};
cl_buf_init(&cache, n * n * sizeof(F));
for (f = 0; f < sizeof(mat_mul_funcs)/sizeof(mat_mul_funcs[0]); ++f) {
mat_zero(C, n);
mat_mul_funcs[f](A, B, C, n, &cache);
mat_assert_eq(C, C_ref, n);
}
cl_buf_deinit(&cache);
}
/* Unit test 4x4. */
{
const F A[] = {
1.0, 2.0, 3.0, 4.0,
5.0, 6.0, 7.0, 8.0,
9.0, 10.0, 11.0, 12.0,
13.0, 14.0, 15.0, 16.0,
};
const F B[] = {
17.0, 18.0, 19.0, 20.0,
21.0, 22.0, 23.0, 24.0,
25.0, 26.0, 27.0, 28.0,
29.0, 30.0, 31.0, 32.0,
};
const F C_ref[] = {
250.0, 260.0, 270.0, 280.0,
618.0, 644.0, 670.0, 696.0,
986.0, 1028.0, 1070.0, 1112.0,
1354.0, 1412.0, 1470.0, 1528.0,
};
enum N { n = 4 };
F C[n*n];
cl_buf_init(&cache, n * n * sizeof(F));
for (f = 0; f < NELEMS(mat_mul_funcs); ++f) {
mat_zero(C, n);
mat_mul_funcs[f](A, B, C, n, &cache);
mat_assert_eq(C, C_ref, n);
}
cl_buf_deinit(&cache);
}
/* Benchmarks. */
{
double dt;
F *A = NULL, *B = NULL, *C = NULL, *C_ref = NULL, *dst = NULL, *ref = NULL;
int done;
size_t n = 2;
puts("#matmul");
done = 0;
while(1) {
printf("%zu ", (size_t)log2(n));
mat_sizeof = n * n * sizeof(F);
/* CPU setup. */
A = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
B = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
C = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
C_ref = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
if (NULL == A || NULL == B || NULL == C) {
printf("error: could not allocate memory for n = %zu", n);
break;
}
mat_rand(A, n);
mat_rand(B, n);
cl_buf_init(&cache, mat_sizeof);
first = 1;
for (f = 0; f < NELEMS(mat_mul_funcs); ++f) {
if (func_done[f]) {
printf("%*s", 10, "");
} else {
if (first) {
dst = C_ref;
ref = NULL;
first = 0;
} else {
dst = C;
ref = C_ref;
}
dt = bench(mat_mul_funcs[f], A, B, dst, ref, n, &cache);
if (dt > max_runtime)
func_done[f] = 1;
}
}
puts("");
done = 1;
for (i = 0; i < NELEMS(mat_mul_funcs); ++i) {
if (!func_done[i]) {
done = 0;
break;
}
}
if (done)
break;
n *= 2;
/* CPU deinit. */
free(A);
free(B);
free(C);
free(C_ref);
cl_buf_deinit(&cache);
}
common_deinit(&cache.common);
}
return EXIT_SUCCESS;
}