Merge branch 'working'

Author: dbottomly

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: oligoMask
-Version: 0.99.08
+Version: 0.99.09
 Date: 2013-5-13
 Title: Tools for masking out problematic Affymetrix probes using VCF files and the oligo package
 Author: Daniel Bottomly

R/VariantMaskParams.R

@@ -1,25 +1,40 @@
-guess.core.query <- function()
-{
-    guess.query.func(oligo:::getFidMetaProbesetCore)
-}
+#guess.core.query <- function()
+#{
+#    guess.query.func(oligo:::getFidMetaProbesetCore)
+#}
+#
+#guess.probeset.query <- function()
+#{
+#    guess.query.func(oligo:::getFidProbeset)
+#}
 
-guess.probeset.query <- function()
+guess.query.func <- function(object, target)
 {
-    guess.query.func(oligo:::getFidProbeset)
-}
-
-guess.query.func <- function(defined.function)
-{
-    core.func <- deparse(defined.function)
-    core.query <- core.func[grep("SELECT", core.func)]
-    if (length(core.query) != 1)
+    if (target == "core")
+    {
+        use.func <- oligo:::getFidMetaProbesetCore
+    }else
+    {
+        use.func <- oligo:::getFidProbeset
+    }
+    
+    func.list <- as.list(body(use.func))
+    
+    which.sql <- sapply(func.list, function(x) any(grep("SELECT", x)))
+    
+    if (sum(which.sql) != 1)
     {
-        stop("ERROR: Guess at query failed, please supply valid SQL queries to the VariantMaskParams object")
+        stop("ERROR: Guess at query failed--multiple possible queries found")
     }
 
-    temp <- eval(parse(text=core.query))
+    sql.val <- eval(func.list[which.sql][[1]])
+    
+    if (is.character(sql.val) == F || length(sql.val) != 1)
+    {
+        stop("ERROR: Guess at query failed--only one SQL query expected")
+    }
 
-    return(temp)
+    return(sql.val)
 }
 
 valid.VariantMaskParams <- function(object)
@@ -53,9 +68,9 @@ valid.VariantMaskParams <- function(object)
     return(TRUE)
 }
 
-setClass(Class="VariantMaskParams", representation=list(mask.type="character", geno.filter="logical", rm.unmap="logical", rm.mult="logical", core.query="character",
-                                                        probeset.query="character", oligo.probe.id="character", var.db="VcfDB"),
-                                    prototype=prototype(mask.type="static", geno.filter=FALSE, rm.unmap=TRUE, rm.mult=TRUE, core.query=guess.core.query(), probeset.query=guess.probeset.query(), oligo.probe.id ="fid", var.db=new("VcfDB")),
+setClass(Class="VariantMaskParams", representation=list(mask.type="character", geno.filter="logical", rm.unmap="logical", rm.mult="logical", 
+                                                        oligo.probe.id="character", var.db="VcfDB"),
+                                    prototype=prototype(mask.type="static", geno.filter=FALSE, rm.unmap=TRUE, rm.mult=TRUE, oligo.probe.id ="fid", var.db=new("VcfDB")),
                                     validity=valid.VariantMaskParams)
 
 setMethod("show", signature("VariantMaskParams"), function(object)
@@ -122,7 +137,7 @@ get.shortest.query.path <- function(var.mask.par, start=NULL, finish=NULL, rever
 setGeneric("validProbeQuery", def=function(object,...) standardGeneric("validProbeQuery"))
 setMethod("validProbeQuery", signature("VariantMaskParams"), function(object, target, should.add=TRUE, should.count=FALSE)
           {
-                oligo.query <- switch(target, core=object@core.query, probeset=object@probeset.query)
+                oligo.query <- guess.query.func(object, target)
 
                 var.presence <- "contains_var"
                 filter.presence <- "passes_filter"

R/vcf_parsing.R

@@ -374,7 +374,7 @@ create.sanger.mouse.vcf.db <- function(vcf.files, vcf.labels, probe.tab.file, st
 		  }
 
 		  syms <- list(VERSION=package.desc$Version, MANUF="Affymetrix", CHIPNAME=gsub("-", "_", strsplit(basename(probe.tab.file), "\\.")[[1]][1]), LIC=package.desc$License, TBSLDATA=basename(actual.tbsl.name), DB_NAME=basename(actual.db.name),
-			  GENOME_PACKAGE=bs.genome@seqs_pkgname, LIMIT_CHR=paste0("c(", paste(paste0("'",use.chr.vec, "'"), collapse=","),")"), VAR_TYPE=var.type.str,
+			  GENOME_PACKAGE=bs.genome@pkgname, LIMIT_CHR=paste0("c(", paste(paste0("'",use.chr.vec, "'"), collapse=","),")"), VAR_TYPE=var.type.str,
 			  NUM_MISMATCH=as.character(max.mismatch))
 
 		  syms <- append(syms, package.info)

inst/NEWS

@@ -1,3 +1,7 @@
+VERSION 0.99.09
+
+Removed the probeset.query and core.query slots in the VariantMaskParams object, the proper SQL query is now inferred using the supplied FeatureSet object.
+
 VERSION 0.99.02
 
 Bux fixes for the methods of TableSchemaList as well as the SangerTableSchemaList to deal with INDELS that have the same exact position as SNVs.

inst/unitTests/test_methods.R

@@ -403,6 +403,8 @@ test.populate.db.tbl.schema.list <- function()
     dbDisconnect(db.con)
 }
 
+###still need to fix me:  attributes are not identical across measure variables; they will be dropped
+
 test.make.vcf.table <- function()
 {
 
@@ -452,7 +454,8 @@ test.make.vcf.table <- function()
 
     filt.vcf.dta <- do.call("rbind", lapply(filt.vcf, function(x)
            {
-                temp.dta <- cbind(as.data.frame(x$rowData), ref=as.character(x$REF), alt=sapply(x$ALT, paste, collapse=","), gt=x$GENO$GT, fi=x$GENO$FI)
+                temp.dta <- cbind(as.data.frame(x$rowData), ref=as.character(x$REF), alt=sapply(x$ALT, paste, collapse=","), gt=x$GENO$GT, fi=x$GENO$FI,
+                                  stringsAsFactors=F)
            }))
 
     #the same variant can impact several probes, so remove the duplicates as the conversion to the database should do so
@@ -593,7 +596,7 @@ examine.vcf.db <- function(db.name, db.schema, tab.aln, vcf.files, strain.names)
 
     checkTrue(nrow(probe.aln) == nrow(sub.tab.aln))
 
-    merged.annot <- merge(probe.aln, sub.tab.aln, by.x="probe_id", by.y="Probe.ID", all=TRUE, incomparables=NA, sort=FALSE)
+    merged.annot <- merge(probe.aln, sub.tab.aln, by.x="probe_id", by.y="Probe.ID", all=TRUE, sort=FALSE)
 
     checkTrue(nrow(merged.annot) == nrow(probe.aln))
 
@@ -622,7 +625,7 @@ examine.vcf.db <- function(db.name, db.schema, tab.aln, vcf.files, strain.names)
     var.ovls <- dbGetQuery(db.con, "SELECT * FROM probe_to_snp NATURAL JOIN reference NATURAL JOIN probe_align NATURAL JOIN probe_info")
 
     #there will be some of these which are not variants in one of the 8 strains, check that here...
-    temp <- merge(probe.snp, var.ovls, all=TRUE, incomparables=NA, sort=FALSE)
+    temp <- merge(probe.snp, var.ovls, all=TRUE,  sort=FALSE)
 
     checkTrue(nrow(temp) == nrow(probe.snp))
     checkTrue(sum(is.na(temp)) == 0)

man/VariantMaskParams.Rd

@@ -24,9 +24,7 @@ VariantMaskParams constructor function as VariantMaskParams(var.db, geno.filter=
     \item{\code{geno.filter}:}{Object of class \code{"logical"} indicating whether only the probes overlapping the high quality genotypes be used (default is FALSE)}
     \item{\code{rm.unmap}:}{Object of class \code{"logical"} indicating whether the probes that are unmapped should be removed as well (default is TRUE)}
     \item{\code{rm.mult}:}{Object of class \code{"logical"} indicating whether the probes that map to multiple locations should be removed as well (default is TRUE)}
-    \item{\code{core.query}:}{Object of class \code{"character"} representing a query from the oligo package to retrieve the probes associated with the core metaprobesets (attempts to find this automatically)}
-    \item{\code{probeset.query}:}{Object of class \code{"character"} representing a query from the oligo package to retrieve the probes associated with the probesets (attempts to find this automatically)}
-    \item{\code{oligo.probe.id}:}{Object of class \code{"character"} indicating the database column that the oligo package uses to denote the probe ID}
+     \item{\code{oligo.probe.id}:}{Object of class \code{"character"} indicating the database column that the oligo package uses to denote the probe ID}
   \item{\code{var.db}:}{Object of class \code{"VcfDB"} corresponding to the VCF database to be used for masking}
   }
 }