Esempio n. 1
0
/* 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;
}
Esempio n. 2
0
// 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);
}
Esempio n. 3
0
/*
 * 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;
    }
}
Esempio n. 6
0
/* 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);
		}
	}
	
}
Esempio n. 7
0
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;
                    }
                }
            }
        }
    }
}
Esempio n. 9
0
void rshuffle(void* base, size_t n, size_t size) {
    gsl_ran_shuffle(RANDOM_NUMBER, base, n, size);
}
Esempio n. 10
0
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);

}
Esempio n. 11
0
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);
}
Esempio n. 12
0
/* 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;
}
Esempio n. 13
0
// --------------------------------------------------------------------------------//
// 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;
}
Esempio n. 14
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]));
    }
}
Esempio n. 16
0
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; */
} 
Esempio n. 17
0
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;
}
Esempio n. 18
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);
}
Esempio n. 20
0
/* 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;
}
Esempio n. 21
0
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;

}