R/methods-SnpSuperSet.R
afb508f9
 setReplaceMethod("snpCall", c("SnpSuperSet", "ff_or_matrix"),
                  function(object, ..., value)
 {
     assayDataElementReplace(object, "call", value)
 })
 setReplaceMethod("snpCallProbability", c("SnpSuperSet", "ff_or_matrix"),
                  function(object, ..., value)
 {
     assayDataElementReplace(object, "callProbability", value)
 })
 
 
82be31d4
 ## Method("initialize", "AlleleSet",
 ##        function(.Object,
 ##                 assayData = assayDataNew(alleleA=alleleA,
 ##                                          alleleB=alleleB, ...),
 ##                 phenoData = annotatedDataFrameFrom(assayData, byrow=FALSE),
 ##                 featureData = annotatedDataFrameFrom(assayData, byrow=TRUE),
 ##                 experimentData = new("MIAME"),
 ##                 annotation = character(),
 ##                 protocolData = phenoData[,integer(0)],
 ##                 alleleA = new("matrix"),
 ##                 alleleB = matrix(numeric(),
 ## 		                    nrow=nrow(alleleA), ncol=ncol(alleleA),
 ##                                  dimnames=dimnames(alleleA)),
 ## 		   chromosome=integer(),
 ## 		   position=integer(),
 ## 		   isSnp=integer(),
 ##                 ...) {
 ## 		  .Object <- callNextMethod(.Object,
 ## 					    assayData = assayData,
 ## 					    phenoData = phenoData,
 ## 					    featureData = featureData,
 ## 					    experimentData = experimentData,
 ## 					    annotation = annotation,
 ## 					    protocolData = protocolData)
 ## 		  if(length(annotation) < 1){
 ## 			  if((length(position) < 1 | length(chromosome) < 1| length(isSnp) < 1)){
 ## 				  stop("must specify annotation if 'chromosome', 'position', and 'isSnp' are missing")
 ## 			  } else {
 ## 				  pData(featureData)$chromosome <- chromosome
 ## 				  pData(featureData)$position <- position
 ## 				  pData(featureData)$isSnp <- isSnp
 ## 			  }
 ## 		  } else{
 ## 			  .Object@annotation <- annotation
 ## 			  if((length(position) < 1 | length(chromosome) < 1| length(isSnp) < 1)){
 ## 				  if(!isSupportedAnnotation(annotation)){
 ## 					  stop("The annotation is not supported. Arguments 'chromosome', 'position', and 'isSnp' can be omitted from the initialization only if the annotation is supported (see oligoClasses:::supportedAnnotation()).")
 ## 				  }
 ## 			  } else {
 ## 				  pData(featureData)$chromosome <- chromosome
 ## 				  pData(featureData)$position <- position
 ## 				  pData(featureData)$isSnp <- isSnp
 ## 			  }
 ## 			  .Object@featureData <- featureData
 ## 		  }
 ## 		  ## Do after annotation has been assigned
 ## 		  if(!(all(c("chromosome", "position", "isSnp") %in% varLabels(featureData))) & isSupportedAnnotation(annotation)){
 ## 			  ##update the featureData
 ## 			  .Object@featureData <- addFeatureAnnotation.crlmm(.Object)
 ## 		  }
 ## 		  .Object
 ##        })
 ## 
 ## ow to make the initialization platform-specific?
 ## Method("initialize", "SnpSuperSet",
 ##        function(.Object,
 ## 		   call=new("matrix"),		   
 ##                 callProbability=matrix(NA, nrow(call), ncol(call), dimnames=dimnames(call)),
 ##                 phenoData = annotatedDataFrameFrom(assayData, byrow=FALSE),		   
 ## 		   featureData=annotatedDataFrameFrom(assayData, byrow=TRUE),
 ## 		   experimentData=new("MIAME"),
 ## 		   annotation=character(),
 ## 		   protocolData=phenoData[, integer(0)],
 ## 		   position=integer(),
 ## 		   chromosome=integer(),
 ## 		   isSnp=integer(),...){
 ## 		  .Object <- callNextMethod(.Object,
 ## 					    call=call,
 ## 					    callProbability=callProbability,
 ## 					    phenoData=phenoData,
 ## 					    featureData=featureData,
 ## 					    experimentData=experimentData,
 ## 					    annotation=annotation,
 ## 					    protocolData=protocolData,
 ## 					    position=position,
 ## 					    chromosome=chromosome,
 ## 					    isSnp=isSnp, ...)
 ##        })
 ##
 
 ##setMethod("initialize", "SnpSuperSet",
 ##          function(.Object,
 ##		   call=new("matrix"),		   
 ##                   callProbability=matrix(NA, nrow(call), ncol(call), dimnames=dimnames(call)),
 ##                   alleleA = new("matrix"),
 ##                   alleleB = matrix(numeric(),
 ##		                    nrow=nrow(alleleA), ncol=ncol(alleleA),
 ##                                    dimnames=dimnames(alleleA)),		   
 ##                   phenoData = annotatedDataFrameFrom(call, byrow=FALSE),		   
 ##		   featureData=annotatedDataFrameFrom(call, byrow=TRUE),
 ##		   experimentData=new("MIAME"),
 ##		   protocolData=phenoData[, integer(0)],
 ##		   position=integer(),
 ##		   chromosome=integer(),
 ##		   isSnp=integer(),
 ##		   annotation=character(), ... ){
 ##		  ##browser()
 ##		  ##the ... should be additional assayDataElements, if any
 ##		  .Object <- callNextMethod(.Object,
 ##					    call=call,
 ##					    callProbability=callProbability,
 ##					    alleleA=alleleA,
 ##					    alleleB=alleleB,
 ##					    phenoData=phenoData,
 ##					    featureData=featureData,
 ##					    experimentData=experimentData,
 ##					    protocolData=protocolData,
 ##					    annotation=annotation, ...)
 ##		  annotation <- .Object@annotation
 ##		  ##add chromosome, position, isSnp to featureData
 ##		  if(length(annotation) < 1){
 ##			  if((length(position) < 1| length(chromosome) < 1 | length(isSnp) < 1)){
 ##				  stop("must specify annotation if 'chromosome', 'position', and 'isSnp' are missing")
 ##			  } else {
 ##				  pData(featureData)$chromosome <- chromosome
 ##				  pData(featureData)$position <- position
 ##				  pData(featureData)$isSnp <- isSnp
 ##			  }
 ##		  } else{
 ##			  if((length(position) < 1| length(chromosome) < 1 | length(isSnp) < 1)){
 ##				  if(!isSupportedAnnotation(annotation)){
 ##					  stop("The annotation is not supported. Arguments 'chromosome', 'position', and 'isSnp' can be omitted from the initialization only if the annotation is supported (see oligoClasses:::supportedAnnotation()).")
 ##				  }
 ##			  } else {
 ##				  pData(featureData)$chromosome <- chromosome
 ##				  pData(featureData)$position <- position
 ##				  pData(featureData)$isSnp <- isSnp
 ##			  }
 ##			  .Object@featureData <- featureData
 ##		  }
 ##		  ##Do after annotation has been assigned
 ##		  if(!(all(c("chromosome", "position", "isSnp") %in% varLabels(featureData))) & isSupportedAnnotation(annotation)){
 ##			  .Object@featureData <- addFeatureAnnotation.crlmm(.Object)
 ##		  }		  
 ##		  .Object
 ##          })
 
bc16b510
 
96d10c6e
 
82be31d4
 ##setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
 ##	addFeatureAnnotation.crlmm(object, ...)
 ##})
96d10c6e
 
bc16b510
 getParam.SnpSuperSet <- function(object, name, batch){
5fcfed7d
 		  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)
 	  }
bf8acd05
 
96d10c6e
 
bf8acd05
 
82be31d4
 ##setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
 ##	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){
 ##			cnSet <- computeCopynumber(callSetPlus, cnOptions)
 ##			
 ##		} 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){
 ##			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)			
 ####		}		
 ##	}
 ##	saved.objects
 ##})
96d10c6e
 
5fcfed7d
 setMethod("computeCopynumber", "SnpSuperSet",
 	  function(object, cnOptions){
 		  computeCopynumber.SnpSuperSet(object, cnOptions)
 	  })
96d10c6e
 
bf8acd05