R/cleanGeno.R

cleanGeno <- function( ldlasso.obj, ... ){
  Xa <- ldlasso.obj@geno
  mono.test <- function( geno.vec ){
    all(geno.vec==0)||all(geno.vec==2)
  }
  index.vec <- which(apply( Xa, 2, mono.test ))
  index.mat <- which(cor(Xa)>0.99999 & !diag(ncol(Xa)), arr.ind = TRUE )
  if(!(nrow(index.mat)==0)){
    index.mat <- index.mat[diff(t(index.mat))>0,]
    if(is.null(dim(index.mat))){
      index.vec <- c( index.vec, index.mat[2] )
    }else{
      index.vec <- c( index.vec, index.mat[,2] )
    }
    Xa <- Xa[,-index.vec]
  }
  if( length(index.vec)!=0 ){
    cat( "Removed SNPs with indices:\n")
    cat( unique(index.vec), sep = "," )
    cat( "\n" )
    ldlasso.obj <- ldlasso(geno = Xa,
                         pheno = ldlasso.obj@pheno,
                         s1 = ldlasso.obj@s1,
                         s2 = ldlasso.obj@s2,
                         r2 = ldlasso.obj@r2
                         )
    return(ldlasso.obj)
  }else{
    cat("Geno is already clean.\n")
    return(ldlasso.obj)
  }
}
syounkin/LD-LASSO documentation built on May 31, 2019, 12:47 a.m.