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;
}
