Browse code

Fixed some status messages and downstream vignette

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

Benilton Carvalho authored on 08/04/2009 03:15:55
Showing 7 changed files

... ...
@@ -137,3 +137,9 @@ is decoded and scanned
137 137
 2009-04-08 Matt Ritchie - committed version 1.0.79
138 138
 
139 139
 * fixed bug in readIDAT and readIdatFiles from reading in RunInfo header information
140
+
141
+2009-04-07 B Carvalho - committed version 1.0.80 (advantages of being a lot of hours behind)
142
+
143
+* Fixed downstream vignette to account for the SnpSet object being returned by crlmm
144
+
145
+* Fixed some minor status messages
... ...
@@ -1,7 +1,7 @@
1 1
 Package: crlmm
2 2
 Type: Package
3
-Title: Genotype Calling (CRLMM) and Copy Number Analysis tool for SNP 5.0 and 6.0 arrays.
4
-Version: 1.0.79
3
+Title: Genotype Calling (CRLMM) and Copy Number Analysis tool for Affymetrix SNP 5.0 and 6.0 and Illumina arrays.
4
+Version: 1.0.80
5 5
 Date: 2008-12-30
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>
... ...
@@ -100,7 +100,7 @@ crlmmGT <- function(A, B, SNR, mixtureParams, cdfName, row.names=NULL,
100 100
                    keepIndex[which(gender[keepIndex]==2)], 
101 101
                    keepIndex[which(gender[keepIndex]==1)])
102 102
   
103
-  if(verbose) cat("Calling", NR, "SNPs for recalibration")
103
+  if(verbose) cat("Calling", NR, "SNPs for recalibration... ")
104 104
 
105 105
   ## call C
106 106
   fIndex <- which(gender==2)
... ...
@@ -185,7 +185,7 @@ crlmmGT <- function(A, B, SNR, mixtureParams, cdfName, row.names=NULL,
185 185
   params[-2] <- newparams[-2]
186 186
   
187 187
   rm(newparams);gc(verbose=FALSE)  
188
-  if(verbose) cat("Calling", NR, "SNPs")
188
+  if(verbose) cat("Calling", NR, "SNPs... ")
189 189
   ## ###################
190 190
   ## ## MOVE TO C#######
191 191
   ImNull <- gtypeCallerR2(A, B, fIndex, mIndex, params[["centers"]],
... ...
@@ -426,7 +426,7 @@ crlmmGTTNoN <- function(A, B, SNR, mixtureParams, cdfName,
426 426
                    keepIndex[which(gender[keepIndex]==2)], 
427 427
                    keepIndex[which(gender[keepIndex]==1)])
428 428
   
429
-  if(verbose) cat("Calling", NR, "SNPs for recalibration")
429
+  if(verbose) cat("Calling", NR, "SNPs for recalibration... ")
430 430
 
431 431
   ## call C
432 432
   fIndex <- which(gender==2)
... ...
@@ -498,7 +498,7 @@ crlmmGTTNoN <- function(A, B, SNR, mixtureParams, cdfName,
498 498
   ## BC: must keep SD
499 499
   params[-2] <- newparams[-2]
500 500
   rm(newparams);gc(verbose=FALSE)  
501
-  if(verbose) cat("Calling", NR, "SNPs")
501
+  if(verbose) cat("Calling", NR, "SNPs... ")
502 502
   ## ###################
503 503
   ## ## MOVE TO C#######
504 504
   t0 <- proc.time()
... ...
@@ -592,7 +592,7 @@ crlmmGTNormalNoN <- function(A, B, SNR, mixtureParams, cdfName,
592 592
                    keepIndex[which(gender[keepIndex]==2)], 
593 593
                    keepIndex[which(gender[keepIndex]==1)])
594 594
   
595
-  if(verbose) cat("Calling", NR, "SNPs for recalibration")
595
+  if(verbose) cat("Calling", NR, "SNPs for recalibration... ")
596 596
 
597 597
   ## call C
598 598
   fIndex <- which(gender==2)
... ...
@@ -664,7 +664,7 @@ crlmmGTNormalNoN <- function(A, B, SNR, mixtureParams, cdfName,
664 664
   ## BC: must keep SD
665 665
   params[-2] <- newparams[-2]
666 666
   rm(newparams);gc(verbose=FALSE)  
667
-  if(verbose) cat("Calling", NR, "SNPs")
667
+  if(verbose) cat("Calling", NR, "SNPs... ")
668 668
   ## ###################
669 669
   ## ## MOVE TO C#######
670 670
   t0 <- proc.time()
... ...
@@ -773,7 +773,7 @@ crlmmGTnm <- function(A, B, SNR, mixtureParams, cdfName, row.names=NULL,
773 773
                    keepIndex[which(gender[keepIndex]==2)], 
774 774
                    keepIndex[which(gender[keepIndex]==1)])
775 775
   
776
-  if(verbose) cat("Calling", NR, "SNPs for recalibration")
776
+  if(verbose) cat("Calling", NR, "SNPs for recalibration... ")
777 777
 
778 778
   ## call C
779 779
   fIndex <- which(gender==2)
... ...
@@ -858,7 +858,7 @@ crlmmGTnm <- function(A, B, SNR, mixtureParams, cdfName, row.names=NULL,
858 858
   params[-2] <- newparams[-2]
859 859
   
860 860
   rm(newparams);gc(verbose=FALSE)  
861
-  if(verbose) cat("Calling", NR, "SNPs")
861
+  if(verbose) cat("Calling", NR, "SNPs... ")
862 862
   ## ###################
863 863
   ## ## MOVE TO C#######
864 864
   t0 <- proc.time()
... ...
@@ -1,7 +1,6 @@
1 1
 #####################################
2 2
 ### FOR CRLMM
3 3
 #####################################
4
-- Fix downstream vignette
5 4
 - Add RS ids to annotation packages
6 5
 - Allele plots
7 6
 - M v S plots
8 7
Binary files a/inst/doc/crlmmDownstream.pdf and b/inst/doc/crlmmDownstream.pdf differ
... ...
@@ -57,14 +57,12 @@ if (!exists("crlmmResult")) {
57 57
 }
58 58
 @
59 59
 
60
-This is currently a list.
60
+This is currently a \Rclass{SnpSet} object.
61 61
 <<lkj21>>=
62 62
   class(crlmmResult)
63
-  sapply(crlmmResult, dim)
64
-  sapply(crlmmResult, length)
65 63
 @
66 64
 
67
-\section{Constructing an eSet extension}
65
+\section{Adding information to a \Rclass{SnpSet}}
68 66
 
69 67
 We will use the \Rpackage{GGdata} package to obtain extra information
70 68
 on the samples. This will be later used when building an \Rclass{eSet}
... ...
@@ -74,30 +72,27 @@ extension to store the genotyping results.
74 72
   if (!exists("hmceuB36")) data(hmceuB36)
75 73
   pd <- phenoData(hmceuB36)
76 74
   ggn <- sampleNames(pd)
77
-  preSN <- colnames(crlmmResult[["calls"]])
75
+  preSN <- sampleNames(crlmmResult)
78 76
   simpSN <- gsub("_.*", "", preSN)
79 77
   if (!all.equal(simpSN, ggn)) stop("align GGdata phenoData with crlmmResult read")
80 78
 @ 
81 79
 
82
-The list obtained as output of the \Rmethod{crlmm} method can be
83
-easily coerced to an eSet extension with the help of the helper
84
-function \Rfunction{list2crlmmSet}.
80
+The additional information obtained from \Rpackage{GGdata} can be
81
+easily combined to what is already available on \Robject{crlmmResult}.
85 82
 <<docl>>=
86
-  colnames(crlmmResult[["calls"]]) <- colnames(crlmmResult[["confs"]]) <- simpSN
87
-  crlmmResultSet <- list2crlmmSet(crlmmResult)
88
-  phenoData(crlmmResultSet) <- combine(pd, phenoData(crlmmResultSet))
89
-  crlmmResultSet
90
-  dim(calls(crlmmResultSet))
91
-  dim(confs(crlmmResultSet))
92
-  calls(crlmmResultSet)[1:10, 1:2]
93
-  confs(crlmmResultSet)[1:10, 1:2]
83
+  sampleNames(crlmmResult) <- simpSN
84
+  phenoData(crlmmResult) <- combine(pd, phenoData(crlmmResult))
85
+  dim(calls(crlmmResult))
86
+  dim(confs(crlmmResult))
87
+  calls(crlmmResult)[1:10, 1:2]
88
+  confs(crlmmResult)[1:10, 1:2]
94 89
 @
95 90
 
96 91
 \section{Coercing to snp.matrix as a prelude to a GWAS}
97 92
 
98 93
 <<lksnm>>=
99 94
 library(snpMatrix)
100
-crlmmSM <- as(t(calls(crlmmResultSet))-1, "snp.matrix")
95
+crlmmSM <- as(t(calls(crlmmResult))-1, "snp.matrix")
101 96
 crlmmSM
102 97
 @
103 98
 
... ...
@@ -116,12 +111,15 @@ gwas <- snp.rhs.tests(ex~male, data=subjdata, snp.data=crlmmSM, family="gaussian
116 111
 ok <- which(p.value(gwas) < 1e-10)
117 112
 gwas[ok,]
118 113
 <<dopl,fig=TRUE>>=
119
-plot(ex~calls(crlmmResultSet)["SNP_A-4208858",],
114
+plot(ex~calls(crlmmResult)["SNP_A-4208858",],
120 115
      xlab="Genotype Call for SNP_A-4208858",
121 116
      ylab="Expression", xaxt="n")
122 117
 axis(1, at=1:3, labels=c("AA", "AB", "BB"))
123 118
 @
124 119
 
120
+\section{Session Info}
121
+
122
+This vignette was created using the following packages:
125 123
 <<lksess>>=
126 124
 sessionInfo()
127 125
 @
128 126
Binary files a/inst/scripts/crlmmDownstream.pdf and b/inst/scripts/crlmmDownstream.pdf differ