Ejemplo n.º 1
0
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, &current_leftover_ind, &current_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;
}
Ejemplo n.º 2
0
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;
}