[med-svn] [r-bioc-biocgenerics] 01/04: Imported Upstream version 0.18.0
Andreas Tille
tille at debian.org
Sun May 8 05:36:14 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-bioc-biocgenerics.
commit 09a6bb84d05d909a19bc5da4a936f63c54e33f07
Author: Andreas Tille <tille at debian.org>
Date: Sun May 8 07:32:07 2016 +0200
Imported Upstream version 0.18.0
---
DESCRIPTION | 6 +-
NAMESPACE | 7 +-
R/order.R | 2 +-
R/strand.R | 10 ++
R/test_BiocGenerics_package.R | 1 -
R/updateObject.R | 105 +++++++++++++++++----
R/zzz.R | 2 +-
inst/unitTests/test_updateObject.R | 28 ++++++
man/BiocGenerics-package.Rd | 4 +-
man/is.unsorted.Rd | 7 +-
man/lengths.Rd | 2 +-
man/order.Rd | 4 +-
man/rank.Rd | 2 +-
man/strand.Rd | 37 ++++++--
man/updateObject.Rd | 29 ++++--
.../{BiocGenerics_unit_tests.R => run_unitTests.R} | 0
16 files changed, 198 insertions(+), 48 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index b32c706..9c2e4ac 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,7 +1,7 @@
Package: BiocGenerics
Title: S4 generic functions for Bioconductor
Description: S4 generic functions needed by many Bioconductor packages.
-Version: 0.16.1
+Version: 0.18.0
Author: The Bioconductor Dev Team
Maintainer: Bioconductor Package Maintainer <maintainer at bioconductor.org>
biocViews: Infrastructure
@@ -21,6 +21,6 @@ Collate: S3-classes-as-S4-classes.R normarg-utils.R replaceSlots.R
weights.R xtabs.R clusterApply.R annotation.R combine.R
dbconn.R dge.R fileName.R normalize.R organism_species.R
plotMA.R plotPCA.R score.R strand.R updateObject.R
- testPackage.R test_BiocGenerics_package.R zzz.R
+ testPackage.R zzz.R
NeedsCompilation: no
-Packaged: 2015-11-06 03:02:04 UTC; biocbuild
+Packaged: 2016-05-04 04:18:48 UTC; biocbuild
diff --git a/NAMESPACE b/NAMESPACE
index 4584ade..ce36595 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -204,7 +204,7 @@ export(
score, "score<-",
## from R/strand.R:
- strand, "strand<-",
+ strand, "strand<-", invertStrand,
## from R/updateObject.R:
updateObject,
@@ -229,7 +229,10 @@ exportMethods(
estimateDispersions,
plotDispEsts,
plotMA,
- plotPCA
+ plotPCA,
+
+ ## from R/strand.R:
+ invertStrand
)
diff --git a/R/order.R b/R/order.R
index e2bf23b..6581b8f 100644
--- a/R/order.R
+++ b/R/order.R
@@ -3,7 +3,7 @@
### -------------------------------------------------------------------------
###
### Need to explicitly define this generic otherwise the implicit generic in
-### package "base" would dispatch on ('na.last', 'decreasing').
+### package "base" would dispatch on ('na.last', 'decreasing', 'method').
###
### Note that dispatching on '...' is supported starting with R 2.8.0 only.
diff --git a/R/strand.R b/R/strand.R
index 06517c9..99e4ef6 100644
--- a/R/strand.R
+++ b/R/strand.R
@@ -12,3 +12,13 @@ unstrand <- function(x)
x
}
+setGeneric("invertStrand", function(x) standardGeneric("invertStrand"))
+
+setMethod("invertStrand", "ANY",
+ function(x)
+ {
+ strand(x) <- invertStrand(strand(x))
+ x
+ }
+)
+
diff --git a/R/test_BiocGenerics_package.R b/R/test_BiocGenerics_package.R
deleted file mode 100644
index a71263d..0000000
--- a/R/test_BiocGenerics_package.R
+++ /dev/null
@@ -1 +0,0 @@
-.test <- function() testPackage("BiocGenerics")
diff --git a/R/updateObject.R b/R/updateObject.R
index 9e36f64..7356cfe 100644
--- a/R/updateObject.R
+++ b/R/updateObject.R
@@ -11,6 +11,15 @@
### Utilities.
###
+updateObjectFrom_errf <- function(..., verbose=FALSE) {
+ function(err) {
+ if (verbose)
+ message(..., ":\n ", conditionMessage(err),
+ "\n trying next method...")
+ NULL
+ }
+}
+
getObjectSlots <- function(object) # object, rather than class defn, slots
{
if (!is.object(object) || isVirtualClass(class(object)))
@@ -45,15 +54,6 @@ updateObjectFromSlots <- function(object, objclass=class(object),
"returning original object")
return(object)
}
- errf <- function(...)
- {
- function(err) {
- if (verbose)
- message(..., ":\n ", conditionMessage(err),
- "\n trying next method...")
- NULL
- }
- }
if (verbose)
message("updateObjectFromSlots(object = '", class(object),
"' class = '", objclass, "')")
@@ -68,9 +68,9 @@ updateObjectFromSlots <- function(object, objclass=class(object),
updateObject, ..., verbose=verbose)
toDrop <- which(!names(objectSlots) %in% classSlots)
if (length(toDrop) > 0L) {
- warning("dropping slot(s) ",
- paste(names(objectSlots)[toDrop],collapse=", "),
- " from object = '", class(object), "'")
+ warning("dropping slot(s) '",
+ paste(names(objectSlots)[toDrop], collapse="', '"),
+ "' from object = '", class(object), "'")
objectSlots <- objectSlots[-toDrop]
}
## ad-hoc methods for creating new instances
@@ -80,8 +80,9 @@ updateObjectFromSlots <- function(object, objclass=class(object),
message("heuristic updateObjectFromSlots, method 1")
res <- tryCatch({
do.call(new, c(objclass, objectSlots[joint]))
- }, error=errf("'new(\"", objclass,
- "\", ...)' from slots failed"))
+ }, error=updateObjectFrom_errf(
+ "'new(\"", objclass, "\", ...)' from slots failed",
+ verbose=verbose))
}
if (is.null(res)) {
if (verbose)
@@ -92,8 +93,9 @@ updateObjectFromSlots <- function(object, objclass=class(object),
slot(obj, slt) <- updateObject(objectSlots[[slt]],
..., verbose=verbose)
obj
- }, error=errf("failed to add slots to 'new(\"", objclass,
- "\", ...)'"))
+ }, error=updateObjectFrom_errf(
+ "failed to add slots to 'new(\"", objclass, "\", ...)'",
+ verbose=verbose))
}
if (is.null(res))
stop("could not updateObject to class '", objclass, "'",
@@ -102,6 +104,60 @@ updateObjectFromSlots <- function(object, objclass=class(object),
res
}
+getObjectFields <- function(object)
+{
+ value <- object$.refClassDef at fieldClasses
+ for (field in names(value))
+ value[[field]] <- object$field(field)
+ value
+}
+
+updateObjectFromFields <-
+ function(object, objclass=class(object), ..., verbose=FALSE)
+{
+ if (verbose)
+ message("updateObjectFromFields(object = '", class(object),
+ "' objclass = '", objclass, "')")
+
+ classFields <- names(getRefClass(objclass)$fields())
+ if (is.null(classFields)) {
+ if (verbose)
+ message("definition of '", objclass, "' has no fields; ",
+ "regurning original object")
+ return(object)
+ }
+
+ objectFields <- getObjectFields(object)
+
+ toUpdate <- joint <- intersect(names(objectFields), classFields)
+ objectFields[toUpdate] <-
+ lapply(objectFields[toUpdate], updateObject, ..., verbose=verbose)
+ toDrop <- which(!names(objectFields) %in% classFields)
+ if (length(toDrop) > 0L) {
+ warning("dropping fields(s) '",
+ paste(names(objectFields)[toDrop], collapse="', '"),
+ "' from object = '", class(object), "'")
+ objectFields <- objectFields[-toDrop]
+ }
+
+ ## ad-hoc methods for creating new instances
+
+ if (verbose)
+ message("heuristic updateObjectFromFields, method 1")
+ res <- tryCatch({
+ do.call(new, c(objclass, objectFields[joint]))
+ }, error = updateObjectFrom_errf(
+ "'new(\"", objclass, "\", ...' from slots failed",
+ verbose=verbose)
+ )
+
+ if (is.null(res))
+ stop("could not updateObject to class '", objclass, "'",
+ "\nconsider defining an 'updateObject' method for class '",
+ class(object), "'")
+ res
+}
+
### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### updateObject()
@@ -180,3 +236,20 @@ setMethod("updateObject", "environment",
}
)
+setMethod("updateObject", "formula",
+ function(object, ..., verbose=FALSE)
+{
+ if (verbose)
+ ## object at .Environment could be too general, e.g,. R_GlobalEnv
+ message("updateObject(object = 'formula'); ignoring .Environment")
+ object
+})
+
+setMethod("updateObject", "envRefClass",
+ function(object, ..., verbose=FALSE)
+{
+ msg <- sprintf("updateObject(object= '%s')", class(object))
+ if (verbose)
+ message(msg)
+ updateObjectFromFields(object, ..., verbose=verbose)
+})
diff --git a/R/zzz.R b/R/zzz.R
index b40e1c1..0b8695b 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -1,2 +1,2 @@
-###
+.test <- function() testPackage("BiocGenerics")
diff --git a/inst/unitTests/test_updateObject.R b/inst/unitTests/test_updateObject.R
index d70fdd6..365ca34 100644
--- a/inst/unitTests/test_updateObject.R
+++ b/inst/unitTests/test_updateObject.R
@@ -91,3 +91,31 @@ test_updateObject_setClass <- function()
removeClass("A", where=.GlobalEnv)
}
+test_updateObject_refClass <- function()
+{
+ cls <- ".__test_updateObject_refClassA"
+ .A <- setRefClass(cls, fields=list(x="numeric", y="numeric"),
+ where=.GlobalEnv)
+
+ a <- .A()
+ checkTrue(all.equal(a, updateObject(a)))
+
+ a <- .A(x=1:5, y=5:1)
+ checkTrue(all.equal(a, updateObject(a)))
+
+ .A <- setRefClass(cls, fields=list(x="numeric", y="numeric", z="numeric"),
+ where=.GlobalEnv)
+ checkTrue(all.equal(.A(x=1:5, y=5:1, z=numeric()), updateObject(a)))
+
+ .A <- setRefClass(cls, fields=list(x="numeric"))
+ warn <- FALSE
+ value <- withCallingHandlers(updateObject(a), warning=function(w) {
+ txt <- "dropping fields(s) 'y' from object = '.__test_updateObject_refClassA'"
+ warn <<- identical(txt, conditionMessage(w))
+ invokeRestart("muffleWarning")
+ })
+ checkTrue(warn)
+ checkTrue(all.equal(.A(x=1:5), value))
+
+ removeClass(cls, where=.GlobalEnv)
+}
diff --git a/man/BiocGenerics-package.Rd b/man/BiocGenerics-package.Rd
index 4e28266..2ce028f 100644
--- a/man/BiocGenerics-package.Rd
+++ b/man/BiocGenerics-package.Rd
@@ -172,13 +172,15 @@
\code{\link[BiocGenerics]{species<-}}
\item \code{\link[BiocGenerics]{plotMA}}
+
\item \code{\link[BiocGenerics]{plotPCA}}
\item \code{\link[BiocGenerics]{score}},
\code{\link[BiocGenerics]{score<-}}
\item \code{\link[BiocGenerics]{strand}},
- \code{\link[BiocGenerics]{strand<-}}
+ \code{\link[BiocGenerics]{strand<-}},
+ \code{\link[BiocGenerics]{invertStrand}}
\item \code{\link[BiocGenerics]{updateObject}}
}
diff --git a/man/is.unsorted.Rd b/man/is.unsorted.Rd
index b9b4dc4..0291a1e 100644
--- a/man/is.unsorted.Rd
+++ b/man/is.unsorted.Rd
@@ -63,9 +63,10 @@ is.unsorted(x, na.rm=FALSE, strictly=FALSE, ...)
\item \code{\link[methods]{selectMethod}} for getting the definition of
a specific method.
- \item \link[S4Vectors]{is.unsorted,Rle-method} in the \pkg{S4Vectors}
- package for an example of a specific \code{is.unsorted} method
- (defined for \link[S4Vectors]{Rle} objects).
+ \item \link[GenomicRanges]{is.unsorted,GenomicRanges-method} in
+ the \pkg{GenomicRanges} package for an example of a specific
+ \code{is.unsorted} method (defined for
+ \link[GenomicRanges]{GenomicRanges} objects).
\item \link{BiocGenerics} for a summary of all the generics defined
in the \pkg{BiocGenerics} package.
diff --git a/man/lengths.Rd b/man/lengths.Rd
index 06c0a0b..3fe45a3 100644
--- a/man/lengths.Rd
+++ b/man/lengths.Rd
@@ -42,7 +42,7 @@ lengths(x, use.names=TRUE)
IMPORTANT: The default method (\code{base::\link[base]{lengths}})
is equivalent to \code{sapply(x, length)}. However, because the
\code{lengths} method for \link[S4Vectors]{Vector} objects is currently
- defined as an alias for \code{S4Vectors::\link[S4Vectors]{elementLengths}},
+ defined as an alias for \code{S4Vectors::\link[S4Vectors]{elementNROWS}},
it's equivalent to \code{sapply(x, NROW)}, not to \code{sapply(x, length)}.
This makes a difference if \code{x} has array-like list elements.
diff --git a/man/order.Rd b/man/order.Rd
index fdfc50b..d931df4 100644
--- a/man/order.Rd
+++ b/man/order.Rd
@@ -18,14 +18,14 @@
}
\usage{
-order(..., na.last=TRUE, decreasing=FALSE)
+order(..., na.last=TRUE, decreasing=FALSE, method=c("shell", "radix"))
}
\arguments{
\item{...}{
One or more vector-like objects, all of the same length.
}
- \item{na.last, decreasing}{
+ \item{na.last, decreasing, method}{
See \code{?base::\link[base]{order}} for a description of
these arguments.
}
diff --git a/man/rank.Rd b/man/rank.Rd
index b1bb4bd..e20574a 100644
--- a/man/rank.Rd
+++ b/man/rank.Rd
@@ -18,7 +18,7 @@
\usage{
rank(x, na.last=TRUE,
- ties.method=c("average", "first", "random", "max", "min"))
+ ties.method=c("average", "first", "last", "random", "max", "min"))
}
\arguments{
diff --git a/man/strand.Rd b/man/strand.Rd
index 937bf06..9429fbc 100644
--- a/man/strand.Rd
+++ b/man/strand.Rd
@@ -3,6 +3,8 @@
\alias{strand}
\alias{strand<-}
\alias{unstrand}
+\alias{invertStrand}
+\alias{invertStrand,ANY-method}
\title{Accessing strand information}
@@ -13,7 +15,11 @@
\usage{
strand(x, ...)
strand(x, ...) <- value
+
unstrand(x)
+
+invertStrand(x)
+\S4method{invertStrand}{ANY}(x)
}
\arguments{
@@ -35,17 +41,30 @@ unstrand(x)
\code{*} is used when the exact strand of the location is unknown,
or irrelevant, or when the "feature" at that location belongs to
both strands.
-}
-\note{
- \code{unstrand} is not a generic function, just a convenience wrapper to
- the generic strand setter (\code{strand<-}) that simply does:
-\preformatted{
- strand(x) <- "*"
+ Note that \code{unstrand} is not a generic function, just a convenience
+ wrapper to the generic strand setter (\code{strand<-}) that does:
+\preformatted{ strand(x) <- "*"
+ x
+}
+ The default method for \code{invertStrand} does:
+\preformatted{ strand(x) <- invertStrand(strand(x))
x
}
}
+\value{
+ If \code{x} is a vector-like object, \code{strand(x)} will typically
+ return a vector-like object \emph{parallel} to \code{x}, that is, an
+ object of the same length as \code{x} where the i-th element describes
+ the strand of the i-th element in \code{x}.
+
+ \code{unstrand(x)} and \code{invertStrand(x)} return a copy of \code{x}
+ with the strand set to \code{"*"} for \code{unstrand} or inverted for
+ \code{invertStrand} (i.e. \code{"+"} and \code{"-"} switched, and
+ \code{"*"} untouched).
+}
+
\seealso{
\itemize{
\item \code{\link[methods]{showMethods}} for displaying a summary of the
@@ -71,6 +90,12 @@ showMethods("strand")
`strand<-`
showMethods("strand<-")
+unstrand
+
+invertStrand
+showMethods("invertStrand")
+selectMethod("invertStrand", "ANY") # the default method
+
library(GenomicRanges)
showMethods("strand")
diff --git a/man/updateObject.Rd b/man/updateObject.Rd
index 27c7e18..5a8b3bb 100644
--- a/man/updateObject.Rd
+++ b/man/updateObject.Rd
@@ -4,6 +4,8 @@
\alias{updateObject,ANY-method}
\alias{updateObject,list-method}
\alias{updateObject,environment-method}
+\alias{updateObject,formula-method}
+\alias{updateObject,envRefClass-method}
\alias{updateObjectFromSlots}
\alias{getObjectSlots}
@@ -77,18 +79,25 @@ getObjectSlots(object)
Visit each element in \code{environment}, applying
\code{updateObject(environment[[elt]], \dots, verbose=verbose)}
}
+ \item{\code{updateObject(formula, \dots, verbose=FALSE)}}{
+ Do nothing; the environment of the formula may be too general
+ (e.g., \code{R_GlobalEnv}) to attempt an update.
+ }
+ \item{\code{updateObject(envRefClass, \dots, verbose=FALSE)}}{
+ Attempt to update objects from fields using a strategy like
+ \code{updateObjectFromSlots} Method 1.
+ }
}
- \code{updateObjectFromSlots(object, objclass=class(object),
- \dots, verbose=FALSE)}
- is a utility function that identifies the intersection of slots defined
- in the \code{object} instance and \code{objclass} definition. The
- corresponding elements in \code{object} are then updated (with
- \code{updateObject(elt, \dots, verbose=verbose)}) and used as arguments to
- a call to \code{new(class, \dots)}, with \code{\dots} replaced by slots
- from the original object. If this fails, \code{updateObjectFromSlots}
- then tries \code{new(class)} and assigns slots of \code{object} to
- the newly created instance.
+ \code{updateObjectFromSlots(object, objclass=class(object), \dots,
+ verbose=FALSE)} is a utility function that identifies the intersection
+ of slots defined in the \code{object} instance and \code{objclass}
+ definition. Under Method 1, the corresponding elements in
+ \code{object} are then updated (with \code{updateObject(elt, \dots,
+ verbose=verbose)}) and used as arguments to a call to \code{new(class,
+ \dots)}, with \code{\dots} replaced by slots from the original
+ object. If this fails, then Method 2 tries \code{new(class)} and
+ assigns slots of \code{object} to the newly created instance.
\code{getObjectSlots(object)} extracts the slot names and contents from
\code{object}. This is useful when \code{object} was created by a class
diff --git a/tests/BiocGenerics_unit_tests.R b/tests/run_unitTests.R
similarity index 100%
rename from tests/BiocGenerics_unit_tests.R
rename to tests/run_unitTests.R
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-bioc-biocgenerics.git
More information about the debian-med-commit
mailing list