R/methods-SnpSuperSet.R
bf8acd05
 ##How to make the initialization platform-specific?
bc16b510
 
 setMethod("initialize", "SnpSuperSet",
bf8acd05
           function(.Object,
bc16b510
 		   assayData,
96d10c6e
                    call=new("matrix"),
                    callProbability=new("matrix"),
bc16b510
                    alleleA=new("matrix"),
                    alleleB=new("matrix"),
 		   featureData,
bf8acd05
 		   annotation,
bc16b510
 		   ...){
 		  if(!missing(assayData)){
 			  .Object <- callNextMethod(.Object, assayData=assayData,...)
bf8acd05
 		  } else{
bc16b510
 			  ad <- assayDataNew("lockedEnvironment",
 					     call=call,
 					     callProbability=callProbability,
 					     alleleA=alleleA,
 					     alleleB=alleleB)
 			  .Object <- callNextMethod(.Object,
 						    assayData=ad, ...)
 		  }		  
 		  if(missing(annotation)){
 			  stop("must specify annotation")
 		  } else{
 			  stopifnot(isValidCdfName(annotation))
 			  .Object@annotation <- annotation
 		  }		  
bf8acd05
 		  if (missing(featureData)){
bc16b510
 			  featureData(.Object) <- annotatedDataFrameFrom(call, byrow=TRUE)
bf8acd05
 		  } else{
 			  featureData(.Object) <- featureData
 		  }
96d10c6e
 		  ## Do after annotation has been assigned
 		  if(!(all(c("chromosome", "position", "isSnp")  %in% colnames(.Object@featureData)))){
 			  ##update the featureData
bc16b510
 			  .Object@featureData <- addFeatureAnnotation.SnpSuperSet(.Object)
96d10c6e
 		  }
bf8acd05
 		  .Object
           })
96d10c6e
 
bc16b510
 setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
 	addFeatureAnnotation.SnpSuperSet(object, ...)
96d10c6e
 })
 
bc16b510
 getParam.SnpSuperSet <- function(object, name, batch){
bf8acd05
 		  label <- paste(name, batch, sep="_")
 		  colindex <- grep(label, fvarLabels(object))
 		  if(length(colindex) == 1){
 			  param <- fData(object)[, colindex]
 		  }
 		  if(length(colindex) < 1){
 			  param <- NULL
 		  }
 		  if(is.na(colindex)){
 			  stop(paste(label, " not found in object"))
 		  }
 		  if(length(colindex) > 1){
 			  stop(paste(label, " not unique"))
 		  }
 		  return(param)
 	  }
 
96d10c6e
 
bf8acd05
 
bc16b510
 setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
bf8acd05
 	tmpdir <- cnOptions[["tmpdir"]]
 	outdir <- cnOptions[["outdir"]]	
 	save.it <- cnOptions[["save.it"]]
 	path <- system.file("extdata", package=paste(annotation(object), "Crlmm", sep=""))	
 	load(file.path(path, "snpProbes.rda"))
 	snpProbes <- get("snpProbes")
 	load(file.path(path, "cnProbes.rda"))
 	cnProbes <- get("cnProbes")	
 	k <- grep("chr", colnames(snpProbes))
 	if(length(k) < 1) stop("chr or chromosome not in colnames(snpProbes)")
 	for(CHR in 1:24){
 		cat("Chromosome ", CHR, "\n")
 		snps <- rownames(snpProbes)[snpProbes[, k] == CHR]
 		cnps <- rownames(cnProbes)[cnProbes[, k] == CHR]
 		index <- c(match(snps, featureNames(object)),
 			   match(cnps, featureNames(object)))
 		index <- index[!is.na(index)]
 		callSetPlus <- object[index, ]
 		if(CHR != 24){
96d10c6e
 			cnSet <- computeCopynumber(callSetPlus, cnOptions)
bf8acd05
 			
 		} else{
 			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSetPlus' object for this chromosome")
 			save(callSetPlus, file=file.path(outdir, paste("callSetPlus_", CHR, ".rda", sep="")))
 		}
 		if(cnOptions[["hiddenMarkovModel"]] & CHR != 24){
96d10c6e
 			cnSet <- computeHmm(cnSet, cnOptions)
 		}
 		save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
 		saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
 ##		} else{ ## save crlmmSet to outdir
 ##			save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
 ##			saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)			
 ##		}		
bf8acd05
 	}
 	saved.objects
 })
96d10c6e
 
bc16b510
 setMethod("computeCopynumber", "SnpSuperSet",
bf8acd05
 	  function(object, cnOptions){
bc16b510
 		  computeCopynumber.SnpSuperSet(object, cnOptions)
bf8acd05
 	  })
96d10c6e
 
bc16b510
 ##gtConfidence <- function(object) 1-exp(-confs(object)/1000)
bf8acd05