Browse code

cleaned up a few of the classes. defined new class called CNSet to take the place of CrlmmSet

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

Rob Scharp authored on 19/11/2009 14:59:04
Showing19 changed files

... ...
@@ -326,3 +326,9 @@ is decoded and scanned
326 326
  * fixed classes imported from oligoClasses in NAMESPACE
327 327
  * imported 'calls<-' from oligoClasses
328 328
 
329
+2009-11-19 R. Scharpf - committed version 1.5.5
330
+
331
+ * removed a few of the classes (CrlmmSet, CrlmmSetFF, SnpCallSetPlusFF,...)
332
+ * added CNSet class
333
+ * segmentData slot in CNSet class is an extension of RangedData (defined in IRanges package)
334
+
... ...
@@ -1,23 +1,20 @@
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.4
4
+Version: 1.5.5
5 5
 Date: 2009-11-15
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)
12
-Suggests: hapmapsnp5, hapmapsnp6, genomewidesnp5Crlmm (>= 1.0.2),genomewidesnp6Crlmm (>= 1.0.2), snpMatrix, GGdata
11
+Imports: affyio, preprocessCore, utils, stats, genefilter, splines, mvtnorm, oligoClasses, ellipse, methods, SNPchip, oligoClasses, VanillaICE (>= 1.9.1), IRanges
12
+Suggests: hapmapsnp5, hapmapsnp6, genomewidesnp5Crlmm (>= 1.0.2),genomewidesnp6Crlmm (>= 1.0.2), snpMatrix
13 13
 Collate: AllClasses.R
14 14
 	 AllGenerics.R
15
-	 methods-CopyNumberSet.R
16
-         methods-CrlmmSet.R
17
-         methods-CrlmmSetFF.R
15
+	 methods-CNSet.R
18 16
 	 methods-eSet.R
19 17
          methods-SnpCallSetPlus.R
20
-         methods-SnpCallSetPlusFF.R
21 18
          methods-SnpSet.R
22 19
          methods-SnpQSet.R
23 20
          cnrma-functions.R
... ...
@@ -1,12 +1,9 @@
1 1
 useDynLib("crlmm", .registration=TRUE)
2 2
 
3
-##importClassesFrom(methods, ANY, character, data.frame, "function", integer, matrix, numeric)
4
-
3
+## Biobase
5 4
 importClassesFrom(Biobase, AnnotatedDataFrame, AssayData, eSet,
6 5
 		  SnpSet, NChannelSet, MIAME, Versioned, VersionedBiobase, Versions)
7 6
 
8
-importClassesFrom(oligoClasses, SnpLevelSet, SnpQSet, SnpCallSet, SnpCallSetPlus, QuantificationSet)
9
-
10 7
 importMethodsFrom(Biobase, annotation, "annotation<-", annotatedDataFrameFrom,
11 8
                   assayData, "assayData<-", combine, dims,
12 9
                   experimentData, "experimentData<-",
... ...
@@ -16,20 +13,33 @@ importMethodsFrom(Biobase, annotation, "annotation<-", annotatedDataFrameFrom,
16 13
                   pubMedIds, rowMedians, sampleNames,
17 14
                   storageMode, "storageMode<-", updateObject, varLabels)
18 15
 
19
-importMethodsFrom(oligoClasses, chromosome, copyNumber, position, calls, "calls<-")
16
+importFrom(Biobase, assayDataElement, assayDataElementNames,
17
+           assayDataElementReplace, assayDataNew, classVersion, validMsg)
18
+
19
+## oligoClasses
20
+importClassesFrom(oligoClasses, SnpLevelSet, SnpQSet, SnpCallSet, SnpCallSetPlus, QuantificationSet)
21
+importMethodsFrom(oligoClasses, 
22
+                  calls, "calls<-",  
23
+                  callsConfidence, "callsConfidence<-", 
24
+                  chromosome, copyNumber, position,
25
+		  senseThetaA, senseThetaB)
26
+
27
+## IRanges
28
+importClassesFrom(IRanges, "RangedData", "IRanges")
29
+importMethodsFrom(IRanges, Rle, start, end, width)
30
+importFrom(IRanges, IRanges, RleList, RangedData)
20 31
 
21 32
 ##importMethodsFrom(methods, initialize, show)
22 33
 
23 34
 ##importFrom(methods, "@<-", callNextMethod, new, validObject)
24 35
 
25
-importFrom(Biobase, assayDataElement, assayDataElementNames,
26
-           assayDataElementReplace, assayDataNew, classVersion, validMsg)
27
-
28 36
 importFrom(graphics, abline, axis, layout, legend, mtext, par, plot,
29 37
            polygon, rect, segments, text, points, boxplot)
30 38
 
31
-importFrom(stats, update)
32 39
 importFrom(SNPchip, chromosome2integer)
40
+importFrom(VanillaICE, viterbi, transitionProbability, breaks)
41
+
42
+importFrom(stats, update)
33 43
 
34 44
 importFrom(grDevices, grey)
35 45
 
... ...
@@ -49,47 +59,37 @@ importFrom(ellipse, ellipse)
49 59
 
50 60
 ##S3method(ellipse,CopyNumberSet)
51 61
 ##S3method(boxplot,CrlmmSetList)
52
-exportClasses(ABset, CopyNumberSet, CrlmmSetList)
62
+exportClasses(SnpCallSetPlus, CNSet)
53 63
 ##S3method(ellipse, CopyNumberSet)
54
-exportMethods("[", ##"[[",
55
-	      "$", A, B,
56
-	      "A<-", "B<-",
57
-	      addFeatureAnnotation,
58
-	      calls,
59
-	      CA,
60
-	      "CA<-",
61
-	      CB,
62
-	      "CB<-",
63
-	      cnIndex,
64
-	      confs,
65
-	      plot,
66
-	      points,
67
-	      show,
68
-	      snpIndex)
69
-
70
-export(batch,
71
-       celDates,
72
-       calls,
73
-       chromosome,
74
-       cnrma,
75
-       combine,
76
-       computeCopynumber,
77
-       copyNumber,
78
-       crlmm,
79
-       crlmmIllumina,
80
-##       crlmmIlluminaWrapper,
81
-       crlmmWrapper,
82
-##       ellipse,
83
-##       computeEmission,
84
-       list.celfiles,
85
-       ncol,
86
-       nrow,
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<-",
72
+       celDates, 
73
+       chromosome, 
74
+       copyNumber, 
75
+       crlmm, 
76
+       cnOptions, 
77
+       emissionPr,
78
+       "emissionPr<-",
79
+       list.celfiles, 
87 80
        position,
88
-       readIdatFiles,
89
-       sampleNames,
90
-       protocolData,
91
-       "protocolData<-",
92
-       snprma, update)
81
+       snprma)
82
+
83
+exportMethods(computeHmm, 
84
+              segmentData,
85
+             "segmentData<-")
86
+
87
+export(hmmOptions,
88
+       crlmmCopynumber)
89
+
90
+export(ellipse) ##, ellipse.CopyNumberSet, getParam.SnpCallSetPlus)
91
+##exportMethods(getParam)
92
+export(viterbi.CNSet, computeHmm.CNSet)
93 93
 
94 94
 
95 95
 
... ...
@@ -1,7 +1,9 @@
1
-setClass("CopyNumberSet", contains="SnpLevelSet")
2
-setClass("CrlmmSet", contains=c("SnpCallSetPlus", "CopyNumberSet"))
3
-setClass("SnpCallSetPlusFF", contains="SnpCallSetPlus")
4
-setClass("CrlmmSetFF", contains="CrlmmSet")
5
-setClass("SegmentSet", contains="CrlmmSet",
1
+##setClass("CNSet", contains="eSet")
2
+##setClass("CNSet", contains=c("SnpCallSetPlus", "CNSet"))
3
+setClass("CNSet", contains="SnpCallSetPlus",
6 4
 	 representation(emissionPr="array",
7
-			segmentData="data.frame"))
5
+			segmentData="RangedData"))
6
+
7
+##setClass("SegmentSet", contains="CNSet",
8
+##	 representation(emissionPr="array",
9
+##			segmentData="data.frame"))
... ...
@@ -239,7 +239,7 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
239 239
 	crlmmFile <- cnOptions[["crlmmFile"]]
240 240
 	intensityFile=cnOptions[["intensityFile"]]
241 241
 	rgFile=cnOptions[["rgFile"]]
242
-	use.ff=cnOptions[["use.ff"]]
242
+	##use.ff=cnOptions[["use.ff"]]
243 243
 	outdir <- cnOptions[["outdir"]]
244 244
 	tmpdir <- cnOptions[["tmpdir"]]
245 245
 	
... ...
@@ -411,7 +411,7 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
411 411
 		  varMetadata=data.frame(labelDescription=colnames(pd),
412 412
 		  row.names=colnames(pd)))
413 413
 	nr <- nrow(ABset); nc <- ncol(ABset)
414
-	if(!use.ff){
414
+##	if(!use.ff){
415 415
 		callSetPlus <- new("SnpCallSetPlus",
416 416
 				   senseThetaA=A(ABset),
417 417
 				   senseThetaB=B(ABset), 
... ...
@@ -423,19 +423,19 @@ crlmmWrapper <- function(filenames, cnOptions, ...){
423 423
 				   experimentData=experimentData(callSet),
424 424
 				   protocolData=protocolData(callSet))
425 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)
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)
439 439
 	if(splitByChr){
440 440
 		saved.objects <- splitByChromosome(callSetPlus, cnOptions)
441 441
 		##callSetPlus <- list.files(outdir, pattern="", full.names=TRUE)
... ...
@@ -461,36 +461,6 @@ validCdfNames <- function(){
461 461
 	  "human1mduov3b")
462 462
 }
463 463
 
464
-##validCdfNames <- function(platform){
465
-##	if(!missing(platform)){
466
-##		if(!platform %in% c("illumina", "affymetrix"))
467
-##			stop("only illumina and affymetrix platforms are supported.")
468
-##		if(platform=="illumina"){
469
-##			chipList = c("human1mv1c",             # 1M
470
-##			"human370v1c",            # 370CNV
471
-##			"human650v3a",            # 650Y
472
-##			"human610quadv1b",        # 610 quad
473
-##			"human660quadv1a",        # 660 quad
474
-##			"human370quadv3c",        # 370CNV quad
475
-##			"human550v3b",            # 550K
476
-##			"human1mduov3b")          # 1M Duo
477
-##		}
478
-##		if(platform=="affymetrix"){
479
-##			chipList=c("genomewidesnp6", "genomewidesnp5")
480
-##		}
481
-##	} else{
482
-##		chipList <- list()
483
-##		chipList$affymetrix <- c("genomewidesnp6","genomewidesnp5")
484
-##		chipList$illumina <- c("human370v1c",
485
-##				       "human370quadv3c",
486
-##				       "human550v3b",
487
-##				       "human650v3a",
488
-##				       "human610quadv1b",
489
-##				       "human660quadv1a",
490
-##				       "human1mduov3b")
491
-##	}
492
-##	return(chipList)
493
-##}
494 464
 isValidCdfName <- function(cdfName){
495 465
 	chipList <- validCdfNames()
496 466
 	result <- cdfName %in% chipList	
... ...
@@ -606,176 +576,6 @@ instantiateObjects <- function(object, cnOptions){
606 576
         return(tmp.objects)
607 577
 }
608 578
 
609
-##updateNuPhi <- function(crlmmSetList, cnSet){
610
-##	##TODO: remove the use of environments.
611
-##	cdfName <- annotation(crlmmSetList[[1]])
612
-##	##repopulate the environment
613
-##	crlmmSetList <- crlmmSetList[, match(sampleNames(cnSet), sampleNames(crlmmSetList))]
614
-##	crlmmSetList <- crlmmSetList[match(featureNames(cnSet), featureNames(crlmmSetList)), ]
615
-##	##envir <- getCopyNumberEnvironment(crlmmSetList, cnSet)
616
-##	Nset <- crlmmSetList[[1]]
617
-##	##indices of polymorphic loci
618
-##	index <- snpIndex(Nset)
619
-##	ABset <- Nset[index, ]
620
-##	##indices of nonpolymorphic loci
621
-##	NPset <- Nset[-index, ]
622
-##	##genotypes/confidences
623
-##	snpset <- crlmmSetList[[2]][index,]
624
-##	##previous version of compute copy number
625
-##	envir <- new.env()	
626
-##	message("Running bias adjustment...")
627
-####	.computeCopynumber(chrom=CHR,
628
-####			   A=A(ABset),
629
-####			   B=B(ABset),
630
-####			   calls=calls(snpset),
631
-####			   conf=confs(snpset),
632
-####			   NP=A(NPset),
633
-####			   plate=batch,
634
-####			   envir=envir,
635
-####			   SNR=ABset$SNR,
636
-####			   bias.adj=TRUE,
637
-####			   SNRmin=SNRmin,
638
-####			   ...)	
639
-##}
640
-
641
-##ist2locusSet <- function(envir, ABset, NPset, CHR, cdfName){
642
-##	if(missing(CHR)) stop("Must specify chromosome")
643
-##	pkgname <- paste(cdfName, "Crlmm", sep="")	
644
-##	path <- system.file("extdata", package=pkgname)
645
-##	loader("cnProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
646
-##	cnProbes <- get("cnProbes", envir=.crlmmPkgEnv)
647
-##	loader("snpProbes.rda", pkgname=pkgname, envir=.crlmmPkgEnv)
648
-##	snpProbes <- get("snpProbes", envir=.crlmmPkgEnv)	
649
-##	##require(oligoClasses) || stop("oligoClasses package not available")
650
-##	if(length(ls(envir)) == 0) stop("environment empty")
651
-##	batch <- envir[["plate"]]
652
-##	##SNP copy number	
653
-##	CA <- envir[["CA"]]
654
-##	dimnames(CA) <- list(envir[["snps"]], envir[["sns"]])	
655
-##	CB <- envir[["CB"]]
656
-##	dimnames(CB) <- dimnames(CA)
657
-##	##NP copy number
658
-##	if(!is.null(NPset)){
659
-##		CT <- envir[["CT"]]
660
-##		rownames(CT) <- envir[["cnvs"]]
661
-##		colnames(CT) <- envir[["sns"]]
662
-##		sig2T <- envir[["sig2T"]]
663
-##		rownames(sig2T) <- rownames(CT)
664
-##		nuT <- envir[["nuT"]]
665
-##		colnames(nuT) <- paste("nuT", unique(batch), sep="_")
666
-##		phiT <- envir[["phiT"]]
667
-##		colnames(phiT) <- paste("phiT", unique(batch), sep="_")
668
-##		naMatrix <- matrix(NA, nrow(CT), ncol(CT))
669
-##		dimnames(naMatrix) <- dimnames(CT)
670
-##	} else{
671
-##		sig2T <- nuT <- phiT <- naMatrix <- CT <- NULL
672
-##	}
673
-##	CA <- rbind(CA, CT)
674
-##	CB <- rbind(CB, naMatrix)	
675
-##
676
-##	##SNP parameters
677
-##	tau2A <- envir[["tau2A"]]
678
-##	colnames(tau2A) <- paste("tau2A", unique(batch), sep="_")
679
-##	tau2B <- envir[["tau2B"]]
680
-##	colnames(tau2B) <- paste("tau2B", unique(batch), sep="_")
681
-##	sig2A <- envir[["sig2A"]]
682
-##	colnames(sig2A) <- paste("sig2A", unique(batch), sep="_")
683
-##	sig2B <- envir[["sig2B"]]
684
-##	colnames(sig2B) <- paste("sig2B", unique(batch), sep="_")
685
-##	nuA <- envir[["nuA"]]
686
-##	colnames(nuA) <- paste("nuA", unique(batch), sep="_")
687
-##	nuB <- envir[["nuB"]]
688
-##	colnames(nuB) <- paste("nuB", unique(batch), sep="_")
689
-##	phiA <- envir[["phiA"]]
690
-##	colnames(phiA) <- paste("phiA", unique(batch), sep="_")
691
-##	phiB <- envir[["phiB"]]
692
-##	colnames(phiB) <- paste("phiB", unique(batch), sep="_")
693
-##	corr <- envir[["corr"]]
694
-##	colnames(corr) <- paste("corr", unique(batch), sep="_")
695
-##	corrA.BB <- envir[["corrA.BB"]]
696
-##	colnames(corrA.BB) <- paste("corrA.BB", unique(batch), sep="_")
697
-##	corrB.AA <- envir[["corrB.AA"]]
698
-##	colnames(corrB.AA) <- paste("corrB.AA", unique(batch), sep="_")
699
-##
700
-##
701
-##	##Combine SNP and NP parameters
702
-##	if(!is.null(NPset)){
703
-##		naMatrixParams <- matrix(NA, nrow(CT), length(unique(batch)))
704
-##		dimnames(naMatrixParams) <- list(rownames(CT), unique(batch))
705
-##	} else{
706
-##		naMatrixParams <- NULL
707
-##	}
708
-##	tau2A <- rbind(tau2A, naMatrixParams)
709
-##	tau2B <- rbind(tau2B, naMatrixParams)
710
-##	sig2A <- rbind(sig2A, sig2T)
711
-##	sig2B <- rbind(sig2B, naMatrixParams)
712
-##	corr <- rbind(corr, naMatrixParams)
713
-##	corrA.BB <- rbind(corrA.BB, naMatrixParams)
714
-##	corrB.AA <- rbind(corrB.AA, naMatrixParams)
715
-##	nuA <- rbind(nuA, nuT)
716
-##	phiA <- rbind(phiA, phiT)
717
-##	nuB <- rbind(nuB, naMatrixParams)
718
-##	phiB <- rbind(phiB, naMatrixParams)
719
-##	rownames(tau2A) <- rownames(tau2B) <- rownames(sig2A) <- rownames(sig2B) <- rownames(CA)
720
-##	rownames(corr) <- rownames(corrA.BB) <- rownames(corrB.AA) <- rownames(CA)
721
-##	rownames(nuA) <- rownames(phiA) <- rownames(nuB) <- rownames(phiB) <- rownames(CA)	
722
-##	##phenodata
723
-##	phenodata <- phenoData(ABset)
724
-##	phenodata <- phenodata[match(envir[["sns"]], sampleNames(phenodata)), ]
725
-##	if(!("batch" %in% varLabels(phenodata))) phenodata$batch <- envir[["plate"]]
726
-##
727
-##	##Feature Data
728
-##	position.snp <- snpProbes[match(envir[["snps"]], rownames(snpProbes)), "position"]
729
-##	names(position.snp) <- envir[["snps"]]
730
-##	if(!is.null(NPset)){
731
-##		position.np <- cnProbes[match(envir[["cnvs"]], rownames(cnProbes)), "position"]
732
-##		names(position.np) <- envir[["cnvs"]]
733
-##	} else position.np <- NULL
734
-##	position <- c(position.snp, position.np)
735
-##	if(!(identical(names(position), rownames(CA)))){
736
-##		position <- position[match(rownames(CA), names(position))]
737
-##	}
738
-##	if(sum(duplicated(names(position))) > 0){
739
-##		warning("Removing rows with NA identifiers...")
740
-##		##RS: fix this
741
-##		I <- which(!is.na(names(position)))
742
-##	}  else I <- seq(along=names(position))
743
-##	fd <- data.frame(cbind(CHR,
744
-##			       position[I],
745
-##			       tau2A[I,, drop=FALSE],
746
-##			       tau2B[I,, drop=FALSE],
747
-##			       sig2A[I,, drop=FALSE],
748
-##			       sig2B[I,, drop=FALSE],
749
-##			       nuA[I,, drop=FALSE],
750
-##			       nuB[I,, drop=FALSE],
751
-##			       phiA[I,, drop=FALSE],
752
-##			       phiB[I,, drop=FALSE],
753
-##			       corr[I,, drop=FALSE],
754
-##			       corrA.BB[I,, drop=FALSE],
755
-##			       corrB.AA[I,, drop=FALSE]))
756
-##	colnames(fd)[1:2] <- c("chromosome", "position")
757
-##	rownames(fd) <- rownames(CA)[I]
758
-##	fD <- new("AnnotatedDataFrame",
759
-##		  data=fd,
760
-##		  varMetadata=data.frame(labelDescription=colnames(fd)))
761
-##	placeholder <- matrix(NA, nrow(CA), ncol(CA))
762
-##	dimnames(placeholder) <- dimnames(CA)
763
-##	assayData <- assayDataNew("lockedEnvironment",
764
-##				  CA=placeholder[I, ],
765
-##				  CB=placeholder[I, ])
766
-##	cnset <- new("CopyNumberSet",
767
-##		      assayData=assayData,
768
-##		      featureData=fD,
769
-##		      phenoData=phenodata,
770
-##		      annotation=cdfName)
771
-##	CA(cnset) <- CA  ##replacement method converts to integer
772
-##	CB(cnset) <- CB  ##replacement method converts to integer
773
-##	cnset <- thresholdCopyNumberSet(cnset)
774
-##	return(cnset)
775
-##
776
-
777
-
778
-
779 579
 thresholdCopynumber <- function(object){
780 580
 	ca <- CA(object)
781 581
 	cb <- CB(object)
... ...
@@ -803,7 +603,6 @@ cnOptions <- function(tmpdir=tempdir(),
803 603
 		      save.it=TRUE,
804 604
 		      load.it=TRUE,
805 605
 		      splitByChr=TRUE,
806
-		      use.ff=FALSE,
807 606
 		      MIN.OBS=3,
808 607
 		      MIN.SAMPLES=10,
809 608
 		      batch=NULL,
... ...
@@ -846,7 +645,6 @@ cnOptions <- function(tmpdir=tempdir(),
846 645
 	     save.it=save.it,
847 646
 	     load.it=load.it,
848 647
 	     splitByChr=splitByChr,
849
-	     use.ff=use.ff,
850 648
 	     MIN.OBS=MIN.OBS,
851 649
 	     MIN.SAMPLES=MIN.SAMPLES,
852 650
 	     batch=batch,
... ...
@@ -1655,7 +1453,7 @@ hmmOptions <- function(copynumberStates=0:4,
1655 1453
 	     MIN.MARKERS=MIN.MARKERS)
1656 1454
 }
1657 1455
 
1658
-computeHmm.CrlmmSet <- function(object, cnOptions){
1456
+computeHmm.CNSet <- function(object, cnOptions){
1659 1457
 	hmmOptions <- cnOptions[["hmmOpts"]]
1660 1458
 	object <- object[order(chromosome(object), position(object)), ]
1661 1459
 	##emission <- hmmOptions[["emission"]]
... ...
@@ -1663,47 +1461,60 @@ computeHmm.CrlmmSet <- function(object, cnOptions){
1663 1461
 	tPr <- transitionProbability(chromosome=chromosome(object),
1664 1462
 				     position=position(object),
1665 1463
 				     TAUP=hmmOptions[["TAUP"]])
1666
-
1667
-	emission <- computeEmission(object, hmmOptions)
1464
+	emissionPr(object) <- computeEmission(object, hmmOptions)
1668 1465
 ##	if(cnOptions[["save.it"]])
1669 1466
 ##		save(emission,
1670 1467
 ##		     file=file.path(cnOptions[["outdir"]], paste("emission_", chrom, ".rda", sep="")))
1671
-	hmmPredictions <- viterbi.CrlmmSet(object,
1672
-					   hmmOptions=hmmOptions,
1673
-					   emissionPr=emission,
1674
-					   transitionPr=tPr[, "transitionPr"],
1675
-					   chromosomeArm=tPr[, "arm"])
1676
-	segments <- breaks(x=hmmPredictions,
1677
-			   states=hmmOptions[["copynumberStates"]],
1678
-			   position=position(object),
1679
-			   chromosome=chromosome(object))
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))
1680 1476
 	##
1681
-	object <- new("SegmentSet",
1682
-		      CA=object@assayData[["CA"]],  ## keep as an integer
1683
-		      CB=object@assayData[["CB"]],  ## keep as an integer
1684
-		      senseThetaA=A(object),
1685
-		      senseThetaB=B(object),
1686
-		      calls=calls(object),
1687
-		      callsConfidence=callsConfidence(object),
1688
-		      featureData=featureData(object),
1689
-		      phenoData=phenoData(object),
1690
-		      protocolData=protocolData(object),
1691
-		      experimentData=experimentData(object),
1692
-		      annotation=annotation(object),
1693
-		      segmentData=segments,
1694
-		      emissionPr=emission)
1695
-
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)
1493
+	return(object)
1696 1494
 }
1697 1495
 
1698
-viterbi.CrlmmSet <- function(object, hmmOptions, emissionPr, transitionPr, chromosomeArm){
1699
-	viterbi(emission=emissionPr,
1700
-		tau=transitionPr,
1701
-		initialStateProbs=hmmOptions[["log.initialP"]],
1702
-		arm=chromosomeArm,
1703
-		normalIndex=hmmOptions[["normalIndex"]],
1704
-		normal2altered=hmmOptions[["normal2altered"]],
1705
-		altered2normal=hmmOptions[["altered2normal"]],
1706
-		altered2altered=hmmOptions[["altered2altered"]])
1496
+viterbi.CNSet <- function(object, hmmOptions, transitionPr, chromosomeArm){
1497
+	state.sequence <- viterbi(emission=emissionPr(object),
1498
+				  tau=transitionPr,
1499
+				  initialStateProbs=hmmOptions[["log.initialP"]],
1500
+				  arm=chromosomeArm,
1501
+				  normalIndex=hmmOptions[["normalIndex"]],
1502
+				  normal2altered=hmmOptions[["normal2altered"]],
1503
+				  altered2normal=hmmOptions[["altered2normal"]],
1504
+				  altered2altered=hmmOptions[["altered2altered"]])
1505
+	state.sequence <- data.frame(state.sequence)
1506
+	rleList <- RleList(state.sequence)
1507
+	rd <- RangedData(rleList)
1508
+##	rdList <- vector("list", length(rle.object))
1509
+##	for(i in seq(along=rdList)){
1510
+##		rdList[[i]] <- RangedData(rle.object[[i]],
1511
+##					  space=paste("chr", transitionPr[, "chromosome"], sep=""),
1512
+##					  state=runValue(rle.object[[i]]),
1513
+##					  sample=sampleNames(object)[i],
1514
+##					  nprobes=runLength(rle.object[[i]]))
1515
+##	}
1516
+##	rangedData <- do.call("rbind", rdList)
1517
+	return(rd)
1707 1518
 }
1708 1519
 
1709 1520
 
... ...
@@ -1737,7 +1548,7 @@ thresholdModelParams <- function(object, cnOptions){
1737 1548
 }
1738 1549
 
1739 1550
 
1740
-computeEmission.CrlmmSet <- function(object, hmmOptions){
1551
+computeEmission.CNSet <- function(object, hmmOptions){
1741 1552
 	EMIT.THR <- hmmOptions[["EMIT.THR"]]
1742 1553
 	cnStates <- hmmOptions[["copynumberStates"]]
1743 1554
 	object <- object[order(chromosome(object), position(object)), ]
... ...
@@ -1900,7 +1711,6 @@ setMethod("update", "character", function(object, ...){
1900 1711
 	}
1901 1712
 })
1902 1713
 
1903
-
1904 1714
 addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1905 1715
 	##if(missing(CHR)) stop("Must specificy chromosome")
1906 1716
 	cdfName <- annotation(object)
... ...
@@ -1915,8 +1725,6 @@ addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1915 1725
 	isSnp <- rep(as.integer(0), nrow(object))
1916 1726
 	isSnp[snpIndex(object)] <- as.integer(1)
1917 1727
 	names(isSnp) <- featureNames(object)
1918
-##	snps <- featureNames(object)[snpIndex(object)]
1919
-##	nps <- featureNames(object)[cnIndex(object)]
1920 1728
 	snps <- featureNames(object)[isSnp == 1]
1921 1729
 	nps <- featureNames(object)[isSnp == 0]
1922 1730
 	position.snp <- snpProbes[match(snps, rownames(snpProbes)), "position"]
... ...
@@ -1949,8 +1757,15 @@ addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1949 1757
 		I <- which(!is.na(names(position)))
1950 1758
 	}  else I <- seq(along=names(position))
1951 1759
 	tmp.fd <- data.frame(cbind(chrom[I],
1952
-			       position[I]), isSnp[I])
1760
+				   position[I],
1761
+				   isSnp[I]))
1953 1762
 	colnames(tmp.fd) <- c("chromosome", "position", "isSnp")
1763
+	if("chromosome" %in% fvarLabels(object))
1764
+		tmp.fd <- tmp.fd[ -1]
1765
+	if("position" %in% fvarLabels(object))
1766
+		tmp.fd <- tmp.fd[ -2]
1767
+	if("isSnp" %in% fvarLabels(object))
1768
+		tmp.fd <- tmp.fd[ -3]
1954 1769
 	rownames(tmp.fd) <- featureNames(object)
1955 1770
 	tmp <- new("AnnotatedDataFrame",
1956 1771
 		   data=tmp.fd,
... ...
@@ -1962,24 +1777,24 @@ addFeatureAnnotation.SnpCallSetPlus <- function(object, ...){
1962 1777
 
1963 1778
 
1964 1779
 computeCopynumber.SnpCallSetPlus <- function(object, cnOptions){
1965
-	use.ff <- cnOptions[["use.ff"]]
1966
-	if(!use.ff){
1967
-		object <- as(object, "CrlmmSet")
1968
-	} else	object <- as(object, "CrlmmSetFF")
1780
+##	use.ff <- cnOptions[["use.ff"]]
1781
+##	if(!use.ff){
1782
+##		object <- as(object, "CrlmmSet")
1783
+##	} else	object <- as(object, "CrlmmSetFF")
1969 1784
 	bias.adj <- cnOptions[["bias.adj"]]
1970 1785
 	##must be FALSE to initialize parameters
1971 1786
 	cnOptions[["bias.adj"]] <- FALSE
1972 1787
 	## Add linear model parameters to the CrlmmSet object
1973 1788
 	featureData(object) <- lm.parameters(object, cnOptions)
1974 1789
 	if(!isValidCdfName(annotation(object))) stop(annotation(object), " not supported.")	
1975
-	object <- computeCopynumber.CrlmmSet(object, cnOptions)
1790
+	object <- computeCopynumber.CNSet(object, cnOptions)
1976 1791
 	if(bias.adj==TRUE){## run a second time
1977
-		object <- computeCopynumber.CrlmmSet(object, cnOptions)
1792
+		object <- computeCopynumber.CNSet(object, cnOptions)
1978 1793
 	}
1979 1794
 	return(object)
1980 1795
 }
1981 1796
 
1982
-## computeCopynumber.CrlmmSet
1797
+## computeCopynumber.CNSet
1983 1798
 ##    tmp.objects <- instantiateObjects() ##vA, vB, (background mean), muA, muB (within genotype means), Ns
1984 1799
 ##    tmp.objects <- withinGenotypeMoments() ##compute vA, vB, muA, muB, Ns
1985 1800
 ##    object.batch <- locationAndScale()  ##calcualte tau2A, tau2B, sig2A, sig2B, corr for polymorphic probes
... ...
@@ -1990,7 +1805,7 @@ computeCopynumber.SnpCallSetPlus <- function(object, cnOptions){
1990 1805
 ##    object.batch <- nonpolymorphic()     assigns CA
1991 1806
 
1992 1807
 
1993
-computeCopynumber.CrlmmSet <- function(object, cnOptions){
1808
+computeCopynumber.CNSet <- function(object, cnOptions){
1994 1809
 	CHR <- unique(chromosome(object))
1995 1810
 	batch <- object$batch
1996 1811
 	if(length(batch) != ncol(object)) stop("Batch must be the same length as the number of samples")
1997 1812
new file mode 100644
... ...
@@ -0,0 +1,295 @@
1
+setMethod("initialize", "CNSet",
2
+          function(.Object,
3
+		   assayData,
4
+                   phenoData,
5
+		   featureData,
6
+		   annotation,
7
+		   experimentData,
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"),
15
+		   segmentData=new("RangedData"),
16
+		   emissionPr=new("array"), ... ){
17
+		  if(missing(assayData)){
18
+			  assayData <- assayDataNew("lockedEnvironment",
19
+						    calls=calls,
20
+						    callsConfidence=callsConfidence,
21
+						    senseThetaA=senseThetaA,
22
+						    senseThetaB=senseThetaB,
23
+						    CA=CA,
24
+						    CB=CB)
25
+		  } 
26
+		  assayData(.Object) <- assayData
27
+		  if (missing(phenoData)){
28
+			  phenoData(.Object) <- annotatedDataFrameFrom(calls, byrow=FALSE)
29
+		  } else phenoData(.Object) <- phenoData
30
+		  if (missing(featureData)){
31
+			  featureData(.Object) <- annotatedDataFrameFrom(calls, byrow=TRUE)
32
+		  } else featureData(.Object) <- featureData
33
+		  if(!missing(annotation)) annotation(.Object) <- annotation
34
+		  if(!missing(experimentData)) experimentData(.Object) <- experimentData
35
+		  if(!missing(protocolData)) protocolData(.Object) <- protocolData
36
+		  if(!missing(emissionPr)) .Object@emissionPr <- emissionPr
37
+		  segmentData(.Object) <- segmentData
38
+		  .Object	    
39
+          })
40
+
41
+setAs("SnpCallSetPlus", "CNSet",
42
+      function(from, to){
43
+	      CA <- CB <- matrix(NA, nrow(from), ncol(from))
44
+	      dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  
45
+	      new("CNSet",
46
+		  calls=calls(from),
47
+		  callsConfidence=callsConfidence(from),
48
+		  senseThetaA=A(from),
49
+		  senseThetaB=B(from),
50
+		  CA=CA,
51
+		  CB=CB,
52
+		  phenoData=phenoData(from),
53
+		  experimentData=experimentData(from),
54
+		  annotation=annotation(from),
55
+		  protocolData=protocolData(from),
56
+		  featureData=featureData(from))
57
+      })
58
+
59
+setValidity("CNSet", function(object) {
60
+	assayDataValidMembers(assayData(object), c("CA", "CB", "call", "callProbability", "senseThetaA", "senseThetaB"))
61
+})
62
+
63
+
64
+
65
+setMethod("computeCopynumber", "CNSet", function(object, cnOptions){
66
+	computeCopynumber.CNSet(object, cnOptions)
67
+})
68
+
69
+setMethod("computeCopynumber", "character", function(object, cnOptions){
70
+	crlmmFile <- object
71
+	isCNSet <- length(grep("cnSet", crlmmFile[1])) > 0
72
+	for(i in seq(along=crlmmFile)){
73
+		cat("Processing ", crlmmFile[i], "...\n")
74
+		load(crlmmFile[i])
75
+		if(isCNSet){
76
+			object <- get("cnSet")
77
+		} else {
78
+			object <- get("callSetPlus")
79
+		}
80
+		CHR <- unique(chromosome(object))
81
+		##if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")		
82
+		if(all(CHR==24)){
83
+			message("skipping chromosome 24")
84
+			next()
85
+		}
86
+		cat("----------------------------------------------------------------------------\n")
87
+		cat("-        Estimating copy number for chromosome", CHR, "\n")
88
+		cat("----------------------------------------------------------------------------\n")
89
+		cnSet <- computeCopynumber(object, cnOptions)
90
+		save(cnSet, file=file.path(dirname(crlmmFile), paste("cnSet_", CHR, ".rda", sep="")))
91
+		if(!isCNSet) if(cnOptions[["unlink"]]) unlink(crlmmFile[i])
92
+		rm(object, cnSet); gc();
93
+	}	
94
+})
95
+
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
+	  })
114
+
115
+setMethod("computeEmission", "CNSet", function(object, hmmOptions){
116
+	computeEmission.CNSet(object, hmmOptions)
117
+})
118
+
119
+setMethod("computeEmission", "character", function(object, hmmOptions){
120
+	filename <- object
121
+	chrom <- gsub(".rda", "", strsplit(filename, "_")[[1]][[2]])
122
+	if(hmmOptions[["verbose"]])
123
+		message("Compute emission probabilities for chromosome ", chrom)
124
+	if(file.exists(filename)){
125
+		load(filename)
126
+		cnSet <- get("cnSet")
127
+	} else {
128
+		stop("File ", filename, " does not exist.")
129
+	}
130
+	emission <- computeEmission(cnSet, hmmOptions)
131
+	message("Saving ", file.path(dirname(filename), paste("emission_", chrom, ".rda", sep="")))
132
+	if(hmmOptions[["save.it"]]){
133
+		save(emission,
134
+		     file=file.path(dirname(filename), paste("emission_", chrom, ".rda", sep="")))
135
+	}
136
+	return(emission)
137
+})
138
+
139
+setMethod("computeHmm", "CNSet", function(object, hmmOptions){
140
+	computeHmm.CNSet(object, hmmOptions)
141
+})
142
+
143
+##setMethod("computeHmm", "SnpCallSetPlus", function(object, hmmOptions){
144
+##	cnSet <- computeCopynumber(object, hmmOptions)
145
+##	computeHmm(cnSet, hmmOptions)
146
+##})
147
+
148
+## Genotype everything to get callSetPlus objects
149
+## Go from callSets to Segments sets, writing only the segment set to file
150
+## Safe, but very inefficient. Writes the quantile normalized data to file several times...
151
+setMethod("computeHmm", "character", function(object, hmmOptions){
152
+	outdir <- cnOptions[["outdir"]]
153
+	hmmOptions <- hmmOptions[["hmmOpts"]]
154
+	filenames <- object
155
+	for(i in seq(along=filenames)){
156
+		chrom <- gsub(".rda", "", strsplit(filenames[i], "_")[[1]][[2]])
157
+		if(hmmOptions[["verbose"]])
158
+			message("Fitting HMM to chromosome ", chrom)
159
+		if(file.exists(filenames[i])){
160
+			message("Loading ", filenames[i])
161
+			load(filenames[i])
162
+			cnSet <- get("cnSet")
163
+		} else {
164
+			stop("File ", filenames[i], " does not exist.")
165
+		}
166
+		hmmOptions$emission <- computeEmission(filenames[i], hmmOptions)
167
+		cnSet <- computeHmm(cnSet, hmmOptions)
168
+		##MIN.MARKERS <- hmmOptions[["MIN.MARKERS"]]
169
+		##segmentSet <- segments[segments$nprobes >= MIN.MARKERS, ]
170
+		message("Saving ", file.path(outdir, paste("cnSet_", chrom, ".rda", sep="")))
171
+		save(cnSet,
172
+		     file=file.path(outdir, paste("cnSet_", chrom, ".rda", sep="")))
173
+		unlink(file.path(outdir, paste("cnSet_", chrom, ".rda", sep="")))
174
+	}
175
+	fns <- list.files(outdir, pattern="cnSet", full.names=TRUE)
176
+	return(fns)	
177
+})
178
+
179
+
180
+
181
+setValidity("CNSet", function(object) {
182
+	msg <- validMsg(NULL, assayDataValidMembers(assayData(object), c("CA", "CB")))
183
+	if (is.null(msg)) TRUE else msg
184
+})
185
+##may want to allow thresholding here (... arg)
186
+setMethod("CA", "CNSet", function(object) assayData(object)[["CA"]]/100)
187
+setMethod("CB", "CNSet", function(object) assayData(object)[["CB"]]/100)
188
+
189
+setReplaceMethod("CA", signature(object="CNSet", value="matrix"),
190
+		 function(object, value){
191
+			 assayDataElementReplace(object, "CA", value)		
192
+		 })
193
+
194
+setReplaceMethod("CB", signature(object="CNSet", value="matrix"),
195
+		 function(object, value){
196
+			 assayDataElementReplace(object, "CB", value)
197
+		 })
198
+
199
+setMethod("copyNumber", "CNSet", function(object){
200
+	I <- isSnp(object)
201
+	CA <- CA(object)
202
+	CB <- CB(object)
203
+	CN <- CA + CB
204
+	##For nonpolymorphic probes, CA is the total copy number
205
+	CN[!I, ] <- CA(object)[!I, ]
206
+	CN
207
+})
208
+
209
+
210
+setMethod("ellipse", "CNSet", function(x, copynumber, batch, ...){
211
+	ellipse.CNSet(x, copynumber, batch, ...)
212
+})
213
+
214
+##setMethod("ellipse", "CNSet", function(x, copynumber, ...){
215
+ellipse.CNSet <- function(x, copynumber, batch, ...){
216
+	if(nrow(x) > 1) stop("only 1 snp at a time")
217
+	##batch <- unique(x$batch)
218
+	if(missing(batch)){
219
+		stop("must specify batch")
220
+	}
221
+	if(length(batch) > 1) stop("batch variable not unique")
222
+	nuA <- getParam(x, "nuA", batch)
223
+	nuB <- getParam(x, "nuB", batch)
224
+	phiA <- getParam(x, "phiA", batch)
225
+	phiB <- getParam(x, "phiB", batch)
226
+	tau2A <- getParam(x, "tau2A", batch)
227
+	tau2B <- getParam(x, "tau2B", batch)
228
+	sig2A <- getParam(x, "sig2A", batch)
229
+	sig2B <- getParam(x, "sig2B", batch)
230
+	corrA.BB <- getParam(x, "corrA.BB", batch)
231
+	corrB.AA <- getParam(x, "corrB.AA", batch)
232
+	corr <- getParam(x, "corr", batch)
233
+##	nuA <- as.numeric(fData(x)[, match(paste("nuA", batch, sep="_"), fvarLabels(x))])
234
+##	nuB <- as.numeric(fData(x)[, match(paste("nuB", batch, sep="_"), fvarLabels(x))])	
235
+##	phiA <- as.numeric(fData(x)[, match(paste("phiA", batch, sep="_"), fvarLabels(x))])
236
+##	phiB <- as.numeric(fData(x)[, match(paste("phiB", batch, sep="_"), fvarLabels(x))])	
237
+##	tau2A <- as.numeric(fData(x)[, match(paste("tau2A", batch, sep="_"), fvarLabels(x))])
238
+##	tau2B <- as.numeric(fData(x)[, match(paste("tau2B", batch, sep="_"), fvarLabels(x))])
239
+##	sig2A <- as.numeric(fData(x)[, match(paste("sig2A", batch, sep="_"), fvarLabels(x))])
240
+##	sig2B <- as.numeric(fData(x)[, match(paste("sig2B", batch, sep="_"), fvarLabels(x))])
241
+##	corrA.BB <- as.numeric(fData(x)[, match(paste("corrA.BB", batch, sep="_"), fvarLabels(x))])
242
+##	corrB.AA <- as.numeric(fData(x)[, match(paste("corrB.AA", batch, sep="_"), fvarLabels(x))])
243
+##	corr <- as.numeric(fData(x)[, match(paste("corr", batch, sep="_"), fvarLabels(x))])
244
+	for(CN in copynumber){
245
+		for(CA in 0:CN){
246
+			CB <- CN-CA
247
+			A.scale <- sqrt(tau2A*(CA==0) + sig2A*(CA > 0))
248
+			B.scale <- sqrt(tau2B*(CB==0) + sig2B*(CB > 0))
249
+			scale <- c(A.scale, B.scale)
250
+			if(CA == 0 & CB > 0) rho <- corrA.BB
251
+			if(CA > 0 & CB == 0) rho <- corrB.AA
252
+			if(CA > 0 & CB > 0) rho <- corr
253
+			if(CA == 0 & CB == 0) rho <- 0
254
+			lines(ellipse(x=rho, centre=c(log2(nuA+CA*phiA),
255
+					     log2(nuB+CB*phiB)),
256
+				      scale=scale), ...)
257
+		}
258
+	}
259
+}
260
+
261
+setMethod("segmentData", "CNSet", function(object) object@segmentData)
262
+setReplaceMethod("segmentData", c("CNSet", "RangedData"), function(object, value){
263
+	object@segmentData <- value
264
+	object
265
+})
266
+
267
+setMethod("emissionPr", "CNSet", function(object) object@emissionPr)
268
+setReplaceMethod("emissionPr", c("CNSet", "array"), function(object, value){
269
+	object@emissionPr <- value
270
+	object
271
+})
272
+
273
+setMethod("show", "CNSet", function(object){
274
+	callNextMethod(object)
275
+	cat("emissionPr\n")
276
+	cat("   array:", nrow(object), "features,", ncol(object), "samples,", dim(emissionPr(object))[3], "states\n")
277
+	cat("   hidden states:\n")
278
+	cat("      ", dimnames(emissionPr(object))[[3]], "\n")
279
+	cat("   Missing values:", sum(is.na(emissionPr(object))), "\n")
280
+	if(!all(is.na(emissionPr(object)))){
281
+		cat("   minimum value:", min(emissionPr(object), na.rm=TRUE), "\n")
282
+	} else  cat("   minimum value: NA (all missing)\n")
283
+	cat("segmentData:  ")
284
+	cat("    ", show(segmentData(object)), "\n")
285
+##	cat("   ", nrow(segmentData(object)), "segments\n")
286
+##	cat("    column names:", paste(colnames(segmentData(object)), collapse=", "), "\n")
287
+#	cat("    mean # markers per segment:", mean(segmentData(object)$nprobes))
288
+})
289
+
290
+
291
+
292
+
293
+
294
+
295
+
0 296
deleted file mode 100644
... ...
@@ -1,79 +0,0 @@
1
-setValidity("CopyNumberSet", function(object) {
2
-	msg <- validMsg(NULL, assayDataValidMembers(assayData(object), c("CA", "CB")))
3
-	if (is.null(msg)) TRUE else msg
4
-})
5
-##may want to allow thresholding here (... arg)
6
-setMethod("CA", "CopyNumberSet", function(object) assayData(object)[["CA"]]/100)
7
-setMethod("CB", "CopyNumberSet", function(object) assayData(object)[["CB"]]/100)
8
-
9
-setReplaceMethod("CA", signature(object="CopyNumberSet", value="matrix"),
10
-		 function(object, value){
11
-			 assayDataElementReplace(object, "CA", value)		
12
-		 })
13
-
14
-setReplaceMethod("CB", signature(object="CopyNumberSet", value="matrix"),
15
-		 function(object, value){
16
-			 assayDataElementReplace(object, "CB", value)
17
-		 })
18
-
19
-setMethod("copyNumber", "CopyNumberSet", function(object){
20
-	I <- isSnp(object)
21
-	CA <- CA(object)
22
-	CB <- CB(object)
23
-	CN <- CA + CB
24
-	##For nonpolymorphic probes, CA is the total copy number
25
-	CN[!I, ] <- CA(object)[!I, ]
26
-	CN
27
-})
28
-
29
-
30
-
31
-##setMethod("ellipse", "CopyNumberSet", function(x, copynumber, ...){
32
-ellipse.CopyNumberSet <- function(x, copynumber, ...){
33
-##setMethod("ellipse", "CopyNumberSet", function(x, copynumber, ...){
34
-	##fittedOrder <- unique(sapply(basename(celFiles), function(x) strsplit(x, "_")[[1]][2]))
35
-	##index <- match(plates, fittedOrder)
36
-	if(nrow(x) > 1) stop("only 1 snp at a time")
37
-	##batch <- unique(x$batch)
38
-	args <- list(...)
39
-	if(!"batch" %in% names(args)){
40
-		jj <- match("batch", varLabels(x))
41
-		if(length(jj) < 1) stop("batch not in varLabels")
42
-		batch <- unique(pData(x)[, jj])
43
-	} else{
44
-		batch <- unique(args$batch)
45
-	}
46
-	if(length(batch) > 1) stop("batch variable not unique")
47
-	nuA <- as.numeric(fData(x)[, match(paste("nuA", batch, sep="_"), fvarLabels(x))])
48
-	nuB <- as.numeric(fData(x)[, match(paste("nuB", batch, sep="_"), fvarLabels(x))])	
49
-	phiA <- as.numeric(fData(x)[, match(paste("phiA", batch, sep="_"), fvarLabels(x))])
50
-	phiB <- as.numeric(fData(x)[, match(paste("phiB", batch, sep="_"), fvarLabels(x))])	
51
-	tau2A <- as.numeric(fData(x)[, match(paste("tau2A", batch, sep="_"), fvarLabels(x))])
52
-	tau2B <- as.numeric(fData(x)[, match(paste("tau2B", batch, sep="_"), fvarLabels(x))])
53
-	sig2A <- as.numeric(fData(x)[, match(paste("sig2A", batch, sep="_"), fvarLabels(x))])
54
-	sig2B <- as.numeric(fData(x)[, match(paste("sig2B", batch, sep="_"), fvarLabels(x))])
55
-	corrA.BB <- as.numeric(fData(x)[, match(paste("corrA.BB", batch, sep="_"), fvarLabels(x))])
56
-	corrB.AA <- as.numeric(fData(x)[, match(paste("corrB.AA", batch, sep="_"), fvarLabels(x))])
57
-	corr <- as.numeric(fData(x)[, match(paste("corr", batch, sep="_"), fvarLabels(x))])
58
-	for(CN in copynumber){
59
-		for(CA in 0:CN){
60
-			CB <- CN-CA
61
-			A.scale <- sqrt(tau2A*(CA==0) + sig2A*(CA > 0))
62
-			B.scale <- sqrt(tau2B*(CB==0) + sig2B*(CB > 0))
63
-			scale <- c(A.scale, B.scale)
64
-			if(CA == 0 & CB > 0) rho <- corrA.BB
65
-			if(CA > 0 & CB == 0) rho <- corrB.AA
66
-			if(CA > 0 & CB > 0) rho <- corr
67
-			if(CA == 0 & CB == 0) rho <- 0
68
-			lines(ellipse(x=rho, centre=c(log2(nuA+CA*phiA),
69
-					     log2(nuB+CB*phiB)),
70
-				      scale=scale), ...)
71
-		}
72
-	}
73
-}
74
-
75
-
76
-
77
-
78
-
79
-
80 0
deleted file mode 100644
... ...
@@ -1,298 +0,0 @@
1
-setMethod("initialize", "CrlmmSet",
2
-          function(.Object,
3
-                   phenoData,
4
-		   featureData,
5
-		   annotation,
6
-		   experimentData,
7
-		   protocolData,
8
-                   calls=new("matrix"),
9
-                   callsConfidence=new("matrix"),
10
-                   senseThetaA=new("matrix"),
11
-                   senseThetaB=new("matrix"),
12
-		   CA=new("matrix"),
13
-		   CB=new("matrix"), ... ){
14
-		  ad <- assayDataNew("lockedEnvironment",
15
-				     calls=calls,
16
-				     callsConfidence=callsConfidence,
17
-				     senseThetaA=senseThetaA,
18
-				     senseThetaB=senseThetaB,
19
-				     CA=CA,
20
-				     CB=CB)
21
-		  assayData(.Object) <- ad
22
-		  if (missing(phenoData)){
23
-			  phenoData(.Object) <- annotatedDataFrameFrom(calls, byrow=FALSE)
24
-		  } else phenoData(.Object) <- phenoData
25
-		  if (missing(featureData)){
26
-			  featureData(.Object) <- annotatedDataFrameFrom(calls, byrow=TRUE)
27
-		  } else featureData(.Object) <- featureData
28
-		  if(!missing(annotation)) annotation(.Object) <- annotation
29
-		  if(!missing(experimentData)) experimentData(.Object) <- experimentData
30
-		  if(!missing(protocolData)) protocolData(.Object) <- protocolData
31
-		  .Object	    
32
-          })
33
-
34
-setAs("SnpCallSetPlus", "CrlmmSet",
35
-      function(from, to){
36
-	      CA <- CB <- matrix(NA, nrow(from), ncol(from))
37
-	      dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  
38
-	      new("CrlmmSet",
39
-		  calls=calls(from),
40
-		  callsConfidence=callsConfidence(from),
41
-		  senseThetaA=A(from),
42
-		  senseThetaB=B(from),
43
-		  CA=CA,
44
-		  CB=CB,
45
-		  phenoData=phenoData(from),
46
-		  experimentData=experimentData(from),
47
-		  annotation=annotation(from),
48
-		  protocolData=protocolData(from),
49
-		  featureData=featureData(from))
50
-      })
51
-
52
-setValidity("CrlmmSet", function(object) {
53
-	assayDataValidMembers(assayData(object), c("CA", "CB", "calls", "callsConfidence", "senseThetaA", "senseThetaB"))
54
-})
55
-
56
-
57
-
58
-setMethod("computeCopynumber", "CrlmmSet", function(object, cnOptions){
59
-	computeCopynumber.CrlmmSet(object, cnOptions)
60
-})
61
-
62
-setMethod("computeCopynumber", "character", function(object, cnOptions){
63
-	crlmmFile <- object
64
-	isCrlmmSet <- length(grep("crlmmSet", crlmmFile[1])) > 0
65
-	for(i in seq(along=crlmmFile)){
66
-		cat("Processing ", crlmmFile[i], "...\n")
67
-		load(crlmmFile[i])
68
-		if(isCrlmmSet){
69
-			object <- get("crlmmSet")
70
-		} else {
71
-			object <- get("callSetPlus")
72
-		}
73
-		CHR <- unique(chromosome(object))
74
-		##if(length(CHR) > 1) stop("More than one chromosome in the object. This method requires one chromosome at a time.")		
75
-		if(all(CHR==24)){
76
-			message("skipping chromosome 24")
77
-			next()
78
-		}
79
-		cat("----------------------------------------------------------------------------\n")
80
-		cat("-        Estimating copy number for chromosome", CHR, "\n")
81
-		cat("----------------------------------------------------------------------------\n")
82
-		crlmmSet <- computeCopynumber(object, cnOptions)
83
-		save(crlmmSet, file=file.path(dirname(crlmmFile), paste("crlmmSet_", CHR, ".rda", sep="")))
84
-		if(!isCrlmmSet) if(cnOptions[["unlink"]]) unlink(crlmmFile[i])
85
-		rm(object, crlmmSet); gc();
86
-	}	
87
-})
88
-
89
-setMethod("pr", signature(object="CrlmmSet",
90
-			  name="character",
91
-			  batch="ANY",
92
-			  value="numeric"), 
93
-	  function(object, name, batch, value){
94
-		  label <- paste(name, batch, sep="_")
95
-		  colindex <- match(label, fvarLabels(object))
96
-		  if(length(colindex) == 1){
97
-			  fData(object)[, colindex] <- value
98
-		  } 
99
-		  if(is.na(colindex)){
100
-			  stop(paste(label, " not found in object"))
101
-		  }
102
-		  if(length(colindex) > 1){
103
-			  stop(paste(label, " not unique"))
104
-		  }
105
-		  object
106
-	  })
107
-
108
-setMethod("computeEmission", "CrlmmSet", function(object, hmmOptions){
109
-	computeEmission.CrlmmSet(object, hmmOptions)
110
-})
111
-
112
-setMethod("computeEmission", "character", function(object, hmmOptions){
113
-	filename <- object
114
-	chrom <- gsub(".rda", "", strsplit(filename, "_")[[1]][[2]])
115
-	if(hmmOptions[["verbose"]])
116
-		message("Compute emission probabilities for chromosome ", chrom)
117
-	if(file.exists(filename)){
118
-		load(filename)
119
-		crlmmSet <- get("crlmmSet")
120
-	} else {
121
-		stop("File ", filename, " does not exist.")
122
-	}
123
-	emission <- computeEmission(crlmmSet, hmmOptions)
124
-	message("Saving ", file.path(dirname(filename), paste("emission_", chrom, ".rda", sep="")))
125
-	if(hmmOptions[["save.it"]]){
126
-		save(emission,
127
-		     file=file.path(dirname(filename), paste("emission_", chrom, ".rda", sep="")))
128
-	}
129
-	return(emission)
130
-})
131
-
132
-setMethod("computeHmm", "CrlmmSet", function(object, hmmOptions){
133
-	computeHmm.CrlmmSet(object, hmmOptions)
134
-})
135
-
136
-##setMethod("computeHmm", "SnpCallSetPlus", function(object, hmmOptions){
137
-##	crlmmSet <- computeCopynumber(object, hmmOptions)
138
-##	computeHmm(crlmmSet, hmmOptions)
139
-##})
140
-
141
-## Genotype everything to get callSetPlus objects
142
-## Go from callSets to Segments sets, writing only the segment set to file
143
-## Safe, but very inefficient. Writes the quantile normalized data to file several times...
144
-setMethod("computeHmm", "character", function(object, hmmOptions){
145
-	outdir <- cnOptions[["outdir"]]
146
-	hmmOptions <- hmmOptions[["hmmOpts"]]
147
-	filenames <- object
148
-	for(i in seq(along=filenames)){
149
-		chrom <- gsub(".rda", "", strsplit(filenames[i], "_")[[1]][[2]])
150
-		if(hmmOptions[["verbose"]])
151
-			message("Fitting HMM to chromosome ", chrom)
152
-		if(file.exists(filenames[i])){
153
-			message("Loading ", filenames[i])
154
-			load(filenames[i])
155
-			crlmmSet <- get("crlmmSet")
156
-		} else {
157
-			stop("File ", filenames[i], " does not exist.")
158
-		}
159
-		hmmOptions$emission <- computeEmission(filenames[i], hmmOptions)
160
-		segmentSet <- computeHmm(crlmmSet, hmmOptions)
161
-		##MIN.MARKERS <- hmmOptions[["MIN.MARKERS"]]
162
-		##segmentSet <- segments[segments$nprobes >= MIN.MARKERS, ]
163
-		message("Saving ", file.path(outdir, paste("segmentSet_", chrom, ".rda", sep="")))
164
-		save(segmentSet,
165
-		     file=file.path(outdir, paste("segmentSet_", chrom, ".rda", sep="")))
166
-		unlink(file.path(outdir, paste("crlmmSet_", chrom, ".rda", sep="")))
167
-	}
168
-	fns <- list.files(outdir, pattern="segmentSet", full.names=TRUE)
169
-	return(fns)	
170
-})
171
-
172
-##initializeCrlmmSet <- function(annotation, sns, backingfile="./"){
173
-##	require(bigmemory)
174
-##	message("Initializing CrlmmSet file--be patient...")
175
-##	path <- system.file("extdata", package=paste(annotation, "Crlmm", sep=""))
176
-##	load(file.path(path, "snpProbes.rda"))
177
-##	load(file.path(path, "cnProbes.rda"))
178
-##	nr <- nrow(snpProbes)+nrow(cnProbes)
179
-##	pos <- c(snpProbes[, "position"], cnProbes[, "position"])
180
-##	chr <- c(snpProbes[, "chrom"], cnProbes[, "chrom"])
181
-##	index <- order(chr, pos)
182
-##	fns <- c(rownames(snpProbes), rownames(cnProbes))[index]
183
-####	fns <- fns[1:20]
184
-##	nr <- length(fns)
185
-##	nc <- length(sns)
186
-####	if(!file.exists(file.path(backingfile, "A.bin"))){
187
-##		AA <- filebacked.big.matrix(nr, nc, 
188
-##					    type="integer",
189
-##					    init=0,
190
-##					    backingpath=backingfile,
191
-##					    backingfile="A.bin",
192
-##					    descriptorfile="A.desc",
193
-##					    dimnames=list(fns, sns))
194
-####	} else {
195
-####		AA <- attach.big.matrix("A.desc", backingpath=backingfile)
196
-####	}
197
-####	if(!file.exists(file.path(backingfile, "B.bin"))){
198
-##		BB <- filebacked.big.matrix(nr, nc, 
199
-##					    type="integer",
200
-##					    init=0,
201
-##					    backingpath=backingfile,
202
-##					    backingfile="B.bin",
203
-##					    descriptorfile="B.desc",
204
-##					    dimnames=list(fns, sns))			   
205
-####	}  else {
206
-####		BB <- attach.big.matrix("B.desc", backingpath=backingfile)
207
-####	}
208
-####	if(!file.exists(file.path(backingfile, "GT.bin"))){
209
-##		gt <- filebacked.big.matrix(nr, nc, 
210
-##					    type="integer",
211
-##					    init=0,
212
-##					    backingpath=backingfile,
213
-##					    backingfile="GT.bin",
214
-##					    descriptorfile="GT.desc",
215
-##					    dimnames=list(fns, sns))
216
-##		confs <- filebacked.big.matrix(nr, nc, 
217
-##					       type="integer",
218
-##					       init=0,
219
-##					       backingpath=backingfile,
220
-##					       backingfile="confs.bin",
221
-##					       descriptorfile="confs.desc",
222
-##					       dimnames=list(fns, sns))	
223
-####	} else {
224
-####		gt <- attach.big.matrix("GT.desc", backingpath=backingfile)
225
-####	}
226
-####	if(!file.exists(file.path(backingfile, "CA.bin"))){
227
-##		ca <- filebacked.big.matrix(nr, nc, 
228
-##					    type="integer",
229
-##					    init=0,
230
-##					    backingpath=backingfile,
231
-##					    backingfile="CA.bin",
232
-##					    descriptorfile="CA.desc",
233
-##					    dimnames=list(fns, sns))
234
-####	}  else {
235
-####		ca <- attach.big.matrix("CA.desc", backingpath=backingfile)
236
-####	}
237
-####	if(!file.exists(file.path(backingfile, "CB.bin"))){
238
-##		cb <- filebacked.big.matrix(nr, nc, 
239
-##					    type="integer",
240
-##					    init=0,
241
-##					    backingpath=backingfile,
242
-##					    backingfile="CB.bin",
243
-##					    descriptorfile="CB.desc",
244
-##					    dimnames=list(fns, sns))
245
-####	} else {
246
-####		cb <- attach.big.matrix("CB.desc", backingpath=backingfile)
247
-####	}
248
-##	return(new("CrlmmSet", A=AA, B=BB, CA=ca, CB=cb, GT=gt, confs=confs))
249
-##}
250
-
251
-
252
-##setMethod("A", signature(object="CrlmmSet"),
253
-##          function(object) assayDataElement(object,"A"))
254
-##setMethod("B", signature(object="CrlmmSet"),
255
-##          function(object) assayDataElement(object,"A"))
256
-##setMethod("CA", signature(object="CrlmmSet"),
257
-##          function(object) assayDataElement(object,"A"))
258
-##setMethod("CB", signature(object="CrlmmSet"),
259
-##          function(object) assayDataElement(object,"A"))
260
-##setMethod("GT", signature(object="CrlmmSet"),
261
-##          function(object) assayDataElement(object,"GT"))
262
-
263
-##setReplaceMethod("CA", signature(object="CrlmmSetList", value="big.matrix"),
264
-##		 function(object, value){
265
-##			 assayDataElementReplace(object, "A", value)
266
-##		 })
267
-##setReplaceMethod("CB", signature(object="CrlmmSetList", value="big.matrix"),
268
-##		 function(object, value){
269
-##			 CB(object[[3]]) <- value
270
-##			 object
271
-##			 })
272
-##
273
-##setReplaceMethod("A", signature(object="CrlmmSet", value="big.matrix"),
274
-##		 function(object, value){
275
-##			 assayDataElementReplace(object, "A", value)
276
-##		 })
277
-
278
-##setReplaceMethod("GT", signature(object="CrlmmSet", value="big.matrix"),
279
-##		 function(object, value){
280
-##			 assayDataElementReplace(object, "GT", value)
281
-##		 })
282
-##setReplaceMethod("confs", signature(object="CrlmmSet", value="big.matrix"),
283
-##		 function(object, value){
284
-##			 assayDataElementReplace(object, "callProbability", value)
285
-##		 })
286
-##setReplaceMethod("confs", signature(object="CrlmmSet", value="matrix"),
287
-##		 function(object, value){
288
-##			 assayDataElementReplace(object, "callProbability", value)
289
-##		 })
290
-##setReplaceMethod("GT", signature(object="CrlmmSet", value="matrix"),
291
-##		 function(object, value){
292
-##			 assayDataElementReplace(object, "GT", value)
293
-##		 })
294
-##setReplaceMethod("B", signature(object="CrlmmSetList", value="big.matrix"),
295
-##		 function(object, value){
296
-##			 B(object[[1]]) <- value
297
-##			 object
298
-##		 })
299 0
deleted file mode 100644
... ...
@@ -1,39 +0,0 @@
1
-##setAs("SnpCallSetPlus", "CrlmmSetFF",
2
-##	  function(from, to){
3
-##		  CA <- CB <- matrix(NA, nrow(from), ncol(from))
4
-##		  dimnames(CA) <- dimnames(CB) <- list(featureNames(from), sampleNames(from))		  
5
-##		  new("CrlmmSetFF",
6
-##		      calls=calls(from),
7
-##		      callsConfidence=callsConfidence(from),
8
-##		      senseThetaA=A(from),
9
-##		      senseThetaB=B(from),
10
-##		      CA=CA,
11
-##		      CB=CB,
12
-##		      phenoData=phenoData(from),
13
-##		      experimentData=experimentData(from),
14
-##		      annotation=annotation(from),
15
-##		      protocolData=protocolData(from),
16
-##		      featureData=featureData(from))
17
-##	  })
18
-
19
-##setMethod("[", "CrlmmSetFF", function(x, i, j, ..., drop = FALSE) {
20
-	## does NOT subset any of the assayDataElements
21
-	## does subset the featureData, phenoData, protocolData
22
-
23
-	## accessors to the assayData work as follows
24
-	## object2 <- object[1:10, ]
25
-	##
26
-	## A(object2)[1:10, ]
27
-	##  - i.  A(object2) gets the file
28
-	##  - ii. A is subset by the dimNames information as follows
29
-	##        dimNames[[1]] %in% featureNames(object2)
30
-	##        dimNames[[2]] %in% sampleNames(object2)
31
-	##    iii. first 10 elements are retrieved
32
-##})
33
-
34
-##setMethod("A", "CrlmmSetFF", function(object) assayData(object)[["senseThetaA"]])
35
-##setMethod("B", "CrlmmSetFF", function(object) assayData(object)[["senseThetaB"]])
36
-##setMethod("CA", "CrlmmSetFF", function(object) assayData(object)[["CA"]]/100)
37
-##setMethod("CB", "CrlmmSetFF", function(object) assayData(object)[["CB"]]/100)
38
-
39
-
... ...
@@ -1,17 +1,18 @@
1 1
 ##How to make the initialization platform-specific?
2 2
 setMethod("initialize", "SnpCallSetPlus",
3 3
           function(.Object,
4
-                   phenoData, featureData,
5
-                   calls=new("matrix"),
6
-                   callsConfidence=new("matrix"),
4
+                   phenoData,
5
+		   featureData,
6
+                   call=new("matrix"),
7
+                   callProbability=new("matrix"),
7 8
                    senseThetaA=new("matrix"),
8 9
                    senseThetaB=new("matrix"),
9 10
 		   annotation,
10 11
 		   experimentData,
11 12
 		   protocolData, ... ){
12 13
 		  ad <- assayDataNew("lockedEnvironment",
13
-				     calls=calls,
14
-				     callsConfidence=callsConfidence,
14
+				     call=call,
15
+				     callProbability=callProbability,
15 16
 				     senseThetaA=senseThetaA,
16 17
 				     senseThetaB=senseThetaB)
17 18
 		  assayData(.Object) <- ad
... ...
@@ -28,8 +29,18 @@ setMethod("initialize", "SnpCallSetPlus",
28 29
 		  if(!missing(annotation)) annotation(.Object) <- annotation
29 30
 		  if(!missing(experimentData)) experimentData(.Object) <- experimentData
30 31
 		  if(!missing(protocolData)) protocolData(.Object) <- protocolData
32
+		  ## Do after annotation has been assigned
33
+		  if(!(all(c("chromosome", "position", "isSnp")  %in% colnames(.Object@featureData)))){
34
+			  ##update the featureData
35
+			  .Object@featureData <- addFeatureAnnotation.SnpCallSetPlus(object)
36
+		  }
31 37
 		  .Object
32 38
           })
39
+
40
+setMethod("addFeatureAnnotation", "SnpCallSetPlus", function(object, ...){
41
+	addFeatureAnnotation.SnpCallSetPlus(object, ...)
42
+})
43
+
33 44
 getParam.SnpCallSetPlus <- function(object, name, batch){
34 45
 		  label <- paste(name, batch, sep="_")
35 46
 		  colindex <- grep(label, fvarLabels(object))
... ...
@@ -48,16 +59,7 @@ getParam.SnpCallSetPlus <- function(object, name, batch){
48 59
 		  return(param)
49 60
 	  }
50 61
 
51
-setMethod("getParam", signature(object="SnpCallSetPlus",
52
-				name="character",
53
-				batch="ANY"),
54
-	  function(object, name, batch){
55
-		  if(length(batch) > 1){
56
-			  warning("batch argument to getParam should have length 1.  Only using the first")
57
-			  batch <- batch[1]
58
-		  }
59
-		  getParam.SnpCallSetPlus(object, name, batch)
60
-})
62
+
61 63
 
62 64
 setMethod("splitByChromosome", "SnpCallSetPlus", function(object, cnOptions){
63 65
 	tmpdir <- cnOptions[["tmpdir"]]
... ...
@@ -79,31 +81,29 @@ setMethod("splitByChromosome", "SnpCallSetPlus", function(object, cnOptions){
79 81
 		index <- index[!is.na(index)]
80 82
 		callSetPlus <- object[index, ]
81 83
 		if(CHR != 24){
82
-			crlmmSet <- computeCopynumber(callSetPlus, cnOptions)
84
+			cnSet <- computeCopynumber(callSetPlus, cnOptions)
83 85
 			
84 86
 		} else{
85 87
 			message("Copy number estimates not available for chromosome Y.  Saving only the 'callSetPlus' object for this chromosome")
86 88
 			save(callSetPlus, file=file.path(outdir, paste("callSetPlus_", CHR, ".rda", sep="")))
87 89
 		}
88 90
 		if(cnOptions[["hiddenMarkovModel"]] & CHR != 24){
89
-			segmentSet <- computeHmm(crlmmSet, cnOptions)
90
-			save(segmentSet, file=file.path(outdir, paste("segmentSet_", CHR, ".rda", sep="")))
91
-			saved.objects <- list.files(outdir, pattern="segmentSet", full.names=TRUE)
92
-		} else{ ## save crlmmSet to outdir
93
-			save(crlmmSet, file=file.path(outdir, paste("crlmmSet_", CHR, ".rda", sep="")))
94
-			saved.objects <- list.files(outdir, pattern="crlmmSet", full.names=TRUE)			
95
-		}		
91
+			cnSet <- computeHmm(cnSet, cnOptions)
92
+		}
93
+		save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
94
+		saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)
95
+##		} else{ ## save crlmmSet to outdir
96
+##			save(cnSet, file=file.path(outdir, paste("cnSet_", CHR, ".rda", sep="")))
97
+##			saved.objects <- list.files(outdir, pattern="cnSet", full.names=TRUE)			
98
+##		}		
96 99
 	}
97 100
 	saved.objects
98 101
 })
99
-setMethod("addFeatureAnnotation", "SnpCallSetPlus", function(object, ...){
100
-	addFeatureAnnotation.SnpCallSetPlus(object, ...)
101
-})
102
+
102 103
 setMethod("computeCopynumber", "SnpCallSetPlus",
103 104
 	  function(object, cnOptions){
104 105
 		  computeCopynumber.SnpCallSetPlus(object, cnOptions)
105 106
 	  })
106
-setMethod("chromosome", "SnpCallSetPlus", function(object) fData(object)$chromosome)
107
-setMethod("position", "SnpCallSetPlus", function(object) fData(object)$position)
107
+
108 108
 gtConfidence <- function(object) 1-exp(-callsConfidence(object)/1000)
109 109
 	
110 110
deleted file mode 100644
... ...
@@ -1,3 +0,0 @@
1
-setMethod("featureNames", "SnpCallSetPlusFF", function(object) sampleNames(featureData(object)))
2
-setMethod("A", "SnpCallSetPlusFF", function(object){})
3
-
... ...
@@ -34,6 +34,17 @@ setMethod("snpNames", "eSet", function(object){
34 34
 setMethod("chromosome", "eSet", function(object) fData(object)$chromosome)
35 35
 setMethod("position", "eSet", function(object) fData(object)$position)
36 36
 
37
+setMethod("getParam", signature(object="eSet",
38
+				name="character",
39
+				batch="ANY"),
40
+	  function(object, name, batch){
41
+		  if(length(batch) > 1){
42
+			  warning("batch argument to getParam should have length 1.  Only using the first")
43
+			  batch <- batch[1]
44
+		  }
45
+		  getParam.SnpCallSetPlus(object, name, batch)
46
+})
47
+
37 48
 ##setMethod("combine", signature=signature(x="eSet", y="eSet"),
38 49
 ##	  function(x, y, ...){
39 50
 ##		  ##Check that both x and y are valid objects
40 51
new file mode 100644
... ...
@@ -0,0 +1,73 @@
1
+\name{CNSet-class}
2
+\Rdversion{1.1}
3
+\docType{class}
4
+\alias{CNSet-class}
5
+\alias{CA}
6
+\alias{CA<-}
7
+\alias{CB}
8
+\alias{CB<-}
9
+\alias{CA,CNSet-method}
10
+\alias{CA<-,CNSet,matrix-method}
11
+\alias{CB,CNSet-method}
12
+\alias{CB<-,CNSet,matrix-method}
13
+\alias{computeHmm}
14
+\alias{computeHmm,CNSet-method}
15
+\alias{copyNumber,CNSet-method}
16
+\alias{ellipse,CNSet-method}
17
+\alias{emissionPr}
18
+\alias{emissionPr<-}
19
+\alias{emissionPr,CNSet-method}
20
+\alias{emissionPr<-,CNSet,array-method}
21
+\alias{segmentData}
22
+\alias{segmentData<-}
23
+\alias{segmentData,CNSet-method}
24
+\alias{segmentData<-,CNSet,RangedData-method}
25
+
26
+\title{Container for allele-specific copy number and lower level SNP /
27
+  NP summaries}
28
+\description{Container for allele-specific copy number and lower level SNP /
29
+  NP summaries}
30
+\section{Objects from the Class}{
31
+Objects can be created by calls of the form \code{new("CNSet", phenoData, featureData, annotation, experimentData, protocolData, calls, callsConfidence, senseThetaA, senseThetaB, CA, CB, ...)}.
32
+}
33
+\section{Slots}{
34
+  \describe{
35
+    \item{\code{assayData}:}{Object of class \code{"AssayData"} ~~ }
36
+    \item{\code{phenoData}:}{Object of class \code{"AnnotatedDataFrame"} ~~ }
37
+    \item{\code{featureData}:}{Object of class \code{"AnnotatedDataFrame"} ~~ }
38
+    \item{\code{experimentData}:}{Object of class \code{"MIAME"} ~~ }
39
+    \item{\code{annotation}:}{Object of class \code{"character"} ~~ }
40
+    \item{\code{protocolData}:}{Object of class \code{"AnnotatedDataFrame"} ~~ }
41
+    \item{\code{.__classVersion__}:}{Object of class \code{"Versions"} ~~ }
42
+  }
43
+}
44
+\section{Extends}{
45
+Class \code{"\linkS4class{SnpCallSetPlus}"}, directly.
46
+Class \code{"\linkS4class{SnpQSet}"}, by class "SnpCallSetPlus", distance 2.
47
+Class \code{"\linkS4class{SnpCallSet}"}, by class "SnpCallSetPlus", distance 2.
48
+Class \code{"\linkS4class{QuantificationSet}"}, by class "SnpCallSetPlus", distance 3.
49
+Class \code{"\linkS4class{SnpLevelSet}"}, by class "SnpCallSetPlus", distance 3.
50
+Class \code{"\linkS4class{eSet}"}, by class "SnpCallSetPlus", distance 4.
51
+Class \code{"\linkS4class{VersionedBiobase}"}, by class "SnpCallSetPlus", distance 5.
52
+Class \code{"\linkS4class{Versioned}"}, by class "SnpCallSetPlus", distance 6.
53
+}
54
+\section{Methods}{
55
+  \describe{
56
+    \item{CA}{\code{signature(object = "CNSet")}: ... }
57
+    \item{CA<-}{\code{signature(object = "CNSet", value = "matrix")}: ... }
58
+    \item{CB}{\code{signature(object = "CNSet")}: ... }
59
+    \item{CB<-}{\code{signature(object = "CNSet", value = "matrix")}: ... }
60
+    \item{computeHmm}{\code{signature(object = "CNSet")}: ... }
61
+    \item{copyNumber}{\code{signature(object = "CNSet")}: ... }
62
+    \item{ellipse}{\code{signature(x = "CNSet")}: ... }
63
+	 }
64
+}
65
+\author{R. Scharpf}
66
+\seealso{
67
+%	~~objects to See Also as \code{\link{~~fun~~}}, ~~~
68
+%	or \code{\linkS4class{CLASSNAME}} for links to other classes
69
+}
70
+\examples{
71
+showClass("CNSet")
72
+}
73
+\keyword{classes}
0 74
deleted file mode 100644
... ...
@@ -1,89 +0,0 @@
1
-\name{CopyNumberSet-class}
2
-\Rdversion{1.1}
3
-\docType{class}
4
-\alias{CopyNumberSet-class}
5
-\alias{batch,CopyNumberSet-method}
6
-\alias{CA}
7
-\alias{CA<-}
8
-\alias{CA,CopyNumberSet-method}
9
-\alias{CA<-,CopyNumberSet,matrix-method}
10
-\alias{CB}
11
-\alias{CB<-}
12
-\alias{CB,CopyNumberSet-method}
13
-\alias{CB<-,CopyNumberSet,matrix-method}
14
-\alias{chromosome,CopyNumberSet-method}
15
-\alias{copyNumber,CopyNumberSet-method}
16
-\alias{ellipse,CopyNumberSet-method}
17
-\alias{plot,ABset,CopyNumberSet-method}
18
-\alias{position,CopyNumberSet-method}
19
-\title{Class "CopyNumberSet"}
20
-\description{Container for allele-specific estimates of copy number and
21
-  the corresponding uncertainty}
22
-\section{Objects from the Class}{
23
-Objects can be created by calls of the form \code{new("CopyNumberSet", assayData, phenoData, featureData, experimentData, annotation, protocolData, ...)}.
24
-}
25
-\section{Slots}{
26
-	 \describe{
27
-    \item{\code{assayData}:}{Object of class \code{"AssayData"}}
28
-    \item{\code{phenoData}:}{Object of class \code{"AnnotatedDataFrame"}}
29
-    \item{\code{featureData}:}{Object of class \code{"AnnotatedDataFrame"} }
30
-    \item{\code{experimentData}:}{Object of class \code{"MIAME"}  }
31
-    \item{\code{annotation}:}{Object of class \code{"character"}  }
32
-    \item{\code{protocolData}:}{Object of class \code{"AnnotatedDataFrame"} }
33
-    \item{\code{.__classVersion__}:}{Object of class \code{"Versions"}  }
34
-  }
35
-}
36
-\section{Extends}{
37
-Class \code{\link[Biobase:class.eSet]{eSet}}, directly.
38
-Class \code{\link[Biobase:class.VersionedBiobase]{VersionedBiobase}}, by class "eSet", distance 2.
39
-Class \code{\link[Biobase:class.Versioned]{Versioned}}, by class "eSet", distance 3.
40
-}
41
-\section{Methods}{
42
-  \describe{
43
-
44
-    \item{batch}{\code{signature(object="CopyNumberSet")}: Extracts the
45
-    batch information used to estimate copy number.}
46
-
47
-    \item{CA}{\code{signature(object = "CopyNumberSet", ...)}: Extracts the
48
-      copy number for allele 'A' at polymorphic loci. At nonpolymorphic
49
-      loci, the total copy number is returned.}
50
-
51
-    \item{CA<-}{\code{signature(object = "CopyNumberSet",
52
-    value="matrix")}: Replaces CA matrix with supplied value.}    
53
-
54
-    \item{CB}{\code{signature(object = "CopyNumberSet", ...)}:
55
-      Extracts copy number for allele 'B' at polymorphic loci. NAs are
56
-      returned for nonpolymorphic loci.}    
57
-
58
-    \item{CB<-}{\code{signature(object = "CopyNumberSet",
59
-	value="matrix")}: Replaces CB matrix with supplied value .}
60
-
61
-    
62
-    \item{chromosome}{\code{signature(object = "CopyNumberSet")}:
63
-      Extract chromosome.}
64
-
65
-    \item{copyNumber}{\code{signature(object = "CopyNumberSet")}:
66
-      Returns CA + CB.}
67
-
68
-    \item{ellipse}{\code{signature(x = "CopyNumberSet", ...)}:
69
-      Extracts parameters from \code{featureData} slot and draws
70
-      prediction regions for the supplied copy number.}
71
-
72
-    \item{plot}{\code{signature(x = "ABset", y = "CopyNumberSet")}:
73
-      Physical position}
74
-    \item{position}{\code{signature(object = "CopyNumberSet")}: physical position}
75
-  }
76
-}
77
-
78
-\author{R. Scharpf}
79
-\examples{
80
-showClass("CopyNumberSet")
81
-
82
-\dontrun{
83
-##returns the copy number for allele A at polymorphic loci
84
-CA(object[snpIndex(object), ])
85
-##returns the total copy number at nonpolymorphic loci
86
-CA(object[cnIndex(object), ])
87
-}
88
-}
89
-\keyword{classes}
90 0
new file mode 100644
... ...
@@ -0,0 +1,31 @@
1
+\name{SnpQSet-methods}
2
+\alias{A}
3
+\alias{A,SnpQSet-method}
4
+\alias{A<-}
5
+\alias{A<-,SnpQSet,matrix-method}
6
+\alias{B}
7
+\alias{B,SnpQSet-method}
8
+\alias{B<-}
9
+\alias{B<-,SnpQSet,matrix-method}
10
+\alias{isSnp}
11
+\alias{isSnp,SnpQSet-method}
12
+\title{Indicator for polymorphic probes}
13
+\description{
14
+  
15
+  This functions uses the annotation slot of the SnpQSet object to load
16
+  the corresponding annotation package and determine whether each probe
17
+  in the object interrogates a polymorphic or nonpolymorphic allele. For
18
+  instance, in the Affy 6.0 platform roughly 900,000 of the 1.8 million
19
+  markers are for polymorphic alleles.
20
+  
21
+}
22
+\usage{
23
+isSnp(object)
24
+}
25
+\arguments{
26
+  \item{object}{SnpQSet object}
27
+}
28
+\value{
29
+  an indicator: 0=nonpolymorphic, 1=polymorphic
30
+}
31
+\keyword{manip}
0 32
similarity index 58%
1 33
rename from man/methods-SnpSet.Rd
2 34
rename to man/SnpSet-methods.Rd
... ...
@@ -1,33 +1,36 @@
1
-\name{calls}
2
-\alias{calls}
1
+\name{SnpSet-methods}
2
+\docType{methods}
3
+%\alias{calls}
3 4
 \alias{calls,SnpSet-method}
5
+\alias{calls<-,SnpSet,matrix-method}
4 6
 \alias{confs}
5 7
 \alias{confs,SnpSet-method}
8
+\alias{confs<-}
9
+\alias{confs<-,SnpSet,matrix-method}
6 10
 \title{Accessors for Calls and Confidences on a SnpSet object}
11
+
7 12
 \description{
8 13
   \code{calls} returns the genotype calls. CRLMM stores genotype calls
9 14
   as integers (1 - AA; 2 - AB; 3 - BB).
10 15
 
11 16
   \code{confs} returns the confidences associated to the genotype
12
-  calls. THe current implementation of CRLMM stores the confidences as
17
+  calls. The current implementation of CRLMM stores the confidences as
13 18
   integers by using the transformation:
14 19
 
15 20
   conf = round(-1000*log2(1-p)),
16 21
 
17 22
   where 'p' is the posterior probability of the call.
18 23
 }
19
-\usage{
20
-calls(object)
21
-confs(object)
22
-}
23
-\arguments{
24
-  \item{object}{SnpSet object}
25
-}
26
-\value{
27
-  Matrix of genotype calls or confidences.
28
-  }
24
+
25
+\section{Methods}{
26
+\describe{
27
+  \item{\code{initialize(SnpSet)}:}{Object instantiation, used by
28
+    \code{new}; not be be called directly by the user.}  
29
+  \item{\code{calls(object)}}{accessor for genotype calls}
30
+  \item{\code{confs(object)}}{accessor for crlmm genotype confidence scores}  
31
+}}
32
+
29 33
 \examples{
30
-  set.seed(1)
31 34
   theCalls <- matrix(sample(1:3, 20, rep=TRUE), nc=2)
32 35
   p <- matrix(runif(20), nc=2)
33 36
   theConfs <- round(-1000*log2(1-p))
34 37
deleted file mode 100644
... ...
@@ -1,32 +0,0 @@
1
-\name{cnrma}
2
-\alias{cnrma}
3
-\title{Quantile normalizes the intensities for the nonpolymorphic probe
4
-  to a HapMap reference distribution.}
5
-\description{Quantile normalizes the intensities for the nonpolymorphic probe
6
-  to a HapMap reference distribution.
7
-}
8
-\usage{
9
-cnrma(filenames, cdfName, sns, seed = 1, verbose=FALSE)
10
-}
11
-\arguments{
12
-  \item{filenames}{filenames with complete path}
13
-  \item{cdfName}{Only 'genomewidesnp6' allowed}
14
-  \item{sns}{the sample names. If missing, the basename of the filenames is used.}
15
-  \item{seed}{seed for sampling the intensities to calculate skewness}
16
-  \item{verbose}{logical}
17
-}
18
-\value{
19
-  A list.  First element is the matrix of quantile-normalized
20
-  intensities.  The second element is the skew.
21
-}
22
-\author{Rob Scharpf}
23
-\note{Not tested}
24
-\examples{
25
-	library(genomewidesnp6Crlmm)
26
-	library(hapmapsnp6)
27
-	path <- system.file("celFiles", package="hapmapsnp6")
28
-	celFiles <- list.celfiles(path, full.names=TRUE)
29
-	cnrmaResult <- cnrma(celFiles, cdfName="genomewidesnp6")
30
-}
31
-\keyword{robust}
32
-
33 0
new file mode 100644
... ...
@@ -0,0 +1,20 @@
1
+\name{methods-eSet}
2
+\alias{chromosome}
3
+\alias{chromosome,eSet-method}
4
+\alias{position}
5
+\alias{position,eSet-method}
6
+\title{Methods for eSet derivatives}
7
+
8
+\description{
9
+  \code{chromosome} return the chromosome number for SNP and NP probes.
10
+  \code{position} return the physical position of the SNP or the
11
+  physical position for the first index of the NP probe.
12
+}
13
+
14
+\section{Methods}{
15
+  \describe{
16
+    \item{\code{chromosome(object)}:}{ accessor for chromosome}
17
+    \item{\code{position(object)}:}{accessor for genomic position}
18
+  }
19
+}
20
+\keyword{manip}
0 21
\ No newline at end of file
1 22
deleted file mode 100644
... ...
@@ -1,58 +0,0 @@
1
-\name{methods-eSet}
2
-\alias{chromosome}
3
-\alias{chromosome,eSet-method}
4
-\alias{cnIndex}
5
-\alias{cnIndex,eSet-method}
6
-\alias{position}
7
-\alias{position,eSet-method}
8
-\alias{snpIndex}
9
-\alias{snpIndex,eSet-method}
10
-
11
-\title{Methods for eSet derivatives}
12
-
13
-\description{
14
-  \code{chromosome} return the chromosome number for SNP and NP probes.
15
-    
16
-  \code{cnIndex, ...} return the row indices of copy number probes.
17
-
18
-  \code{position} return the physical position of the SNP or the
19
-  physical position for the first index of the NP probe.
20
-  
21
-  \code{snpIndex, ...} return the row indices of polymorphic loci.
22
-
23
-}
24
-
25
-\usage{
26
-
27
-  chromosome(object)
28
-  cnIndex(object, ...)
29
-  position(object)
30
-  snpIndex(object, ...)
31
-
32
-}
33
-
34
-\arguments{
35
-  
36
-  \item{object}{Any object extending eSet (ABset, CopyNumberSet,
37
-    CrlmmSetList, SnpSet}
38
-
39
-  \item{\dots}{Usually the character string indicating annotation package.}
40
-
41
-}
42
-
43
-\value{
44
-
45
-  Vector of indices.
46
-
47
-}
48
-
49
-\seealso{
50
-
51
-  \code{"\linkS4class{ABset}"}
52
-  \code{"\linkS4class{CopyNumberSet}"}
53
-  \code{"\linkS4class{CrlmmSetList}"}
54
-  
55
-}
56
-  
57
-
58
-\keyword{manip}
59 0
\ No newline at end of file