Browse code

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

unknown authored on 05/02/2010 03:27:18
Showing 4 changed files

... ...
@@ -377,3 +377,7 @@ in the one function to reduce memory usage (not exported as yet)
377 377
 to save memory.  Instead, 'zero', which indicates which SNPs have zero beads 
378 378
 is stored in the assayData slot.
379 379
  * now store 'zero' with copy number AB intensities in preprocessInfinium2()
380
+
381
+2010-02-05 M. Ritchie - committed version 1.5.24
382
+ * preprocessed allele A and B intensities from copy number and regular SNPs are now saved separately by crlmmIllumina().  The 'intensityFile' argument has been replaced by 'snpFile' and 'cnFile'.
383
+ * updated man page for crlmmIllumina()
380 384
\ No newline at end of file
... ...
@@ -1,8 +1,8 @@
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.23
5
-Date: 2010-02-04
4
+Version: 1.5.24
5
+Date: 2010-02-05
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
... ...
@@ -612,7 +612,8 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,
612 612
 				stripNorm=TRUE,
613 613
 				useTarget=TRUE,
614 614
 				save.it=FALSE,
615
-				intensityFile) {
615
+				snpFile,
616
+				cnFile) {
616 617
   if(stripNorm)
617 618
     XY = stripNormalize(XY, useTarget=useTarget, verbose=verbose)
618 619
 
... ...
@@ -660,7 +661,13 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,
660 661
   rownames(A) <- rownames(B) <- rownames(zero) <- names(npIndex)
661 662
   
662 663
   cnAB = list(A=A, B=B, zero=zero, sns=sns, gns=names(npIndex), cdfName=cdfName)
663
-  rm(A, B, zero)
664
+  if(save.it & !missing(cnFile)) {
665
+    t0 <- proc.time() 
666
+    save(cnAB, file=cnFile) 
667
+    t0 <- proc.time()-t0
668
+    if(verbose) message("Used ", round(t0[3],1), " seconds to save ", cnFile, ".")
669
+  }
670
+  rm(cnAB, B, zero)
664 671
   
665 672
   # next process snp probes
666 673
   snpIndex = getVarInEnv("snpProbesFid")
... ...
@@ -723,11 +730,11 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,
723 730
   ## gns comes from preprocStuff.rda
724 731
   res = list(A=A, B=B, zero=zero, sns=sns, gns=gns, SNR=SNR, SKW=SKW, mixtureParams=mixtureParams, cdfName=cdfName)
725 732
 
726
-  if(save.it & !missing(intensityFile)) {
733
+  if(save.it & !missing(snpFile)) {
727 734
     t0 <- proc.time() 
728
-    save(cnAB, res, file=intensityFile)
735
+    save(res, file=snpFile) 
729 736
     t0 <- proc.time()-t0
730
-    if(verbose) message("Used ", round(t0[3],1), " seconds to save ", intensityFile, ".")
737
+    if(verbose) message("Used ", round(t0[3],1), " seconds to save ", snpFile, ".")
731 738
   }
732 739
   return(res)
733 740
 }
... ...
@@ -738,17 +745,19 @@ preprocessInfinium2 <- function(XY, mixtureSampleSize=10^5,
738 745
 crlmmIllumina <- function(RG, XY, stripNorm=TRUE, useTarget=TRUE,
739 746
                   row.names=TRUE, col.names=TRUE,
740 747
                   probs=c(1/3, 1/3, 1/3), DF=6, SNRMin=5, gender=NULL,
741
-                  seed=1, save.it=FALSE, load.it=FALSE, intensityFile,
748
+                  seed=1, save.it=FALSE, load.it=FALSE, snpFile, cnFile,
742 749
                   mixtureSampleSize=10^5, eps=0.1, verbose=TRUE,
743 750
                   cdfName, sns, recallMin=10, recallRegMin=1000,
744 751
                   returnParams=FALSE, badSNP=.7) {
745
-  if ((load.it | save.it) & missing(intensityFile))
746
-    stop("'intensityFile' is missing, and you chose either load.it or save.it")
747
-  if (!missing(intensityFile))
748
-    if (load.it & !file.exists(intensityFile)){
752
+  if (save.it & (missing(snpFile) | missing(cnFile)))
753
+    stop("'snpFile' and/or 'cnFile' is missing and you chose to save.it")
754
+  if (load.it & missing(snpFile))
755
+    stop("'snpFile' is missing and you chose to load.it")
756
+  if (!missing(snpFile))
757
+    if (load.it & !file.exists(snpFile)){
749 758
       load.it <- FALSE
750
-      message("File ", intensityFile, " does not exist.")
751
-      message("Not loading it, but running SNPRMA from scratch.")
759
+      message("File ", snpFile, " does not exist.")
760
+      stop("Cannot load SNP data.")
752 761
   }
753 762
   if (!load.it){
754 763
     if(!missing(RG)) {
... ...
@@ -761,13 +770,13 @@ crlmmIllumina <- function(RG, XY, stripNorm=TRUE, useTarget=TRUE,
761 770
     
762 771
     res = preprocessInfinium2(XY, mixtureSampleSize=mixtureSampleSize, fitMixture=TRUE, verbose=verbose,
763 772
                         seed=seed, eps=eps, cdfName=cdfName, sns=sns, stripNorm=stripNorm, useTarget=useTarget,
764
-                        save.it=save.it, intensityFile=intensityFile)
773
+                        save.it=save.it, snpFile=snpFile, cnFile=cnFile)
765 774
   }else{
766
-      if(verbose) message("Loading ", intensityFile, ".")
767
-        obj <- load(intensityFile)
775
+      if(verbose) message("Loading ", snpFile, ".")
776
+        obj <- load(snpFile)
768 777
         if(verbose) message("Done.")
769 778
         if(!any(obj == "res"))
770
-          stop("Object in ", intensityFile, " seems to be invalid.")
779
+          stop("Object in ", snpFile, " seems to be invalid.")
771 780
   }
772 781
   if(row.names) row.names=res$gns else row.names=NULL
773 782
   if(col.names) col.names=res$sns else col.names=NULL
... ...
@@ -804,15 +813,15 @@ crlmmIlluminaV2 = function(sampleSheet=NULL,
804 813
           	  row.names=TRUE, 
805 814
 			  col.names=TRUE,
806 815
 			  probs=c(1/3, 1/3, 1/3), DF=6, SNRMin=5, gender=NULL,
807
-              seed=1, save.ab=FALSE, abFile,
816
+              seed=1, save.ab=FALSE, snpFile, cnFile,
808 817
               mixtureSampleSize=10^5, eps=0.1, verbose=TRUE,
809 818
               cdfName, sns, recallMin=10, recallRegMin=1000,
810 819
               returnParams=FALSE, badSNP=.7) {
811 820
 			  
812 821
   if (save.rg & missing(rgFile))
813 822
     stop("'rgFile' is missing, and you chose save.rg")
814
-  if (save.ab & missing(abFile))
815
-    stop("'abFile' is missing, and you chose save.ab")
823
+  if (save.ab & (missing(snpFile) | missing(cnFile)))
824
+    stop("'snpFile' or 'cnFile' is missing and you chose save.ab")
816 825
 				  
817 826
   RG = readIdatFiles(sampleSheet=sampleSheet, arrayNames=arrayNames,
818 827
                        ids=ids, path=path, arrayInfoColNames=arrayInfoColNames,
... ...
@@ -827,7 +836,7 @@ crlmmIlluminaV2 = function(sampleSheet=NULL,
827 836
     
828 837
   res = preprocessInfinium2(XY, mixtureSampleSize=mixtureSampleSize, fitMixture=TRUE, verbose=verbose,
829 838
                         seed=seed, eps=eps, cdfName=cdfName, sns=sns, stripNorm=stripNorm, useTarget=useTarget,
830
-                        save.it=save.ab, intensityFile=abFile)
839
+                        save.it=save.ab, snpFile=snpFile, cnFile=cnFile)
831 840
   rm(XY)
832 841
   gc()
833 842
   if(row.names) row.names=res$gns else row.names=NULL
... ...
@@ -11,7 +11,7 @@ crlmmIllumina(RG, XY, stripNorm=TRUE, method="quantile",
11 11
       useTarget=TRUE, row.names=TRUE, col.names=TRUE,
12 12
       probs=c(1/3, 1/3, 1/3), DF=6, SNRMin=5,
13 13
       gender=NULL, seed=1, save.it=FALSE, load.it=FALSE,
14
-      intensityFile, mixtureSampleSize=10^5,
14
+      snpFile, cnFile, mixtureSampleSize=10^5,
15 15
       eps=0.1, verbose=TRUE, cdfName, sns, recallMin=10,
16 16
       recallRegMin=1000, returnParams=FALSE, badSNP=0.7)
17 17
 }
... ...
@@ -33,10 +33,12 @@ crlmmIllumina(RG, XY, stripNorm=TRUE, method="quantile",
33 33
     defining sex. (1 - male; 2 - female)}
34 34
   \item{seed}{'integer' scalar for random number generator (used to
35 35
     sample \code{mixtureSampleSize} SNPs for mixture model.}
36
-  \item{save.it}{'logical'. Save preprocessed data?}
37
-  \item{load.it}{'logical'. Load preprocessed data to speed up analysis?}
38
-  \item{intensityFile}{'character' with filename of preprocessed data to
36
+  \item{save.it}{'logical'. Save preprocessed SNP and copy number data?}
37
+  \item{load.it}{'logical'. Load preprocessed SNP data to speed up analysis?}
38
+  \item{snpFile}{'character' with filename of preprocessed SNP data to
39 39
     be saved/loaded.}
40
+  \item{cnFile}{'character' with filename of preprocessed copy number 
41
+    data to be saved.}
40 42
   \item{mixtureSampleSize}{'integer'. The number of SNP's to be used
41 43
     when fitting the mixture model.}
42 44
   \item{eps}{Minimum change for mixture model.}