CAMLprim value ml_gsl_ran_choose(value rng, value src, value dest)
{
if(Tag_val(src) == Double_array_tag)
gsl_ran_choose(Rng_val(rng),
Double_array_val(dest), Double_array_length(dest),
Double_array_val(src), Double_array_length(src),
sizeof(double));
else
gsl_ran_choose(Rng_val(rng),
(value *)dest, Array_length(dest),
(value *)src, Array_length(src),
sizeof(value));
return Val_unit;
}
vector< vector<double> > get_rand_fitScape(int N, int L, double mu, double s, gsl_rng* rng) {
//Decide how many non-dark matter alleles are sorting through the population.
unsigned int polymx = gsl_ran_poisson(rng,N*L*mu);
if (polymx > N*L) {polymx =N*L;}
cout << polymx << "\n";
//Decide placement of founding polymorphisms.
pair<int,int>* polymx_loc = new pair<int,int>[polymx];
pair<int,int>* genome_loc = new pair<int,int>[N*L];
for (int i=0; i<N; i++) {
for (int j=0; j<L; j++) {
genome_loc[i*L+j]= pair<int,int> (i,j);
}
}
gsl_ran_choose(rng, polymx_loc, polymx, genome_loc, N*L, sizeof(pair<int,int>));
delete [] genome_loc;
//Decide on selective strength
vector<double> polymx_s (polymx);
for (int i=0; i<polymx; i++) {polymx_s[i] = gsl_ran_gaussian(rng,s);}
//Build fitness landscape
vector< vector<double> > fitScape_pop (N);
for (int i=0; i<N; i++) {fitScape_pop[i] = vector<double> (L);}
for (int i=0; i<polymx; i++) {fitScape_pop[polymx_loc[i].first][polymx_loc[i].second] = polymx_s[i];}
delete [] polymx_loc;
return fitScape_pop;
}
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]
);
}
/*
* draw K random integers from 0..N-1
*
*/
void choose_k_from_n(int k, unsigned int n, int* result) {
int x[n];
if (RANDOM_NUMBER_GENERATOR == NULL) {
RANDOM_NUMBER_GENERATOR = gsl_rng_alloc(gsl_rng_taus);
}
for (unsigned int i = 0; i < n; i++) {
x[i] = i;
}
gsl_ran_choose (RANDOM_NUMBER_GENERATOR, (void *) result, k,
(void *) x, n, sizeof(int));
}
void
test_choose (void)
{
double count[10] ;
int x[10] = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9} ;
int y[3] = {0, 1, 2} ;
int i, j, status = 0;
for (i = 0; i < 10; i++)
{
count[i] = 0 ;
}
for (i = 0 ; i < N; i++)
{
for (j = 0; j < 10; j++)
x[j] = j ;
gsl_ran_choose (r_global, y, 3, x, 10, sizeof(int)) ;
for (j = 0; j < 3; j++)
count[y[j]]++ ;
}
for (i = 0; i < 10; i++)
{
double expected = 3.0 * N / 10.0 ;
double d = fabs(count[i] - expected);
double sigma = d / sqrt(expected) ;
if (sigma > 5 && d > 1)
{
status = 1 ;
gsl_test (status,
"gsl_ran_choose %d (%g observed vs %g expected)",
i, count[i]/N, 0.1) ;
}
}
gsl_test (status, "gsl_ran_choose (3) on {0, 1, 2, 3, 4, 5, 6, 7, 8, 9}") ;
}
/* Randomly set S' */
static void pam_choose_random_partition(pam_partition p)
{
gsl_rng *rng;
size_t *indices, *chosen, i, *j;
/* Number of unconstrained medoids */
size_t random_n = p->M->size1 - p->always_select_count;
/* Number of unconstrained medoids to pick */
size_t random_k = p->k - p->always_select_count;
rng = gsl_rng_alloc(gsl_rng_taus2);
indices = malloc(sizeof(size_t) * random_n);
chosen = calloc(random_k, sizeof(size_t));
/* Reset */
gsl_vector_uchar_set_zero(p->in_set);
/* First, fill with any indices which must be part of the solution */
j = indices;
for (i = 0; i < p->M->size1; i++) {
if (pam_always_select(p, i)){
gsl_vector_uchar_set(p->in_set, i, 1);
} else {
*j++ = i;
}
}
/* Choose randomly from all indices we can */
gsl_ran_choose(rng, (void *) chosen, random_k, indices,
random_n,
sizeof(size_t));
for (i = 0; i < random_k; i++) {
gsl_vector_uchar_set(p->in_set, chosen[i], 1);
}
gsl_rng_free(rng);
free(indices);
free(chosen);
}
void choose_k_from_n(int k, int n, int* result, int* src) {
gsl_ran_choose(RANDOM_NUMBER, (void *) result, k, (void *) src, n, sizeof(int));
}
/* Fan-in/ Fan-out method
*/
igraph_t *ggen_generate_fifo(gsl_rng *r, unsigned long n, unsigned long od, unsigned long id)
{
igraph_t *g = NULL;
igraph_vector_t available_od;
igraph_vector_t out_degrees;
igraph_vector_t vertices;
igraph_vector_t choice;
igraph_vector_t edges;
unsigned long max;
unsigned long i,j,k;
unsigned long vcount = 1;
int err;
ggen_error_start_stack();
if(r == NULL)
GGEN_SET_ERRNO(GGEN_EINVAL);
if(id == 0 || od == 0 || od > n || id > n)
GGEN_SET_ERRNO(GGEN_EINVAL);
g = malloc(sizeof(igraph_t));
GGEN_CHECK_ALLOC(g);
GGEN_FINALLY3(free,g,1);
GGEN_CHECK_IGRAPH(igraph_empty(g,1,1));
GGEN_FINALLY3(igraph_destroy,g,1);
GGEN_CHECK_IGRAPH(igraph_vector_init(&available_od,n));
GGEN_FINALLY(igraph_vector_destroy,&available_od);
GGEN_CHECK_IGRAPH(igraph_vector_init(&out_degrees,n));
GGEN_FINALLY(igraph_vector_destroy,&out_degrees);
GGEN_CHECK_IGRAPH(igraph_vector_init(&vertices,n));
GGEN_FINALLY(igraph_vector_destroy,&vertices);
GGEN_CHECK_IGRAPH(igraph_vector_init(&choice,n));
GGEN_FINALLY(igraph_vector_destroy,&choice);
GGEN_CHECK_IGRAPH(igraph_vector_init(&edges,n*2));
GGEN_FINALLY(igraph_vector_destroy,&edges);
while(vcount < n)
{
// never trigger errors as it doesn't allocate or free memory
igraph_vector_resize(&available_od,vcount);
igraph_vector_resize(&out_degrees,vcount);
igraph_vector_resize(&vertices,vcount);
// compute the available out degree of each vertex
GGEN_CHECK_IGRAPH(igraph_degree(g,&out_degrees,igraph_vss_all(),IGRAPH_OUT,0));
// fill available with od and substract out_degrees
igraph_vector_fill(&available_od,od);
GGEN_CHECK_IGRAPH(igraph_vector_sub(&available_od,&out_degrees));
if(gsl_ran_bernoulli(r,0.5)) //Fan-out Step
{
// find max
max = igraph_vector_max(&available_od);
// register all vertices having max as outdegree
j = 0;
for (i = 0; i < vcount; i++)
if(VECTOR(available_od)[i] == max)
VECTOR(vertices)[j++] = i;
// choose randomly a vertex among availables
GGEN_CHECK_GSL_DO(i = gsl_rng_uniform_int(r,j));
// how many children ?
GGEN_CHECK_GSL_DO(j = gsl_rng_uniform_int(r,max));
j = j+1;
// create all new nodes and add edges
GGEN_CHECK_IGRAPH(igraph_add_vertices(g,j,NULL));
// cannot fail
igraph_vector_resize(&edges,j*2);
for(k = 0; k < j; k++)
{
VECTOR(edges)[2*k] = i;
VECTOR(edges)[2*k+1] = vcount + k;
}
vcount+=k;
}
else //Fan-In Step
{
// register all vertices having an available outdegree
j = 0;
for (i = 0; i < vcount; i++)
if(VECTOR(available_od)[i] > 0)
VECTOR(vertices)[j++] = i;
// we can add at most id vertices
max =( j > id)? id: j;
// how many edges to add
GGEN_CHECK_GSL_DO(k = gsl_rng_uniform_int(r,max));
k = k+1;
// choose that many nodes and add edges from them to the new node
// cannot fail either
igraph_vector_resize(&choice,k);
gsl_ran_choose(r,VECTOR(choice),k,
VECTOR(vertices),j,sizeof(VECTOR(vertices)[0]));
// add a vertex to the graph
GGEN_CHECK_IGRAPH(igraph_add_vertices(g,1,NULL));
igraph_vector_resize(&edges,k*2);
// be carefull, vcount is the last ID of vertices not vcount +1
for(i = 0; i < k; i++)
{
VECTOR(edges)[2*i] = VECTOR(choice)[i];
VECTOR(edges)[2*i+1] = vcount;
}
vcount++;
}
// in all cases, edges should be added
GGEN_CHECK_IGRAPH(igraph_add_edges(g,&edges,NULL));
}
ggen_error_clean(1);
return g;
ggen_error_label:
return NULL;
}
int sock_sim(double prior_r,double prior_p,double alpha,double beta,double obs_paired,double obs_odd,double *BigVector,int iter){
int nthreads;
//variables, gsl rng initiation
int i,j,match_count,n_picked;
unsigned int n_socks;
double prop_pairs,n_pairs,n_odd,prior_n;
double obs_total = obs_paired + obs_odd;
prior_n = prior_r - 1;
match_count = 0;
double temp_paired,temp_odd,temp_pairs;
//setup gsl random seed
const gsl_rng_type * T;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
#pragma omp parallel for
for(i=0;i<iter;i++){
//sample, get n_pairs and n_odd
n_socks = gsl_ran_negative_binomial(r,prior_p,prior_n);
prop_pairs = gsl_ran_beta(r,alpha,beta);
n_pairs = round(floor(.5*n_socks)*prop_pairs);
n_odd = n_socks - 2*n_pairs;
//make generated population
double *gen_pop = (double *)malloc(sizeof(double)*n_socks);
for(j=0;j<n_pairs;j++){
gen_pop[2*j] = (double) j;
gen_pop[(2*j)+1] = (double) j;
}
for(j=2*n_pairs;j<n_socks;j++){
gen_pop[j]= (double) j;
}
//get generated sample size
if(obs_total <= n_socks){
n_picked = (int) obs_total;
}else{ n_picked = n_socks; }
//get sample vector
double *gen_samp = (double *)malloc(sizeof(double)*n_picked);
//count pairs
//sample from generated population
gsl_ran_choose(r,gen_samp,n_picked,gen_pop,n_socks,sizeof(double));
//sort sample
gsl_sort(gen_samp,1,n_picked);
//count the number of pairs/odd in sample
temp_pairs = 0.;
temp_odd = 1.;
for(j=1;j<n_picked;j++){
if(gen_samp[j] == gen_samp[j-1]){
temp_pairs = temp_pairs + 1;
temp_odd = temp_odd - 1;
continue;
}else{ temp_odd = temp_odd + 1; }
}
temp_paired = 2*temp_pairs;
//allocate big vector
BigVector[5*i] = (double) n_socks;
BigVector[(5*i) + 1] = n_pairs;
BigVector[(5*i) + 2] = n_odd;
BigVector[(5*i) + 3] = prop_pairs;
//counter
if(temp_odd==obs_odd && temp_paired==obs_paired){
match_count = match_count + 1;
BigVector[(5*i) + 4] = 1.;
continue;
}
else{
BigVector[(5*i) + 4] = 0.;
continue;
}
//free the temp allocated things
free(gen_pop);
free(gen_samp);
}
gsl_rng_free(r);
return(match_count);
}
