Browse code

updates for compatability with oligoClasses

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/crlmm@43365 bc3139a8-67e5-0310-9ffc-ced21a209358

Rob Scharp authored on 03/12/2009 13:02:58
Showing13 changed files

... ...
@@ -1,22 +1,21 @@
1 1
 Package: crlmm
2 2
 Type: Package
3 3
 Title: Genotype Calling (CRLMM) and Copy Number Analysis tool for Affymetrix SNP 5.0 and 6.0 and Illumina arrays.
4
-Version: 1.5.8
5
-Date: 2009-12-01
4
+Version: 1.5.9
5
+Date: 2009-12-03
6 6
 Author: Rafael A Irizarry, Benilton S Carvalho <bcarvalh@jhsph.edu>, Robert Scharpf <rscharpf@jhsph.edu>, Matt Ritchie <mritchie@wehi.edu.au>
7 7
 Maintainer: Benilton S Carvalho <bcarvalh@jhsph.edu>, Robert Scharpf <rscharpf@jhsph.edu>, Matt Ritchie <mritchie@wehi.EDU.AU>
8 8
 Description: Faster implementation of CRLMM specific to SNP 5.0 and 6.0 arrays, as well as a copy number tool specific to 5.0, 6.0, and Illumina platforms
9 9
 License: Artistic-2.0
10 10
 Depends: methods, Biobase (>= 2.5.5), R (>= 2.10.0)
11
-Imports: affyio, preprocessCore, utils, stats, genefilter, splines, mvtnorm, oligoClasses, ellipse, methods, SNPchip, oligoClasses, VanillaICE (>= 1.9.1), IRanges
11
+Imports: affyio, preprocessCore, utils, stats, genefilter, splines, mvtnorm, oligoClasses (>= 1.9.9), ellipse, methods, SNPchip, oligoClasses, VanillaICE (>= 1.9.1), IRanges
12 12
 Suggests: hapmapsnp5, hapmapsnp6, genomewidesnp5Crlmm (>= 1.0.2),genomewidesnp6Crlmm (>= 1.0.2), snpMatrix
13
-Collate: AllClasses.R
14
-	 AllGenerics.R
13
+Collate: AllGenerics.R
15 14
 	 methods-CNSet.R
16 15
 	 methods-eSet.R
17
-         methods-SnpCallSetPlus.R
16
+         methods-SnpSuperSet.R
18 17
          methods-SnpSet.R
19
-         methods-SnpQSet.R
18
+         methods-AlleleSet.R
20 19
          cnrma-functions.R
21 20
          crlmm-functions.R
22 21
          crlmm-illumina.R
... ...
@@ -1,5 +1,6 @@
1 1
 useDynLib("crlmm", .registration=TRUE)
2 2
 
3
+
3 4
 ## Biobase
4 5
 importClassesFrom(Biobase, AnnotatedDataFrame, AssayData, eSet,
5 6
 		  SnpSet, NChannelSet, MIAME, Versioned, VersionedBiobase, Versions)
... ...
@@ -17,16 +18,19 @@ importFrom(Biobase, assayDataElement, assayDataElementNames,
17 18
            assayDataElementReplace, assayDataNew, classVersion, validMsg)
18 19
 
19 20
 ## oligoClasses
20
-importClassesFrom(oligoClasses, SnpLevelSet, SnpQSet, SnpCallSet, SnpCallSetPlus, QuantificationSet)
21
+importClassesFrom(oligoClasses, SnpSuperSet, AlleleSet)
21 22
 importMethodsFrom(oligoClasses, 
22
-                  calls, "calls<-",  
23
-                  callsConfidence, "callsConfidence<-", 
24
-                  chromosome, copyNumber, position,
25
-		  senseThetaA, senseThetaB)
26
-
23
+				 allele,
24
+                                 calls, "calls<-",  
25
+          			 confs, "confs<-",
26
+				 cnConfidence, "cnConfidence<-", 
27
+				 copyNumber)
28
+importFrom("oligoClasses", "position")
29
+importFrom("oligoClasses", "chromosome")
30
+ 
27 31
 ## IRanges
28 32
 importClassesFrom(IRanges, "RangedData", "IRanges")
29
-importMethodsFrom(IRanges, Rle, start, end, width)
33
+importMethodsFrom(IRanges, Rle, start, end, width, runValue)
30 34
 importFrom(IRanges, IRanges, RleList, RangedData)
31 35
 
32 36
 ##importMethodsFrom(methods, initialize, show)
... ...
@@ -37,7 +41,8 @@ importFrom(graphics, abline, axis, layout, legend, mtext, par, plot,
37 41
            polygon, rect, segments, text, points, boxplot)
38 42
 
39 43
 importFrom(SNPchip, chromosome2integer)
40
-importFrom(VanillaICE, viterbi, transitionProbability, breaks)
44
+
45
+importFrom(VanillaICE, viterbi, transitionProbability)
41 46
 
42 47
 importFrom(stats, update)
43 48
 
... ...
@@ -57,39 +62,46 @@ importFrom(mvtnorm, dmvnorm)
57 62
 
58 63
 importFrom(ellipse, ellipse)
59 64
 
60
-##S3method(ellipse,CopyNumberSet)
61
-##S3method(boxplot,CrlmmSetList)
62
-exportClasses(SnpCallSetPlus, CNSet)
63
-##S3method(ellipse, CopyNumberSet)
64
-exportMethods(##"[", "$", 
65
-              A, B, "A<-", "B<-", 
66
-	      CA, "CA<-", CB, "CB<-",
67
-	      chromosome,
68
-	      confs, "confs<-", isSnp, 
69
-	      position)
70
-export(calls, 
71
-       "calls<-",
65
+exportMethods(A, B,
66
+		 CA, "CA<-", CB, "CB<-",
67
+		 isSnp) 
68
+
69
+
70
+exportMethods(chromosome, position)
71
+
72
+export(
72 73
        celDates, 
73
-       chromosome, 
74
-       copyNumber, 
75
-       crlmm, 
74
+      crlmm, 
76 75
        cnOptions, 
76
+       confs,
77
+       "confs<-",
78
+       copyNumber, 
77 79
        emissionPr,
78 80
        "emissionPr<-",
79 81
        list.celfiles, 
80
-       position,
81
-       snprma)
82
+      snprma)
82 83
 
83 84
 exportMethods(computeHmm, 
84
-              segmentData,
85
-             "segmentData<-")
85
+              rangedData,
86
+             "rangedData<-",
87
+	     segmentData,
88
+	     "segmentData<-")
86 89
 
87 90
 export(hmmOptions,
88 91
        crlmmCopynumber)
89 92
 
90
-export(ellipse) ##, ellipse.CopyNumberSet, getParam.SnpCallSetPlus)
91
-##exportMethods(getParam)
92
-export(viterbi.CNSet, computeHmm.CNSet, addFeatureAnnotation.SnpCallSetPlus)
93
-
93
+export(ellipse) ##, ellipse.CopyNumberSet, getParam.SnpSuperSet)
94
+export(viterbi.CNSet, 
95
+		      combineIntensities,
96
+		      whichPlatform,
97
+		      isValidCdfName,
98
+		      splitByChromosome,
99
+	crlmmWrapper,
100
+       computeHmm.CNSet, addFeatureAnnotation.SnpSuperSet,
101
+       readIdatFiles,
102
+       withinGenotypeMoments,  trioOptions, hmm.SnpSuperSet, trioOptions, computeBpiEmission.SnpSuperSet,
103
+       isBiparental.matrix, isBiparental.SnpSuperSet, hapmapPedFile, isSnp.AlleleSet,
104
+       findFatherMother)
105
+exportMethods(start, end, width)
94 106
 
95 107
 
96 108
deleted file mode 100644
... ...
@@ -1,9 +0,0 @@
1
-##setClass("CNSet", contains="eSet")
2
-##setClass("CNSet", contains=c("SnpCallSetPlus", "CNSet"))
3
-setClass("CNSet", contains="SnpCallSetPlus",
4
-	 representation(emissionPr="array",
5
-			segmentData="RangedData"))
6
-
7
-##setClass("SegmentSet", contains="CNSet",
8
-##	 representation(emissionPr="array",
9
-##			segmentData="data.frame"))
... ...
@@ -3,7 +3,7 @@ setGeneric("B", function(object) standardGeneric("B"))
3 3
 setGeneric("A<-", function(object, value) standardGeneric("A<-"))
4 4
 setGeneric("addFeatureAnnotation", function(object, ...) standardGeneric("addFeatureAnnotation"))
5 5
 setGeneric("B<-", function(object, value) standardGeneric("B<-"))
6
-setGeneric("confs", function(object) standardGeneric("confs"))
6
+
7 7
 setGeneric("CA", function(object) standardGeneric("CA"))
8 8
 setGeneric("CB", function(object) standardGeneric("CB"))
9 9
 setGeneric("CA<-", function(object, value) standardGeneric("CA<-"))
... ...
@@ -17,11 +17,13 @@ setGeneric("cnNames", function(object) standardGeneric("cnNames"))
17 17
 setGeneric("computeCopynumber", function(object, cnOptions) standardGeneric("computeCopynumber"))
18 18
 setGeneric("computeEmission", function(object, hmmOptions) standardGeneric("computeEmission"))
19 19
 setGeneric("computeHmm", function(object, hmmOptions) standardGeneric("computeHmm"))
20
-setGeneric("confs<-", function(object, value) standardGeneric("confs<-"))
20
+
21 21
 setGeneric("GT", function(object, ...) standardGeneric("GT"))
22 22
 setGeneric(".harmonizeDimnames", function(object) standardGeneric(".harmonizeDimnames"))
23 23
 setGeneric("isSnp", function(object) standardGeneric("isSnp"))
24 24
 setGeneric("pr", function(object, name, batch, value) standardGeneric("pr"))
25
+setGeneric("rangedData", function(object) standardGeneric("rangedData"))
26
+setGeneric("rangedData<-", function(object, value) standardGeneric("rangedData<-"))
25 27
 setGeneric("segmentData", function(object) standardGeneric("segmentData"))
26 28
 setGeneric("segmentData<-", function(object, value) standardGeneric("segmentData<-"))
27 29
 setGeneric("snpIndex", function(object) standardGeneric("snpIndex"))
... ...
@@ -182,9 +182,9 @@ combineIntensities <- function(res, cnrmaResult, cdfName){
182 182
 		A <- res$A
183 183
 		B <- res$B
184 184
 	}
185
-	ABset <- new("SnpQSet",
186
-		     senseThetaA=A,
187
-		     senseThetaB=B,
185
+	ABset <- new("AlleleSet",
186
+		     alleleA=A,
187
+		     alleleB=B,
188 188
 		     annotation=cdfName)
189 189
 	return(ABset)
190 190
 }
... ...
@@ -242,7 +242,6 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
242 242
 	##use.ff=cnOptions[["use.ff"]]
243 243
 	outdir <- cnOptions[["outdir"]]
244 244
 	tmpdir <- cnOptions[["tmpdir"]]
245
-	
246 245
 	if(missing(cdfName)) stop("cdfName is missing -- a valid cdfName is required.  See crlmm:::validCdfNames()")
247 246
 	platform <- whichPlatform(cdfName)
248 247
 	if(!(platform %in% c("affymetrix", "illumina"))){
... ...
@@ -267,7 +266,7 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
267 266
 			if(save.it) save(RG, file=rgFile)
268 267
 		}
269 268
 		if(load.it & !file.exists(rgFile)){
270
-			message("load.it is TRUE, bug rgFile not present.  Attempting to read the idatFiles.")
269
+			message("load.it is TRUE, but rgFile not present.  Attempting to read the idatFiles.")
271 270
 			RG <- readIdatFiles(...)
272 271
 			if(save.it) save(RG, file=rgFile)
273 272
 		}
... ...
@@ -279,7 +278,6 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
279 278
 	}
280 279
 	if(!(file.exists(dirname(crlmmFile)))) stop(dirname(crlmmFile), " does not exist.")
281 280
 	if(!(file.exists(dirname(intensityFile)))) stop(dirname(intensityFile), " does not exist.")
282
-
283 281
 	##---------------------------------------------------------------------------
284 282
 	## FIX
285 283
 	outfiles <- file.path(dirname(crlmmFile), paste("crlmmSetList_", 1:24, ".rda", sep=""))
... ...
@@ -298,7 +296,6 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
298 296
 			load.it <- FALSE
299 297
 		}
300 298
 	}
301
-
302 299
 	if(platform == "affymetrix"){
303 300
 		if(!file.exists(crlmmFile) | !load.it){
304 301
 			callSet <- crlmm(filenames=filenames,
... ...
@@ -399,7 +396,6 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
399 396
 	}
400 397
 	stopifnot(all.equal(featureNames(callSet), featureNames(ABset)))
401 398
 	stopifnot(all.equal(sampleNames(callSet), sampleNames(ABset)))
402
-
403 399
 	## create object with all of the assay data elements
404 400
 	## add an indicator to featureData for whether it is a snp or a np probe
405 401
 	## add annotation
... ...
@@ -411,31 +407,17 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
411 407
 		  varMetadata=data.frame(labelDescription=colnames(pd),
412 408
 		  row.names=colnames(pd)))
413 409
 	nr <- nrow(ABset); nc <- ncol(ABset)
414
-##	if(!use.ff){
415
-		callSetPlus <- new("SnpCallSetPlus",
416
-				   senseThetaA=A(ABset),
417
-				   senseThetaB=B(ABset), 
418
-				   calls=calls(callSet), 
419
-				   callsConfidence=confs(callSet),
420
-				   phenoData=pD,
421
-				   featureData=featureData(callSet),
422
-				   annotation=annotation(ABset),
423
-				   experimentData=experimentData(callSet),
424
-				   protocolData=protocolData(callSet))
425
-
426
-##	} else {
427
-##		callSetPlus <- new("SnpCallSetPlusFF",
428
-##				   senseThetaA=ff(as.integer(A(ABset)), dim=c(nr,nc), vmode="integer", dimnames=list(featureNames(ABset), sampleNames(ABset))),
429
-##				   senseThetaB=ff(as.integer(B(ABset)), dim=c(nr, nc), vmode="integer", dimnames=list(featureNames(ABset), sampleNames(ABset))),
430
-##				   calls=ff(as.integer(calls(callSet)), dim=c(nr, nc), vmode="integer", dimnames=list(featureNames(ABset), sampleNames(ABset))),
431
-##				   callsConfidence=ff(as.integer(confs(callSet)), dim=c(nr, nc), vmode="integer", dimnames=list(featureNames(ABset), sampleNames(ABset))),
432
-##				   phenoData=pD,
433
-##				   featureData=featureData(callSet),
434
-##				   annotation=annotation(ABset),
435
-##				   experimentData=experimentData(callSet),
436
-##				   protocolData=protocolData(callSet))
437
-##	}
438
-##	featureData(callSetPlus) <- addFeatureAnnotation(callSetPlus)
410
+	callSetPlus <- new("SnpSuperSet",
411
+			   alleleA=A(ABset),
412
+			   alleleB=B(ABset), 
413
+			   call=calls(callSet), 
414
+			   callProbability=assayData(callSet)[["callProbability"]],
415
+			   phenoData=pD,
416
+			   featureData=featureData(callSet),
417
+			   annotation=annotation(ABset),
418
+			   experimentData=experimentData(callSet),
419
+			   protocolData=protocolData(callSet))
420
+	
439 421
 	if(splitByChr){
440 422
 		saved.objects <- splitByChromosome(callSetPlus, cnOptions)
441 423
 		##callSetPlus <- list.files(outdir, pattern="", full.names=TRUE)
... ...
@@ -661,11 +643,12 @@ cnOptions <- function(tmpdir=tempdir(),
661 643
 	     MIN.NU=MIN.NU,
662 644
 	     MIN.PHI=MIN.PHI,
663 645
 	     THR.NU.PHI=THR.NU.PHI,
646
+	     thresholdCopynumber=thresholdCopynumber,
664 647
 	     unlink=unlink,
665 648
 	     hiddenMarkovModel=hiddenMarkovModel,
666 649
 	     circularBinarySegmentation=circularBinarySegmentation,
667 650
 	     cbsOpts=cbsOpts,
668
-	     hmmOpts=hmmOpts) ##remove SnpCallSetPlus object
651
+	     hmmOpts=hmmOpts) ##remove SnpSuperSet object
669 652
 }
670 653
 
671 654
 ##linear model parameters
... ...
@@ -850,7 +833,6 @@ nonpolymorphic <- function(object, cnOptions, tmp.objects){
850 833
 ##sufficient statistics on the intensity scale
851 834
 withinGenotypeMoments <- function(object, cnOptions, tmp.objects){
852 835
 	normal <- tmp.objects[["normal"]]
853
-
854 836
 	## muA, muB: robust estimates of the within-genotype center (intensity scale)
855 837
 	muA <- tmp.objects[["muA"]]
856 838
 	muB <- tmp.objects[["muB"]]
... ...
@@ -864,7 +846,8 @@ withinGenotypeMoments <- function(object, cnOptions, tmp.objects){
864 846
 
865 847
 	A <- A(object)
866 848
 	B <- B(object)
867
-	highConf <- (1-exp(-callsConfidence(object)/1000)) > GT.CONF.THR
849
+##	highConf <- (1-exp(-confs(object)/1000)) > GT.CONF.THR
850
+	highConf <- confs(object) > GT.CONF.THR
868 851
 	##highConf <- highConf > GT.CONF.THR
869 852
 	if(CHR == 23){
870 853
 		gender <- object$gender
... ...
@@ -1462,34 +1445,10 @@ computeHmm.CNSet <- function(object, cnOptions){
1462 1445
 				     position=position(object),
1463 1446
 				     TAUP=hmmOptions[["TAUP"]])
1464 1447
 	emissionPr(object) <- computeEmission(object, hmmOptions)
1465
-##	if(cnOptions[["save.it"]])
1466
-##		save(emission,
1467
-##		     file=file.path(cnOptions[["outdir"]], paste("emission_", chrom, ".rda", sep="")))
1468
-	segmentData(object) <- viterbi.CNSet(object,
1469
-					     hmmOptions=hmmOptions,
1470
-					     transitionPr=tPr[, "transitionPr"],
1471
-					     chromosomeArm=tPr[, "arm"])
1472
-##	segments <- breaks(x=hmmPredictions,
1473
-##			   states=hmmOptions[["copynumberStates"]],
1474
-##			   position=position(object),
1475
-##			   chromosome=chromosome(object))
1476
-	##
1477
-##	segmentData(object) <- rangedData
1478
-##	emissionPr(object) <- emission
1479
-##	object <- new("SegmentSet",
1480
-##		      CA=object@assayData[["CA"]],  ## keep as an integer
1481
-##		      CB=object@assayData[["CB"]],  ## keep as an integer
1482
-##		      senseThetaA=A(object),
1483
-##		      senseThetaB=B(object),
1484
-##		      calls=calls(object),
1485
-##		      callsConfidence=callsConfidence(object),
1486
-##		      featureData=featureData(object),
1487
-##		      phenoData=phenoData(object),
1488
-##		      protocolData=protocolData(object),
1489
-##		      experimentData=experimentData(object),
1490
-##		      annotation=annotation(object),
1491
-##		      segmentData=rangedData,
1492
-##		      emissionPr=emission)
1448
+	rangedData(object) <- viterbi.CNSet(object,
1449
+					    hmmOptions=hmmOptions,
1450
+					    transitionPr=tPr[, "transitionPr"],
1451
+					    chromosomeArm=tPr[, "arm"])
1493 1452
 	return(object)
1494 1453
 }
1495 1454
 
... ...
@@ -1513,7 +1472,7 @@ viterbi.CNSet <- function(object, hmmOptions, transitionPr, chromosomeArm){
1513 1472
 ##					  sample=sampleNames(object)[i],
1514 1473
 ##					  nprobes=runLength(rle.object[[i]]))
1515 1474
 ##	}
1516
-##	rangedData <- do.call("rbind", rdList)
1475
+##	rangedData <- do.call("c", rdList)
1517 1476
 	return(rd)
1518 1477
 }
1519 1478
 
... ...
@@ -1686,32 +1645,32 @@ getEmission.snps <- function(object, hmmOptions){
1686 1645
 	emissionProbs
1687 1646
 }
1688 1647
 
1689
-setMethod("update", "character", function(object, ...){
1690
-	crlmmFile <- object
1691
-	for(i in seq(along=crlmmFile)){
1692
-		cat("Processing ", crlmmFile[i], "...\n")
1693
-		load(crlmmFile[i])
1694
-		crlmmSetList <- get("crlmmSetList")
1695
-		if(length(crlmmSetList) == 3) next()  ##copy number object already present. 
1696
-		if(!"chromosome" %in% fvarLabels(crlmmSetList[[1]])){
1697
-			featureData(crlmmSetList[[1]]) <- addFeatureAnnotation(crlmmSetList)
1698
-		} 
1699
-		CHR <- unique(chromosome(crlmmSetList[[1]]))
1700
-		if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")		
1701
-		if(CHR==24){
1702
-			message("skipping chromosome 24")
1703
-			next()
1704
-		}
1705
-		cat("----------------------------------------------------------------------------\n")
1706
-		cat("-        Estimating copy number for chromosome", CHR, "\n")
1707
-		cat("----------------------------------------------------------------------------\n")		
1708
-		crlmmSetList <- update(crlmmSetList, CHR=CHR, ...)
1709
-		save(crlmmSetList, file=crlmmFile[i])
1710
-		rm(crlmmSetList); gc();
1711
-	}
1712
-})
1648
+##setMethod("update", "character", function(object, ...){
1649
+##	crlmmFile <- object
1650
+##	for(i in seq(along=crlmmFile)){
1651
+##		cat("Processing ", crlmmFile[i], "...\n")
1652
+##		load(crlmmFile[i])
1653
+##		crlmmSetList <- get("crlmmSetList")
1654
+##		if(length(crlmmSetList) == 3) next()  ##copy number object already present. 
1655
+##		if(!"chromosome" %in% fvarLabels(crlmmSetList[[1]])){
1656
+##			featureData(crlmmSetList[[1]]) <- addFeatureAnnotation(crlmmSetList)
1657
+##		} 
1658
+##		CHR <- unique(chromosome(crlmmSetList[[1]]))
1659
+##		if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")		
1660
+##		if(CHR==24){
1661
+##			message("skipping chromosome 24")
1662
+##			next()
1663
+##		}
1664
+##		cat("----------------------------------------------------------------------------\n")
1665
+##		cat("-        Estimating copy number for chromosome", CHR, "\n")
1666
+##		cat("----------------------------------------------------------------------------\n")		
1667
+##		crlmmSetList <- update(crlmmSetList, CHR=CHR, ...)
1668
+##		save(crlmmSetList, file=crlmmFile[i])
1669
+##		rm(crlmmSetList); gc();
1670
+##	}
1671
+##})
1713 1672
 
1714
-addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1673
+addFeatureAnnotation.SnpSuperSet <- function(object, ...){
1715 1674
 	##if(missing(CHR)) stop("Must specificy chromosome")
1716 1675
 	cdfName <- annotation(object)
1717 1676
 	pkgname <- paste(cdfName, "Crlmm", sep="")	
... ...
@@ -1725,17 +1684,26 @@ addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1725 1684
 	isSnp <- rep(as.integer(0), nrow(object))
1726 1685
 	isSnp[snpIndex(object)] <- as.integer(1)
1727 1686
 	names(isSnp) <- featureNames(object)
1728
-	snps <- featureNames(object)[isSnp == 1]
1729
-	nps <- featureNames(object)[isSnp == 0]
1730
-	position.snp <- snpProbes[match(snps, rownames(snpProbes)), "position"]
1731
-	names(position.snp) <- snps
1732
-	position.np <- cnProbes[match(nps, rownames(cnProbes)), "position"]
1733
-	names(position.np) <- nps
1734
-
1735
-	J <- grep("chr", colnames(snpProbes))
1736
-	chr.snp <- snpProbes[match(snps, rownames(snpProbes)), J]
1737
-	chr.np <- cnProbes[match(nps, rownames(cnProbes)), J]	
1738
-	
1687
+
1688
+	if(any(isSnp)){
1689
+		snps <- featureNames(object)[isSnp == 1]
1690
+		position.snp <- snpProbes[match(snps, rownames(snpProbes)), "position"]
1691
+		names(position.snp) <- snps
1692
+
1693
+		J <- grep("chr", colnames(snpProbes))
1694
+		chr.snp <- snpProbes[match(snps, rownames(snpProbes)), J]		
1695
+	} else{
1696
+		chr.snp <- position.snp <- integer()
1697
+	}
1698
+	if(any(!isSnp)){
1699
+		nps <- featureNames(object)[isSnp == 0]
1700
+		position.np <- cnProbes[match(nps, rownames(cnProbes)), "position"]
1701
+		names(position.np) <- nps
1702
+		
1703
+		chr.np <- cnProbes[match(nps, rownames(cnProbes)), J]	
1704
+	} else {
1705
+		chr.np <- position.np <- integer()
1706
+	}
1739 1707
 	position <- c(position.snp, position.np)
1740 1708
 	chrom <- c(chr.snp, chr.np)
1741 1709
 
... ...
@@ -1776,7 +1744,7 @@ addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1776 1744
 }
1777 1745
 
1778 1746
 
1779
-computeCopynumber.SnpCallSetPlus <- function(object, cnOptions){
1747
+computeCopynumber.SnpSuperSet <- function(object, cnOptions){
1780 1748
 ##	use.ff <- cnOptions[["use.ff"]]
1781 1749
 ##	if(!use.ff){
1782 1750
 ##		object <- as(object, "CrlmmSet")
... ...
@@ -1786,7 +1754,8 @@ computeCopynumber.SnpCallSetPlus <- function(object, cnOptions){
1786 1754
 	cnOptions[["bias.adj"]] <- FALSE
1787 1755
 	## Add linear model parameters to the CrlmmSet object
1788 1756
 	featureData(object) <- lm.parameters(object, cnOptions)
1789
-	if(!isValidCdfName(annotation(object))) stop(annotation(object), " not supported.")	
1757
+	if(!isValidCdfName(annotation(object))) stop(annotation(object), " not supported.")
1758
+	object <- as(object, "CNSet")
1790 1759
 	object <- computeCopynumber.CNSet(object, cnOptions)
1791 1760
 	if(bias.adj==TRUE){## run a second time
1792 1761
 		object <- computeCopynumber.CNSet(object, cnOptions)
... ...
@@ -1875,7 +1844,7 @@ computeCopynumber.CNSet <- function(object, cnOptions){
1875 1844
 }
1876 1845
 
1877 1846
 
1878
-isSnp.SnpQSet <- function(object){
1847
+isSnp.AlleleSet <- function(object){
1879 1848
 	labels <- fvarLabels(object)
1880 1849
 	if("isSnp" %in% labels){
1881 1850
 		res <- fData(object)[, "isSnp"]
... ...
@@ -1884,3 +1853,238 @@ isSnp.SnpQSet <- function(object){
1884 1853
 	}
1885 1854
 	return(res==1)
1886 1855
 }
1856
+
1857
+isBiparental.SnpSuperSet <- function(object, allowHetParent=TRUE){
1858
+	##if(length(object$familyMember) < 3) stop("object$familyMember not the right length")
1859
+	father <- 1
1860
+	mother <- 2
1861
+	offspring <- 3
1862
+	F <- calls(object[, father])
1863
+	M <- calls(object[, mother])
1864
+	O <- calls(object[, offspring])
1865
+	object <- cbind(F, M, O)
1866
+	colnames(object) <- c("father", "mother", "offspring")
1867
+	biparental <- isBiparental.matrix(object, allowHetParent=allowHetParent)
1868
+	return(biparental)
1869
+}
1870
+
1871
+isBiparental.matrix <- function(object, allowHetParent=TRUE){
1872
+	F <- object[, 1]
1873
+	M <- object[, 2]
1874
+	O <- object[, 3]
1875
+	##M/F AA, F/M BB, O AB 
1876
+	##isHet <- offspringHeterozygous(object)  ##offspring is heterozygous
1877
+	biparental <- rep(NA, nrow(object))
1878
+	biparental[F==1 & M == 3 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1879
+	biparental[F==3 & M == 1 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1880
+	##M/F AA, F/M BB, O AA or BB
1881
+	biparental[F==1 & M == 3 & (O == 1 | O == 3)] <- FALSE#Pr(O | biparental)=0.001, Pr(O | not biparental) = 1-0.01
1882
+	biparental[F==3 & M == 1 & (O == 1 | O == 3)] <- FALSE#Pr(O | biparental)=0.001, Pr(O | not biparental) = 1-0.01
1883
+	## M/F AA, F/M BB, O AB
1884
+	if(allowHetParent) biparental[F == 1 & M == 2 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1885
+	if(allowHetParent) biparental[F == 2 & M == 1 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1886
+	## F AB, M AA, O BB is not biparental
1887
+	## F AA, M AB, O BB is not biparental
1888
+	biparental[F == 2 & M == 1 & O == 3] <- FALSE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1889
+	biparental[F == 1 & M == 2 & O == 3] <- FALSE#Pr(O | biparental)=0.001, Pr(O | not biparental) = 1-0.01
1890
+	## M AA, F AB, O AB
1891
+	if(allowHetParent) biparental[F == 2 & M == 3 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1892
+	if(allowHetParent) biparental[F == 3 & M == 2 & O == 2] <- TRUE#Pr(O | biparental)=1-0.001, Pr(O | not biparental) = 0.01
1893
+	## F=AB, M=BB, O=AA is NOT biparental
1894
+	biparental[F == 2 & M == 3 & O == 1] <- FALSE#Pr(O | biparental)=0.001, Pr(O | not biparental) = 1-0.01
1895
+	biparental[F == 3 & M == 2 & O == 1] <- FALSE#Pr(O | biparental)=0.001, Pr(O | not biparental) = 1-0.01
1896
+	return(biparental)
1897
+}
1898
+
1899
+findFatherMother <- function(offspringId, object){
1900
+	stopifnot(!missing(offspringId)) 
1901
+	family.id <- pData(object)[sampleNames(object) == offspringId, "familyId"]
1902
+	father.id <- pData(object)[sampleNames(object) == offspringId, "fatherId"]
1903
+	mother.id <- pData(object)[sampleNames(object) == offspringId, "motherId"]
1904
+	father.name <- sampleNames(object)[object$familyId == family.id & object$individualId == father.id]
1905
+	mother.name <- sampleNames(object)[object$familyId == family.id & object$individualId == mother.id]
1906
+	if(length(father.name) > 1 | length(mother.name) > 1){
1907
+		stop("More than 1 father and/or more than 1 mother.  Check annotation in phenoData")
1908
+	}
1909
+	if(length(father.name) < 1 ){
1910
+		father.name <- NA
1911
+	}
1912
+	if(length(mother.name) < 1){
1913
+		mother.name <- NA
1914
+	}
1915
+	fmo.trio <- c(father.name, mother.name, offspringId)
1916
+	names(fmo.trio) <- c("father", "mother", "offspring")
1917
+	return(fmo.trio)
1918
+}
1919
+
1920
+hmm.SnpSuperSet <- function(object, hmmOptions){
1921
+	if(ncol(object) < 3){
1922
+		return("No complete trios")
1923
+	}
1924
+	stopifnot(all(c("familyId", "fatherId", "motherId", "individualId") %in% varLabels(object)))
1925
+	require(VanillaICE) || stop("VanillaICE not available")
1926
+	TAUP <- hmmOptions[["TAUP"]]
1927
+	states <- hmmOptions[["states"]]
1928
+	initialP <- hmmOptions[["initialP"]]
1929
+	verbose <- hmmOptions[["verbose"]]
1930
+	normal2altered <- hmmOptions[["normal2altered"]]
1931
+	altered2normal <- hmmOptions[["altered2normal"]]
1932
+	normalIndex <- hmmOptions[["normalIndex"]]
1933
+	offspringId <- sampleNames(object)[object$fatherId != 0 & object$motherId != 0]
1934
+
1935
+	##For each offspring, find the father and mother in the same family
1936
+
1937
+	trios <- as.matrix(t(sapply(offspringId, findFatherMother, object=object)))
1938
+	trios <- trios[rowSums(is.na(trios)) == 0, , drop=FALSE]
1939
+	colnames(trios) <- c("father", "mother", "offspring")
1940
+	
1941
+	rD <- vector("list", nrow(trios))
1942
+	for(i in 1:nrow(trios)){
1943
+		##if(verbose) cat("Family ", unique(familyId)[i], ", ")
1944
+		if(verbose) cat("Offspring ID ", trios[i, "offspring"], "\n")
1945
+		trioSet <- object[, match(trios[i, ], sampleNames(object))]
1946
+		## Remove the noinformative snps here.
1947
+		isBPI <- isBiparental.SnpSuperSet(trioSet)
1948
+		isInformative <- !is.na(isBPI)
1949
+		if(all(!isInformative)){
1950
+			fit[, i] <- 1
1951
+			next()
1952
+		}
1953
+		trioSet <- trioSet[isInformative, ]
1954
+		##index <- match(featureNames(trioSet), rownames(fit))
1955
+		tau <- transitionProbability(chromosome=chromosome(trioSet),
1956
+					     position=position(trioSet),
1957
+					     TAUP=TAUP)
1958
+		isBPI <- isBPI[isInformative]
1959
+		emission <- computeBpiEmission.SnpSuperSet(trioSet, hmmOptions, isBPI=isBPI)
1960
+		.GlobalEnv[["emission"]] <- emission
1961
+		if(is.null(emission)) stop("not a father, mother, offspring trio")
1962
+		log.e <- array(log(emission), dim=c(nrow(trioSet), 1, 2), dimnames=list(featureNames(trioSet), trios[i, "offspring"], hmmOptions[["states"]]))
1963
+		index <- match(featureNames(trioSet), featureNames(object))
1964
+		vitResults <- viterbi(initialStateProbs=log(initialP),
1965
+						 emission=log.e,
1966
+						 tau=tau[, "transitionPr"],
1967
+						 arm=tau[, "arm"],
1968
+						 normalIndex=normalIndex,
1969
+						 verbose=verbose,
1970
+						 normal2altered=normal2altered,
1971
+						 altered2normal=altered2normal,
1972
+						 returnLikelihood=TRUE)
1973
+		##vitSequence is a vector -- one trio at a time
1974
+		vitSequence <- vitResults[["stateSequence"]]
1975
+		if(length(table(tau[, "arm"])) > 1){
1976
+			##insert an extra index to force a break between chromosome arms
1977
+			tmp <- rep(NA, length(vitSequence)+1)
1978
+			end.parm <- end(Rle(tau[, "arm"]))[1]
1979
+			tmp[1:end.parm] <- vitSequence[1:end.parm]
1980
+			tmp[end.parm+1] <- 999
1981
+			tmp[(end.parm+2):length(tmp)] <- vitSequence[((end.parm)+1):length(vitSequence)]
1982
+			vitSequence <- tmp
1983
+		}
1984
+		llr <- vitResults[["logLikelihoodRatio"]][[1]]
1985
+		rl <- Rle(vitSequence)
1986
+		start.index <- start(rl)[runValue(rl) != 999]
1987
+		end.index <- end(rl)[runValue(rl) != 999]
1988
+		##this is tricky since we've added an index to force a segment for each arm.
1989
+		armBreak <- which(vitSequence==999)
1990
+		if(length(armBreak) > 0){
1991
+			start.index[start.index > armBreak] <- start.index[start.index > armBreak] - 1
1992
+			end.index[end.index > armBreak] <- end.index[end.index > armBreak] - 1
1993
+		}
1994
+		start <- position(trioSet)[start.index]
1995
+		end <- position(trioSet)[end.index]
1996
+		##numMarkers <- unlist(numMarkers)
1997
+		numMarkers <- width(rl)[runValue(rl) != 999]
1998
+		states <- hmmOptions[["states"]][vitSequence[start.index]]
1999
+		##states <- (hmmOptions[["states"]])[vitSequence[start.index]]
2000
+		ir <- IRanges(start=start, end=end)
2001
+		##For each segment, calculate number biparental, number not biparental
2002
+		nBpi <- nNotBpi <- rep(NA, length(ir))
2003
+		for(j in 1:length(start)){
2004
+			region <- (start(rl)[j]):(end(rl)[j])
2005
+			region <- (start.index[j]):(end.index[j])
2006
+			nNonInformative <- sum(is.na(isBPI[region]))
2007
+			nInformative <- sum(!is.na(isBPI[region]))
2008
+			nNotBpi[j] <- sum(isBPI[region] == FALSE, na.rm=TRUE)
2009
+			nBpi[j] <- sum(isBPI[region] == TRUE, na.rm=TRUE)
2010
+		}
2011
+		rD[[i]] <- RangedData(ir,
2012
+				      space=rep(paste("chr", unique(chromosome(trioSet)), sep=""), length(ir)),
2013
+				      offspringId=rep(trios[i, "offspring"], length(ir)),
2014
+				      numMarkers=numMarkers,
2015
+				      state=states,
2016
+				      nNotBpi=nNotBpi,
2017
+				      nBpi=nBpi,
2018
+				      LLR=llr)
2019
+	}
2020
+	##to avoid a .Primivite error with do.call(c, rD)
2021
+	tmp <- do.call(c, rD[sapply(rD, nrow) == 1])
2022
+	tmp2 <- do.call(c, rD[sapply(rD, nrow) > 1])
2023
+	rD <- c(tmp, tmp2)
2024
+	return(rD)
2025
+}
2026
+
2027
+trioOptions <- function(states=c("BPI", "notBPI"),
2028
+			initialP=c(0.99, 0.01),
2029
+			TAUP=1e7,
2030
+			prGtError=c(0.001, 0.01),
2031
+			verbose=FALSE,
2032
+			allowHetParent=FALSE,
2033
+			normalIndex=1,
2034
+			normal2altered=1,
2035
+			altered2normal=1,
2036
+			useCrlmmConfidence=FALSE){
2037
+	names(prGtError) <- states
2038
+	names(initialP) <- states
2039
+	list(states=states,
2040
+	     initialP=initialP,
2041
+	     TAUP=TAUP,
2042
+	     prGtError=prGtError,
2043
+	     verbose=verbose,
2044
+	     allowHetParent=allowHetParent,
2045
+	     normalIndex=normalIndex,
2046
+	     normal2altered=normal2altered,
2047
+	     altered2normal=altered2normal,
2048
+	     useCrlmmConfidence=useCrlmmConfidence)
2049
+}
2050
+
2051
+
2052
+
2053
+computeBpiEmission.SnpSuperSet <- function(object, hmmOptions, isBPI){
2054
+	states <- hmmOptions[["states"]]
2055
+	prGtError <- hmmOptions[["prGtError"]]
2056
+	useCrlmmConfidence <- hmmOptions[["useCrlmmConfidence"]]
2057
+	emission <- matrix(NA, nrow(object), ncol=2)
2058
+	colnames(emission) <- states
2059
+	if(useCrlmmConfidence){
2060
+		pCrlmm <- confs(object)  ## crlmm confidence score
2061
+		## take the minimum confidence score in the trio
2062
+		pCrlmm <- apply(pCrlmm, 1, min, na.rm=TRUE)
2063
+		## set emission probability to min(crlmmConfidence, 0.999)
2064
+		I <- as.integer(pCrlmm < (1 - prGtError[["BPI"]]))
2065
+		pCrlmm <- pCrlmm*I + (1 - prGtError[["BPI"]])*(1-I)
2066
+		emission[,  "BPI"] <- pCrlmm
2067
+		##Pr(mendelian inconsistency | BPI) = 0.001 
2068
+		emission[, "BPI"] <- 1 - pCrlmm
2069
+	} else { ##ignore confidence scores
2070
+		##Pr(call is consistent with biparental inheritance | BPI) = 0.999
2071
+		emission[isBPI==TRUE,  "BPI"] <-  1-prGtError["BPI"]
2072
+		##Pr(mendelian inconsistency | BPI) = 0.001 
2073
+		emission[isBPI==FALSE, "BPI"] <- prGtError["BPI"] ##Mendelian inconsistancy
2074
+	}
2075
+	##Pr(call is consistent with biparental inheritance | not BPI) = 0.01 		
2076
+	emission[isBPI==TRUE,  "notBPI"] <- prGtError["notBPI"]   ## biparental inheritance, but true state is not Biparental
2077
+	##Pr(mendelian inconsistency | not BPI) = 0.99 				
2078
+	emission[isBPI==FALSE, "notBPI"] <- 1-prGtError["notBPI"] ## Mendelian inconsistancy
2079
+	return(emission)
2080
+}
2081
+
2082
+## ---------------------------------------------------------------------------
2083
+## not to be exported
2084
+hapmapPedFile <- function(){
2085
+	pedFile <- read.csv("~/projects/Beaty/inst/extdata/HapMap_samples.csv", as.is=TRUE)
2086
+	pedFile <- pedFile[, 1:5]
2087
+	colnames(pedFile) <- c("coriellId", "familyId", "individualId", "fatherId", "motherId")
2088
+	return(pedFile)
2089
+}
2090
+
... ...
@@ -6,7 +6,7 @@
6 6
 readIdatFiles <- function(sampleSheet=NULL,
7 7
 			  arrayNames=NULL,
8 8
 			  ids=NULL,
9
-			  path="",
9
+			  path=".",
10 10
 			  arrayInfoColNames=list(barcode="SentrixBarcode_A", position="SentrixPosition_A"),
11 11
 			  highDensity=FALSE,
12 12
 			  sep="_",
... ...
@@ -23,7 +23,6 @@ readIdatFiles <- function(sampleSheet=NULL,
23 23
        if(!is.null(arrayNames)) {
24 24
                pd = new("AnnotatedDataFrame", data = data.frame(Sample_ID=arrayNames))
25 25
        }
26
-      
27 26
        if(!is.null(sampleSheet)) { # get array info from Illumina's sample sheet
28 27
 	       if(is.null(arrayNames)){
29 28
 		       ##arrayNames=NULL
... ...
@@ -63,10 +62,11 @@ readIdatFiles <- function(sampleSheet=NULL,
63 62
 	       stop("Cannot find .idat files")
64 63
        if(length(grnfiles)!=length(redfiles))
65 64
 	       stop("Cannot find matching .idat files")
66
-       if(path != ""){
65
+       if(path[1] != "."){
67 66
 	       grnidats = file.path(path, grnfiles)
68 67
 	       redidats = file.path(path, redfiles)
69 68
        }  else {
69
+	       message("path arg not set.  Assuming files are in local directory")
70 70
 	       grnidats <- grnfiles
71 71
 	       redidats <- redfiles
72 72
        }
73 73
new file mode 100644
... ...
@@ -0,0 +1,15 @@
1
+setMethod("A", "AlleleSet", function(object) allele(object, "A"))
2
+setMethod("B", "AlleleSet", function(object) allele(object, "B"))
3
+##setReplaceMethod("A", signature(object="AlleleSet", value="matrix"),
4
+##		 function(object, value){
5
+##			 assayDataElementReplace(object, "senseThetaA", value)			
6
+##		 })
7
+##setReplaceMethod("B", signature(object="AlleleSet", value="matrix"),
8
+##		 function(object, value){
9
+##			 assayDataElementReplace(object, "senseThetaB", value)			
10
+##		 })
11
+setMethod("isSnp", "AlleleSet", function(object) {
12
+	isSnp.AlleleSet(object)
13
+})
14
+
15
+
... ...
@@ -6,20 +6,21 @@ setMethod("initialize", "CNSet",
6 6
 		   annotation,
7 7
 		   experimentData,
8 8
 		   protocolData,
9
-                   calls=new("matrix"),
10
-                   callsConfidence=new("matrix"),
11
-                   senseThetaA=new("matrix"),
12
-                   senseThetaB=new("matrix"),
13
-		   CA=new("matrix"),
14
-		   CB=new("matrix"),
9
+                   call=new("matrix"),
10
+		   callProbability=matrix(integer(), nrow=nrow(call), ncol=ncol(call), dimnames=dimnames(call)),
11
+		   alleleA=matrix(integer(), nrow=nrow(call), ncol=ncol(call), dimnames=dimnames(call)),
12
+		   alleleB=matrix(integer(), nrow=nrow(call), ncol=ncol(call), dimnames=dimnames(call)),
13
+		   CA=matrix(integer(), nrow=nrow(call), ncol=ncol(call), dimnames=dimnames(call)),
14
+		   CB=matrix(integer(), nrow=nrow(call), ncol=ncol(call), dimnames=dimnames(call)),
15 15
 		   segmentData=new("RangedData"),
16 16
 		   emissionPr=new("array"), ... ){
17
+		  ## callProbability, CA, CB, are stored as integers
17 18
 		  if(missing(assayData)){
18 19
 			  assayData <- assayDataNew("lockedEnvironment",
19
-						    calls=calls,
20
-						    callsConfidence=callsConfidence,
21
-						    senseThetaA=senseThetaA,
22
-						    senseThetaB=senseThetaB,
20
+						    call=call,
21
+						    callProbability=callProbability,
22
+						    alleleA=alleleA,
23
+						    alleleB=alleleB,
23 24
 						    CA=CA,
24 25
 						    CB=CB)
25 26
 		  } 
... ...
@@ -38,15 +39,15 @@ setMethod("initialize", "CNSet",
38 39
 		  .Object	    
39 40
           })
40 41
 
41
-setAs("SnpCallSetPlus", "CNSet",
42
+setAs("SnpSuperSet", "CNSet",
42 43
       function(from, to){
43 44
 	      CA <- CB <- matrix(NA, nrow(from), ncol(from))
44 45
 	      dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  
45 46
 	      new("CNSet",
46
-		  calls=calls(from),
47
-		  callsConfidence=callsConfidence(from),
48
-		  senseThetaA=A(from),
49
-		  senseThetaB=B(from),
47
+		  call=calls(from),
48
+		  callProbability=assayData(from)[["callProbability"]],  ##confs(from) returns 1-exp(-x/1000)
49
+		  alleleA=A(from),
50
+		  alleleB=B(from),
50 51
 		  CA=CA,
51 52
 		  CB=CB,
52 53
 		  phenoData=phenoData(from),
... ...
@@ -57,7 +58,7 @@ setAs("SnpCallSetPlus", "CNSet",
57 58
       })
58 59
 
59 60
 setValidity("CNSet", function(object) {
60
-	assayDataValidMembers(assayData(object), c("CA", "CB", "call", "callProbability", "senseThetaA", "senseThetaB"))
61
+	assayDataValidMembers(assayData(object), c("CA", "CB", "call", "callProbability", "alleleA", "alleleB"))
61 62
 })
62 63
 
63 64
 
... ...
@@ -93,24 +94,7 @@ setMethod("computeCopynumber", "character", function(object, cnOptions){
93 94
 	}	
94 95
 })
95 96
 
96
-setMethod("pr", signature(object="CNSet",
97
-			  name="character",
98
-			  batch="ANY",
99
-			  value="numeric"), 
100
-	  function(object, name, batch, value){
101
-		  label <- paste(name, batch, sep="_")
102
-		  colindex <- match(label, fvarLabels(object))
103
-		  if(length(colindex) == 1){
104
-			  fData(object)[, colindex] <- value
105
-		  } 
106
-		  if(is.na(colindex)){
107
-			  stop(paste(label, " not found in object"))
108
-		  }
109
-		  if(length(colindex) > 1){
110
-			  stop(paste(label, " not unique"))
111
-		  }
112
-		  object
113
-	  })
97
+
114 98
 
115 99
 setMethod("computeEmission", "CNSet", function(object, hmmOptions){
116 100
 	computeEmission.CNSet(object, hmmOptions)
... ...
@@ -140,7 +124,7 @@ setMethod("computeHmm", "CNSet", function(object, hmmOptions){
140 124
 	computeHmm.CNSet(object, hmmOptions)
141 125
 })
142 126
 
143
-##setMethod("computeHmm", "SnpCallSetPlus", function(object, hmmOptions){
127
+##setMethod("computeHmm", "SnpSuperSet", function(object, hmmOptions){
144 128
 ##	cnSet <- computeCopynumber(object, hmmOptions)
145 129
 ##	computeHmm(cnSet, hmmOptions)
146 130
 ##})
... ...
@@ -184,17 +168,17 @@ setValidity("CNSet", function(object) {
184 168
 ##may want to allow thresholding here (... arg)
185 169
 setMethod("CA", "CNSet", function(object) assayData(object)[["CA"]]/100)
186 170
 setMethod("CB", "CNSet", function(object) assayData(object)[["CB"]]/100)
187
-
188 171
 setReplaceMethod("CA", signature(object="CNSet", value="matrix"),
189 172
 		 function(object, value){
173
+			 value <- matrix(as.integer(value*100), nrow(value), ncol(value), dimnames=dimnames(value))
190 174
 			 assayDataElementReplace(object, "CA", value)		
191 175
 		 })
192 176
 
193 177
 setReplaceMethod("CB", signature(object="CNSet", value="matrix"),
194 178
 		 function(object, value){
179
+			 value <- matrix(as.integer(value*100), nrow(value), ncol(value), dimnames=dimnames(value))			 
195 180
 			 assayDataElementReplace(object, "CB", value)
196 181
 		 })
197
-
198 182
 setMethod("copyNumber", "CNSet", function(object){
199 183
 	I <- isSnp(object)
200 184
 	CA <- CA(object)
... ...
@@ -257,6 +241,11 @@ ellipse.CNSet <- function(x, copynumber, batch, ...){
257 241
 	}
258 242
 }
259 243
 
244
+setMethod("rangedData", "CNSet", function(object) segmentData(object))
245
+setReplaceMethod("rangedData", c("CNSet", "RangedData"), function(object, value){
246
+	segmentData(object) <- value
247
+})
248
+
260 249
 setMethod("segmentData", "CNSet", function(object) object@segmentData)
261 250
 setReplaceMethod("segmentData", c("CNSet", "RangedData"), function(object, value){
262 251
 	object@segmentData <- value
... ...
@@ -279,15 +268,16 @@ setMethod("show", "CNSet", function(object){
279 268
 	if(!all(is.na(emissionPr(object)))){
280 269
 		cat("   minimum value:", min(emissionPr(object), na.rm=TRUE), "\n")
281 270
 	} else  cat("   minimum value: NA (all missing)\n")
282
-	cat("segmentData:  ")
283
-	cat("    ", show(segmentData(object)), "\n")
271
+	cat("rangedData:  ")
272
+	cat("    ", show(rangedData(object)), "\n")
284 273
 ##	cat("   ", nrow(segmentData(object)), "segments\n")
285 274
 ##	cat("    column names:", paste(colnames(segmentData(object)), collapse=", "), "\n")
286 275
 #	cat("    mean # markers per segment:", mean(segmentData(object)$nprobes))
287 276
 })
288 277
 
289
-
290
-
278
+setMethod("start", "CNSet", function(x, ...) start(segmentData(x), ...))
279
+setMethod("end", "CNSet", function(x, ...) end(segmentData(x), ...))
280
+setMethod("width", "CNSet", function(x) width(segmentData(x)))
291 281
 
292 282
 
293 283
 
294 284
deleted file mode 100644
... ...
@@ -1,44 +0,0 @@
1
-##setValidity("SnpQSet", function(object) {
2
-##	##msg <- validMsg(NULL, Biobase:::isValidVersion(object, "CopyNumberSet"))
3
-##	msg <- validMsg(NULL, assayDataValidMembers(assayData(object), c("A", "B")))
4
-##	if (is.null(msg)) TRUE else msg
5
-##})
6
-
7
-setMethod("initialize", "SnpQSet",
8
-          function(.Object,
9
-                   assayData = assayDataNew(senseThetaA=senseThetaA, senseThetaB=senseThetaB),
10
-                   senseThetaA=new("matrix"),
11
-                   senseThetaB=new("matrix"),
12
-                   phenoData=annotatedDataFrameFrom(assayData, byrow=FALSE),
13
-                   featureData = annotatedDataFrameFrom(assayData, byrow=TRUE),
14
-                   experimentData=new("MIAME"),
15
-                   annotation=new("character")){
16
-            .Object <- callNextMethod(.Object,
17
-				      assayData = assayDataNew(senseThetaA=senseThetaA, senseThetaB=senseThetaB),
18
-				      phenoData=phenoData,
19
-				      experimentData=experimentData,
20
-				      annotation=annotation)
21
-            .Object
22
-    })
23
-
24
-setValidity("SnpQSet",
25
-            function(object)
26
-            assayDataValidMembers(assayData(object),
27
-                                  c("senseThetaA",
28
-                                    "senseThetaB")
29
-            ))
30
-setMethod("A", "SnpQSet", function(object) senseThetaA(object))
31
-setMethod("B", "SnpQSet", function(object) senseThetaB(object))
32
-setReplaceMethod("A", signature(object="SnpQSet", value="matrix"),
33
-		 function(object, value){
34
-			 assayDataElementReplace(object, "senseThetaA", value)			
35
-		 })
36
-setReplaceMethod("B", signature(object="SnpQSet", value="matrix"),
37
-		 function(object, value){
38
-			 assayDataElementReplace(object, "senseThetaB", value)			
39
-		 })
40
-setMethod("isSnp", "SnpQSet", function(object) {
41
-	isSnp.SnpQSet(object)
42
-})
43
-
44
-
45 0
deleted file mode 100644
... ...
@@ -1,5 +0,0 @@
1
-## Methods for crlmm
2
-setMethod("calls", "SnpSet", function(object) assayData(object)$call)
3
-setReplaceMethod("calls", signature(object="SnpSet", value="matrix"), function(object, value) assayDataElementReplace(object, "call", value))
4
-setMethod("confs", "SnpSet", function(object) assayData(object)$callProbability)
5
-setReplaceMethod("confs", signature(object="SnpSet", value="matrix"), function(object, value) assayDataElementReplace(object, "callProbability", value))
6 0
similarity index 64%
7 1
rename from R/methods-SnpCallSetPlus.R
8 2
rename to R/methods-SnpSuperSet.R
... ...
@@ -1,47 +1,50 @@
1 1
 ##How to make the initialization platform-specific?
2
-setMethod("initialize", "SnpCallSetPlus",
2
+
3
+setMethod("initialize", "SnpSuperSet",
3 4
           function(.Object,
4
-                   phenoData,
5
-		   featureData,
5
+		   assayData,
6 6
                    call=new("matrix"),
7 7
                    callProbability=new("matrix"),
8
-                   senseThetaA=new("matrix"),
9
-                   senseThetaB=new("matrix"),
8
+                   alleleA=new("matrix"),
9
+                   alleleB=new("matrix"),
10
+		   featureData,
10 11
 		   annotation,
11
-		   experimentData,
12
-		   protocolData, ... ){
13
-		  ad <- assayDataNew("lockedEnvironment",
14
-				     call=call,
15
-				     callProbability=callProbability,
16
-				     senseThetaA=senseThetaA,
17
-				     senseThetaB=senseThetaB)
18
-		  assayData(.Object) <- ad
19
-		  if (missing(phenoData)){
20
-			  phenoData(.Object) <- annotatedDataFrameFrom(calls, byrow=FALSE)
12
+		   ...){
13
+		  if(!missing(assayData)){
14
+			  .Object <- callNextMethod(.Object, assayData=assayData,...)
21 15
 		  } else{
22
-			  phenoData(.Object) <- phenoData
23
-		  }
16
+			  ad <- assayDataNew("lockedEnvironment",
17
+					     call=call,
18
+					     callProbability=callProbability,
19
+					     alleleA=alleleA,
20
+					     alleleB=alleleB)
21
+			  .Object <- callNextMethod(.Object,
22
+						    assayData=ad, ...)
23
+		  }		  
24
+		  if(missing(annotation)){
25
+			  stop("must specify annotation")
26
+		  } else{
27
+			  stopifnot(isValidCdfName(annotation))
28
+			  .Object@annotation <- annotation
29
+		  }		  
24 30
 		  if (missing(featureData)){
25
-			  featureData(.Object) <- annotatedDataFrameFrom(calls, byrow=TRUE)
31
+			  featureData(.Object) <- annotatedDataFrameFrom(call, byrow=TRUE)
26 32
 		  } else{
27 33
 			  featureData(.Object) <- featureData
28 34
 		  }
29
-		  if(!missing(annotation)) annotation(.Object) <- annotation
30
-		  if(!missing(experimentData)) experimentData(.Object) <- experimentData
31
-		  if(!missing(protocolData)) protocolData(.Object) <- protocolData
32 35
 		  ## Do after annotation has been assigned
33 36
 		  if(!(all(c("chromosome", "position", "isSnp")  %in% colnames(.Object@featureData)))){
34 37
 			  ##update the featureData
35
-			  .Object@featureData <- addFeatureAnnotation.SnpCallSetPlus(.Object)
38
+			  .Object@featureData <- addFeatureAnnotation.SnpSuperSet(.Object)
36 39
 		  }
37 40
 		  .Object
38 41
           })
39 42
 
40
-setMethod("addFeatureAnnotation", "SnpCallSetPlus", function(object, ...){
41
-	addFeatureAnnotation.SnpCallSetPlus(object, ...)
43
+setMethod("addFeatureAnnotation", "SnpSuperSet", function(object, ...){
44
+	addFeatureAnnotation.SnpSuperSet(object, ...)
42 45
 })
43 46
 
44
-getParam.SnpCallSetPlus <- function(object, name, batch){
47
+getParam.SnpSuperSet <- function(object, name, batch){
45 48
 		  label <- paste(name, batch, sep="_")
46 49
 		  colindex <- grep(label, fvarLabels(object))
47 50
 		  if(length(colindex) == 1){
... ...
@@ -61,7 +64,7 @@ getParam.SnpCallSetPlus <- function(object, name, batch){
61 64
 
62 65
 
63 66
 
64
-setMethod("splitByChromosome", "SnpCallSetPlus", function(object, cnOptions){
67
+setMethod("splitByChromosome", "SnpSuperSet", function(object, cnOptions){
65 68
 	tmpdir <- cnOptions[["tmpdir"]]
66 69
 	outdir <- cnOptions[["outdir"]]	
67 70
 	save.it <- cnOptions[["save.it"]]
... ...
@@ -100,10 +103,10 @@ setMethod("splitByChromosome", "SnpCallSetPlus", function(object, cnOptions){
100 103
 	saved.objects
101 104
 })
102 105
 
103
-setMethod("computeCopynumber", "SnpCallSetPlus",
106
+setMethod("computeCopynumber", "SnpSuperSet",
104 107
 	  function(object, cnOptions){
105
-		  computeCopynumber.SnpCallSetPlus(object, cnOptions)
108
+		  computeCopynumber.SnpSuperSet(object, cnOptions)
106 109
 	  })
107 110
 
108
-gtConfidence <- function(object) 1-exp(-callsConfidence(object)/1000)
111
+##gtConfidence <- function(object) 1-exp(-confs(object)/1000)
109 112
 	
... ...
@@ -42,7 +42,7 @@ setMethod("getParam", signature(object="eSet",
42 42
 			  warning("batch argument to getParam should have length 1.  Only using the first")
43 43
 			  batch <- batch[1]
44 44
 		  }
45
-		  getParam.SnpCallSetPlus(object, name, batch)
45
+		  getParam.SnpSuperSet(object, name, batch)
46 46
 })
47 47
 
48 48
 ##setMethod("combine", signature=signature(x="eSet", y="eSet"),
... ...
@@ -73,3 +73,21 @@ setMethod("getParam", signature(object="eSet",
73 73
 
74 74
 
75 75
 
76
+setMethod("pr", signature(object="eSet",
77
+			  name="character",
78
+			  batch="ANY",
79
+			  value="numeric"), 
80
+	  function(object, name, batch, value){
81
+		  label <- paste(name, batch, sep="_")
82
+		  colindex <- match(label, fvarLabels(object))
83
+		  if(length(colindex) == 1){
84
+			  fData(object)[, colindex] <- value
85
+		  } 
86
+		  if(is.na(colindex)){
87
+			  stop(paste(label, " not found in object"))
88
+		  }
89
+		  if(length(colindex) > 1){
90
+			  stop(paste(label, " not unique"))
91
+		  }
92
+		  object
93
+	  })
... ...
@@ -135,11 +135,11 @@ list2SnpSet <- function(x, returnParams=FALSE){
135 135
 }
136 136
 
137 137
 loader <- function(theFile, envir, pkgname){
138
-  theFile <- file.path(system.file(package=pkgname),
139
-                       "extdata", theFile)
140
-  if (!file.exists(theFile))
141
-    stop("File ", theFile, " does not exist in ", pkgname)
142
-  load(theFile, envir=envir)
138
+	theFile <- file.path(system.file(package=pkgname),
139
+			     "extdata", theFile)
140
+	if (!file.exists(theFile))
141
+		stop("File ", theFile, " does not exist in ", pkgname)
142
+	load(theFile, envir=envir)
143 143
 }
144 144
 
145 145
 celfileDate <- function(filename) {