AgProc.R

From Organic Design wiki
Revision as of 00:35, 6 June 2007 by Sven (talk | contribs) (# {{R}})
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

Code snipits and programs written in R, S or S-PLUS

  1. R class for processed data from Agilent arrays.
  2. Class marrayProc
  3. Abbreviated names: ag Agilent; R red; G Green; L Log; sat saturated; pv p value; e error.
  4. John Pearson
  5. modified 20/9/2003

setClass("marrayProc",

        representation(agG     = "matrix", agR     = "matrix", agControls = "matrix", 
                       agGsat  = "matrix", agRsat  = "matrix", 
                       agGpv   = "matrix", agRpv   = "matrix",
                       agLRpv  = "matrix", agLRe   = "matrix"
                       )
        )     
  1. Accessor methods for marrayProc class

if(!isGeneric("agG"))

  setGeneric("agG", function(object) standardGeneric("agG"))
  setMethod("agG", "marrayProc", function(object) slot(object, "agG"))

if(!isGeneric("agR"))

  setGeneric("agR", function(object) standardGeneric("agR"))
  setMethod("agR", "marrayProc", function(object) slot(object, "agR"))

if(!isGeneric("agControls"))

  setGeneric("agControls", function(object) standardGeneric("agControls"))
  setMethod("agControls", "marrayProc", function(object) slot(object, "agControls"))
  

if(!isGeneric("agGsat"))

  setGeneric("agGsat", function(object) standardGeneric("agGsat"))
  setMethod("agGsat", "marrayProc", function(object) slot(object, "agGsat"))
  

if(!isGeneric("agRsat"))

  setGeneric("agRsat", function(object) standardGeneric("agRsat"))
  setMethod("agRsat", "marrayProc", function(object) slot(object, "agRsat"))

if(!isGeneric("agRpv"))

  setGeneric("agRpv", function(object) standardGeneric("agRpv"))
  setMethod("agRpv", "marrayProc", function(object) slot(object, "agRpv"))

if(!isGeneric("agGpv"))

  setGeneric("agGpv", function(object) standardGeneric("agGpv"))
  setMethod("agGpv", "marrayProc", function(object) slot(object, "agGpv"))
  

if(!isGeneric("agLRpv"))

  setGeneric("agLRpv", function(object) standardGeneric("agLRpv"))
  setMethod("agLRpv", "marrayProc", function(object) slot(object, "agLRpv"))
  

if(!isGeneric("agLRe"))

  setGeneric("agLRe", function(object) standardGeneric("agLRe"))
  setMethod("agLRe", "marrayProc", function(object) slot(object, "agLRe"))

setMethod("[", "marrayProc", function(x, i, j, ..., drop=FALSE) {

 newx<-x
 if(missing(j))
  j<-TRUE
 if(missing(i)) 
  i<-TRUE


 if(length(agR(x))!=0)
   slot(newx,"agR")        <-agR(x)[i,j,drop=FALSE]
 if(length(agG(x))!=0)
   slot(newx,"agG")        <-agG(x)[i,j,drop=FALSE]
 if(length(agControls(x))!=0)
   slot(newx,"agControls") <-agControls(x)[i,j,drop=FALSE]
 if(length(agRsat(x))!=0)
   slot(newx,"agRsat")     <-agRsat(x)[i,j,drop=FALSE] 
 if(length(agGsat(x))!=0)
   slot(newx,"agGsat")     <-agGsat(x)[i,j,drop=FALSE] 
 if(length(agRpv(x))!=0)
   slot(newx,"agRpv")      <-agRpv(x)[i,j,drop=FALSE] 
 if(length(agGpv(x))!=0)
   slot(newx,"agGpv")      <-agGpv(x)[i,j,drop=FALSE]   
 if(length(agLRpv(x))!=0)
   slot(newx,"agLRpv")     <-agLRpv(x)[i,j,drop=FALSE] 
 if(length(agLRe(x))!=0)
   slot(newx,"agLRe")      <-agLRe(x)[i,j,drop=FALSE]   
 return(newx)

} )

read.AgProc <- function( fn, path = ".",

                        name.Rf    = "rProcessedSignal", 
                        name.Gf    = "gProcessedSignal",
                        name.ct    = "ControlType",
                        name.Rsat  = "rIsSaturated",
                        name.Gsat  = "gIsSaturated",
                        name.Gpv   = "gPValFeatEqBG",
                        name.Rpv   = "rPValFeatEqBG", 
                        name.LRpv  = "PValueLogRatio",
                        name.LRe   = "LogRatioError",
                       sep = "\t", quote = ""){
   
   if(path !=".") fn <- file.path(path,fn)
   y       <- readLines(fn[1], n = 40)
   skip    <- grep(name.Rf, y)[1] - 1
   print(skip)
   Gf <- Gsat <- Rf <- Rsat <- Ct <- Rpv <- Gpv <- LRpv <- LRe <- NULL
   
   for(f in fn){
       print(paste("Reading", f)
       h       <- scan(f, what=character(0), sep=sep, skip = skip, quote=quote, nlines=1, quiet=TRUE)
       names(h)<- gsub("\"","",h)
       h       <- lapply(h,as.null)
       cols    <- c(name.Gf, name.Rf, name.ct, name.Rsat, name.Gsat, name.Gpv, name.Rpv, name.LRpv, name.LRe)
       h[cols] <- character(1)
   
       dat     <- scan(f, quiet = TRUE, what = h, sep = sep, skip = skip + 1, quote = quote)
       Gf      <- cbind(Gf, as.numeric(datname.Gf))
       Rf      <- cbind(Rf, as.numeric(datname.Rf))
       Ct      <- cbind(Ct, as.numeric(datname.ct))
       Gsat    <- cbind(Gsat, as.numeric(datname.Gsat))
       Rsat    <- cbind(Rsat, as.numeric(datname.Rsat))
       Gpv     <- cbind(Gpv, as.numeric(datname.Gpv))
       Rpv     <- cbind(Rpv, as.numeric(datname.Rpv))
       LRpv    <- cbind(LRpv, as.numeric(datname.LRpv))
       LRe     <- cbind(LRe, as.numeric(datname.LRe))
       }
   mproc   <- new("marrayProc", 
                   agG     = Gf,   agR     = Rf,   agControls = Ct, 
                   agRsat  = Rsat, agGsat  = Gsat, 
                   agRpv   = Rpv,  agGpv   = Gpv, 
                   agLRpv  = LRpv, agLRe   = LRe)
   return(mproc)
   }