[Wavetiling-commits] r21 - in pkg: . R man vignettes
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Mar 1 08:31:58 CET 2012
Author: kdbeuf
Date: 2012-03-01 08:31:57 +0100 (Thu, 01 Mar 2012)
New Revision: 21
Added:
pkg/R/methods-MapFilterProbe.R
pkg/man/GenomeInfo-class.Rd
pkg/man/MapFilterProbe-class.Rd
pkg/man/WfmFit-class.Rd
pkg/man/WfmFitCircadian-class.Rd
pkg/man/WfmFitCustom-class.Rd
pkg/man/WfmFitFactor-class.Rd
pkg/man/WfmFitTime-class.Rd
pkg/man/WfmInf-class.Rd
pkg/man/WfmInfCompare-class.Rd
pkg/man/WfmInfCustom-class.Rd
pkg/man/WfmInfEffects-class.Rd
pkg/man/WfmInfMeans-class.Rd
pkg/man/WfmInfOverallMean-class.Rd
pkg/man/cel2TilingFeatureSet.Rd
pkg/man/getBetaWav.Rd
pkg/man/getDesignMatrix.Rd
pkg/man/getVarBetaWav.Rd
pkg/man/plot.Rd
pkg/man/wfm.fit.Rd
pkg/man/wfm.inference.Rd
Removed:
pkg/R/methods-mapFilterProbe.R
pkg/man/Wfm-class.Rd
pkg/man/genomeInfo-class.Rd
pkg/man/getBetaMAP.Rd
pkg/man/getDesign.Rd
pkg/man/getVarBetaMAP.Rd
pkg/man/mapFilterProbe-class.Rd
pkg/man/wfm.analysis.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/allClasses.R
pkg/R/allGenerics.R
pkg/R/helperFunctions.R
pkg/R/initialize-methods.R
pkg/R/methods-WaveTilingFeatureSet.R
pkg/R/methods-WfmFit.R
pkg/R/methods-WfmInf.R
pkg/R/show-methods.R
pkg/TODO
pkg/man/addPheno.Rd
pkg/man/bgCorrQn.Rd
pkg/man/filterOverlap.Rd
pkg/man/getAlpha.Rd
pkg/man/getChromosome.Rd
pkg/man/getDataOrigSpace.Rd
pkg/man/getDataWaveletSpace.Rd
pkg/man/getDelta.Rd
pkg/man/getEff.Rd
pkg/man/getF.Rd
pkg/man/getFDR.Rd
pkg/man/getFilteredIndices.Rd
pkg/man/getGenomeInfo.Rd
pkg/man/getGenomicRegions.Rd
pkg/man/getGroupNames.Rd
pkg/man/getKj.Rd
pkg/man/getMaxPos.Rd
pkg/man/getMinPos.Rd
pkg/man/getNoGroups.Rd
pkg/man/getNoLevels.Rd
pkg/man/getNoProbes.Rd
pkg/man/getNonAnnotatedRegions.Rd
pkg/man/getPhenoInfo.Rd
pkg/man/getPosition.Rd
pkg/man/getPrior.Rd
pkg/man/getProbePosition.Rd
pkg/man/getRegions.Rd
pkg/man/getReplics.Rd
pkg/man/getSigGenes.Rd
pkg/man/getSigProbes.Rd
pkg/man/getSmoothPar.Rd
pkg/man/getStrand.Rd
pkg/man/getTwoSided.Rd
pkg/man/getVarEff.Rd
pkg/man/getVarEps.Rd
pkg/man/getVarF.Rd
pkg/man/getWaveletFilter.Rd
pkg/man/makeDesign.Rd
pkg/man/plotWfm.Rd
pkg/man/selectProbesFromFilterOverlap.Rd
pkg/man/selectProbesFromTilingFeatureSet.Rd
pkg/vignettes/waveTiling-vignette.Rnw
Log:
documentation/vignettes
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/DESCRIPTION 2012-03-01 07:31:57 UTC (rev 21)
@@ -10,7 +10,7 @@
Suggests:
Description: This package is designed to conduct transcriptome analysis for tiling arrays based on fast wavelet-based functional models.
Collate: allClasses.R allGenerics.R helperFunctions.R
- initialize-methods.R methods-mapFilterProbe.R
+ initialize-methods.R methods-MapFilterProbe.R
methods-WaveTilingFeatureSet.R methods-WfmFit.R methods-WfmInf.R show-methods.R
URL: https://r-forge.r-project.org/projects/wavetiling/
LazyLoad: yes
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/NAMESPACE 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,4 +1,4 @@
-## useDynLib("waveTiling")
+useDynLib("waveTiling")
## Importing
importClassesFrom(methods, ANY, character, data.frame, "function", integer, matrix, numeric)
@@ -40,7 +40,7 @@
## Exporting
## Classes
-exportClasses(WaveTilingFeatureSet, mapFilterProbe, genomeInfo, WfmFit, WfmInf, WfmFitTime, WfmFitFactor, WfmFitCircadian, WfmFitCustom, WfmInfCompare, WfmInfEffects )
+exportClasses(WaveTilingFeatureSet, MapFilterProbe, GenomeInfo, WfmFit, WfmInf, WfmFitTime, WfmFitFactor, WfmFitCircadian, WfmFitCustom, WfmInfCompare, WfmInfEffects )
## exportMethods(show)
exportMethods(show)
@@ -49,14 +49,14 @@
exportMethods(plot)
## waveTilingFeatureSet methods
-exportMethods(addPheno, getNoGroups, getGroupNames, getReplics, filterOverlap, selectProbesFromTilingFeatureSet,bgCorrQn,wfm.analysis)
+exportMethods(addPheno, getNoGroups, getGroupNames, getReplics, filterOverlap, selectProbesFromTilingFeatureSet,bgCorrQn,wfm.fit)
-## mapFilterProbe methods
+## MapFilterProbe methods
exportMethods(getFilteredIndices, getPosition, selectProbesFromFilterOverlap)
## WfmFit methods
-exportMethods(getProbePosition, getNoProbes, getBetaMAP, getVarBetaMAP, getSmoothPar, getVarEps, getGenomeInfo, getChromosome, getStrand, getMinPos, getMaxPos, getNoLevels, getWfmMethod, getDesign, getPhenoInfo, getDataOrigSpace, getDataWaveletSpace, getWaveletFilter, getKj,getPrior, getAlpha, getDelta, getTwoSided, getRescale, getSigProbes,getRegions, getGenomicRegions, getFDR, getF, getVarF, getEff,getVarEff, wfm.inference, getSigGenes, getNonAnnotatedRegions)
+exportMethods(getProbePosition, getNoProbes, getBetaWav, getVarBetaWav, getSmoothPar, getVarEps, getGenomeInfo, getChromosome, getStrand, getMinPos, getMaxPos, getNoLevels, getDesignMatrix, getPhenoInfo, getDataOrigSpace, getDataWaveletSpace, getWaveletFilter, getKj,getPrior, getAlpha, getDelta, getTwoSided, getSigProbes,getRegions, getGenomicRegions, getFDR, getF, getVarF, getEff,getVarEff, wfm.inference, getSigGenes, getNonAnnotatedRegions)
## Other
-export(cel2TilingFeatureSet, makeContrasts, makeDesign)
+export(cel2TilingFeatureSet, makeContrasts, makeDesign, plotWfm)
Modified: pkg/R/allClasses.R
===================================================================
--- pkg/R/allClasses.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/allClasses.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,15 +1,15 @@
-#mapFilterProbe
-setClass("mapFilterProbe",representation(filteredIndices="vector",chromosome="vector",position="vector",strand="vector"))
+#MapFilterProbe
+setClass("MapFilterProbe",representation(filteredIndices="vector",chromosome="vector",position="vector",strand="vector"))
-#genomeInfo
-setClass("genomeInfo",representation(chromosome="vector",strand="character",minPos="numeric",maxPos="numeric"))
+#GenomeInfo
+setClass("GenomeInfo",representation(chromosome="vector",strand="character",minPos="numeric",maxPos="numeric"))
#WaveTilingFeatureSet
setClass("WaveTilingFeatureSet",contains="TilingFeatureSet")
#WfmFit
setClass(Class="WfmFit",
- representation = representation (betaMAP="matrix",varbetaMAP="matrix",smoothPar="matrix",varEps="numeric",dataOrigSpace="matrix",dataWaveletSpace="matrix",design.matrix="matrix",phenoData="data.frame",genome.info="genomeInfo",n.levels="numeric",probePosition="vector",wave.filt="character",Kj="numeric",prior="character",F="matrix",varF="matrix",P="numeric",Z="matrix",noGroups="numeric",replics="numeric")
+ representation = representation (betaWav="matrix",varbetaWav="matrix",smoothPar="matrix",varEps="numeric",dataOrigSpace="matrix",dataWaveletSpace="matrix",design.matrix="matrix",phenoData="data.frame",genome.info="GenomeInfo",n.levels="numeric",probePosition="vector",wave.filt="character",Kj="numeric",prior="character",F="matrix",varF="matrix",P="numeric",Z="matrix",noGroups="numeric",replics="numeric")
)
### Factor
Modified: pkg/R/allGenerics.R
===================================================================
--- pkg/R/allGenerics.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/allGenerics.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,3 +1,11 @@
+# temporary(?) pmStrand
+
+setGeneric("pmStrand",function(object)
+{
+ standardGeneric("pmStrand")
+}
+)
+
# method data extraction
setGeneric("addPheno",function(object, noGroups, groupNames, replics, ...)
@@ -7,7 +15,7 @@
)
-setGeneric("filterOverlap",function(object, remap=TRUE, fastaFile, chrId, strand=c("forward","reverse","both"), MM=FALSE, ...)
+setGeneric("filterOverlap",function(object, remap=TRUE, BSgenomeObject, chrId, strand=c("forward","reverse","both"), MM=FALSE, ...)
{
standardGeneric("filterOverlap")
}
@@ -38,9 +46,9 @@
# }
# )
-setGeneric("wfm.analysis",function(object, filter.overlap=NULL, design=c("time","circadian","group","factorial","custom"), n.levels, factor.levels=NULL, chromosome, strand, minPos, maxPos, design.matrix=NULL, var.eps=c("margLik","mad"), prior=c("normal","improper"), eqsmooth=TRUE, max.it=20, wave.filt="haar", skiplevels=NULL, trace=FALSE, save.obs=c("plot","regions","all"))
+setGeneric("wfm.fit",function(object, filter.overlap=NULL, design=c("time","circadian","group","factorial","custom"), n.levels, factor.levels=NULL, chromosome, strand, minPos, maxPos, design.matrix=NULL, var.eps=c("margLik","mad"), prior=c("normal","improper"), eqsmooth=FALSE, max.it=20, wave.filt="haar", skiplevels=NULL, trace=FALSE, save.obs=c("plot","regions","all"))
{
- standardGeneric("wfm.analysis")
+ standardGeneric("wfm.fit")
}
)
@@ -107,15 +115,15 @@
}
)
-setGeneric("getBetaMAP",function(object)
+setGeneric("getBetaWav",function(object)
{
- standardGeneric("getBetaMAP")
+ standardGeneric("getBetaWav")
}
)
-setGeneric("getVarBetaMAP",function(object)
+setGeneric("getVarBetaWav",function(object)
{
- standardGeneric("getVarBetaMAP")
+ standardGeneric("getVarBetaWav")
}
)
@@ -160,11 +168,12 @@
standardGeneric("getWfmMethod")
}
)
-setGeneric("getDesign",function(object)
+setGeneric("getDesignMatrix",function(object)
{
- standardGeneric("getDesign")
+ standardGeneric("getDesignMatrix")
}
)
+
setGeneric("getWfmDesign",function(object)
{
standardGeneric("getWfmDesign")
@@ -175,6 +184,7 @@
standardGeneric("getPhenoInfo")
}
)
+
setGeneric("getDataOrigSpace",function(object)
{
standardGeneric("getDataOrigSpace")
@@ -185,6 +195,7 @@
standardGeneric("getDataWaveletSpace")
}
)
+
setGeneric("getWaveletFilter",function(object)
{
standardGeneric("getWaveletFilter")
@@ -195,94 +206,91 @@
standardGeneric("getKj")
}
)
+
setGeneric("getPrior",function(object)
{
standardGeneric("getPrior")
}
)
+
setGeneric("getAlpha",function(object)
{
standardGeneric("getAlpha")
}
)
+
setGeneric("getDelta",function(object)
{
standardGeneric("getDelta")
}
)
+
setGeneric("getTwoSided",function(object)
{
standardGeneric("getTwoSided")
}
)
-setGeneric("getRescale",function(object)
-{
- standardGeneric("getRescale")
-}
-)
+
setGeneric("getSigProbes",function(object)
{
standardGeneric("getSigProbes")
}
)
+
setGeneric("getRegions",function(object)
{
standardGeneric("getRegions")
}
)
+
setGeneric("getGenomicRegions",function(object)
{
standardGeneric("getGenomicRegions")
}
)
+
setGeneric("getFDR",function(object)
{
standardGeneric("getFDR")
}
)
+
setGeneric("getCI",function(object)
{
standardGeneric("getCI")
}
)
+
setGeneric("getF",function(object)
{
standardGeneric("getF")
}
)
+
setGeneric("getVarF",function(object)
{
standardGeneric("getVarF")
}
)
+
setGeneric("getEff",function(object)
{
standardGeneric("getEff")
}
)
+
setGeneric("getVarEff",function(object)
{
standardGeneric("getVarEff")
}
)
+
setGeneric("getDesignMatrix",function(object)
{
standardGeneric("getDesignMatrix")
}
)
-setGeneric("getP",function(object)
-{
- standardGeneric("getP")
-}
-)
-
-setGeneric("getZ",function(object)
-{
- standardGeneric("getZ")
-}
-)
-
# setGeneric("plotWfm",function(object, annoFile, minPos, maxPos, trackFeature="exon", overlayFeature=c("gene","transposable_element_gene"), two.strand=TRUE, plotData=TRUE, plotMean=TRUE, tracks=0)
# {
# standardGeneric("plotWfm")
@@ -305,6 +313,6 @@
setGeneric("plot",function(fit,inf,...){
standardGeneric("plot")
}
-)
+)
}
Modified: pkg/R/helperFunctions.R
===================================================================
--- pkg/R/helperFunctions.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/helperFunctions.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -126,12 +126,10 @@
phi <- B
if (eqsmooth)
{
- #out <- .C("MAPMARGEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
- out <- .C("MAPMARGEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends))[4:6]
+ out <- .C("MAPMARGEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
} else
{
- #out <- .C("MAPMARG",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
- out <- .C("MAPMARG",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends))[4:6]
+ out <- .C("MAPMARG",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
}
names(out) <- c("beta_MAP","varbeta_MAP","phi")
dim(out[[1]]) <- c(K,q)
@@ -160,12 +158,10 @@
phi <- B
if (eqsmooth)
{
- #out <- .C("MAPMARGIMPEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
- out <- .C("MAPMARGIMPEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends))[4:6]
+ out <- .C("MAPMARGIMPEQSMOOTH",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
} else
{
- #out <- .C("MAPMARGIMP",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
- out <- .C("MAPMARGIMP",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends))[4:6]
+ out <- .C("MAPMARGIMP",as.double(D),as.integer(K),as.double(vareps),as.double(B),as.double(varB),as.double(phi),as.double(X),as.double(diag(t(X)%*%X)),as.integer(q),as.integer(N),as.integer(ends), PACKAGE = "waveTiling")[4:6]
}
names(out) <- c("beta_MAP","varbeta_MAP","phi")
dim(out[[1]]) <- c(K,q)
@@ -322,7 +318,7 @@
Xorig[,1] <- 1
Xorig[,2:noGroups] <- apply(desHelmert[,1:(noGroups-1)],2,rep,replics)
}
- else if (method=="factorial")
+ else if (design=="factorial")
{
if (is.null(factor.levels))
{
@@ -362,7 +358,7 @@
#### makeContrasts
makeContrasts <- function(contrasts, nlevels) {
- if (contrasts=="compare") {
+ if (contrasts=="compare") {
q <- nlevels*(nlevels-1)/2
contr <- matrix(0,nrow=q,ncol=nlevels)
hlp1 <- rep(2:nlevels,1:(nlevels-1))
@@ -379,7 +375,7 @@
##### plot
-plotWfm<-function(fit,inf,annoFile,minPos,maxPos,trackFeature="exon",overlayFeature=c("gene","transposable_element_gene"),two.strand=TRUE,plotData=TRUE,plotMean=TRUE,tracks=0)
+plotWfm <- function(fit,inf,annoFile,minPos,maxPos,trackFeature="exon",overlayFeature=c("gene","transposable_element_gene"),two.strand=TRUE,plotData=TRUE,plotMean=TRUE,tracks=0)
{
if (missing(annoFile)) {stop("Annotation File is missing!!")}
Gloc <- getProbePosition(fit)
@@ -426,7 +422,7 @@
{
names(trackInfo)[trackCount] <- "R"
}
- overlayInfo[[trackCount]] <- makeNewAnnotationTextOverlay(annoFile=annoFile,chromosome=chromosome,minBase=minBase,maxBase=maxBase,strand=strand,region=c(trackcount,trackCount),feature=overlayFeature,y=0.5)
+ overlayInfo[[trackCount]] <- makeNewAnnotationTextOverlay(annoFile=annoFile,chromosome=chromosome,minBase=minBase,maxBase=maxBase,strand=strand,region=c(trackCount,trackCount),feature=overlayFeature,y=0.5)
trackCount <- trackCount + 1
gAxis <- makeGenomeAxis(add53 = TRUE,add35 = TRUE)
trackCount <- trackCount + 1
Modified: pkg/R/initialize-methods.R
===================================================================
--- pkg/R/initialize-methods.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/initialize-methods.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,5 +1,5 @@
-#mapFilterProbe
-setMethod("initialize","mapFilterProbe",function(.Object,filteredIndices,chromosome,position,strand)
+#MapFilterProbe
+setMethod("initialize","MapFilterProbe",function(.Object,filteredIndices,chromosome,position,strand)
{
.Object at filteredIndices <- filteredIndices
.Object at chromosome <- chromosome
@@ -8,11 +8,29 @@
return(.Object)
})
+#WaveTilingFeatureSet
+setMethod("initialize","WaveTilingFeatureSet",function (.Object)
+{
+ callNextMethod(.Object);
+}
+)
+
+
+#GenomeInfo
+setMethod("initialize","GenomeInfo",function(.Object,chromosome,strand,minPos,maxPos)
+{
+ .Object at chromosome <- chromosome
+ .Object at strand <- strand
+ .Object at minPos <- minPos
+ .Object at maxPos <- maxPos
+ return(.Object)
+})
+
#WfmFit
-setMethod("initialize","WfmFit",function(.Object,betaMAP,varbetaMAP,smoothPar,varEps,dataOrigSpace,dataWaveletSpace,design.matrix,phenoData,genome.info,n.levels,probePosition,wave.filt,Kj,prior,F,varF,P,Z,noGroups,replics)
+setMethod("initialize","WfmFit",function(.Object,betaWav,varbetaWav,smoothPar,varEps,dataOrigSpace,dataWaveletSpace,design.matrix,phenoData,genome.info,n.levels,probePosition,wave.filt,Kj,prior,F,varF,P,Z,noGroups,replics)
{
- .Object at betaMAP <- betaMAP
- .Object at varbetaMAP <- varbetaMAP
+ .Object at betaWav <- betaWav
+ .Object at varbetaWav <- varbetaWav
.Object at smoothPar <- smoothPar
.Object at varEps <- varEps
.Object at dataOrigSpace <- dataOrigSpace
@@ -53,23 +71,7 @@
return(.Object)
})
-#genomeInfo
-setMethod("initialize","genomeInfo",function(.Object,chromosome,strand,minPos,maxPos)
-{
- .Object at chromosome <- chromosome
- .Object at strand <- strand
- .Object at minPos <- minPos
- .Object at maxPos <- maxPos
- return(.Object)
-})
-#waveTilingFeatureSet
-setMethod("initialize","WaveTilingFeatureSet",function (.Object)
-{
- callNextMethod(.Object);
-}
-)
-
## Subclasses
setMethod("initialize","WfmFitTime",function (.Object, ...)
{
Added: pkg/R/methods-MapFilterProbe.R
===================================================================
--- pkg/R/methods-MapFilterProbe.R (rev 0)
+++ pkg/R/methods-MapFilterProbe.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -0,0 +1,48 @@
+setMethod("getFilteredIndices",signature("MapFilterProbe"),function(object)
+{
+ return(object at filteredIndices)
+}
+)
+
+setMethod("getChromosome",signature("MapFilterProbe"),function(object)
+{
+ return(object at chromosome)
+}
+)
+
+setMethod("getPosition",signature("MapFilterProbe"),function(object)
+{
+ return(object at position)
+}
+)
+
+setMethod("getStrand",signature("MapFilterProbe"),function(object)
+{
+ return(object at strand)
+}
+)
+
+setMethod("selectProbesFromFilterOverlap",signature("MapFilterProbe"),function(object,chromosome,strand=c("forward","reverse"),minPos=min(getPosition(object)),maxPos=max(getPosition(object)))
+{
+ if (class(object)!="MapFilterProbe")
+ {
+ stop("class of object is not MapFilterProbe. Use 'filterOverlap()' to create such an object.")
+ }
+ if ((length(grep("chr",chromosome))>0) | (length(grep("Chr",chromosome))>0))
+ {
+ stop("give only the number (or letter) in the chromosome argument.")
+ }
+ if (minPos > maxPos)
+ {
+ stop("minPos is greater than maxPos")
+ }
+ selChrom <- (1:length(getFilteredIndices(object)))[getChromosome(object)==paste("chr",as.character(chromosome),sep="") | getChromosome(object)==paste("Chr",as.character(chromosome),sep="")]
+ selStrand <- (1:length(getFilteredIndices(object)))[getStrand(object)==strand]
+ selHlp <- intersect(selChrom,selStrand)
+ selPos <- (1:length(getFilteredIndices(object)))[(getPosition(object)>=minPos)&(getPosition(object)<=maxPos)]
+ selectionInit <- intersect(selHlp,selPos)
+ selection <- getFilteredIndices(object)[selectionInit]
+ return(list(selection=selection,selectionInit=selectionInit))
+}
+)
+
Modified: pkg/R/methods-WaveTilingFeatureSet.R
===================================================================
--- pkg/R/methods-WaveTilingFeatureSet.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/methods-WaveTilingFeatureSet.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -241,13 +241,21 @@
filteredPosition <- filteredPosition[order(filteredIndices)]
filteredStrand <- filteredStrand[order(filteredIndices)]
filteredIndices <- filteredIndices[order(filteredIndices)]
- out <- new("mapFilterProbe",filteredIndices=filteredIndices,chromosome=filteredChromosome,position=filteredPosition,strand=filteredStrand)
+ out <- new("MapFilterProbe",filteredIndices=filteredIndices,chromosome=filteredChromosome,position=filteredPosition,strand=filteredStrand)
return(out)
}
)
setMethod("selectProbesFromTilingFeatureSet",signature("WaveTilingFeatureSet"),function(object,chromosome,strand=c("forward","reverse"),minPos,maxPos)
{
+ if (strand=="forward")
+ {
+ strand <- 1
+ }
+ if (strand=="reverse")
+ {
+ strand <- 0
+ }
if (!inherits(object,"TilingFeatureSet")) #class(object)!="TilingFeatureSet")
{
stop("class of object is not TilingFeatureSet.")
@@ -268,7 +276,7 @@
{
maxPos <- max(pmPosition(object))
}
- if (maxPos < max(pmPosition(object)))
+ if (maxPos > max(pmPosition(object)))
{
maxPos <- max(pmPosition(object))
}
@@ -303,7 +311,7 @@
-setMethod("wfm.analysis",signature("WaveTilingFeatureSet"),function(object,filter.overlap=NULL,design=c("time","circadian","group","factorial","custom"),n.levels,factor.levels=NULL,chromosome,strand,minPos,maxPos,design.matrix=NULL,var.eps=c("margLik","mad"),prior=c("normal","improper"),eqsmooth=FALSE,max.it=20,wave.filt="haar",skiplevels=NULL,trace=FALSE,save.obs=c("plot","regions","all"))
+setMethod("wfm.fit",signature("WaveTilingFeatureSet"),function(object,filter.overlap=NULL,design=c("time","circadian","group","factorial","custom"),n.levels,factor.levels=NULL,chromosome,strand,minPos,maxPos,design.matrix=NULL,var.eps=c("margLik","mad"),prior=c("normal","improper"),eqsmooth=FALSE,max.it=20,wave.filt="haar",skiplevels=NULL,trace=FALSE,save.obs=c("plot","regions","all"))
{
# construct filtered data set
if ((names(pData(object))[1]!="group")|((names(pData(object))[2]!="replicate")))
@@ -312,9 +320,9 @@
}
if (!is.null(filter.overlap))
{
- if (!inherits(filter.overlap,"mapFilterProbe"))
+ if (!inherits(filter.overlap,"MapFilterProbe"))
{
- stop("class of filter.overlap is not mapFilterProbe. Use 'filterOverlap()' to create such an object.")
+ stop("class of filter.overlap is not MapFilterProbe. Use 'filterOverlap()' to create such an object.")
}
if (missing(minPos))
{
@@ -325,7 +333,7 @@
maxPos <- max(getPosition(filter.overlap))
}
probeId <- selectProbesFromFilterOverlap(filter.overlap,chromosome,strand,minPos=minPos,maxPos=maxPos)
- dataInit <- data.frame(cbind(exprs(object)[probeId$selectionFiltered,],getPosition(filter.overlap)[probeId$selectionFiltered]))
+ dataInit <- data.frame(cbind(exprs(object)[probeId$selectionInit,],getPosition(filter.overlap)[probeId$selectionInit]))
#attention probeId$selection or probeId$selectionFiltered
} else
@@ -368,7 +376,7 @@
X <- desgn$Xorig
} else
{
- if(mode(design.matrix) != "numeric") stop("design.matrix must be a numeric matrix")
+ if (mode(design.matrix) != "numeric") stop("design.matrix must be a numeric matrix")
## must matrix be full rank?
X <- design.matrix
Z <- qr.Q(qr(X))
@@ -416,20 +424,20 @@
fit$phi <- matrix()
}
- genomeLoc <- new("genomeInfo",chromosome=chromosome,strand=strand,minPos=min(Gloc),maxPos=max(Gloc))
+ genomeLoc <- new("GenomeInfo",chromosome=chromosome,strand=strand,minPos=min(Gloc),maxPos=max(Gloc))
replics <- getReplics(object)
if (design=="time") {
- fitObject <- new("WfmFitTime",betaMAP=fit$beta_MAP,varbetaMAP=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
+ fitObject <- new("WfmFitTime",betaWav=fit$beta_MAP,varbetaWav=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
}
else if (design=="circadian") {
- fitObject <- new("WfmFitCircadian",betaMAP=fit$beta_MAP,varbetaMAP=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
+ fitObject <- new("WfmFitCircadian",betaWav=fit$beta_MAP,varbetaWav=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
}
else if (design %in% c("group","factorial")) {
- fitObject <- new("WfmFitFactor",betaMAP=fit$beta_MAP,varbetaMAP=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
+ fitObject <- new("WfmFitFactor",betaWav=fit$beta_MAP,varbetaWav=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
}
else if (design=="custom") {
- fitObject <- new("WfmFitCustom",betaMAP=fit$beta_MAP,varbetaMAP=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
+ fitObject <- new("WfmFitCustom",betaWav=fit$beta_MAP,varbetaWav=fit$varbeta_MAP,smoothPar=fit$phi,varEps=fit$varEps,dataOrigSpace=Y,dataWaveletSpace=D,design.matrix=X,phenoData=pData(object),genome.info=genomeLoc,n.levels=n.levels,probePosition=Gloc,wave.filt=wave.filt,Kj=fit$Kj,prior=prior,F=F,varF=varF,P=P,Z=Z,noGroups=noGroups,replics=replics)
}
return (fitObject);
Modified: pkg/R/methods-WfmFit.R
===================================================================
--- pkg/R/methods-WfmFit.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/methods-WfmFit.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -8,14 +8,14 @@
return(length(object at probePosition))
})
-setMethod("getBetaMAP",signature("WfmFit"),function(object)
+setMethod("getBetaWav",signature("WfmFit"),function(object)
{
- return(object at betaMAP)
+ return(object at betaWav)
})
-setMethod("getVarBetaMAP",signature("WfmFit"),function(object)
+setMethod("getVarBetaWav",signature("WfmFit"),function(object)
{
- return(object at varbetaMAP)
+ return(object at varbetaWav)
})
setMethod("getSmoothPar",signature("WfmFit"),function(object)
@@ -101,17 +101,11 @@
return(object at F)
})
-setMethod("getP",signature("WfmFit"),function(object)
+setMethod("getVarF",signature("WfmFit"),function(object)
{
- return(object at P)
+ return(object at varF)
})
-setMethod("getZ",signature("WfmFit"),function(object)
-{
- return(object at Z)
-})
-
-
setMethod("wfm.inference",signature("WfmFit"),function(object,contrast.matrix=NULL,contrasts=c("compare","means","effects","overallMean"),delta=NULL,two.sided=NULL,minRunPos=90,minRunProbe=1,alpha=0.05,nsim=1000,rescale=NULL)
{
@@ -133,15 +127,73 @@
Z <- object at Z
if (!is.null(contrast.matrix)) {
- ## Given contrast matrix (CustomFit)
- # Further implementation needed
- warning("Custom Inference Procedure Not Implemented yet!")
+ ## Given contrast matrix (CustomFit)
+ if (ncol(contrast.matrix) != nrow(Xdes))
+ {
+ stop("Wrong number of columns in contrast matrix.")
+ }
+ q <- nrow(contrast.matrix)
+ if (is.null(rescale))
+ {
+ rescale <- contrast.matrix%*%Xdes
+ rescale <- rbind(c(mean(Xdes[,1]),rep(0,noGroups-1)),rescale)
+ }
+ eff <- rescale%*%solve(t(Z)%*%X)%*%F
+ varEff <- (rescale%*%solve(t(Z)%*%X))^2%*%varF
+
+ if (length(alpha)==1)
+ {
+ alpha <- rep(alpha,q+1)
+ }
+ FDR <- matrix(0,nrow=q+1,ncol=P)
+ CI <- rep(0,P*(q+1)*2)
+ dim(CI) <- c(q+1,2,P)
+ if (is.null(givenDelta))
+ {
+ delta <- c(median(getDataOrigSpace(object)),rep(log(1.1,2),q))
+ } else if (length(givenDelta)==1)
+ {
+ delta <- rep(delta,q+1)
+ } else if ((length(givenDelta)==2) & givenDelta[1]=="median")
+ {
+ delta <- rep(0,q+1)
+ delta[1] <- median(getDataOrigSpace(object))
+ delta[2:(q+1)] <- rep(as.numeric(givenDelta[2]),q)
+ } else if ((length(givenDelta)==q+1) & givenDelta[1]=="median")
+ {
+ delta <- rep(0,q+1)
+ delta[1] <- median(getDataOrigSpace(object))
+ delta[2:(q+1)] <- as.numeric(givenDelta[2:(q+1)])
+ }
+ if (is.null(two.sided))
+ {
+ two.sided <- c(0,rep(1,q))
+ }
+ for (i in 1:(q+1))
+ {
+ if (two.sided[i]==1)
+ {
+ #FDR[i,] <- pnorm(delta[i],abs(eff[i,]),sqrt(varEff[i,]))
+ FDRUp <- pnorm(delta[i],eff[i,],sqrt(varEff[i,]))
+ FDRDown <- 1-pnorm(-delta[i],eff[i,],sqrt(varEff[i,]))
+ FDR[i,] <- pmin(FDRUp,FDRDown)
+ }
+ if (two.sided[i]==0)
+ {
+ FDR[i,] <- pnorm(delta[i],eff[i,],sqrt(varEff[i,]))
+ }
+ CI[i,1,] <- qnorm(alpha/2,eff[i,],sqrt(varEff[i,]))
+ CI[i,2,] <- qnorm(1-alpha/2,eff[i,],sqrt(varEff[i,]))
+ }
+
+ # Further implementation needed
+ # warning("Custom Inference Procedure Not Implemented yet!")
}
else if (contrasts=="compare") {
if (inherits(object,"WfmFitFactor") | inherits(object,"WfmFitTime") | inherits(object,"WfmFitCircadian") | inherits(object,"WfmFitCustom")) {
#q <- noGroups*(noGroups-1)/2
q <- noGroups*(noGroups-1)/2
- contr <- makeContrasts(contrasts=contrasts,nlevels=noGroups);
+ contr <- makeContrasts(contrasts=contrasts,nlevels=noGroups)
noBetas <- noGroups
if (is.null(rescale))
{
@@ -378,7 +430,7 @@
warning("Contrast 'overall mean' not yet implemented!")
}
else {
- stop ("No contrast matrix of contrast statement specified!")
+ stop ("No contrast matrix or contrast statement specified!")
}
Gloc <- object at probePosition
Modified: pkg/R/methods-WfmInf.R
===================================================================
--- pkg/R/methods-WfmInf.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/methods-WfmInf.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -46,7 +46,7 @@
setMethod("getVarEff",signature("WfmInf"),function(object)
{
- return(object at vareff)
+ return(object at varEff)
})
@@ -153,6 +153,6 @@
return(out)
})
-setMethod("plot",signature=c(fit="WfmFit",inf="WfmInf"),plotWfm)
+setMethod("plot",signature=c(fit="WfmFit",inf="WfmInf"),plotWfm)
Deleted: pkg/R/methods-mapFilterProbe.R
===================================================================
--- pkg/R/methods-mapFilterProbe.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/methods-mapFilterProbe.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,48 +0,0 @@
-setMethod("getFilteredIndices",signature("mapFilterProbe"),function(object)
-{
- return(object at filteredIndices)
-}
-)
-
-setMethod("getChromosome",signature("mapFilterProbe"),function(object)
-{
- return(object at chromosome)
-}
-)
-
-setMethod("getPosition",signature("mapFilterProbe"),function(object)
-{
- return(object at position)
-}
-)
-
-setMethod("getStrand",signature("mapFilterProbe"),function(object)
-{
- return(object at strand)
-}
-)
-
-setMethod("selectProbesFromFilterOverlap",signature("mapFilterProbe"),function(object,chromosome,strand=c("forward","reverse"),minPos=min(getPosition(object)),maxPos=max(getPosition(object)))
-{
- if (class(object)!="mapFilterProbe")
- {
- stop("class of object is not mapFilterProbe. Use 'filterOverlap()' to create such an object.")
- }
- if ((length(grep("chr",chromosome))>0) | (length(grep("Chr",chromosome))>0))
- {
- stop("give only the number (or letter) in the chromosome argument.")
- }
- if (minPos > maxPos)
- {
- stop("minPos is greater than maxPos")
- }
- selChrom <- (1:length(getFilteredIndices(object)))[getChromosome(object)==paste("chr",as.character(chromosome),sep="") | getChromosome(object)==paste("Chr",as.character(chromosome),sep="")]
- selStrand <- (1:length(getFilteredIndices(object)))[getStrand(object)==strand]
- selHlp <- intersect(selChrom,selStrand)
- selPos <- (1:length(getFilteredIndices(object)))[(getPosition(object)>=minPos)&(getPosition(object)<=maxPos)]
- selectionInit <- intersect(selHlp,selPos)
- selection <- getFilteredIndices(object)[selectionInit]
- return(list(selection=selection,selectionFiltered=selectionInit))
-}
-)
-
Modified: pkg/R/show-methods.R
===================================================================
--- pkg/R/show-methods.R 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/R/show-methods.R 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,11 +1,11 @@
-setMethod("show",signature("mapFilterProbe"),function(object)
+setMethod("show",signature("MapFilterProbe"),function(object)
{
cat("Remapped and filtered probe information\n")
cat("No. of filtered probes:",length(object at filteredIndices),"\n")
}
)
-setMethod("show",signature("genomeInfo"),function(object)
+setMethod("show",signature("GenomeInfo"),function(object)
{
cat("Genome Info :\n")
cat("\tChromosome:",object at chromosome,"\n")
Modified: pkg/TODO
===================================================================
--- pkg/TODO 2012-02-17 16:31:41 UTC (rev 20)
+++ pkg/TODO 2012-03-01 07:31:57 UTC (rev 21)
@@ -1,16 +1,12 @@
-1) mail Benilton Carvalho to make available pmStrand for TilingFeatureSet
-2) split function wfm.analysis in part for fitting with normalized estimated effect functions and part for inference for specific contrasts
-3) wfm.analysis: merge arguments "method" and "design.matrix" to "design". If character then use preprogrammed code, if matrix use custom design matrix
-4) plot function: create argument contrasts to plot specific contrasts
-5) wfm.analysis,WaveTilingFeatureSet-method: check calculation of confidence intervals
-6) wfm.analysis,WaveTilingFeatureSet-method: check implementation of "two.sided" (adapt according to SAGMB paper)
-7) plotWfm,Wfm-method: introduce option to give groupnames to put on Y-axis of plot
-8) getNonAnnotatedRegions,Wfm-method: make function more generic wrt how the strands and features in the annotation file are defined
-9) getNonAnnotatedRegions,Wfm-method: include option to give max./mean expression / FC per region
-10) getNonAnnotatedRegions,Wfm-method: add option to set threshold for minimum density of probes within the regions
-11) getSigGenes,Wfm-method: add option to include thresholds (density, outliers,...)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/wavetiling -r 21
More information about the Wavetiling-commits
mailing list