static VALUE rb_gsl_vector_int_mul(VALUE obj, VALUE b)
{
VALUE argv[2];
gsl_vector_int *v, *vnew, *v2;
gsl_matrix_int *m;
int val;
size_t i, j;
switch (TYPE(b)) {
case T_FIXNUM:
case T_FLOAT:
return rb_gsl_vector_int_scale(obj, b);
break;
default:
if (VECTOR_INT_ROW_P(obj) && VECTOR_INT_COL_P(b)) {
argv[0] = obj;
argv[1] = b;
return rb_gsl_vector_int_inner_product(2, argv, CLASS_OF(obj));
} else if (VECTOR_INT_ROW_P(obj) && MATRIX_INT_P(b)) {
Data_Get_Struct(obj, gsl_vector_int, v);
Data_Get_Struct(b, gsl_matrix_int, m);
vnew = mygsl_vector_int_mul_matrix(v, m);
return Data_Wrap_Struct(cgsl_vector_int, 0, gsl_vector_int_free, vnew);
} else if (VECTOR_INT_COL_P(obj) && VECTOR_INT_ROW_P(b)) {
Data_Get_Struct(obj, gsl_vector_int, v);
Data_Get_Struct(b, gsl_vector_int, v2);
if (v->size != v2->size) rb_raise(rb_eIndexError, "Vector sizes does not match.");
m = gsl_matrix_int_alloc(v->size, v2->size);
for (i = 0; i < v->size; i++) {
for (j = 0; j < v2->size; j++) {
val = gsl_vector_int_get(v, i)*gsl_vector_int_get(v2, j);
gsl_matrix_int_set(m, i, j, val);
}
}
return Data_Wrap_Struct(cgsl_matrix_int, 0, gsl_matrix_int_free, m);
} else {
return rb_gsl_vector_mul(rb_gsl_vector_int_to_f(obj), b);
}
break;
}
}
/**
* The function creates and loads the segmentation image
* of a flux_cube file into a gsl_matrix_int structure.
*
* @param fcube_file - the file name of the fluxcube
*
* @return ret - pointer to the gsl_matrix_int structure
*/
gsl_matrix_int *
load_segmentation(const char fcube_file[])
{
gsl_matrix_int *segmentation;
gsl_matrix *dvals;
int i,j;
double diff;
// load the segmentation image into a gsl_matrix_(double)
dvals = FITSimage_to_gsl(fcube_file, 2, 1);
// add 0.5 to get proper rounding with (int)
gsl_matrix_add_constant (dvals, 0.5);
// allocate space for the integer matrix
segmentation = gsl_matrix_int_alloc(dvals->size1,dvals->size2);
// fill the integer matrix with values from the double matrix
for (i=0; i < dvals->size1; i++)
{
for (j=0; j < dvals->size2; j++)
{
gsl_matrix_int_set(segmentation, i, j, (int)gsl_matrix_get(dvals, i, j));
diff = gsl_matrix_get(dvals, i, j) - (double)gsl_matrix_int_get(segmentation, i, j);
if (diff > 0.6 || diff < 0.4)
fprintf(stdout, "diff %f; %f --> %i, (%i, %i)\n", diff, gsl_matrix_get(dvals, i, j), gsl_matrix_int_get(segmentation, i, j), i, j);
}
}
// free the space for the double matrix
gsl_matrix_free(dvals);
return segmentation;
}
// Load one of data into the model. The vararg should be a list of values with
// length equal to the number of discrete columns plus the number of continuous
// columns. The first values in the vararg are taken to be discrete, followed
// by the continuous values.
//
SCM
thit_load_row_x(SCM s_model, SCM s_varargs) {
scm_assert_smob_type(thit_model_tag, s_model);
banmi_model_t *model = (banmi_model_t*)SCM_SMOB_DATA(s_model);
int n_col = model->n_disc + model->n_cont;
int n_args = scm_to_int(scm_length(s_varargs));
if (model->n_rows == model->disc->size1)
scm_error_scm(thit_error,
scm_from_locale_string("load-row!"),
scm_from_locale_string("The model is full, can't add more rows."),
scm_list_2(scm_from_int(n_col), scm_from_int(n_args)),
SCM_BOOL_F);
if (n_args != n_col)
scm_error_scm(thit_error,
scm_from_locale_string("load-row!"),
scm_from_locale_string("Expected ~A values, got ~A."),
scm_list_2(scm_from_int(n_col), scm_from_int(n_args)),
SCM_BOOL_F);
int j, ival;
for (j = 0; j < model->n_disc; j++) {
ival = scm_to_int(scm_list_ref(s_varargs, scm_from_int(j)));
gsl_matrix_int_set(model->disc, model->n_rows, j, ival);
}
double dval;
for (j = 0; j < model->n_cont; j++) {
dval = scm_to_double(scm_list_ref(s_varargs, scm_from_int(j + model->n_disc)));
gsl_matrix_set(model->cont, model->n_rows, j, dval);
}
model->n_rows++;
return SCM_BOOL_T;
}
nextstep Step5(gsl_matrix_uint * const mask,
gsl_matrix_int * const path,
gsl_vector_uint * const rowCov,
gsl_vector_uint * const colCov,
unsigned int z0_r,
unsigned int z0_c)
{
unsigned int count = 0;
int row, col;
gsl_matrix_int_set_all(path, -1);
// Begin with 0' from Step 4
gsl_matrix_int_set(path, count, 0, z0_r);
gsl_matrix_int_set(path, count, 1, z0_c);
while(count < (path->size1-1))
{
// Find 0* in col
FindStarInCol(mask, &row, gsl_matrix_int_get(path, count, 1));
if(row == -1) break;
count++;
gsl_matrix_int_set(path, count, 0, row);
gsl_matrix_int_set(path, count, 1, gsl_matrix_int_get(path, count-1, 1));
if(count < (path->size1-1))
{
// Find 0' in row
FindPrimeInRow(mask, gsl_matrix_int_get(path, count, 0), &col);
count++;
gsl_matrix_int_set(path, count, 0, gsl_matrix_int_get(path, count-1, 0));
gsl_matrix_int_set(path, count, 1, col);
}
}
count++;
ConvertPath(path, count, mask);
gsl_vector_uint_set_all(rowCov, UNCOVERED);
gsl_vector_uint_set_all(colCov, UNCOVERED);
ErasePrimes(mask);
return STEP3;
}
void coalMarkovChainTopologyMatrix_pthread(afsStateSpace *S,gsl_matrix *topol, gsl_matrix_int *moveType, int *dim1, int *dim2, int start, int stop, int *nnz){
int i,j,k,steps,x,y;
double top,bottom;
afsObject *delta;
int **activePos1, **activePos2; //first dimension here relates to 2 popns
int nlin1,nlin2,compat;
int nonZeroCount, tot, tCount;
int size = 200;
nlin1 = nlin2 = 0;
nonZeroCount = 0;
if(S->nstates != topol->size1 || S->nstates != moveType->size1){
fprintf(stderr,"Error: StateSpace and matrices are not of equal size\n");
exit(1);
}
*nnz = 0;
//arrays for finding positions of entries
activePos1 = malloc(size*sizeof(int *));
activePos2 = malloc(size*sizeof(int *));
for(i=0;i<size;i++){
activePos1[i] = malloc(2*sizeof(int));
activePos1[i][0] = activePos1[i][1] = 0;
activePos2[i] = malloc(2*sizeof(int));
activePos2[i][0] = activePos2[i][1] = 0;
}
tot = S->nstates * S->nstates;
tCount = 0;
delta = afsObjectNewFrom(S->states[0]);
for(i=start;i<stop;i++){
for(j=0;j<S->nstates;j++){
gsl_matrix_int_set(moveType,i,j,666);
//is ith state root state?
if(S->states[i]->nalleles == 1){
//set correct absorbing conditions
if(i==j){
gsl_matrix_set(topol,i,j,1.0);
gsl_matrix_int_set(moveType,i,j,-1);
dim1[nonZeroCount] = i;
dim2[nonZeroCount] = j;
nonZeroCount += 1;
}
else{
gsl_matrix_set(topol,i,j,0.0);
gsl_matrix_int_set(moveType,i,j,-1);
}
}
else{ //ith not root; what is the move?
steps = S->states[i]->nalleles - S->states[j]->nalleles ;
if(steps < 2){
// delta = afsObjectDelta(S->states[i],S->states[j]);
afsObjectDeltaPre(S->states[i],S->states[j],delta);
switch(steps){
case 0:
// 0 "steps", so no changes in nalleles between two
//check counts and positions
if(abs(matrixSum(delta->popMats[0])) == 1){
nonZeroEntries(delta->popMats[0], activePos1, &nlin1);
nonZeroEntries(delta->popMats[1], activePos2, &nlin2);
//migration?
if(nlin1 == nlin2 && activePos1[0][0] == activePos2[0][0] &&
(gsl_matrix_int_min(delta->popMats[0]) >= 0 || gsl_matrix_int_min(delta->popMats[1]) >= 0))
{
//migration popn1?
if(matrixSum(delta->popMats[0]) == 1){
gsl_matrix_set(topol,i,j,
(double) gsl_matrix_int_get(S->states[i]->popMats[0],
activePos1[0][0], activePos1[0][1]) / S->states[i]->aCounts[0]);
gsl_matrix_int_set(moveType,i,j,2);
dim1[nonZeroCount] = i;
dim2[nonZeroCount] = j;
nonZeroCount += 1;
}
else{ //migration popn2
gsl_matrix_set(topol,i,j,
(double) gsl_matrix_int_get(S->states[i]->popMats[1],
activePos2[0][0],activePos2[0][1]) / S->states[i]->aCounts[1]);
gsl_matrix_int_set(moveType,i,j,3);
dim1[nonZeroCount] = i;
dim2[nonZeroCount] = j;
nonZeroCount += 1;
}
}
}
break;
case 1://coalescent?
//coal popn1?
if(matrixSum(delta->popMats[0]) == 1 && countNegativeEntries(delta->popMats[1]) == 0 && S->states[j]->aCounts[0] >= 1 ){
entriesGreaterThan(delta->popMats[0], activePos1, &nlin1,0);//old lineages
entriesLessThan(delta->popMats[0], activePos2, &nlin2,0);//new lineages
if(nlin2 != 0 && nlin2 < 2){
compat=0;
if(nlin1 == 1){
if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
compat = 1;
}
if(nlin1==2){
if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
compat = 1;
}
if(compat != 1){
gsl_matrix_set(topol,i,j,0.0);
gsl_matrix_int_set(moveType,i,j,666);
}
else{
top = 1.0;
bottom = S->states[i]->aCounts[0] * (S->states[i]->aCounts[0]-1) /2.0 ;
for(k=0;k<nlin1;k++){
x = activePos1[k][0];
y = activePos1[k][1];
top *= (float) xchoosey(gsl_matrix_int_get(S->states[i]->popMats[0],x,y),
gsl_matrix_int_get(delta->popMats[0],x,y));
}
gsl_matrix_set(topol,i,j,top/bottom);
gsl_matrix_int_set(moveType,i,j,0);
dim1[nonZeroCount] = i;
dim2[nonZeroCount] = j;
nonZeroCount += 1;
}
}
}
else{
if(matrixSum(delta->popMats[1]) == 1 && countNegativeEntries(delta->popMats[0]) == 0 && S->states[j]->aCounts[1] >= 1 ){
entriesGreaterThan(delta->popMats[1], activePos1, &nlin1,0);//old lineages
entriesLessThan(delta->popMats[1], activePos2, &nlin2,0);//new lineages
if(nlin2 != 0 && nlin2 < 2){
compat=0;
if(nlin1 == 1){
if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
compat = 1;
}
if(nlin1==2){
if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
compat = 1;
}
if(compat != 1){
gsl_matrix_set(topol,i,j,0.0);
gsl_matrix_int_set(moveType,i,j,666);
}
else{
top = 1.0;
bottom = S->states[i]->aCounts[1] * (S->states[i]->aCounts[1]-1) /2.0 ;
for(k=0;k<nlin1;k++){
x = activePos1[k][0];
y = activePos1[k][1];
top *= xchoosey(gsl_matrix_int_get(S->states[i]->popMats[1],x,y),
gsl_matrix_int_get(delta->popMats[1],x,y));
}
gsl_matrix_set(topol,i,j,top/bottom);
gsl_matrix_int_set(moveType,i,j,1);
dim1[nonZeroCount] = i;
dim2[nonZeroCount] = j;
nonZeroCount += 1;
}
}
}
}
break;
}
//afsObjectFree(delta);
}
}
}
}
//cleanup and free
for(i=0;i<size;i++){
free(activePos1[i]);
free(activePos2[i]);
}
free(activePos1);
free(activePos2);
*nnz = nonZeroCount;
}
