/* SHUFFLING */
CAMLprim value ml_gsl_ran_shuffle(value rng, value arr)
{
if(Tag_val(arr) == Double_array_tag)
gsl_ran_shuffle(Rng_val(rng), Double_array_val(arr),
Double_array_length(arr), sizeof(double));
else
gsl_ran_shuffle(Rng_val(rng), (value *)arr,
Array_length(arr), sizeof(value));
return Val_unit;
}
// Chooses representatives at random from x and stores them in r.
void pickReps(matrix x, matrix *r){
unint n = x.r;
unint i, j;
unint *shuf = (unint*)calloc(n, sizeof(*shuf));
for(i=0; i<n; i++)
shuf[i]=i;
//generate a random permutation of 1..n
struct timeval tv;
gettimeofday(&tv,NULL);
gsl_rng * rng;
const gsl_rng_type *rngT;
gsl_rng_env_setup();
rngT = gsl_rng_default;
rng = gsl_rng_alloc(rngT);
gsl_rng_set(rng,tv.tv_usec);
gsl_ran_shuffle(rng, shuf, n, sizeof(*shuf));
gsl_rng_free(rng);
for(i=0; i<r->r; i++){
for(j=0; j<r->c; j++){
r->mat[IDX( i, j, r->ld )] = x.mat[IDX( shuf[i], j, x.ld )];
}
}
free(shuf);
}
/*
* Generates a random directed weighted graph with the same number of nodes,
* number of edges, and weight distribution as the given graph. No edges are
* placed on the main diagonal. The given matrix should therefore not contain
* nonzero entries on the main diagonal.
*/
MATRIX_T* BCT_NAMESPACE::makerandCIJ_wd_wp(const MATRIX_T* m) {
if (safe_mode) check_status(m, SQUARE | NO_LOOPS, "makerandCIJ_wd_wp");
int N = m->size1;
int K = N * (N - 1);
FP_T* w = new FP_T[K];
for (int i = 0, k = 0; i < (int)m->size1; i++) {
for (int j = 0; j < (int)m->size2; j++) {
if (i != j) {
w[k++] = MATRIX_ID(get)(m, i, j);
}
}
}
gsl_rng* rng = get_rng();
gsl_ran_shuffle(rng, w, K, sizeof(FP_T));
MATRIX_T* rand_m = MATRIX_ID(alloc)(m->size1, m->size2);
for (int i = 0, k = 0; i < (int)m->size1; i++) {
for (int j = 0; j < (int)m->size2; j++) {
if (i == j) {
MATRIX_ID(set)(rand_m, i, j, 0.0);
} else {
MATRIX_ID(set)(rand_m, i, j, w[k++]);
}
}
}
delete[] w;
return rand_m;
}
void test_shuffle(void){
int original[SIZE] = {1,2,3,4};
int to_be_shuffled[SIZE] = {1,2,3,4};
int draws[5];
gsl_ran_sample(rng, draws, 5, original, SIZE, sizeof(int));
printf("gsl_ran_sample\t[%d,%d,%d,%d]\t%d\t[%d,%d,%d,%d,%d]\n",
original[0], original[1], original[2], original[3],
5,
draws[0], draws[1], draws[2], draws[3], draws[4]
);
gsl_ran_choose(rng, draws, 3, original, SIZE, sizeof(int));
printf("gsl_ran_choose\t[%d,%d,%d,%d]\t%d\t[%d,%d,%d]\n",
original[0], original[1], original[2], original[3],
3,
draws[0], draws[1], draws[2]
);
gsl_ran_shuffle(rng, to_be_shuffled, SIZE, sizeof(int));
printf("gsl_ran_shuffle\t[%d,%d,%d,%d]\t[%d,%d,%d,%d]\n",
original[0], original[1], original[2], original[3],
to_be_shuffled[0], to_be_shuffled[1], to_be_shuffled[2], to_be_shuffled[3]
);
}
/**
* IN FULL UPDATE CASE:
*
* return the empirical covariance matrix or the initial one
* (depending on the iteration value and options) and the evaluated
* tuning factor sd_fac
*
*
* IN SEQUENTIAL UPDATE CASE:
*
* Generate a random value for a component "k" of proposed chosen
* randomly. Every number of parameters with jump_size > 0.0
* (n_to_be_estimated) we randomly shuffle the index of the n_to_be
* estimated parameter index. In between these shuffling event, we
* cycle throufh the shuffled indexes. Traces are printed every
* n_to_be_estimated iterations. This should mimate block update of
* the n_to_be_estimated component of theta while increasing the
* acceptance ratio
*
* return the initial covariance matrix
*/
gsl_matrix * get_var_and_sd_fac(double *sd_fac, struct s_best *p_best, struct s_mcmc_calc_data *p, struct s_calc *p_calc, int m)
{
if (OPTION_FULL_UPDATE) {
//////////////////////
// FULL UPDATE CASE //
//////////////////////
// evaluate epsilon(m) = epsilon(m-1) * exp(a^(m-1) * (acceptance_rate(m-1) - 0.234))
if ( (m > p->m_epsilon) && (m*p->global_acceptance_rate < p->m_switch) ) {
double ar = (p->is_smoothed_tunning) ? p->smoothed_global_acceptance_rate : p->global_acceptance_rate;
p->epsilon *= exp(pow(p->a, (double)(m-1)) * (ar - 0.234));
} else {
// after switching epsilon is set back to 1
p->epsilon = 1.0;
}
p->epsilon = GSL_MIN(p->epsilon, p->epsilon_max);
#if FLAG_VERBOSE
char str[STR_BUFFSIZE];
snprintf(str, STR_BUFFSIZE, "epsilon = %g", p->epsilon);
print_log(str);
#endif
// evaluate tuning factor sd_fac = epsilon * 2.38/sqrt(n_to_be_estimated)
*sd_fac = p->epsilon * 2.38/sqrt(p_best->n_to_be_estimated);
if( (m * p->global_acceptance_rate) >= p->m_switch) {
return p_best->var_sampling;
} else {
return p_best->var;
}
} else {
////////////////////////////
// SEQUENTIAL UPDATE CASE //
////////////////////////////
*sd_fac = 1.0;
if(p_best->n_to_be_estimated > 0) { //due to the webApp all jump size can be 0.0...
if(p->has_cycled) {
gsl_ran_shuffle(p_calc->randgsl, p_best->to_be_estimated, p_best->n_to_be_estimated, sizeof (unsigned int));
}
}
return p_best->var;
}
}
/* Random 1-1 relationship between meanings and signals; NB won't work if meanings>signals */
void rook_associations(grammar_t g, gsl_rng* rng) {
if(!g) return;
assert(signals>=meanings);
// Get a random permutation of the integers
int sigs[signals];
for(signal_t s=0; s<signals; s++) {
sigs[s] = s;
}
gsl_ran_shuffle(rng, sigs, signals, sizeof(*sigs));
// Now take sig[m] to be the signal for meaning m
for(meaning_t m=0; m<meanings; m++) {
for(signal_t s=0; s<signals; s++) {
g->msraw[m*signals+s] = s == sigs[m] ? 1.0-EPSILON : 0.0+EPSILON/(double)(signals-1);
}
}
}
void
test_shuffle (void)
{
double count[10][10] ;
int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
int i, j, status = 0;
for (i = 0; i < 10; i++)
{
for (j = 0; j < 10; j++)
{
count[i][j] = 0 ;
}
}
for (i = 0 ; i < N; i++)
{
for (j = 0; j < 10; j++)
x[j] = j ;
gsl_ran_shuffle (r_global, x, 10, sizeof(int)) ;
for (j = 0; j < 10; j++)
count[x[j]][j] ++ ;
}
for (i = 0; i < 10; i++)
{
for (j = 0; j < 10; j++)
{
double expected = N / 10.0 ;
double d = fabs(count[i][j] - expected);
double sigma = d / sqrt(expected) ;
if (sigma > 5 && d > 1)
{
status = 1 ;
gsl_test (status,
"gsl_ran_shuffle %d,%d (%g observed vs %g expected)",
i, j, count[i][j]/N, 0.1) ;
}
}
}
gsl_test (status, "gsl_ran_shuffle on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;
}
static void host_infection_process_for_field(Host *host_to_infect, Field *field,
unsigned short time) {
Host *neigh, *other_host_in_range;
Host *neigh_array[field->nof_infected];
// put hosts into array
List_element *el = list_first(field->infected);
int j = 0;
while (el) {
neigh_array[j] = list_element_get_value(el);
el = list_element_next(el);
++j;
}
// shuffle hosts randomly
if (field->nof_infected > 1) {
gsl_ran_shuffle(rng, neigh_array, field->nof_infected, sizeof(Host *));
}
for (unsigned i = 0; i < field->nof_infected; ++i) {
neigh = neigh_array[i];
// list contains only infected and ill host neighbours
// => are infectious if ill or agent is infectious during incubation
if ((neigh->agent.infectious_incubation && neigh->state == INFECTED &&
time > neigh->infection_time) ||
(neigh->state == ILL && ((!neigh->agent.infectious_incubation &&
time > neigh->outbreak_time) ||
(neigh->agent.infectious_incubation &&
time > neigh->infection_time))) ||
neigh->state == DEAD) {
unsigned dist;
other_host_in_range = neigh;
dist = sq_euclidean(host_to_infect->pos.x, host_to_infect->pos.y,
other_host_in_range->pos.x,
other_host_in_range->pos.y);
if (dist < world.radius_air_sq &&
other_host_in_range->state != DEAD) {
if (rnd_percent(rng) <
other_host_in_range->agent.infection_prob.air) {
host_infect(host_to_infect, other_host_in_range->agent,
time);
if (host_to_infect->state == INFECTED) {
break;
}
}
}
if (dist < world.radius_oral_sq &&
other_host_in_range->state != DEAD) {
if (rnd_percent(rng) <
other_host_in_range->agent.infection_prob.oral) {
host_infect(host_to_infect, other_host_in_range->agent,
time);
if (host_to_infect->state == INFECTED) {
break;
}
}
}
if (dist < world.radius_skin_sq) {
if (rnd_percent(rng) <
other_host_in_range->agent.infection_prob.skin) {
host_infect(host_to_infect, other_host_in_range->agent,
time);
if (host_to_infect->state == INFECTED) {
break;
}
}
}
if (dist < world.radius_xxx_sq &&
other_host_in_range->state != DEAD) {
if (rnd_percent(rng) <
other_host_in_range->agent.infection_prob.xxx) {
host_infect(host_to_infect, other_host_in_range->agent,
time);
if (host_to_infect->state == INFECTED) {
break;
}
}
}
}
}
}
void rshuffle(void* base, size_t n, size_t size) {
gsl_ran_shuffle(RANDOM_NUMBER, base, n, size);
}
int w_update(
gsl_matrix *weights,
gsl_matrix *x_white,
gsl_matrix *bias,
gsl_matrix *shuffled_x_white, //work space for shuffled x_white
gsl_permutation *p, // random permutation
gsl_rng *r, // random stream from gsl
double lrate){
int error = 0;
size_t i;
const size_t NVOX = x_white->size2;
const size_t NCOMP = x_white->size1;
size_t block = (size_t)floor(sqrt(NVOX/3.0));
gsl_matrix *ib = gsl_matrix_alloc(1,block);
gsl_matrix_set_all( ib, 1.0);
gsl_ran_shuffle (r, p->data, NVOX, sizeof(size_t));
// gsl_matrix *shuffled_x_white = gsl_matrix_alloc(NCOMP,NVOX);
// gsl_matrix_memcpy(shuffled_x_white, x_white);
gsl_vector_view arow;
#pragma omp parallel for private(i,arow)
for (i = 0; i < x_white->size1; i++) {
arow = gsl_matrix_row(shuffled_x_white,i);
gsl_permute_vector (p, &arow.vector);
}
size_t start;
gsl_matrix *unmixed = gsl_matrix_alloc(NCOMP,block);
gsl_matrix *unm_logit = gsl_matrix_alloc(NCOMP,block);
gsl_matrix *temp_I = gsl_matrix_alloc(NCOMP,NCOMP);
gsl_matrix *ones = gsl_matrix_alloc(block,1);
gsl_matrix_set_all(ones, 1.0);
double max;
gsl_matrix_view sub_x_white_view;
// gsl_matrix *d_unmixer = gsl_matrix_alloc(NCOMP,NCOMP);
for (start = 0; start < NVOX; start = start + block) {
if (start + block > NVOX-1){
block = NVOX-start;
gsl_matrix_free(ib);
ib = gsl_matrix_alloc(1,block);
gsl_matrix_set_all( ib, 1.0);
gsl_matrix_free(unmixed);
unmixed = gsl_matrix_alloc(NCOMP,block);
gsl_matrix_free(unm_logit);
unm_logit = gsl_matrix_alloc(NCOMP,block);
gsl_matrix_free(ones);
ones = gsl_matrix_alloc(block,1);
gsl_matrix_set_all(ones, 1.0);
}
// sub_x_white = xwhite[:, permute[start:start+block]]
sub_x_white_view = gsl_matrix_submatrix(shuffled_x_white, 0,start, NCOMP, block );
// Compute unmixed = weights . sub_x_white + bias . ib
matrix_mmul(weights, &sub_x_white_view.matrix, unmixed);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans,
1.0, bias, ib, 1.0, unmixed);
// Compute 1-2*logit
gsl_matrix_memcpy(unm_logit, unmixed);
matrix_apply_all(unm_logit, logit);
// weights = weights + lrate*(block*I+(unm_logit*unmixed.T))*weights
gsl_matrix_set_identity(temp_I); // temp_I = I
// (1) temp_I = block*temp_I +unm_logit*unmixed.T
gsl_blas_dgemm( CblasNoTrans,CblasTrans,
1.0, unm_logit, unmixed,
(double)block , temp_I);
// BE CAREFUL with aliasing here! use d_unmixer if problems arise
// gsl_matrix_memcpy(d_unmixer, weights);
// (2) weights = weights + lrate*temp_I*weights
gsl_blas_dgemm( CblasNoTrans,CblasNoTrans,
lrate, temp_I, weights,
1.0, weights);
// Update the bias
gsl_blas_dgemm( CblasNoTrans, CblasNoTrans,
lrate, unm_logit, ones,
1.0, bias);
// check if blows up
max = gsl_matrix_max(weights);
if (max > MAX_W){
if (lrate<1e-6) {
printf("\nERROR: Weight matrix may not be invertible\n");
error = 2;
break;
}
error = 1;
break;
}
}
// set number of threads back to normal
// openblas_set_num _threads(MAX_THREAD);
//clean up
// gsl_rng_free (r);
// gsl_permutation_free (p);
// gsl_matrix_free(d_unmixer);
gsl_matrix_free(ib);
gsl_matrix_free(unmixed);
gsl_matrix_free(temp_I);
gsl_matrix_free(ones);
gsl_matrix_free(unm_logit);
// gsl_matrix_free(shuffled_x_white);
return(error);
}
void generate_kmeans_centres(const double * X,const int dim_x,const int dim_n,const int dim_b,double * centres){
int i,N, iter,k,num_ix,num_empty_clusters;
int* ind_,*empty_clusters,*minDi,*ix;
size_t *sDi;
double * M, * D,*minDv,*X_ix,*X_ix_m,*X_ink,*sDv;
double dist_old, dist_new;
dist_old = 10000;
gsl_permutation *ind;
const gsl_rng_type *T;
gsl_rng * r;
// finish declaration
N = dim_n;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
gsl_rng_set(r,3);
ind = gsl_permutation_alloc(N);
gsl_permutation_init(ind);
gsl_ran_shuffle(r,ind->data,N,sizeof(size_t));
// gsl_permutation_fprintf(stdout,ind,"%u");
ind_ = malloc(dim_b*sizeof(int));
for (i=0;i<dim_b;i++){
ind_[i] = (int)(gsl_permutation_get(ind,i));
}
M = malloc(dim_x*dim_b*sizeof(double));
D = malloc(dim_b*dim_n*sizeof(double));
minDv = malloc(dim_n*sizeof(double));
minDi = malloc(dim_n*sizeof(int));
sDv = malloc(dim_n*sizeof(double));
sDi = malloc(dim_n*sizeof(int));
ix = malloc(dim_n*sizeof(int));
X_ix_m= malloc(dim_x*1*sizeof(double));
X_ink = malloc(dim_x*sizeof(double));
ccl_get_sub_mat_cols(X,dim_x,dim_n,ind_,dim_b,M);
empty_clusters = malloc(dim_b*sizeof(int));
num_empty_clusters = 0;
for (iter=0;iter<1001;iter++){
num_empty_clusters = 0;
ccl_mat_distance(M,dim_x,dim_b,X,dim_x,dim_n,D);
ccl_mat_min(D,dim_b,dim_n,1,minDv,minDi);
memcpy(sDv,minDv,dim_n*sizeof(double));
memset(empty_clusters,0,dim_b*sizeof(int));
for (k=0;k<dim_b;k++){
memset(ix,0,dim_n*sizeof(int));
num_ix = ccl_find_index_int(minDi,dim_n,1,k,ix);
// print_mat_i(ix,1,dim_n);
X_ix = malloc(dim_x*num_ix*sizeof(double));
if(num_ix!=0){// not empty
ccl_get_sub_mat_cols(X,dim_x,dim_n,ix,num_ix,X_ix);
ccl_mat_mean(X_ix,dim_x,num_ix,0,X_ix_m);
ccl_mat_set_col(M,dim_x,dim_b,k,X_ix_m);
}
else{
empty_clusters[num_empty_clusters] = k;
num_empty_clusters ++;
}
free(X_ix);
}
dist_new = ccl_vec_sum(minDv,dim_n);
if (num_empty_clusters == 0){
if(fabs(dist_old-dist_new)<1E-10) {
memcpy(centres,M,dim_x*dim_b*sizeof(double));
return;
}
}
else{
// print_mat_i(empty_clusters,1,num_empty_clusters);
gsl_sort_index(sDi,sDv,1,dim_n);
gsl_sort(sDv,1,dim_n);
for (k=0;k<num_empty_clusters;k++){
int ii = (int) sDi[dim_n-k-1];
//print_mat_d(X,dim_x,dim_n);
ccl_get_sub_mat_cols(X,dim_x,dim_n,&ii,1,X_ink);
ccl_mat_set_col(M,dim_x,dim_b,empty_clusters[k],X_ink);
}
}
dist_old = dist_new;
}
memcpy(centres,M,dim_x*dim_b*sizeof(double));
gsl_permutation_free(ind);
gsl_rng_free(r);
free(ind_);
free(empty_clusters);
free(minDi);
free(M);
free(minDv);
free(X_ink);
free(ix);
free(sDi);
free(sDv);
free(X_ix_m);
free(D);
}
/* Random Orders Method :
*/
igraph_t * ggen_generate_random_orders(gsl_rng *r, unsigned long n, unsigned int orders)
{
igraph_t *g = NULL;
igraph_matrix_t m,edge_validity;
int err = 0;
long long i = 0,j,k;
igraph_vector_ptr_t posets;
igraph_vector_ptr_t indexes;
igraph_vector_t *v,*w;
ggen_error_start_stack();
if(r == NULL)
GGEN_SET_ERRNO(GGEN_EINVAL);
if(orders == 0)
GGEN_SET_ERRNO(GGEN_EINVAL);
// init structures
g = malloc(sizeof(igraph_t));
GGEN_CHECK_ALLOC(g);
GGEN_FINALLY3(free,g,1);
GGEN_CHECK_IGRAPH(igraph_matrix_init(&m,n,n));
GGEN_FINALLY(igraph_matrix_destroy,&m);
GGEN_CHECK_IGRAPH(igraph_matrix_init(&edge_validity,n,n));
GGEN_FINALLY(igraph_matrix_destroy,&edge_validity);
GGEN_CHECK_IGRAPH(igraph_vector_ptr_init(&posets,orders));
IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&posets,igraph_vector_destroy);
GGEN_FINALLY(igraph_vector_ptr_destroy_all,&posets);
GGEN_CHECK_IGRAPH(igraph_vector_ptr_init(&indexes,orders));
IGRAPH_VECTOR_PTR_SET_ITEM_DESTRUCTOR(&indexes,igraph_vector_destroy);
GGEN_FINALLY(igraph_vector_ptr_destroy_all,&indexes);
for(i = 0; i < orders; i++)
{
// posets is used for permutation computations
// it should contain vertices
VECTOR(posets)[i] = calloc(1,sizeof(igraph_vector_t));
GGEN_CHECK_ALLOC(VECTOR(posets)[i]);
GGEN_CHECK_IGRAPH_VECTPTR(igraph_vector_init_seq(VECTOR(posets)[i],0,n-1),posets,i);
VECTOR(indexes)[i] = calloc(1,sizeof(igraph_vector_t));
GGEN_CHECK_ALLOC(VECTOR(indexes)[i]);
GGEN_CHECK_IGRAPH_VECTPTR(igraph_vector_init(VECTOR(indexes)[i],n),indexes,i);
}
// zero all structs
igraph_matrix_null(&m);
igraph_matrix_null(&edge_validity);
// use gsl to shuffle each poset
for( j = 0; j < orders; j++)
{
v = VECTOR(posets)[j];
GGEN_CHECK_GSL_DO(gsl_ran_shuffle(r,VECTOR(*v), n, sizeof(VECTOR(*v)[0])));
}
// index saves the indices of each vertex in each permutation
for( i = 0; i < orders; i++)
for( j = 0; j < n; j++)
{
v = VECTOR(posets)[i];
w = VECTOR(indexes)[i];
k = VECTOR(*v)[j];
VECTOR(*w)[k] = j;
}
// edge_validity count if an edge is in all permutations
for( i = 0; i < n; i++)
for( j = 0; j < n; j++)
for( k = 0; k < orders; k++)
{
v = VECTOR(indexes)[k];
if( VECTOR(*v)[i] < VECTOR(*v)[j])
igraph_matrix_set(&edge_validity,i,j,
igraph_matrix_e(&edge_validity,i,j)+1);
}
// if an edge is present in all permutations then add it to the graph
for( i = 0; i < n; i++)
for( j = 0; j < n; j++)
if(igraph_matrix_e(&edge_validity,i,j) == orders)
igraph_matrix_set(&m,i,j,1);
// translate the matrix to a graph
GGEN_CHECK_IGRAPH(igraph_adjacency(g,&m,IGRAPH_ADJ_DIRECTED));
ggen_error_clean(1);
return g;
ggen_error_label:
return NULL;
}
// --------------------------------------------------------------------------------//
// MAIN //
// --------------------------------------------------------------------------------//
int main(int argc, char* argv[])
{
// process command-line arguments
if (argc<2) { Usage(); exit(1); }
char *method = argv[1];
CmdLine *cmdLine = InitCmdLine(method);
//--------------------------------------------------------------------------------------//
// OPTION -permute: permute rows //
//--------------------------------------------------------------------------------------//
if (strcmp(method,"-permute")==0) {
// read options
cmdLine->Read(argv+1,argc-1);
MESSAGES(VERBOSE);
// initialize random generator
unsigned long int seed = RND_SEED+getpid()+time(NULL);
gsl_rng *RANDOM_GENERATOR = InitRandomGenerator(seed);
// read input
long int n_lines;
char **L;
FILE *fp = LoadStdIn(&n_lines,BUFFER_SIZE);
if (n_lines==0) return 0;
ALLOCATE1D(L,n_lines,char *);
FileBufferText *buffer = new FileBufferText(fp,BUFFER_SIZE);
Progress PRG("Reading input rows...",n_lines);
for (long int n=0; n<n_lines; n++) {
L[n] = StrCopy(buffer->Next());
PRG.Check();
}
PRG.Done();
// permute
long int *seq;
ALLOCATE1D(seq,n_lines,long int);
for (long int k=0; k<n_lines; k++) seq[k] = k;
gsl_ran_shuffle(RANDOM_GENERATOR,seq,n_lines,sizeof(long int));
// print output
Progress PRG1("Printing output rows...",n_lines);
for (long int n=0; n<n_lines; n++) {
printf("%s\n", L[seq[n]]);
PRG1.Check();
}
PRG1.Done();
// cleanup
FREE1D(seq);
delete RANDOM_GENERATOR;
delete buffer;
}
//--------------------------------------------------------------------------------------//
// OPTION -resample: resample rows //
//--------------------------------------------------------------------------------------//
else if (strcmp(method,"-resample")==0) {
// read options
cmdLine->Read(argv+1,argc-1);
MESSAGES(VERBOSE);
// initialize random generator
unsigned long int seed = (RND_SEED==0)?(getpid()+time(NULL)):RND_SEED;
gsl_rng *RANDOM_GENERATOR = InitRandomGenerator(seed);
// read input
long int n_lines;
char **L;
FILE *fp = LoadStdIn(&n_lines,BUFFER_SIZE);
if (n_lines==0) return 0;
ALLOCATE1D(L,n_lines,char *);
FileBufferText *buffer = new FileBufferText(fp,BUFFER_SIZE);
Progress PRG("Reading input rows...",n_lines);
for (long int n=0; n<n_lines; n++) {
L[n] = StrCopy(buffer->Next());
PRG.Check();
}
PRG.Done();
// print output
if (N_SAMPLES<=0) N_SAMPLES = n_lines;
Progress PRG1("Printing output rows...",N_SAMPLES);
for (long int n=0; n<N_SAMPLES; n++) {
long int k = gsl_rng_uniform_int(RANDOM_GENERATOR,n_lines);
printf("%s\n", L[k]);
PRG1.Check();
}
PRG1.Done();
// cleanup
delete RANDOM_GENERATOR;
delete buffer;
}
//--------------------------------------------------------------------------------------//
// OPTION -number: do row numbering //
//--------------------------------------------------------------------------------------//
else if (strcmp(method,"-number")==0) {
// read options
cmdLine->Read(argv+1,argc-1);
MESSAGES(VERBOSE);
// read input
FileBufferText buffer((char*)NULL,BUFFER_SIZE);
Progress PRG("Reading input rows...",1);
long int id = HEADER?0:1;
for (char *inp=buffer.Next(); inp!=NULL; inp=buffer.Next()) {
if (id==0) printf("\t");
else printf("%s%012ld\t", PREFIX, id);
printf("%s\n", inp);
id++;
PRG.Check();
}
PRG.Done();
}
//--------------------------------------------------------------------------------------//
// OTHER OPTIONS //
//--------------------------------------------------------------------------------------//
else {
// read options
int next_arg = cmdLine->Read(argv,argc);
MESSAGES(VERBOSE);
// allocate buffer
char *BUFFER = (char *) malloc(BUFFER_SIZE*sizeof(char));
if (BUFFER==NULL) { fprintf(stderr, "Out of memory!\n"); exit(1); }
Sequence rows = strlen(ROW_FILE)==0 ? GetRows(&argv[next_arg],argc-next_arg) : LoadRows(ROW_FILE);
// option 1: use period
if (PERIOD>0) {
int choose = MERGE ? -1 : atoi(argv[next_arg]);
//printf("(PERIOD,NEXTARG,CHOOSE) = (%i,%i,%i)\n", PERIOD, next_arg, choose);
for (int n=0; ; n++) {
if (fgets(BUFFER,BUFFER_SIZE,stdin)==NULL) break;
if (BUFFER[strlen(BUFFER)-1]!='\n') {
fprintf(stderr, "Error: line was only partially read (max chars=%i)!\n", BUFFER_SIZE); exit(1);
}
if (BUFFER[strlen(BUFFER)-1]=='\n') BUFFER[strlen(BUFFER)-1] = 0;
if (MERGE) printf("%s%s", BUFFER, n%PERIOD==PERIOD-1?"\n":SEPARATOR);
else if (n%PERIOD==choose) printf("%s\n", BUFFER);
}
}
// option 2: choose rows
else {
if (EXCLUDE==true) {
for (long int n=0,k=1; k<=rows[0]; n++) {
fgets(BUFFER,BUFFER_SIZE,stdin);
if (feof(stdin)) break;
if (BUFFER[strlen(BUFFER)-1]!='\n') { fprintf(stderr, "Error: line was only partially read (max chars=%i)!\n", BUFFER_SIZE); exit(1); }
if (n<rows[k]) printf("%s", BUFFER);
else { ++k; if (EMPTY) printf("\n"); }
}
while (true) {
fgets(BUFFER,BUFFER_SIZE,stdin);
if (feof(stdin)) break;
if (BUFFER[strlen(BUFFER)-1]!='\n') { fprintf(stderr, "Error: line was only partially read (max chars=%i)!\n", BUFFER_SIZE); exit(1); }
printf("%s", BUFFER);
}
}
else {
for (long int n=0,k=1; k<=rows[0]; n++) {
fgets(BUFFER,BUFFER_SIZE,stdin);
if (feof(stdin)) break;
if (BUFFER[strlen(BUFFER)-1]!='\n') { fprintf(stderr, "Error: line was only partially read (max chars=%i)!\n", BUFFER_SIZE); exit(1); }
if (n==rows[k]) { printf("%s", BUFFER); k++; }
else if (EMPTY) printf("\n");
}
if (EMPTY) {
while (true) {
fgets(BUFFER,BUFFER_SIZE,stdin);
if (feof(stdin)) break;
if (BUFFER[strlen(BUFFER)-1]!='\n') { fprintf(stderr, "Error: line was only partially read (max chars=%i)!\n", BUFFER_SIZE); exit(1); }
printf("\n");
}
}
}
}
// clean up
FREE1D(rows);
FREE1D(BUFFER);
}
// clean up
delete cmdLine;
return 0;
}
int
main (int argc, char *argv[])
{
double N1, N2, Nanc, NancLower, *uniqTauArray = NULL, *taxonTauArray = NULL,
*descendant1ThetaArray = NULL, *descendant2ThetaArray = NULL,
*ancestralThetaArray = NULL, spTheta, thetaMean, tauequalizer, gaussTime = 0.0,
mig, rec, BottStr1, BottStr2, BottleTime;
double *recTbl;
int tauClass, *PSIarray = NULL, i;
unsigned int numTauClasses = -1, u, locus, taxonID, zzz;
unsigned long randSeed;
unsigned long long rep;
extern const gsl_rng *gBaseRand;
int comp_nums (const void *, const void *);
int b_constrain = 0;
int *subParamConstrainConfig = NULL;
#ifndef HOMOGENEOUS_MUT
double *mutScalerTbl;
#endif
/* set up gParam and gMutParam, as well as gConParam if constrain */
LoadConfiguration (argc, argv);
/* set the lower Nanc */
/* NancLower = 0.00001 * gParam.lowerTheta; */
/* if (NancLower < 0.00000000004) { /1* 4 * (mu=10^(-11)) * (Ne=1) *1/ */
/* NancLower = 0.00000000004; */
/* } */
/* set b_constrain to 1 if constrain */
if (gParam.constrain > 0)
{
//initialize constrain indicator
b_constrain = 1;
//initialize subParamConstrainConfig array
subParamConstrainConfig = calloc (NUMBER_OF_CONPARAM, sizeof (int));
if (subParamConstrainConfig == NULL)
{
fprintf (stderr,
"ERROR: Not enough memory for subParamConstrainConfig\n");
exit (EXIT_FAILURE);
}
for (i = 0; i < strlen (gParam.subParamConstrain); i++)
{
char a = (gParam.subParamConstrain)[i];
if (a == '1')
subParamConstrainConfig[i] = 1;
else if (a == '0')
subParamConstrainConfig[i] = 0;
else {
fprintf(stderr, "ERROR: subParamConstrain string in the config file"
"should be either 0 or 1\n");
exit (EXIT_FAILURE);
}
}
}
/* for initiating the gsl random number generator */
/* initialize PRNG */
srand (gParam.prngSeed); /* Better way of seeding here ? */
randSeed = rand ();
if (debug_level > 0)
randSeed = 1;
gBaseRand = gsl_rng_alloc (gsl_rng_mt19937); /* set the base PRNG to
Mersenne Twister */
gsl_rng_set (gBaseRand, randSeed); /* seed the PRNG */
/* print out all of the parameters */
if(gParam.printConf) {
PrintParam(stdout);
exit (0);
}
/* set up arrays */
/* Sizes are set to the number of taxon pairs (Max number of tau's) */
if ((b_constrain == 1) && (subParamConstrainConfig[0] == 1)) {
uniqTauArray = calloc (gParam.numTaxonLocusPairs, sizeof (double));
PSIarray = calloc (gParam.numTaxonLocusPairs, sizeof (int));
taxonTauArray = calloc(gParam.numTaxonLocusPairs, sizeof (double));
} else {
uniqTauArray = calloc (gParam.numTaxonPairs, sizeof (double));
PSIarray = calloc (gParam.numTaxonPairs, sizeof (int));
taxonTauArray = calloc(gParam.numTaxonPairs, sizeof (double));
}
descendant1ThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
descendant2ThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
ancestralThetaArray = calloc (gParam.numTaxonPairs, sizeof (double));
recTbl = calloc (gParam.numLoci, sizeof (double));
if (uniqTauArray == NULL || PSIarray == NULL || recTbl == NULL ||
taxonTauArray == NULL || descendant1ThetaArray == NULL ||
descendant2ThetaArray == NULL || ancestralThetaArray == NULL)
{
fprintf (stderr, "ERROR: Not enough memory for uniqTauArray, PSIarray, or recTbl\n");
exit (EXIT_FAILURE);
}
/* deal with num tau classes */
if (b_constrain == 0 || subParamConstrainConfig[0] != 1)
{
/* fixed numTauClasses configuration */
if (gParam.numTauClasses != 0)
{
if (gParam.numTauClasses > gParam.numTaxonPairs)
{
fprintf (stderr, "WARN: numTauClasses (%u) is larger than "
"numTaxonPairs (%u). Setting numTauClasses to %u",
gParam.numTauClasses, gParam.numTaxonPairs,
gParam.numTaxonPairs);
gParam.numTauClasses = gParam.numTaxonPairs;
}
numTauClasses = gParam.numTauClasses;
}
} /* when tau is constrained numTauClasses are set later */
/* deal with the case when tau is constrained */
if ((b_constrain == 1) && (subParamConstrainConfig[0] == 1)) {
int jj, kk;
double *tempTauArray;
if ((tempTauArray = calloc(gParam.numTaxonLocusPairs, sizeof(double)))
== NULL) {
fprintf (stderr, "ERROR: Not enough memory for tempTauArray\n");
exit (EXIT_FAILURE);
}
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
tempTauArray[jj] = (gConParam.conData[jj]).conTau;
}
numTauClasses = UniqueDouble(tempTauArray, uniqTauArray,
gParam.numTaxonLocusPairs, DBL_EPSILON);
if (gParam.numTauClasses != numTauClasses) {
fprintf (stderr, "WARN: tau's are constrained and found %u different "
"classes in the constrain table. But numTauClasses = %u was set."
" Using the value found in the constrain table.\n", numTauClasses,
gParam.numTauClasses);
gParam.numTauClasses = numTauClasses;
}
/* count tau's to create PSIarray */
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
PSIarray[jj] = 0;
}
for (jj = 0; jj < gParam.numTaxonLocusPairs; jj++) {
for (kk = 0; kk < numTauClasses; kk++) {
/* there shouldn't be fabs() below */
if (tempTauArray[jj] - uniqTauArray[kk] < DBL_EPSILON) {
PSIarray[kk]++;
break;
}
}
}
free (tempTauArray);
}
#ifndef HOMOGENEOUS_MUT
if ((mutScalerTbl = calloc(gParam.numLoci, sizeof(double))) == NULL) {
fprintf (stderr, "ERROR: Not enough memory for mutScalerTbl\n");
exit(EXIT_FAILURE);
}
#endif
thetaMean = 1.0;
if (gParam.timeInSubsPerSite == 0) {
thetaMean = (gParam.lowerTheta + gParam.upperTheta) / 2.0;
}
/* Beginning of the main loop */
for (rep = 0; rep < gParam.reps; rep++)
{
int lociTaxonPairIDcntr = 1;
/*
* Each taxon pair was separated at a time tau in the past. Of
* all pairs, some of them may have been separated at the same
* time. numTauClasses is the number of classes with different
* divergence time.
*
* If gParam.numTauClasses is not set, we are sampling
* numTauClasses from a uniform prior dist'n.
*/
if (gParam.numTauClasses == 0)
{ /* numTauClasses is NOT fixed */
numTauClasses =
1 + gsl_rng_uniform_int (gBaseRand, gParam.numTaxonPairs);
}
/* create the recombination rate table for each gene */
rec = gsl_ran_flat (gBaseRand, 0.0, gParam.upperRec);
for (u=0; u < gParam.numLoci; u++)
{
/* all loci shares same recombination rate */
recTbl[u] = rec;
/* each locus has different recomb. rate
recTbl[u] = gsl_ran_flat (gBaseRand, 0.0, gParam.upperRec);
*/
}
#ifndef HOMOGENEOUS_MUT
/* create regional heterogeneity in the mutation rate */
if (gParam.numLoci > 1) {
double shape, scale;
/* arbitrary sample the shape parameter from uniform dist'n */
shape = gsl_ran_flat(gBaseRand, 1.0, 20);
/* shape = 1 is exponential with lambda=1,
larger shape -> normal dist'n with smaller var */
scale = 1/shape; /* E[x] = 1, Var[x] = shape * scale^2 = 1/shape */
/* use gamma */
for (u=0; u < gParam.numLoci; u++) {
mutScalerTbl[u] = gsl_ran_gamma(gBaseRand, shape, scale);
}
} else {
mutScalerTbl[0] = 1.0;
}
#endif
// Randomly generate TauArray only when NOT constrain
if ((b_constrain == 0) || (subParamConstrainConfig[0] != 1))
{
int counter;
/* sample tau's from uniform prior dist'n */
for (u = 0; u < numTauClasses; u++)
// JRO - modified - 11/17/2011
// uniqTauArray[u] = gsl_ran_flat (gBaseRand, 0.0, gParam.upperTau);
uniqTauArray[u] = gsl_ran_flat (gBaseRand, gParam.lowerTau,
gParam.upperTau);
qsort(uniqTauArray, numTauClasses, sizeof(double),comp_nums);
for (counter = 0; counter < numTauClasses; counter++)
{
taxonTauArray[counter] = uniqTauArray[counter];
PSIarray[counter] = 1;
}
for (counter = numTauClasses;
counter < gParam.numTaxonPairs; counter++)
{
tauClass = gsl_rng_uniform_int(gBaseRand, numTauClasses);
taxonTauArray[counter] = uniqTauArray[tauClass];
PSIarray[tauClass] = PSIarray[tauClass] + 1;
}
/* randomly shuflling the order of taxonTauArray */
gsl_ran_shuffle(gBaseRand, taxonTauArray,
gParam.numTaxonPairs, sizeof (double));
}
for (taxonID = 0; taxonID < gParam.numTaxonPairs; taxonID++)
{
//Check upperAncPopSize before doing anything
/* ancestral population size prior */
if (gParam.upperAncPopSize < gParam.lowerTheta)
{
fprintf (stderr,
"The upper bound (%lf * %lf) of ancestral pop. size is "
"smaller than the lower bound (%lf)\n",
gParam.upperAncPopSize, gParam.upperTheta, gParam.lowerTheta);
exit (EXIT_FAILURE);
}
constrainedParameter conTaxonPairDat;
/* Population sizes during the bottleneck after the divergence of 2
pops. This is same as the population sizes, immediately after the
divergence/separation of the 2 pops. These are relative sizes. */
BottStr1 = gsl_ran_flat (gBaseRand, 0.01, 1.0);
BottStr2 = gsl_ran_flat (gBaseRand, 0.01, 1.0);
/* After the populations diverge, they experience pop. bottleneck.
Then the population size exponentially grows until current size.
BottleTime indicate the time when population started to grow.
BottleTime of 1 means, populations start to expand immediately
after divergence. Closer to 0 means, populations hasn't started
to expand until very recently. */
BottleTime = gsl_ran_flat (gBaseRand, 0.000001, 1.0);
/* migration rate prior */
mig = gsl_ran_flat (gBaseRand, 0.0, gParam.upperMig);
/* spTheta prior */
while ((spTheta = gsl_ran_flat (gBaseRand, gParam.lowerTheta,
gParam.upperTheta)) <= 0);
/* The ratio of current population sizes. The populations
exponentially grow to these sizes after bottkleneck is done. */
/* both ends excluded for symmetry */
while ((N1 = gsl_ran_flat (gBaseRand, 0.01, 1.99)) == 0.01)
;
N2 = 2.0 - N1;
/* The upper limit of ancestral theta is defined by the product
of upper Theta (e.g. 40) and upper AncPopSize (e.g. 0.5) */
/* JRO - changing the following hard coded lower limit on ancestral
theta to the lower limit specified by user */
/* Nanc = gsl_ran_flat (gBaseRand, 0.01,
gParam.upperAncPopSize * gParam.upperTheta);*/
Nanc = gsl_ran_flat (gBaseRand, gParam.lowerTheta,
gParam.upperAncPopSize * gParam.upperTheta);
descendant1ThetaArray[taxonID] = spTheta * N1;
descendant2ThetaArray[taxonID] = spTheta * N2;
ancestralThetaArray[taxonID] = Nanc;
/* pick a tau for every taxon-pair with replacement from the
array of X taxon-pairs, where X is a uniform discrete RV
from 1 to number of taxon-pairs */
if ((b_constrain == 0) || (subParamConstrainConfig[0] != 1))
{
gaussTime = taxonTauArray[taxonID];
}
/* use the following if simulating a particular fixed history */
/* gaussTime = uniqTauArray[taxonID]; */
/* print out the results by going through each locus */
for (locus = 0; locus < gParam.numLoci; locus++)
{
double locTheta, thisNanc, scaledGaussTime, scaledBottleTime;
/* check if this locus exist for this taxon pair */
/* this table contains 0-offset index for corresponding
taxon:locus mutPara */
int mpIndex = gMutParam.locTbl->tbl[taxonID][locus];
if(mpIndex<0) { /* this taxon:locus is not in the data */
continue;
}
if (b_constrain == 1)
{ /* If constrained, override with the fixed paras */
/* This part is not debugged well 2/14/2008, Naoki */
int mpIndex = gMutParam.locTbl->tbl[taxonID][locus];
conTaxonPairDat = gConParam.conData[mpIndex];
/* tau */
/* This allow that tau could differ between loci
within a single taxon pair */
if (subParamConstrainConfig[0] == 1)
gaussTime = conTaxonPairDat.conTau;
/** bottleneck priors **/
/* severity of bottle neck (how small the pop become) */
/* these should be [0,1] */
if (subParamConstrainConfig[1] == 1)
BottStr1 = conTaxonPairDat.conBottPop1;
if (subParamConstrainConfig[2] == 1)
BottStr2 = conTaxonPairDat.conBottPop2;
/* timing of bottle neck */
/* should be [0,1] */
if (subParamConstrainConfig[3] == 1)
BottleTime = conTaxonPairDat.conBottleTime;
/* migration rate prior */
if (subParamConstrainConfig[4] == 1)
mig = conTaxonPairDat.conMig;
/* theta per site */
if (subParamConstrainConfig[5] == 1)
spTheta = conTaxonPairDat.conTheta;
/* population sizes immediately after the separation, and
what it grows to after the bottleneck (today) */
/* (0.01, 1.99) */
if (subParamConstrainConfig[6] == 1) {
N1 = conTaxonPairDat.conN1;
N2 = 2.0 - N1;
}
/* The upper limit of ancestral theta is defined by the
product of upper Theta (e.g. 40) and upper
AncPopSize (e.g. 0.5), then converted to relative size
to spTheta */
if (subParamConstrainConfig[7] == 1)
Nanc = conTaxonPairDat.conNanc * gParam.upperTheta;
/* recombination rate per neighboring site */
if (subParamConstrainConfig[8] == 1)
recTbl[locus] = conTaxonPairDat.conRec;
} /* end of constrai */
/* access sample sizes, mutational model for this taxon:locus */
mutParameter taxonPairDat;
taxonPairDat = gMutParam.data[mpIndex];
/* scale the theta for each locus */
/* Note that species wide theta (represents pop size) is
4 Ne mu with mu per site, not per gene.
Assumes mu is constant. This may be a problem with
mitochondoria */
locTheta = spTheta * taxonPairDat.seqLen *
taxonPairDat.NScaler * taxonPairDat.mutScaler;
#ifndef HOMOGENEOUS_MUT
locTheta *= mutScalerTbl[locus];
#endif
/* thisNanc is basically a random deviate from a uniform dist'n:
[gParam.lowerTheta / spTheta,
gParam.upperAncPopSize * gParam.upperTheta/spTheta)
For example, if upperTheta = 10 & upperAncPopSize = 0.5,
upperAncTheta become 10 * 0.5 = 5.
msDQH specify the past population sizes in terms of the
ratio of N_anc / N_theta, so the following division
by locTheta is required.
*/
/* thisNanc = Nanc * taxonPairDat.seqLen / locTheta; */
thisNanc = Nanc / spTheta; /* this can be done outside of locus loop */
/* this scaling is done inside of locus loop to accomodate
the gamma dist'n of mut rate for each locus */
/* tauequalizer = gParam.upperTheta / */
/* 2 / (spTheta * taxonPairDat.NScaler); */
tauequalizer = thetaMean / (spTheta * taxonPairDat.NScaler);
/* WORK, CONFIRM THIS. Naoki Nov 2, 2009. IT USED TO BE
tauequalizer = gParam.upperTheta * taxonPairDat.seqLen /
2 / locTheta;
*/
/* Division by 2 is coming from N1 + N2 = 2.
We are considering that N_0 in theta_0 (=4 N_0 mu) specified
for -t option (we use -t locTheta) of msDQH is equal to
(N1+N2)/2 */
scaledGaussTime = gaussTime * tauequalizer;
/* 1 unit of tau (gaussTime) = 2 N_max (N_max is the
N assumed in upperTheta) */
/* I think we should get rid of /2 from tauequalizer */
/* JRO: Yes the following is weird and the threshold of 0.0001
* coalescent units can actually be thousands of generations which
* is not trivial. Also, the hack to avoid unrealistic growth rates
* is the wrong approach. If the div time is essentially zero, then
* there should simply be no bottleneck. Updating to make the
* threshold smaller, and simply preventing a bottleneck if the
* div time is smaller.*/
/* The following if is a little weird */
/* if (scaledGaussTime < 0.0001) { */
/* scaledGaussTime = 0.0001; */
/* scaledBottleTime = 0.00005; */
/* } else { */
/* scaledBottleTime = BottleTime * 0.95 * scaledGaussTime; */
/* } */
if (scaledGaussTime < 0.000001) {
// no bottleneck if div time is essentially zero
BottStr1 = 1.0;
BottStr2 = 1.0;
}
scaledBottleTime = BottleTime * 0.95 * scaledGaussTime;
if (debug_level)
fprintf (stderr,
"DEBUG: scaled BottleTime:%lf\tgaussTime:%lf\n",
scaledBottleTime, scaledGaussTime);
/* We can send some extra info to msbayes.pl here */
printf ("%u %u %u ", lociTaxonPairIDcntr, taxonID+1, locus+1);
lociTaxonPairIDcntr ++; /* seriral id: 1 to # taxon:locus pairs */
printf ("%.17lf %.17lf %.17lf %.17lf ",
locTheta, scaledGaussTime, mig,
recTbl[locus] * (taxonPairDat.seqLen - 1));
printf ("%.17lf %.17lf %.17lf ", scaledBottleTime,
BottStr1 * N1, BottStr2 * N2);
printf ("%u %u %u %lf %lf %lf ",
taxonPairDat.numPerTaxa,
taxonPairDat.sample[0], taxonPairDat.sample[1],
taxonPairDat.tstv[0], taxonPairDat.tstv[1],
taxonPairDat.gamma);
printf ("%u %.17lf %.17lf %.17lf ",
taxonPairDat.seqLen, N1, N2, thisNanc);
printf ("%lf %lf %lf %lf\n",
taxonPairDat.freqA, taxonPairDat.freqC,
taxonPairDat.freqG, taxonPairDat.freqT);
/* These feed into the system command line (msDQH) within
the perl shell msbayes. Some of these are used directly
by msDQH, but some are also passed on to the sumstats
programs via the msDQH commabnd line, .... like bp[taxonID],
theta, gaussTime, NumPerTax[taxonID], yy, */
}
}
/* The followings are used to calculate prior, processed in msbayes.pl */
printf ("# TAU_PSI_TBL setting: %d realizedNumTauClasses: %u",
gParam.numTauClasses, numTauClasses);
printf(" tauTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%.11lf", taxonTauArray[zzz]);
printf(" d1ThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", descendant1ThetaArray[zzz]);
printf(" d2ThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", descendant2ThetaArray[zzz]);
printf(" aThetaTbl:");
for (zzz = 0; zzz < gParam.numTaxonPairs; zzz++)
printf (",%lf", ancestralThetaArray[zzz]);
printf("\n");
}
free (uniqTauArray);
free (taxonTauArray);
free (PSIarray);
free (descendant1ThetaArray);
free (descendant2ThetaArray);
free (ancestralThetaArray);
free (recTbl);
free (subParamConstrainConfig);
exit (0);
}
void MoleculePopulateProcess::populateUniformRanged(Species* aSpecies)
{
Comp* aComp(aSpecies->getComp());
double delta(0);
// Increase the compartment dimensions by delta if it is a surface
// compartment:
if(aComp->dimension == 2)
{
delta = 0.1;
}
double maxX(std::min(1.0, OriginX+UniformRadiusX));
double minX(std::max(-1.0, OriginX-UniformRadiusX));
double maxY(std::min(1.0, OriginY+UniformRadiusY));
double minY(std::max(-1.0, OriginY-UniformRadiusY));
double maxZ(std::min(1.0, OriginZ+UniformRadiusZ));
double minZ(std::max(-1.0, OriginZ-UniformRadiusZ));
maxX = aComp->centerPoint.x + maxX*aComp->lengthX/2*(1+delta);
minX = aComp->centerPoint.x + minX*aComp->lengthX/2*(1+delta);
maxY = aComp->centerPoint.y + maxY*aComp->lengthY/2*(1+delta);
minY = aComp->centerPoint.y + minY*aComp->lengthY/2*(1+delta);
maxZ = aComp->centerPoint.z + maxZ*aComp->lengthZ/2*(1+delta);
minZ = aComp->centerPoint.z + minZ*aComp->lengthZ/2*(1+delta);
std::vector<unsigned int> aCoords;
for(std::vector<unsigned int>::iterator i(aComp->coords.begin());
i != aComp->coords.end(); ++i)
{
Voxel* aVoxel(theSpatiocyteStepper->coord2voxel(*i));
Point aPoint(theSpatiocyteStepper->coord2point(aVoxel->coord));
if(aVoxel->id == aSpecies->getVacantID() &&
aPoint.x < maxX && aPoint.x > minX &&
aPoint.y < maxY && aPoint.y > minY &&
aPoint.z < maxZ && aPoint.z > minZ)
{
aCoords.push_back(*i);
}
}
unsigned int aSize(aSpecies->getPopulateMoleculeSize());
if(aCoords.size() < aSize)
{
THROW_EXCEPTION(ValueError, String(
getPropertyInterface().getClassName()) +
"[" + getFullID().asString() + "]: There are " +
int2str(aSize) + " " + getIDString(aSpecies) +
" molecules that must be uniformly populated in a " +
"given range,\n but there are only " +
int2str(aCoords.size()) + " vacant voxels of " +
getIDString(aSpecies->getVacantSpecies()) +
" that can be populated.");
}
unsigned int aCoordsArray[aCoords.size()];
for(unsigned int i(0); i != aCoords.size(); ++i)
{
aCoordsArray[i] = aCoords[i];
}
gsl_ran_shuffle(getStepper()->getRng(), aCoordsArray, aCoords.size(),
sizeof(unsigned int));
for(unsigned int i(0); i != aSize; ++i)
{
aSpecies->addMolecule(theSpatiocyteStepper->coord2voxel(aCoordsArray[i]));
}
}
bool CEES_Node::Initialize(CStorageHead &storage, const gsl_rng *r)
{
// random permutation of 0, 1, ..., K-1
gsl_permutation *p = gsl_permutation_alloc(K);
gsl_permutation_init(p);
gsl_ran_shuffle(r, p->data, K, sizeof(int));
int binOffset;
if (next_level == NULL)
binOffset = this->BinID(0);
else
binOffset = next_level->BinID(0);
int index=0, bin_id;
while (index <K )
{
bin_id = binOffset+gsl_permutation_get(p, index);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
gsl_permutation_free(p);
return true;
}
index ++;
}
gsl_permutation_free(p);
return false;
// Initialize using samples from the next level;
/*if (next_level == NULL)
{
for (int try_id = id; try_id >=0; try_id --)
{
int bin_id = this->BinID(try_id);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
for (int try_id = id+1; try_id <K; try_id ++)
{
int bin_id = this->BinID(try_id);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
}
else
{
// Try next levels' bins with the same or lower energies
for (int try_id = id; try_id >= 0; try_id --)
{
int bin_id_next_level = next_level->BinID(try_id);
if (storage.DrawSample(bin_id_next_level, r, x_current))
{
// x_current.weight will remain the same
// x_current.log_prob needs to be updated according to
// current level's H and T
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
// If not successful, then try next level's bins with higher energies
for (int try_id = id+1; try_id <K; try_id ++)
{
int bin_id_next_level = next_level->BinID(try_id);
if (storage.DrawSample(bin_id_next_level, r, x_current))
{
// x_current.weight will remain the same
// x_current.log_prob needs to be updated according to
// current level's H and T
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
}
return false; */
}
int main(int argc, char **argv) {
gsl_rng *rng;
gsl_rng_env_setup();
const gsl_rng_type *rngType = gsl_rng_default;
rng = gsl_rng_alloc(rngType);
const size_t M = SIZE1;
const size_t N = SIZE2;
gsl_matrix *A = gsl_matrix_alloc(M, N);
int i = 0;
int j = 0;
int sigNum = 0;
for (i = 0; i < M; i++) {
for (j = 0; j < N; j++) {
gsl_matrix_set(A, i, j, gsl_ran_ugaussian(rng));
}
}
gsl_matrix *B = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(B, A);
gsl_matrix *C = gsl_matrix_alloc(M, N);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, A, B, 0.0, C);
gsl_matrix *D = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(D, C); // will be used in QTQ' decompostion
gsl_linalg_cholesky_decomp(C);
printf("%e\n", gsl_matrix_get(C, M/2, N/2));
gsl_matrix_free(B);
gsl_matrix *A1 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A1, A);
gsl_permutation *P = gsl_permutation_alloc(M); // will be used in
// other cases
gsl_permutation_init(P);
gsl_ran_shuffle (rng, P->data, M, sizeof(size_t));
gsl_linalg_LU_decomp(A1, P, &sigNum);
printf("%e\n", gsl_matrix_get(A1, M/2, N/2));
gsl_matrix *A2 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A2, A);
gsl_vector *tau = gsl_vector_alloc(GSL_MIN(M, N));
gsl_linalg_QR_decomp(A2, tau);
printf("%e\n", gsl_matrix_get(A2, M/2, N/2));
gsl_vector_free(tau);
gsl_matrix *A3 = gsl_matrix_alloc(M, N);
gsl_matrix_memcpy(A3, A);
gsl_matrix *svdV = gsl_matrix_alloc(N, N);
gsl_vector *svdS = gsl_vector_alloc(N);
gsl_vector *svdWorkspace = gsl_vector_alloc(N);
gsl_linalg_SV_decomp(A3, svdV, svdS, svdWorkspace);
printf("%e\n", gsl_vector_get(svdS, N/2));
gsl_vector *tau2 = gsl_vector_alloc(N - 1);
gsl_linalg_symmtd_decomp(D, tau2);
printf("%e\n", gsl_matrix_get(D, N/2, N/2));
return 0;
}
int GlmTest::resampNonCase(glm *model, gsl_matrix *bT, unsigned int i)
{
unsigned int j, k, id;
double bt, score, yij, mij;
gsl_vector_view yj;
unsigned int nRows=tm->nRows, nVars=tm->nVars;
// note that residuals have got means subtracted
switch (tm->resamp) {
case RESIBOOT:
if (tm->reprand!=TRUE) GetRNGstate();
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
id = (unsigned int) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
id = (unsigned int) gsl_rng_uniform_int(rnd, nRows);
else id = (unsigned int) nRows * Rf_runif(0, 1);
// bY = mu+(bootr*sqrt(variance))
for (k=0; k<nVars; k++) {
bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
if (tm->reprand!=TRUE) PutRNGstate();
break;
case SCOREBOOT:
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
score = (double) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
score = gsl_ran_ugaussian (rnd);
else score = Rf_rnorm(0.0, 1.0);
// bY = mu + score*sqrt(variance)
for (k=0; k<nVars; k++){
bt=gsl_matrix_get(model->Mu, j, k)+sqrt(gsl_matrix_get(model->Var, j, k))*gsl_matrix_get(model->Res, j, k)*score;
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
break;
case PERMUTE:
if (bootID==NULL)
gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int));
for (j=0; j<nRows; j++) {
if (bootID==NULL) id = permid[j];
else id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bY = mu + bootr * sqrt(var)
for (k=0; k<nVars; k++) {
bt=gsl_matrix_get(model->Mu,j,k)+sqrt(gsl_matrix_get(model->Var,j,k))*gsl_matrix_get(model->Res, id, k);
bt = MAX(bt, 0.0);
bt = MIN(bt, model->maxtol);
gsl_matrix_set(bT, j, k, bt);
} }
break;
case FREEPERM:
if (bootID==NULL)
gsl_ran_shuffle(rnd,permid,nRows,sizeof(unsigned int));
for (j=0; j<nRows; j++) {
if (bootID==NULL) id = permid[j];
else id = (unsigned int) gsl_matrix_get(bootID, i, j);
yj=gsl_matrix_row(model->Yref, id);
gsl_matrix_set_row (bT, j, &yj.vector);
}
break;
case MONTECARLO:
McSample(model, rnd, XBeta, Sigma, bT);
break;
case PITSBOOT:
if (tm->reprand!=TRUE) GetRNGstate();
for (j=0; j<nRows; j++) {
if (bootID!=NULL)
id = (unsigned int) gsl_matrix_get(bootID, i, j);
else if (tm->reprand==TRUE)
id = (unsigned int) gsl_rng_uniform_int(rnd, nRows);
else id = (unsigned int) Rf_runif(0, nRows);
for (k=0; k<nVars; k++) {
bt = gsl_matrix_get(model->PitRes, id, k);
mij = gsl_matrix_get(model->Mu, j, k);
yij = model->cdfinv(bt, mij, model->theta[k]);
gsl_matrix_set(bT, j, k, yij);
}
}
if (tm->reprand!=TRUE) PutRNGstate();
break;
default: GSL_ERROR("The resampling method is not supported", GSL_ERANGE); break;
}
return SUCCESS;
}
/**
* Interacts with all other host in range.
*
*
* @param host host to interact with others
* @param time time-point of interaction
*/
void host_prepare_infection_process(Host *host, unsigned short time) {
Coordinates field_coord_rel = world_get_rel_coord_for_host(host);
Coordinates field_coord_abs =
world_get_abs_for_rel_coord(field_coord_rel.x, field_coord_rel.y);
Position hostPos = world_get_pos_within_field(host);
unsigned field_max_x_pos = host->field->size.width - 1;
unsigned field_max_y_pos = host->field->size.height - 1;
// squared euclidean distances to each corner
unsigned left = sq_euclidean(0, hostPos.y, hostPos.x, hostPos.y);
unsigned topleft = sq_euclidean(0, 0, hostPos.x, hostPos.y);
unsigned top = sq_euclidean(hostPos.x, 0, hostPos.x, hostPos.y);
unsigned topright = sq_euclidean(field_max_x_pos, 0, hostPos.x, hostPos.y);
unsigned right =
sq_euclidean(field_max_x_pos, hostPos.y, hostPos.x, hostPos.y);
unsigned bottomright =
sq_euclidean(field_max_x_pos, field_max_y_pos, hostPos.x, hostPos.y);
unsigned bottom =
sq_euclidean(hostPos.x, field_max_y_pos, hostPos.x, hostPos.y);
unsigned bottomleft =
sq_euclidean(0, field_max_y_pos, hostPos.x, hostPos.y);
// host can have max. 3 neighbourfields + his own = 4
HostForInfection host_for_infection;
host_for_infection.host = *host;
host_for_infection.phost = host;
// fields processed from max index to 0 (pfield at the end of this process)
// then no max index var is needed
host_for_infection.curr_field_coord = 0;
// unsigned matrix_cols = world.field_matrix->n *
// world.process_matrix_dimensions.cols;
// unsigned matrix_rows = world.field_matrix->m *
// world.process_matrix_dimensions.rows;
unsigned matrix_cols = world.size.width / world.full_size_one_field.width;
unsigned matrix_rows = world.size.height / world.full_size_one_field.height;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
field_coord_abs;
Coordinates next_field_coord;
if (left < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x - 1 + matrix_cols) % matrix_cols;
next_field_coord.y = field_coord_abs.y;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (topleft < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x - 1 + matrix_cols) % matrix_cols;
next_field_coord.y =
(field_coord_abs.y - 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (top < world.maxradius_sq) {
next_field_coord.x = field_coord_abs.x;
next_field_coord.y =
(field_coord_abs.y - 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (topright < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x + 1 + matrix_cols) % matrix_cols;
next_field_coord.y =
(field_coord_abs.y - 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (right < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x + 1 + matrix_cols) % matrix_cols;
next_field_coord.y = field_coord_abs.y;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (bottomright < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x + 1 + matrix_cols) % matrix_cols;
next_field_coord.y =
(field_coord_abs.y + 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (bottom < world.maxradius_sq) {
next_field_coord.x = field_coord_abs.x;
next_field_coord.y =
(field_coord_abs.y + 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
if (bottomleft < world.maxradius_sq) {
next_field_coord.x =
(field_coord_abs.x - 1 + matrix_cols) % matrix_cols;
next_field_coord.y =
(field_coord_abs.y + 1 + matrix_rows) % matrix_rows;
host_for_infection.field_coord[host_for_infection.curr_field_coord++] =
next_field_coord;
}
// curr_field_coord ends with max-index +1
//& is further used to describe the array length
gsl_ran_shuffle(rng, host_for_infection.field_coord,
host_for_infection.curr_field_coord, sizeof(Coordinates));
host_for_infection_process(&host_for_infection, time);
}
/* read the configuration file and the graph */
chaincolln chaincolln_readdata(void) {
FILE *fileptr, *initzsfile;
int i, j, k, ndom, nreln, d, r, nitem, dim, maxclass, initclass, relcl, ndim,
domlabel, clusterflag, itemind, nchains, cind, zind;
int *domlabels, *participants, participant;
double val;
double nig[DISTSIZE];
domain *doms;
relation rn;
int *initclasses, ***edgecounts, *relsizes;
char prefix[MAXSTRING];
chaincolln cc;
chain c, c0;
#ifdef GSL
gsl_rng *rng;
const gsl_rng_type *T;
gsl_permutation *perm ;
size_t N;
gsl_rng_env_setup();
T = gsl_rng_default;
rng = gsl_rng_alloc(T);
#endif
fprintf(stdout,"A\n");
nchains = ps.nchains+1;
nig[0] = ps.m; nig[1] = ps.v; nig[2] = ps.a; nig[3] = ps.b;
fileptr = fopen(ps.configfile,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read config file\n"); exit(1);
}
/* initial read of ps.configfile to get ps.maxdim, ps.maxrel, ps.maxitem,
ps.maxclass */
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
relsizes= (int *) my_malloc(nreln*sizeof(int));
ps.maxrel = nreln;
ps.maxitem = 0; ps.maxclass = 0;
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
if (nitem > ps.maxitem) {
ps.maxitem = nitem;
}
if (maxclass > ps.maxclass) {
ps.maxclass= maxclass;
}
}
fprintf(stdout,"B\n");
ps.maxdim = 0;
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
relsizes[r] = ndim;
if (ndim > ps.maxdim) {
ps.maxdim = ndim;
}
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
}
}
fclose(fileptr);
fprintf(stdout,"C\n");
domlabels= (int *) my_malloc(ps.maxdim*sizeof(int));
participants= (int *) my_malloc(ps.maxdim*sizeof(int));
initclasses = (int *) my_malloc(ps.maxitem*sizeof(int));
fprintf(stdout,"D \n");
/* initial read of ps.graphname to get ps.maxobjtuples */
edgecounts = (int ***) my_malloc(ps.maxrel*sizeof(int **));
for (i = 0; i < ps.maxrel; i++) {
edgecounts[i] = (int **) my_malloc(ps.maxdim*sizeof(int *));
for (j = 0; j < ps.maxdim; j++) {
edgecounts[i][j] = (int *) my_malloc(ps.maxitem*sizeof(int));
for (k = 0; k < ps.maxitem; k++) {
edgecounts[i][j][k] = 0;
}
}
}
ps.maxobjtuples = 0;
fprintf(stdout,"D2 \n");
fileptr = fopen(ps.graphname,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read graph\n"); exit(1);
}
while( fscanf( fileptr, " %d", &r)!=EOF ) {
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,r);
ndim = relsizes[r];
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,ndim);
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
participants[dim] = participant;
}
fscanf(fileptr, "%lf", &val);
for (dim = 0; dim < ndim; dim++) {
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
edgecounts[r][dim][participants[dim]]++;
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
}
}
fprintf(stdout,"E\n");
fclose(fileptr);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
for (k = 0; k < ps.maxitem; k++) {
if (edgecounts[i][j][k] > ps.maxobjtuples) {
ps.maxobjtuples = edgecounts[i][j][k];
}
edgecounts[i][j][k]= 0;
}
}
}
fprintf(stdout,"F\n");
free(relsizes);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
free(edgecounts[i][j]);
}
free(edgecounts[i]);
}
free(edgecounts);
fprintf(stdout,"G\n");
/* second read of ps.configfile where we set up datastructures */
fileptr = fopen(ps.configfile,"r");
if (ps.outsideinit) {
initzsfile= fopen(ps.initfile,"r");
if (initzsfile == NULL) {
fprintf(stderr, "couldn't read initzsfile\n"); exit(1);
}
} else {
initzsfile = NULL;
}
fprintf(stdout,"H\n");
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
cc = chaincolln_create(nchains, ndom, nreln, prefix);
c0 = chaincolln_getchain(cc, 0);
fprintf(stdout,"I\n");
/* read domains */
/* input file: nitem maxclass initclass clusterflag*/
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
#ifdef GSL
N = nitem;
#endif
if (ps.outsideinit) {
for (zind = 0; zind < nitem; zind++) {
fscanf(initzsfile, "%d", &initclasses[zind]);
}
}
fprintf(stdout,"J\n");
/* add domains and items to chains */
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_adddomain(c, d, nitem, maxclass, clusterflag, ps.alpha,
ps.alphahyp, initclasses);
#ifdef GSL
perm = gsl_permutation_alloc(N);
gsl_permutation_init(perm);
gsl_ran_shuffle(rng, perm->data, N, sizeof(size_t));
#endif
/* assign items to classes */
relcl = 0;
for (i = 0; i < nitem; i++) {
if (ps.outsideinit) {
chain_additemtoclass(c, d, i, initclasses[i]);
} else {
if (relcl == initclass) relcl = 0;
/* without the GNUSL, each chain gets initialized the same way. This
* is suboptimal */
itemind = i;
#ifdef GSL
itemind = gsl_permutation_get(perm, i);
#endif
chain_additemtoclass(c, d, itemind, relcl);
relcl++;
}
}
#ifdef GSL
gsl_permutation_free(perm);
#endif
}
}
#ifdef GSL
gsl_rng_free(rng);
#endif
fprintf(stdout,"K\n");
/* read relations*/
/* input file: ndim d0 ... dn */
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
domlabels[dim] = domlabel;
}
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addrelation(c, r, ndim, ps.betaprop, ps.betamag, nig, domlabels);
}
}
if (ps.outsideinit) {
fclose(initzsfile);
}
fprintf(stdout,"L\n");
fclose(fileptr);
/* second read of ps.graphname: store edges*/
fileptr = fopen(ps.graphname,"r");
/* input file: relind p0 p1 p2 .. pn val */
while( fscanf( fileptr, " %d", &r)!= EOF ) {
ndim = relation_getdim( chain_getrelation(c0, r) );
doms = relation_getdoms( chain_getrelation(c0, r) );
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
fprintf(stdout,"M %d %d\n",dim,participant);
participants[dim] = participant;
domlabels[dim] = domain_getlabel(doms[dim]);
}
for (i = 0; i < ndim; i++) {
for (j = 0; j < i; j++) {
if (participants[i] == participants[j] &&
domlabels[i] == domlabels[j]) {
fprintf(stderr, "Self links not allowed.\n"); exit(1);
}
}
}
fscanf(fileptr, "%lf", &val);
fprintf(stderr,"%d\n",nchains);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addedge(c, r, val, participants);
rn = chain_getrelation(c, r);
if (doubleeq(val, 0)) {
relation_setmissing(rn, 1);
}
if (val > 1.5 && relation_getdtype(rn) != CONT) {
relation_setdtype(rn, FREQ);
}
if (!doubleeq(val, (int) val)) {
relation_setdtype(rn, CONT);
relation_setmissing(rn, 1); /* XXX: no sparse continuous matrices */
}
}
}
fprintf(stderr,"N\n");
fclose(fileptr);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
for (i = 0; i < chain_getndomains(c); i++) {
chain_updatedomprobs(c, i);
}
}
fprintf(stderr,"O\n");
free(domlabels); free(participants); free(initclasses);
return cc;
}
int AnovaTest::resampTest(void)
{
// printf("Start resampling test ...\n");
unsigned int i, j, p, id;
unsigned int maxiter=mmRef->nboot;
double hii, score;
gsl_matrix *bX, *bY;
bY = gsl_matrix_alloc(nRows, nVars);
bX = gsl_matrix_alloc(nRows, nParam);
// initialize permid
unsigned int *permid=NULL;
if ( bootID == NULL ) {
if ( mmRef->resamp == PERMUTE ){
permid = (unsigned int *)malloc(nRows*sizeof(unsigned int));
for (i=0; i<nRows; i++)
permid[i] = i;
} }
// else
// displaymatrix(bootID, "bootID received");
// resampling options
if (mmRef->resamp == CASEBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for ( j=0; j<nRows; j++ ){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// resample Y and X
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view Xj=gsl_matrix_row(Xref, id);
gsl_matrix_set_row (bX, j, &Xj.vector);
}
anovacase(bY, bX);
nSamp++;
}
}
else if (mmRef->resamp == RESIBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
if (mmRef->reprand!=TRUE) {
GetRNGstate();
printf("reprand==FALSE\n");
}
for (j=0; j<nRows; j++){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
if (mmRef->reprand!=TRUE) PutRNGstate();
anovaresi(bY, p);
}
nSamp++;
} }
else if (mmRef->resamp == SCOREBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
for ( j=0; j<nRows; j++ ) {
// random score
if ( bootID == NULL )
score = gsl_ran_ugaussian (rnd);
else
score = (double)gsl_matrix_get(bootID, i, j);
// bootr = (Y - fit)*score
gsl_vector_view Yj=gsl_matrix_row(Yref, j);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, j);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, j, j);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
gsl_vector_scale (&bootr.vector, score);
gsl_vector_add (&bootr.vector, &Fj.vector);
}
anovaresi(bY, p);
}
nSamp++;
} }
else if ( mmRef->resamp == PERMUTE ) {
gsl_matrix_add_constant (Pstatj, 1.0);
for (p=0; p<nModels-1; p++)
Pmultstat[p]=1.0; // include itself
nSamp = 1;
for (i=0; i<maxiter-1; i++) { //999
for (p=1; p<nModels; p++){
if (bootID == NULL )
gsl_ran_shuffle(rnd, permid, nRows, sizeof(unsigned int));
// get bootr by permuting resi:Y-fit
for (j=0; j<nRows; j++){
if (bootID == NULL)
id = permid[j];
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
anovaresi(bY, p);
}
nSamp++;
}
}
else
GSL_ERROR("Invalid resampling option", GSL_EINVAL);
// p-values
unsigned int sid, sid0;
double *pj;
for (i=0; i<nModels-1; i++) {
Pmultstat[i]=(double) (Pmultstat[i]+1)/(nSamp+1); // adjusted with +1
pj = gsl_matrix_ptr (Pstatj, i, 0);
if ( mmRef->punit == FREESTEP ){
for (j=1; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], j);
sid0 = gsl_permutation_get(sortid[i], j-1);
*(pj+sid)=MAX(*(pj+sid), *(pj+sid0));
}
}
if ( mmRef->punit == STEPUP ){
for (j=2; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], nVars-j);
sid0 = gsl_permutation_get(sortid[i], nVars-j+1);
*(pj+sid) = MIN(*(pj+sid), *(pj+sid0));
}
}
for (j=0; j<nVars; j++)
*(pj+j) = (double)(*(pj+j)+1)/(nSamp+1); // adjusted with +1
}
// free memory
gsl_matrix_free(bX);
gsl_matrix_free(bY);
if (permid!=NULL) free(permid);
return 0;
}