int main(int argc, char **argv) { struct timeval ts,tf; double tt; int n; matrix a, b,c; check(argc >= 3, "main: Need matrix size and block size on command line"); n = atoi(argv[1]); block=atoi(argv[2]); a = newmatrix(n); b = newmatrix(n); c = newmatrix(n); randomfill(n, a); randomfill(n, b); gettimeofday(&ts,NULL); StrassenMult(n, a, b, c); /* strassen algorithm */ gettimeofday(&tf,NULL); tt=(tf.tv_sec-ts.tv_sec)+(tf.tv_usec-ts.tv_usec)*0.000001; printf("Strassen Size %d Block %d Time %lf\n",n,block,tt); char *filename=malloc(30*sizeof(char)); sprintf(filename,"res_mm_strassen_%d",n); FILE * f=fopen(filename,"w"); print(n,c,f); fclose(f); freematrix(a,n); freematrix(b,n); freematrix(c,n); return 0; }
/* return new square n by n matrix */ matrix newmatrix(int n) { matrix a; a = (matrix)malloc(sizeof(*a)); check(a != NULL, "newmatrix: out of space for matrix"); if (n <= block) { int i; a->d = (double **)calloc(n, sizeof(double *)); check(a->d != NULL, "newmatrix: out of space for row pointers"); for (i = 0; i < n; i++) { a->d[i] = (double *)calloc(n, sizeof(double)); check(a != NULL, "newmatrix: out of space for rows"); } } else { n /= 2; a->p = (matrix *)calloc(4, sizeof(matrix)); check(a->p != NULL,"newmatrix: out of space for submatrices"); a11 = newmatrix(n); a12 = newmatrix(n); a21 = newmatrix(n); a22 = newmatrix(n); } return a; }
/**The direct sum of two LaGenMatDouble */ LaGenMatDouble snake::math::directsum(LaGenMatDouble &a,LaGenMatDouble &b) { int arow = a.size(0),brow = b.size(0); int acol = a.size(1),bcol = b.size(1); LaGenMatDouble newmatrix(arow+brow,acol+bcol); newmatrix(LaIndex(0,arow+brow-1),LaIndex(0,acol+bcol-1)) = 0; if(arow>0&&acol>0) newmatrix(LaIndex(0,arow-1),LaIndex(0,acol-1)).inject(a); if(brow>0&&bcol>0) newmatrix(LaIndex(arow,arow+brow-1),LaIndex(acol,acol+bcol-1)).inject(b); return newmatrix; }
/* c = a*b */ void RecMult(int n, matrix a, matrix b, matrix c) { matrix d; if (n <= block) { double sum, **p = a->d, **q = b->d, **r = c->d; int i, j, k; for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { for (sum = 0., k = 0; k < n; k++) sum += p[i][k] * q[k][j]; r[i][j] = sum; } } } else { d=newmatrix(n); n /= 2; RecMult(n, a11, b11, d11); RecMult(n, a12, b21, c11); RecAdd(n, d11, c11, c11); RecMult(n, a11, b12, d12); RecMult(n, a12, b22, c12); RecAdd(n, d12, c12, c12); RecMult(n, a21, b11, d21); RecMult(n, a22, b21, c21); RecAdd(n, d21, c21, c21); RecMult(n, a21, b12, d22); RecMult(n, a22, b22, c22); RecAdd(n, d22, c22, c22); freematrix(d,n*2); } }
void MatrMultTG(int n, matrix a, matrix b, matrix c){ matrix d; if (n<=block) { double sum, **p = a->d, **q = b->d, **r = c->d, temp; int i, j, k,jj, kk; /* for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { for (sum = 0., k = 0; k < n; k++) sum += p[i][k] * q[k][j]; r[i][j] = sum; } } */ for(int jj=0;jj<n;jj+= 16){ for(int kk=0; kk<n; kk+= 16){ for(int i=0;i<n; i++){ for(int j = jj; j<((jj+16)>n ? n:(jj+16)); j++){ temp = 0; for(int k = kk; k<((kk+16) > n ?n :(kk+16)); k++){ temp += p[i][k]*q[k][j]; } r[i][j] += temp; } } } } } else { d=newmatrix(n); n/=2; tbb::task_group g; g.run([&] { MatrMultTG(n, a11, b11, d11); }); g.run([&] { MatrMultTG(n, a12, b21, c11); }); g.run([&] { MatrMultTG(n, a11, b12, d12); }); g.run([&] { MatrMultTG(n, a12, b22, c12); }); g.run([&] { MatrMultTG(n, a21, b11, d21); }); g.run([&] { MatrMultTG(n, a22, b21, c21); }); g.run([&] { MatrMultTG(n, a21, b12, d22); }); g.run([&] { MatrMultTG(n, a22, b22, c22); }); g.wait(); g.run([&] { RecAddTG(n, d11, c11, c11); }); g.run([&] { RecAddTG(n, d12, c12, c12); }); g.run([&] { RecAddTG(n, d21, c21, c21); }); g.run([&] { RecAddTG(n, d22, c22, c22); }); g.wait(); freematrix(d,n*2); } };
Matrix Matrix::operator-(Matrix& inmatrix) { int32 i,j; Matrix newmatrix(*this); for(i = 0; i < _row; i++){ for(j = 0; j < _col; j++){ newmatrix._m[i][j] -= inmatrix._m[i][j]; } } return newmatrix; }
void modi(problem *p, matrix *x) { matrix *rcost = newmatrix(p->angebot,p->nachfrage); nochmal: { tmatrix *m = newtmatrix(x); update_alphabeta(p,m); relcost(p,rcost); if(DEBUG) { printf("\nLoesung:\n"); printmatrix(x); printf("\n\n"); printf("Wahrheitsmatrix zu Loesung:\n"); printtmatrix(m); printf("\n\n"); printf("\nAlpha/Beta dazu:\n"); print_alphabeta(p); printf("\n\n"); printf("\nRelative Kosten dazu:\n"); printmatrix(rcost); printf("\n\n"); } int i=0,j=0,min=0,merker_i=0,merker_j=0; for(i=0; i < rcost->x; i++) { for(j=0; j < rcost->y; j++) { if(rcost->matrix[i*rcost->y+j] < min) { min = rcost->matrix[i*rcost->y+j]; merker_i = i; merker_j = j; } } } if(min < 0) { node *n = newnode(merker_i,merker_j); if(findezyklus(n,m)) { int mfluss = maxfluss(n,x,0,BIGINT); /* Basisloesung anpassen */ aenderloesung(x,n,mfluss,0,0); goto nochmal; } } } }
int main(int argc, char* argv[]) { int nthreads=0; int n=0; matrix a,b,c; tbb::tick_count tic, toc; n = atoi(argv[1]); block=atoi(argv[2]); nthreads=atoi(argv[3]); a = newmatrix(n); b = newmatrix(n); c = newmatrix(n); randomfill(n, a); randomfill(n, b); randomfill(n,c); tbb::task_scheduler_init init(nthreads); tic = tbb::tick_count::now (); RecMultTask &start = *new(tbb::task::allocate_root()) RecMultTask(n, a, b, c); tbb::task::spawn_root_and_wait(start); toc = tbb::tick_count::now(); std::cout << (toc - tic).seconds() << "\n"; tic = tbb::tick_count::now (); MatrMultTG(n,a,b,c); toc = tbb::tick_count::now (); std::cout << (toc - tic).seconds() << "\n"; freematrix(a,n); freematrix(b,n); freematrix(c,n); return 0; }
static LVAL make_transformation P2C(double **, a, int, vars) { LVAL result, data; int i, j, k; if (a == NULL) return(NIL); xlsave1(result); result = newmatrix(vars, vars); data = getdarraydata(result); for (i = 0, k = 0; i < vars; i++) for (j = 0; j < vars; j++, k++) settvecelement(data, k, cvflonum((FLOTYPE) a[i][j])); xlpop(); return(result); }
matrix matrix::operator-(const matrix& right) const { if (dimension_c_ != right.dimension_c_ || dimension_r_ != right.dimension_r_) perror("trying to minus one matrix by another one with different dimension"); matrix newmatrix(dimension_r_, dimension_c_); for (size_t j = 0; j < dimension_c_; j++) { double* this_cols = this->getcolumnhead_const(j); double* new_cols = newmatrix.getcolumnhead(j); double* right_cols = right.getcolumnhead_const(j); for (size_t i = 0; i < dimension_r_; i++) { new_cols[i] = this_cols[i] - right_cols[i]; } } return newmatrix; }
LOCAL LVAL linalg2genmat P4C(LVAL, arg, int, m, int, n, int, trans) { LVAL x, y; int mn; x = compounddataseq(arg); mn = m * n; if (! tvecp(x)) xlbadtype(arg); if (n <= 0 || m <= 0 || gettvecsize(x) < mn) xlfail("bad dimensions"); xlsave1(y); y = newmatrix(m, n); if (trans) transposeinto(x, n, m, y); else xlreplace(getdarraydata(y), x, 0, mn, 0, mn); xlpop(); return y; }
Matrix Matrix::operator*(Matrix& inmatrix) { int32 i,j,k; int32 inrow = inmatrix._row; int32 incol = inmatrix._col; double temp; Matrix newmatrix(_row, incol); for(i = 0; i < _row; i++){ for(j = 0; j < incol; j++){ newmatrix._m[i][j] = 0.0; for(k = 0; k < _col; k++){ newmatrix._m[i][j] += _m[i][k]*inmatrix._m[k][j]; } } } return newmatrix; /* Matrix *newmatrix; newmatrix = new Matrix(_row, incol); for(int32 i = 0; i < _row; i++){ for(int32 j = 0; j < incol; j++){ newmatrix->_m[i][j] = 0.0; for(int32 k = 0; k < _col; k++){ temp = (double)(_m[i][k])*(double)(inmatrix._m[k][j]); newmatrix->_m[i][j] += temp; } } } return *newmatrix; */ }
task* execute() { matrix d; if (n<=block) { double sum, **p = a->d, **q = b->d, **r = c->d; int i, j, k; /* for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { for (sum = 0., k = 0; k < n; k++) sum += p[i][k] * q[k][j]; r[i][j] = sum; } } */ for(int jj=0;jj<n;jj+= 16){ for(int kk=0; kk<n; kk+= 16){ for(int i=0;i<n; i++){ for(int j = jj; j<((jj+16)>n ? n:(jj+16)); j++){ temp = 0; for(int k = kk; k<((kk+16) > n ?n :(kk+16)); k++){ temp += p[i][k]*q[k][j]; } r[i][j] += temp; } } } } } else { d=newmatrix(n); n/=2; RecMultTask& t1 = *new(tbb::task::allocate_child() ) RecMultTask(n, a11, b11, d11); RecMultTask& t2 = *new(tbb::task::allocate_child() ) RecMultTask(n, a12, b21, c11); RecMultTask& t3 = *new(tbb::task::allocate_child() ) RecMultTask(n, a11, b12, d12); RecMultTask& t4 = *new(tbb::task::allocate_child() ) RecMultTask(n, a12, b22, c12); RecMultTask& t5 = *new(tbb::task::allocate_child() ) RecMultTask(n, a21, b11, d21); RecMultTask& t6 = *new(tbb::task::allocate_child() ) RecMultTask(n, a22, b21, c21); RecMultTask& t7 = *new(tbb::task::allocate_child() ) RecMultTask(n, a21, b12, d22); RecMultTask& t8 = *new(tbb::task::allocate_child() ) RecMultTask(n, a22, b22, c22); set_ref_count(9); tbb::task::spawn(t1); tbb::task::spawn(t2); tbb::task::spawn(t3); tbb::task::spawn(t4); tbb::task::spawn(t5); tbb::task::spawn(t6); tbb::task::spawn(t7); tbb::task::spawn(t8); tbb::task::wait_for_all(); RecAddTask& t9 = *new(tbb::task::allocate_child() ) RecAddTask(n, c11, c11, d11); RecAddTask& t10 = *new(tbb::task::allocate_child() ) RecAddTask(n, c12, c12, d12); RecAddTask& t11 = *new(tbb::task::allocate_child() ) RecAddTask(n, c21, c21, d21); RecAddTask& t12 = *new(tbb::task::allocate_child() ) RecAddTask(n, c22, c22, d22); set_ref_count(5); tbb::task::spawn(t9); tbb::task::spawn(t10); tbb::task::spawn(t11); tbb::task::spawn(t12); tbb::task::wait_for_all(); } return NULL; }
double analyseF2(int Nind, int *nummark, cvector *cofactor, MQMMarkerMatrix marker, vector y, int Backwards, double **QTL,vector *mapdistance, int **Chromo, int Nrun, int RMLorML, double windowsize, double stepsize, double stepmin, double stepmax, double alfa, int em, int out_Naug, int **INDlist, char reestimate, MQMCrossType crosstype, bool dominance, int verbose) { if (verbose) Rprintf("INFO: Starting C-part of the MQM analysis\n"); int Naug, Nmark = (*nummark), run = 0; bool useREML = true, fitQTL = false; bool warned = false; ivector chr = newivector(Nmark); // The chr vector contains the chromosome number for every marker for(int i = 0; i < Nmark; i++){ // Rprintf("INFO: Receiving the chromosome matrix from R"); chr[i] = Chromo[0][i]; } if(RMLorML == 1) useREML=false; // use ML instead // Create an array of marker positions - and calculate R[f] based on these locations cvector position = relative_marker_position(Nmark,chr); vector r = recombination_frequencies(Nmark, position, (*mapdistance)); //Rprintf("INFO: Initialize Frun and informationcontent to 0.0"); const int Nsteps = (int)(chr[Nmark-1]*((stepmax-stepmin)/stepsize+1)); matrix Frun = newmatrix(Nsteps,Nrun+1); vector informationcontent = newvector(Nsteps); for (int i = 0; i < (Nrun+1); i++) { for (int ii = 0; ii < Nsteps; ii++) { if(i==0) informationcontent[ii] = 0.0; Frun[ii][i]= 0.0; } } bool dropj = false; int jj=0; // Rprintf("any triple of non-segregating markers is considered to be the result of:\n"); // Rprintf("identity-by-descent (IBD) instead of identity-by-state (IBS)\n"); // Rprintf("no (segregating!) cofactors are fitted in such non-segregating IBD regions\n"); for (int j=0; j < Nmark; j++) { // WRONG: (Nmark-1) Should fix the out of bound in mapdistance, it does fix, but created problems for the last marker dropj = false; if(j+1 < Nmark){ // Check if we can look ahead if(((*mapdistance)[j+1]-(*mapdistance)[j])==0.0){ dropj=true; } } if (!dropj) { marker[jj] = marker[j]; (*cofactor)[jj] = (*cofactor)[j]; (*mapdistance)[jj] = (*mapdistance)[j]; chr[jj] = chr[j]; r[jj] = r[j]; position[jj] = position[j]; jj++; } else{ if (verbose) Rprintf("INFO: Marker %d at chr %d is dropped\n",j,chr[j]); if ((*cofactor)[j]==MCOF) { if (verbose) Rprintf("INFO: Cofactor at chr %d is dropped\n",chr[j]); } } } //if(verbose) Rprintf("INFO: Number of markers: %d -> %d\n",Nmark,jj); Nmark = jj; (*nummark) = jj; // Update the array of marker positions - and calculate R[f] based on these new locations position = relative_marker_position(Nmark,chr); r = recombination_frequencies(Nmark, position, (*mapdistance)); debug_trace("After dropping of uninformative cofactors\n"); ivector newind; // calculate Traits mean and variance vector newy; MQMMarkerMatrix newmarker; double ymean = 0.0, yvari = 0.0; //Rprintf("INFO: Number of individuals: %d Number Aug: %d",Nind,out_Naug); int cur = -1; for (int i=0; i < Nind; i++){ if(INDlist[0][i] != cur){ ymean += y[i]; cur = INDlist[0][i]; } } ymean/= out_Naug; for (int i=0; i < Nind; i++){ if(INDlist[0][i] != cur){ yvari += pow(y[i]-ymean, 2); cur = INDlist[0][i]; } } yvari /= (out_Naug-1); Naug = Nind; // Fix for not doing dataaugmentation, we just copy the current as the augmented and set Naug to Nind Nind = out_Naug; newind = newivector(Naug); newy = newvector(Naug); newmarker = newMQMMarkerMatrix(Nmark,Naug); for (int i=0; i<Naug; i++) { newy[i]= y[i]; newind[i]= INDlist[0][i]; for (int j=0; j<Nmark; j++) { newmarker[j][i]= marker[j][i]; } } // End fix vector newweight = newvector(Naug); double max = rmixture(newmarker, newweight, r, position, newind,Nind, Naug, Nmark, mapdistance,reestimate,crosstype,verbose); //Re-estimation of mapdistances if reestimate=TRUE if(max > stepmax){ fatal("ERROR: Re-estimation of the map put markers at: %f Cm, run the algorithm with a step.max larger than %f Cm", max, max); } //Check if everything still is correct positions and R[f] position = relative_marker_position(Nmark,chr); r = recombination_frequencies(Nmark, position, (*mapdistance)); /* eliminate individuals with missing trait values */ //We can skip this part iirc because R throws out missing phenotypes beforehand int oldNind = Nind; for (int i=0; i<oldNind; i++) { Nind -= ((y[i]==TRAITUNKNOWN) ? 1 : 0); } int oldNaug = Naug; for (int i=0; i<oldNaug; i++) { Naug -= ((newy[i]==TRAITUNKNOWN) ? 1 : 0); } marker = newMQMMarkerMatrix(Nmark+1,Naug); y = newvector(Naug); ivector ind = newivector(Naug); vector weight = newvector(Naug); int newi = 0; for (int i=0; i < oldNaug; i++) if (newy[i]!=TRAITUNKNOWN) { y[newi]= newy[i]; ind[newi]= newind[i]; weight[newi]= newweight[i]; for (int j=0; j<Nmark; j++) marker[j][newi]= newmarker[j][i]; newi++; } int diff; for (int i=0; i < (Naug-1); i++) { diff = ind[i+1]-ind[i]; if (diff>1) { for (int ii=i+1; ii<Naug; ii++){ ind[ii]=ind[ii]-diff+1; } } } //END throwing out missing phenotypes double variance=-1.0; cvector selcofactor = newcvector(Nmark); /* selected cofactors */ int dimx = designmatrixdimensions((*cofactor),Nmark,dominance); double F1 = inverseF(1,Nind-dimx,alfa,verbose); double F2 = inverseF(2,Nind-dimx,alfa,verbose); if (verbose) { Rprintf("INFO: dimX: %d, nInd: %d\n",dimx,Nind); Rprintf("INFO: F(Threshold, Degrees of freedom 1, Degrees of freedom 2) = Alfa\n"); Rprintf("INFO: F(%.3f, 1, %d) = %f\n",ftruncate3(F1),(Nind-dimx),alfa); Rprintf("INFO: F(%.3f, 2, %d) = %f\n",ftruncate3(F2),(Nind-dimx),alfa); } F2 = 2.0* F2; // 9-6-1998 using threshold x*F(x,df,alfa) weight[0]= -1.0; double logL = QTLmixture(marker,(*cofactor),r,position,y,ind,Nind,Naug,Nmark,&variance,em,&weight,useREML,fitQTL,dominance,crosstype, &warned, verbose); if(verbose){ if (!R_finite(logL)) { Rprintf("WARNING: Log-likelihood of full model = INFINITE\n"); }else{ if (R_IsNaN(logL)) { Rprintf("WARNING: Log-likelihood of full model = NOT A NUMBER (NAN)\n"); }else{ Rprintf("INFO: Log-likelihood of full model = %.3f\n",ftruncate3(logL)); } } Rprintf("INFO: Residual variance = %.3f\n",ftruncate3(variance)); Rprintf("INFO: Trait mean= %.3f; Trait variation = %.3f\n",ftruncate3(ymean),ftruncate3(yvari)); } if (R_finite(logL) && !R_IsNaN(logL)) { if(Backwards==1){ // use only selected cofactors logL = backward(Nind, Nmark, (*cofactor), marker, y, weight, ind, Naug, logL,variance, F1, F2, &selcofactor, r, position, &informationcontent, mapdistance,&Frun,run,useREML,fitQTL,dominance, em, windowsize, stepsize, stepmin, stepmax,crosstype,verbose); }else{ // use all cofactors logL = mapQTL(Nind, Nmark, (*cofactor), (*cofactor), marker, position,(*mapdistance), y, r, ind, Naug, variance, 'n', &informationcontent,&Frun,run,useREML,fitQTL,dominance, em, windowsize, stepsize, stepmin, stepmax,crosstype,verbose); // printout=='n' } } // Write output and/or send it back to R // Cofactors that made it to the final model for (int j=0; j<Nmark; j++) { if (selcofactor[j]==MCOF) { (*cofactor)[j]=MCOF; }else{ (*cofactor)[j]=MNOCOF; } } if (verbose) Rprintf("INFO: Number of output datapoints: %d\n", Nsteps); // QTL likelihood for each location for (int ii=0; ii<Nsteps; ii++) { //Convert LR to LOD before sending back QTL[0][ii] = Frun[ii][0] / 4.60517; QTL[0][Nsteps+ii] = informationcontent[ii]; } return logL; }
/*Recursive Strassen Multiplication*/ void StrassenMult(int n, matrix a, matrix b, matrix c) { matrix t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,q1,q2,q3,q4,q5,q6,q7; if (n <= block) { double sum, **p = a->d, **q = b->d, **r = c->d; int i, j, k; for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { for (sum = 0., k = 0; k < n; k++) sum += p[i][k] * q[k][j]; r[i][j] = sum; } } } else { n /= 2; t1=newmatrix(n); t2=newmatrix(n); t3=newmatrix(n); t4=newmatrix(n); t5=newmatrix(n); t6=newmatrix(n); t7=newmatrix(n); t8=newmatrix(n); t9=newmatrix(n); t10=newmatrix(n); q1=newmatrix(n); q2=newmatrix(n); q3=newmatrix(n); q4=newmatrix(n); q5=newmatrix(n); q6=newmatrix(n); q7=newmatrix(n); RecAdd(n,a11,a22,t1); RecAdd(n,b11,b22,t2); RecAdd(n,a21,a22,t3); RecSub(n,b12,b22,t4); RecSub(n,b21,b11,t5); RecAdd(n,a11,a12,t6); RecSub(n,a21,a11,t7); RecAdd(n,b11,b12,t8); RecSub(n,a12,a22,t9); RecAdd(n,b21,b22,t10); StrassenMult(n,t1,t2,q1); StrassenMult(n,t3,b11,q2); StrassenMult(n,a11,t4,q3); StrassenMult(n,a22,t5,q4); StrassenMult(n,t6,b22,q5); StrassenMult(n,t7,t8,q6); StrassenMult(n,t9,t10,q7); RecAdd(n,q1,q4,c11); RecSub(n,c11,q5,c11); RecAdd(n,q7,c11,c11); RecAdd(n,q3,q5,c12); RecAdd(n,q2,q4,c21); RecAdd(n,q1,q3,c22); RecAdd(n,q6,c22,c22); RecSub(n,c22,q2,c22); freematrix(t1,n); freematrix(t2,n); freematrix(t3,n); freematrix(t4,n); freematrix(t5,n); freematrix(t6,n); freematrix(t7,n); freematrix(t8,n); freematrix(t9,n); freematrix(t10,n); freematrix(q1,n); freematrix(q2,n); freematrix(q3,n); freematrix(q4,n); freematrix(q5,n); freematrix(q6,n); freematrix(q7,n); } }
int mqmaugmentfull(MQMMarkerMatrix* markers,int* nind, int* augmentednind, ivector* INDlist, double neglect_unlikely, int max_totalaugment, int max_indaugment, const matrix* pheno_value, const int nmark, const ivector chr, const vector mapdistance, const int augment_strategy, const MQMCrossType crosstype,const int verbose){ //Prepare for the first augmentation if (verbose) Rprintf("INFO: Augmentation routine\n"); const int nind0 = *nind; const vector originalpheno = (*pheno_value)[0]; MQMMarkerMatrix newmarkerset; // [Danny:] This LEAKS MEMORY the Matrices and vectors are not cleaned at ALL vector new_y; // Because we do a phenotype matrix, we optimize by storing original the R-individual ivector new_ind; // numbers inside the trait-values, ands use new_ind etc for inside C ivector succes_ind; cvector position = relative_marker_position(nmark,chr); vector r = recombination_frequencies(nmark, position, mapdistance); if(verbose) Rprintf("INFO: Step 1: Augmentation"); mqmaugment((*markers), (*pheno_value)[0], &newmarkerset, &new_y, &new_ind, &succes_ind, nind, augmentednind, nmark, position, r, max_totalaugment, max_indaugment, neglect_unlikely, crosstype, verbose); //First round of augmentation, check if there are still individuals we need to do int ind_still_left=0; int ind_done=0; for(int i=0; i<nind0; i++){ debug_trace("Individual:%d Succesfull?:%d",i,succes_ind[i]); if(succes_ind[i]==0){ ind_still_left++; }else{ ind_done++; } } if(ind_still_left && verbose) Rprintf("INFO: Step 2: Unaugmented individuals\n"); if(ind_still_left && augment_strategy != 3){ //Second round we augment dropped individuals from the first augmentation MQMMarkerMatrix left_markerset; matrix left_y_input = newmatrix(1,ind_still_left); vector left_y; ivector left_ind; if(verbose) Rprintf("INFO: Done with: %d/%d individuals still need to do %d\n",ind_done,nind0,ind_still_left); //Create a new markermatrix for the individuals MQMMarkerMatrix indleftmarkers= newMQMMarkerMatrix(nmark,ind_still_left); int current_leftover_ind=0; for(int i=0;i<nind0;i++){ if(succes_ind[i]==0){ debug_trace("IND %d -> %d",i,current_leftover_ind); left_y_input[0][current_leftover_ind] = originalpheno[i]; for(int j=0;j<nmark;j++){ indleftmarkers[j][current_leftover_ind] = (*markers)[j][i]; } current_leftover_ind++; } } mqmaugment(indleftmarkers, left_y_input[0], &left_markerset, &left_y, &left_ind, &succes_ind, ¤t_leftover_ind, ¤t_leftover_ind, nmark, position, r, max_totalaugment, max_indaugment, 1, crosstype, verbose); if(verbose) Rprintf("INFO: Augmentation step 2 returned most likely for %d individuals\n", current_leftover_ind); //Data augmentation done, we need to return both matrices to R int numimputations=1; if(augment_strategy==2){ numimputations=max_indaugment; //If we do imputation, we should generate enough to not increase likelihood for the 'unlikely genotypes' } MQMMarkerMatrix newmarkerset_all = newMQMMarkerMatrix(nmark,(*augmentednind)+numimputations*current_leftover_ind); vector new_y_all = newvector((*augmentednind)+numimputations*current_leftover_ind); ivector new_ind_all = newivector((*augmentednind)+numimputations*current_leftover_ind);; for(int i=0;i<(*augmentednind)+current_leftover_ind;i++){ int currentind; double currentpheno; if(i < (*augmentednind)){ // Results from first augmentation step currentind = new_ind[i]; currentpheno = new_y[i]; for(int j=0;j<nmark;j++){ newmarkerset_all[j][i] = newmarkerset[j][i]; } new_ind_all[i]= currentind; new_y_all[i]= currentpheno; }else{ // Results from second augmentation step currentind = ind_done+(i-(*augmentednind)); currentpheno = left_y[(i-(*augmentednind))]; debug_trace("Imputation of individual %d %d",currentind,numimputations); for(int a=0;a<numimputations;a++){ int newindex = (*augmentednind)+a+((i-(*augmentednind))*numimputations); debug_trace("i=%d,s=%d,i-s=%d index=%d/%d",i,(*augmentednind),(i-(*augmentednind)),newindex,(*augmentednind)+numimputations*current_leftover_ind); if(augment_strategy == 2 && a > 0){ for(int j=0;j<nmark;j++){ // Imputed genotype at 1 ... max_indaugment if(indleftmarkers[j][(i-(*augmentednind))]==MMISSING){ newmarkerset_all[j][newindex] = randommarker(crosstype); }else{ newmarkerset_all[j][newindex] = left_markerset[j][(i-(*augmentednind))]; } } }else{ for(int j=0;j<nmark;j++){ // Most likely genotype at 0 newmarkerset_all[j][newindex] = left_markerset[j][(i-(*augmentednind))]; } } new_ind_all[newindex]= currentind; new_y_all[newindex]= currentpheno; debug_trace("Individual: %d OriginalID:%f Variant:%d",currentind,currentpheno,a); } } } //Everything is added together so lets set out return pointers (*pheno_value)[0] = new_y_all; (*INDlist) = new_ind_all; (*markers) = newmarkerset_all; (*augmentednind)=(*augmentednind)+(numimputations*current_leftover_ind); (*nind)= (*nind)+(current_leftover_ind); debug_trace("nind:%d,naugmented:%d",(*nind)+(current_leftover_ind),(*augmentednind)+(current_leftover_ind)); Rprintf("INFO: VALGRIND MEMORY DEBUG BARRIERE TRIGGERED\n", ""); delMQMMarkerMatrix(newmarkerset, nmark); // Free the newmarkerset, this can only be done here since: (*markers) = newmarkerset_all; // Free(new_y_all); // Free(new_ind_all); }else{ if(ind_still_left && augment_strategy == 3){ if(verbose) Rprintf("INFO: Dropping %d augment_strategy individuals from further analysis\n",ind_still_left); } //We augmented all individuals in the first go so lets use those (*pheno_value)[0] = new_y; (*INDlist) = new_ind; (*markers) = newmarkerset; } if(verbose) Rprintf("INFO: Done with augmentation\n"); // Free(new_y); // Free vector indicating the new phenotypes // Free(new_ind); // Free vector indicating the new individuals Free(succes_ind); // Free vector indicating the result of round 1 - augmentation Free(position); // Free the positions of the markers Free(r); // Free the recombination frequencies return 1; }
int main(void) { int i=0; problem *p = readparameters(&nodes,&edges); if(!p) { printf("readparameters failed."); exit(1); } printf("Knoten:\t\t%4d\n Angebot:\t%4d\n Nachfrage:\t%4d\nKanten:\t\t%4d\n\n",nodes,p->angebot,p->nachfrage,edges); readgraph(p); printf("Kosten auf Kanten nach dem Einlesen:\n\n"); printgraph(p); matrix *x = newmatrix(p->angebot,p->nachfrage); /* Solange noch Spalten oder Zeilen vorhanden, Kante waehlen, * in die Basisloesung aufnehmen und Vogel-Werte neu berechnen. */ /* for(i=0; i < p->angebot+p->nachfrage-1; i++) { waehlekante_vogel(p,x); vogel(p); } printf("\n\nBasislösung nach Vogel:\n\n"); printmatrix(x); p = readparameters(&nodes,&edges); readgraph(p); x = newmatrix(p->angebot,p->nachfrage); */ for(i=0; i < p->angebot+p->nachfrage-1; i++) { waehlekante_nwe(p,x); } printf("\n\nBasislösung nach Nordwest-Ecken-Regel:\n\n"); printmatrix(x); /* p = readparameters(&nodes,&edges); readgraph(p); x = newmatrix(p->angebot,p->nachfrage); for(i=0; i < p->angebot+p->nachfrage-1; i++) { waehlekante_mkk(p,x); } printf("\n\nBasislösung nach Methode der kleinsten Kosten:\n\n"); printmatrix(x); */ /* Stepping stone */ /* stepstone(x,p); printf("\n\nBasislösung nach Stepping Stone:\n\n"); printmatrix(x); */ /* Modi */ modi(p,x); printf("\n\nBasislösung nach Modi:\n\n"); printmatrix(x); return 0; }
double regression(int Nind, int Nmark, cvector cofactor, MQMMarkerMatrix marker, vector y, vector *weight, ivector ind, int Naug, double *variance, vector Fy, bool biasadj, bool fitQTL, bool dominance, bool verbose) { debug_trace("regression IN\n"); /* cofactor[j] at locus j: MNOCOF: no cofactor at locus j MCOF: cofactor at locus j MSEX: QTL at locus j, but QTL effect is not included in the model MQTL: QTL at locu j and QTL effect is included in the model */ //Calculate the dimensions of the designMatrix int dimx=designmatrixdimensions(cofactor,Nmark,dominance); int j, jj; const int dimx_alloc = dimx+2; //Allocate structures matrix XtWX = newmatrix(dimx_alloc, dimx_alloc); cmatrix Xt = newcmatrix(dimx_alloc, Naug); vector XtWY = newvector(dimx_alloc); //Reset dimension designmatrix dimx = 1; for (j=0; j<Nmark; j++){ if ((cofactor[j]==MCOF)||(cofactor[j]==MQTL)) dimx+= (dominance ? 2 : 1); } cvector xtQTL = newcvector(dimx); int jx=0; for (int i=0; i<Naug; i++) Xt[jx][i]= MH; xtQTL[jx]= MNOCOF; for (j=0; j<Nmark; j++) if (cofactor[j]==MCOF) { // cofactor (not a QTL moving along the chromosome) jx++; xtQTL[jx]= MCOF; if (dominance) { for (int i=0; i<Naug; i++) if (marker[j][i]==MH) { Xt[jx][i]=48; //ASCII code 47, 48 en 49 voor -1, 0, 1; Xt[jx+1][i]=49; } else if (marker[j][i]==MAA) { Xt[jx][i]=47; // '/' stands for -1 Xt[jx+1][i]=48; } else { Xt[jx][i]=49; Xt[jx+1][i]=48; } jx++; xtQTL[jx]= MCOF; } else { for (int i=0; i<Naug; i++) { if (marker[j][i]==MH) { Xt[jx][i]=48; //ASCII code 47, 48 en 49 voor -1, 0, 1; } else if (marker[j][i]==MAA) { Xt[jx][i]=47; // '/' stands for -1 } else { Xt[jx][i]=49; } } } } else if (cofactor[j]==MQTL) { // QTL jx++; xtQTL[jx]= MSEX; if (dominance) { jx++; xtQTL[jx]= MQTL; } } //Rprintf("calculate xtwx and xtwy\n"); /* calculate xtwx and xtwy */ double xtwj, yi, wi, calc_i; for (j=0; j<dimx; j++) { XtWY[j]= 0.0; for (jj=0; jj<dimx; jj++) XtWX[j][jj]= 0.0; } if (!fitQTL){ for (int i=0; i<Naug; i++) { yi= y[i]; wi= (*weight)[i]; //in the original version when we enable Dominance , we crash around here for (j=0; j<dimx; j++) { xtwj= ((double)Xt[j][i]-48.0)*wi; XtWY[j]+= xtwj*yi; for (jj=0; jj<=j; jj++) XtWX[j][jj]+= xtwj*((double)Xt[jj][i]-48.0); } } }else{ // QTL is moving along the chromosomes for (int i=0; i<Naug; i++) { wi= (*weight)[i]+ (*weight)[i+Naug]+ (*weight)[i+2*Naug]; yi= y[i]; //Changed <= to < to prevent chrashes, this could make calculations a tad different then before for (j=0; j<dimx; j++){ if (xtQTL[j]<=MCOF) { xtwj= ((double)Xt[j][i]-48.0)*wi; XtWY[j]+= xtwj*yi; for (jj=0; jj<=j; jj++) if (xtQTL[jj]<=MCOF) XtWX[j][jj]+= xtwj*((double)Xt[jj][i]-48.0); else if (xtQTL[jj]==MSEX) // QTL: additive effect if QTL=MCOF or MSEX { // QTL==MAA XtWX[j][jj]+= ((double)(Xt[j][i]-48.0))*(*weight)[i]*(47.0-48.0); // QTL==MBB XtWX[j][jj]+= ((double)(Xt[j][i]-48.0))*(*weight)[i+2*Naug]*(49.0-48.0); } else // (xtQTL[jj]==MNOTAA) QTL: dominance effect only if QTL=MCOF { // QTL==MH XtWX[j][jj]+= ((double)(Xt[j][i]-48.0))*(*weight)[i+Naug]*(49.0-48.0); } } else if (xtQTL[j]==MSEX) { // QTL: additive effect if QTL=MCOF or MSEX xtwj= -1.0*(*weight)[i]; // QTL==MAA XtWY[j]+= xtwj*yi; for (jj=0; jj<j; jj++) XtWX[j][jj]+= xtwj*((double)Xt[jj][i]-48.0); XtWX[j][j]+= xtwj*-1.0; xtwj= 1.0*(*weight)[i+2*Naug]; // QTL==MBB XtWY[j]+= xtwj*yi; for (jj=0; jj<j; jj++) XtWX[j][jj]+= xtwj*((double)Xt[jj][i]-48.0); XtWX[j][j]+= xtwj*1.0; } else { // (xtQTL[j]==MQTL) QTL: dominance effect only if QTL=MCOF xtwj= 1.0*(*weight)[i+Naug]; // QTL==MCOF XtWY[j]+= xtwj*yi; // j-1 is for additive effect, which is orthogonal to dominance effect for (jj=0; jj<j-1; jj++) XtWX[j][jj]+= xtwj*((double)Xt[jj][i]-48.0); XtWX[j][j]+= xtwj*1.0; } } } } for (j=0; j<dimx; j++){ for (jj=j+1; jj<dimx; jj++){ XtWX[j][jj]= XtWX[jj][j]; } } int d; ivector indx= newivector(dimx); /* solve equations */ ludcmp(XtWX, dimx, indx, &d); lusolve(XtWX, dimx, indx, XtWY); double* indL = (double *)R_alloc(Nind, sizeof(double)); int newNaug = ((!fitQTL) ? Naug : 3*Naug); vector fit = newvector(newNaug); vector resi = newvector(newNaug); debug_trace("Calculate residuals\n"); if (*variance<0) { *variance= 0.0; if (!fitQTL) for (int i=0; i<Naug; i++) { fit[i]= 0.0; for (j=0; j<dimx; j++) fit[i]+=((double)Xt[j][i]-48.0)*XtWY[j]; resi[i]= y[i]-fit[i]; *variance += (*weight)[i]*pow(resi[i], 2.0); } else for (int i=0; i<Naug; i++) { fit[i]= 0.0; fit[i+Naug]= 0.0; fit[i+2*Naug]= 0.0; for (j=0; j<dimx; j++) if (xtQTL[j]<=MCOF) { calc_i =((double)Xt[j][i]-48.0)*XtWY[j]; fit[i]+= calc_i; fit[i+Naug]+= calc_i; fit[i+2*Naug]+= calc_i; } else if (xtQTL[j]==MSEX) { fit[i]+=-1.0*XtWY[j]; fit[i+2*Naug]+=1.0*XtWY[j]; } else fit[i+Naug]+=1.0*XtWY[j]; resi[i]= y[i]-fit[i]; resi[i+Naug]= y[i]-fit[i+Naug]; resi[i+2*Naug]= y[i]-fit[i+2*Naug]; *variance +=(*weight)[i]*pow(resi[i], 2.0); *variance +=(*weight)[i+Naug]*pow(resi[i+Naug], 2.0); *variance +=(*weight)[i+2*Naug]*pow(resi[i+2*Naug], 2.0); } *variance/= (!biasadj ? Nind : Nind-dimx); // to compare results with Johan; variance/=Nind; if (!fitQTL) for (int i=0; i<Naug; i++) Fy[i]= Lnormal(resi[i], *variance); else for (int i=0; i<Naug; i++) { Fy[i] = Lnormal(resi[i], *variance); Fy[i+Naug] = Lnormal(resi[i+Naug], *variance); Fy[i+2*Naug]= Lnormal(resi[i+2*Naug], *variance); } } else { if (!fitQTL) for (int i=0; i<Naug; i++) { fit[i]= 0.0; for (j=0; j<dimx; j++) fit[i]+=((double)Xt[j][i]-48.0)*XtWY[j]; resi[i]= y[i]-fit[i]; Fy[i] = Lnormal(resi[i], *variance); // ???? } else for (int i=0; i<Naug; i++) { fit[i]= 0.0; fit[i+Naug]= 0.0; fit[i+2*Naug]= 0.0; for (j=0; j<dimx; j++) if (xtQTL[j]<=MCOF) { calc_i =((double)Xt[j][i]-48.0)*XtWY[j]; fit[i]+= calc_i; fit[i+Naug]+= calc_i; fit[i+2*Naug]+= calc_i; } else if (xtQTL[j]==MSEX) { fit[i]+=-1.0*XtWY[j]; fit[i+2*Naug]+=1.0*XtWY[j]; } else fit[i+Naug]+=1.0*XtWY[j]; resi[i]= y[i]-fit[i]; resi[i+Naug]= y[i]-fit[i+Naug]; resi[i+2*Naug]= y[i]-fit[i+2*Naug]; Fy[i] = Lnormal(resi[i], *variance); Fy[i+Naug] = Lnormal(resi[i+Naug], *variance); Fy[i+2*Naug]= Lnormal(resi[i+2*Naug], *variance); } } /* calculation of logL */ debug_trace("calculate logL\n"); double logL=0.0; for (int i=0; i<Nind; i++) { indL[i]= 0.0; } if (!fitQTL) { for (int i=0; i<Naug; i++) indL[ind[i]]+=(*weight)[i]*Fy[i]; } else { for (int i=0; i<Naug; i++) { indL[ind[i]]+=(*weight)[i]* Fy[i]; indL[ind[i]]+=(*weight)[i+Naug]* Fy[i+Naug]; indL[ind[i]]+=(*weight)[i+2*Naug]*Fy[i+2*Naug]; } } for (int i=0; i<Nind; i++) { //Sum up log likelihoods for each individual logL+= log(indL[i]); } return (double)logL; }
//divide, not implemented yet Matrix Matrix::operator/(Matrix& inmatrix) { Matrix newmatrix(_row); return newmatrix; }