R.methodsS3/0000755000176200001440000000000013721505666012336 5ustar liggesusersR.methodsS3/NAMESPACE0000644000176200001440000000323513621443352013550 0ustar liggesusers# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # IMPORTS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - importFrom("utils", "capture.output") importFrom("utils", "getAnywhere") importFrom("utils", "getS3method") importFrom("utils", "head") importFrom("utils", "file_test") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # EXPORTS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Export all public methods, that is, those without a preceeding dot # in their names. ##exportPattern("^[^\\.]") export("appendVarArgs") ##export("export") ##export("export<-") export("findDispatchMethodsS3") export("getDispatchMethodS3") export("getGenericS3") export("getMethodS3") export("hasVarArgs") export("isGenericS3") export("isGenericS4") ##export("noexport") ##export("S3class<-") export("setGenericS3") export("setMethodS3") export("throw") export("pkgStartupMessage") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # DECLARATIONS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # default S3method("getGenericS3", "default") S3method("getMethodS3", "default") S3method("isGenericS3", "default") S3method("isGenericS4", "default") S3method("pkgStartupMessage", "default") S3method("setGenericS3", "default") S3method("setMethodS3", "default") S3method("throw", "default") ##export("startupMessage") ##S3method("startupMessage", "default") S3method("findDispatchMethodsS3", "default") ## private; drop? S3method("getDispatchMethodS3", "default") ## private; drop? # function S3method("appendVarArgs", "function") S3method("hasVarArgs", "function") R.methodsS3/man/0000755000176200001440000000000013621443360013100 5ustar liggesusersR.methodsS3/man/getMethodS3.Rd0000644000176200001440000000174513720750646015534 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getMethodS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getMethodS3} \alias{getMethodS3.default} \alias{getMethodS3} \title{Gets an S3 method} \description{ Gets an S3 method. } \usage{ \method{getMethodS3}{default}(name, class="default", envir=parent.frame(), ...) } \arguments{ \item{name}{The name of the method.} \item{class}{The class of the method.} \item{envir}{The \code{\link[base]{environment}} from which the search for the S3 method is done.} \item{...}{Not used.} } \seealso{ This is just a conveniency wrapper around \code{\link[utils]{getS3method}} that have arguments consistent with \code{\link{setMethodS3}}(). \code{\link{getGenericS3}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} R.methodsS3/man/findDispatchMethodsS3.Rd0000644000176200001440000000240213720750646017527 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % findDispatchMethodsS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{findDispatchMethodsS3} \alias{findDispatchMethodsS3.default} \alias{findDispatchMethodsS3} \title{Finds the S3 methods that a generic function would call} \description{ Finds the S3 methods that a generic function would call, ordered according to an S3 \code{\link[base]{class}}() \code{\link[base]{vector}}. } \usage{ \method{findDispatchMethodsS3}{default}(methodName, classNames, firstOnly=FALSE, ...) } \arguments{ \item{methodName}{A \code{\link[base]{character}} string specifying the name of a generic function.} \item{classNames}{A \code{\link[base]{character}} \code{\link[base]{vector}} of \code{\link[base]{class}}() names.} \item{firstOnly}{If \code{\link[base:logical]{TRUE}}, only the first method is returned.} \item{...}{Not used.} } \value{ Returns a names \code{\link[base]{list}} structure. } \seealso{ \code{\link{getDispatchMethodS3}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} \keyword{internal} R.methodsS3/man/getDispatchMethodS3.Rd0000644000176200001440000000223113720750646017203 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getDispatchMethodS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getDispatchMethodS3} \alias{getDispatchMethodS3.default} \alias{getDispatchMethodS3} \title{Gets the S3 method that a generic function would call} \description{ Gets the S3 method that a generic function would call according to an S3 \code{\link[base]{class}}() \code{\link[base]{vector}}. } \usage{ \method{getDispatchMethodS3}{default}(methodName, classNames, ...) } \arguments{ \item{methodName}{A \code{\link[base]{character}} string specifying the name of a generic function.} \item{classNames}{A \code{\link[base]{character}} \code{\link[base]{vector}} of \code{\link[base]{class}}() names.} \item{...}{Not used.} } \value{ Returns a \code{\link[base]{function}}, or throws an exception if not found. } \seealso{ \code{\link{findDispatchMethodsS3}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} \keyword{internal} R.methodsS3/man/throw.Rd0000644000176200001440000000250613720750646014545 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % throw.default.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{throw} \alias{throw.default} \alias{throw} \title{Throws an exception} \description{ Throws an exception by calling stop(). Note that \code{throw()} can be defined for specific classes, which can then be caught (or not) using \code{\link[base:conditions]{tryCatch}}(). \emph{This default function will be overridden by ditto in the \pkg{R.oo} package, if that is loaded. The latter \code{\link[R.oo]{throw}} implementation is fully backward compatible with this one, but the error object thrown is of class \code{\link[R.oo]{Exception}}.} } \usage{ \method{throw}{default}(...) } \arguments{ \item{...}{One or several strings that are concatenated and collapsed into on message string.} } \value{ Returns nothing. } \examples{ rbern <- function(n=1, prob=1/2) { if (prob < 0 || prob > 1) throw("Argument 'prob' is out of range: ", prob) rbinom(n=n, size=1, prob=prob) } rbern(10, 0.4) # [1] 0 1 0 0 0 1 0 0 1 0 tryCatch({ rbern(10, 10*0.4) }, error=function(ex) {}) } \author{Henrik Bengtsson} \keyword{error} R.methodsS3/man/R.methodsS3-package.Rd0000644000176200001440000000501313720750646017040 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 999.package.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{R.methodsS3-package} \alias{R.methodsS3-package} \alias{R.methodsS3} \docType{package} \title{Package R.methodsS3} \description{ Methods that simplify the setup of S3 generic functions and S3 methods. Major effort has been made in making definition of methods as simple as possible with a minimum of maintenance for package developers. For example, generic functions are created automatically, if missing, and naming conflict are automatically solved, if possible. The method setMethodS3() is a good start for those who in the future may want to migrate to S4. This is a cross-platform package implemented in pure R that generates standard S3 methods. This contents of this package was extracted from the \pkg{R.oo} package [1]. } \section{Installation and updates}{ To install this package do\cr \code{install.packages("R.methodsS3")} To get the "devel" version, see \url{https://github.com/HenrikBengtsson/R.methodsS3/}. } \section{Dependencies and other requirements}{ This package only requires a standard \R installation. } \section{To get started}{ To get started, see: \enumerate{ \item \code{\link{setMethodS3}}() - Simple and safe creation of S3 methods and, whenever needed, automatic creation of S3 generic function. } } \section{Further readings}{ For a detailed introduction to the package, see [1]. } \section{How to cite this package}{ Whenever using this package, please cite [1] as\cr \preformatted{ Bengtsson, H. The R.oo package - Object-Oriented Programming with References Using Standard R Code, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ISSN 1609-395X, Hornik, K.; Leisch, F. & Zeileis, A. (ed.), 2003 } \emph{} } \author{Henrik Bengtsson} \section{License}{ The releases of this package is licensed under LGPL version 2.1 or newer. } \references{ [1] H. Bengtsson, \emph{The R.oo package - Object-Oriented Programming with References Using Standard R Code}, In Kurt Hornik, Friedrich Leisch and Achim Zeileis, editors, Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), March 20-22, Vienna, Austria. \url{https://www.r-project.org/conferences/DSC-2003/Proceedings/} \cr } \keyword{package} R.methodsS3/man/getGenericS3.Rd0000644000176200001440000000203613720750646015662 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % getGenericS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{getGenericS3} \alias{getGenericS3.default} \alias{getGenericS3} \title{Gets an S3 generic function} \description{ Gets an S3 generic function. } \usage{ \method{getGenericS3}{default}(name, envir=parent.frame(), inherits=TRUE, ...) } \arguments{ \item{name}{The name of the generic function.} \item{envir}{The \code{\link[base]{environment}} from which the search for the generic \code{\link[base]{function}} is done.} \item{inherits}{A \code{\link[base]{logical}} specifying whether the enclosing frames should be searched or not.} \item{...}{Not used.} } \seealso{ \code{\link{setGenericS3}}(). \code{\link{getMethodS3}}(). \code{\link{isGenericS3}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} R.methodsS3/man/isGenericS4.Rd0000644000176200001440000000204213720750646015514 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isGenericS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isGenericS4} \alias{isGenericS4.default} \alias{isGenericS4} \title{Checks if a function is a S4 generic function} \description{ Checks if a function is a S4 generic function. } \usage{ \method{isGenericS4}{default}(fcn, envir=parent.frame(), ...) } \arguments{ \item{fcn}{A \code{\link[base]{function}} or a \code{\link[base]{character}} string.} \item{...}{Not used.} } \details{ A function is considered to be a generic S4 function if its body, that is the source code, contains the regular pattern \code{"standardGeneric"}. } \value{ Returns \code{\link[base:logical]{TRUE}} if a generic S4 function, otherwise \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} \keyword{internal} R.methodsS3/man/isGenericS3.Rd0000644000176200001440000000234313720750646015517 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % isGenericS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{isGenericS3} \alias{isGenericS3.default} \alias{isGenericS3} \title{Checks if a function is a S3 generic function} \description{ Checks if a function is a S3 generic function. } \usage{ \method{isGenericS3}{default}(fcn, envir=parent.frame(), ...) } \arguments{ \item{fcn}{A \code{\link[base]{function}} or a \code{\link[base]{character}} string.} \item{envir}{If argument \code{fcn} is a \code{\link[base]{character}}, this is the \code{\link[base]{environment}} from which the search for the \code{\link[base]{function}} is done.} \item{...}{Not used.} } \details{ A function is considered to be a generic S3/UseMethod function if its name matches one of the known S3 generic functions, or if it calls \code{UseMethod()}. } \value{ Returns \code{\link[base:logical]{TRUE}} if a generic S3/UseMethod function, otherwise \code{\link[base:logical]{FALSE}}. } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} R.methodsS3/man/setMethodS3.Rd0000644000176200001440000001217713720750646015551 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 030.setMethodS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setMethodS3} \alias{setMethodS3.default} \alias{setMethodS3} \title{Creates an S3 method} \description{ Creates an S3 method. A function with name \code{.} will be set to \code{definition}. The method will get the modifiers specified by \code{modifiers}. If there exists no generic function for this method, it will be created automatically. } \usage{ \method{setMethodS3}{default}(name, class="default", definition, private=FALSE, protected=FALSE, export=FALSE, static=FALSE, abstract=FALSE, trial=FALSE, deprecated=FALSE, envir=parent.frame(), overwrite=TRUE, conflict=c("warning", "error", "quiet"), createGeneric=TRUE, exportGeneric=TRUE, appendVarArgs=TRUE, validators=getOption("R.methodsS3:validators:setMethodS3"), ...) } \arguments{ \item{name}{The name of the method.} \item{class}{The class for which the method should be defined. If \code{class == "default"} a function with name \code{.default} will be created.} \item{definition}{The method definition.} \item{private, protected}{If \code{private=TRUE}, the method is declared private. If \code{protected=TRUE}, the method is declared protected. In all other cases the method is declared public.} \item{export}{A \code{\link[base]{logical}} setting attribute \code{"export"}.} \item{static}{If \code{\link[base:logical]{TRUE}} this method is defined to be static, otherwise not. Currently this has no effect expect as an indicator.} \item{abstract}{If \code{\link[base:logical]{TRUE}} this method is defined to be abstract, otherwise not. Currently this has no effect expect as an indicator.} \item{trial}{If \code{\link[base:logical]{TRUE}} this method is defined to be a trial method, otherwise not. A trial method is a method that is introduced to be tried out and it might be modified, replaced or even removed in a future release. Some people prefer to call trial versions, beta version. Currently this has no effect expect as an indicator.} \item{deprecated}{If \code{\link[base:logical]{TRUE}} this method is defined to be deprecated, otherwise not. Currently this has no effect expect as an indicator.} \item{envir}{The environment for where this method should be stored.} \item{overwrite}{If \code{\link[base:logical]{TRUE}} an already existing method with the same name (and of the same class) will be overwritten, otherwise not.} \item{conflict}{If a method already exists with the same name (and of the same class), different actions can be taken. If \code{"error"}, an exception will be thrown and the method will not be created. If \code{"warning"}, a \code{\link[base]{warning}} will be given and the method \emph{will} be created, otherwise the conflict will be passed unnoticed.} \item{createGeneric, exportGeneric}{If \code{createGeneric=TRUE}, a generic S3/UseMethod function is defined for this method, iff missing, and \code{exportGeneric} species attribute \code{"export"} of it.} \item{appendVarArgs}{If \code{\link[base:logical]{TRUE}}, argument \code{...} is added with a warning, if missing. For special methods such as \code{$} and \code{[[}, this is never done (argument is ignored). This will increase the chances that the method is consistent with a generic function with many arguments and/or argument \code{...}.} \item{validators}{An optional \code{\link[base]{list}} of \code{\link[base]{function}}s that can be used to assert that the generated method meets certain criteria.} \item{...}{Passed to \code{\link{setGenericS3}}(), iff called.} } \examples{ ###################################################################### # Example 1 ###################################################################### setMethodS3("foo", "default", function(x, ...) { cat("In default foo():\n"); print(x, ...); }) setMethodS3("foo", "character", function(s, ...) { cat("In foo() for class 'character':\n"); print(s, ...); }) # The generic function is automatically created! print(foo) foo(123) foo("123") ###################################################################### # Example 2 # # Assume that in a loaded package there is already a function bar(), # but you also want to use the name 'bar' for the character string. # It may even be the case that you do not know of the other package, # but your users do! ###################################################################### # bar() in other package bar <- function(x, y, ...) { cat("In bar() of 'other' package.\n"); } # Your definition; will redefine bar() above to bar.default(). setMethodS3("bar", "character", function(object, ...) { cat("In bar() for class 'character':\n"); print(object, ...); }) bar(123) bar("123") } \seealso{ For more information about S3, see \code{\link[base]{UseMethod}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} R.methodsS3/man/R.KEYWORDS.Rd0000644000176200001440000000140413720750646015045 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 001.R.KEYWORDS.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{R.KEYWORDS} \alias{R.KEYWORDS} \title{Reserved words in R not to be used for object names} \description{ Reserved words in R not to be used for object names. \code{R.KEYWORDS} is a \code{\link[base]{character}} \code{\link[base]{vector}} of all reserved words in \R according to [1]. } \author{Henrik Bengtsson} \references{ [1] Section "Reserved words", R Language Definition, version 2.6.0 (2007-09-14) DRAFT. } \keyword{programming} \keyword{internal} R.methodsS3/man/pkgStartupMessage.Rd0000644000176200001440000000232613720750646017053 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % pkgStartupMessage.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{pkgStartupMessage} \alias{pkgStartupMessage.default} \alias{pkgStartupMessage} \title{Generates a (package) startup message} \description{ Generates a (package) startup message. Contrary to \code{\link[base]{packageStartupMessage}}(), this method does \emph{not} output a message when \code{library()/require()} is called with argument \code{quietly=TRUE}. } \usage{ \method{pkgStartupMessage}{default}(..., quietly=NA) } \arguments{ \item{...}{Arguments passed to \code{\link[base]{packageStartupMessage}}().} \item{quietly}{If \code{\link[base:logical]{FALSE}}, the message is outputted, otherwise not. If \code{\link[base]{NA}}, the message is \emph{not} outputted if \code{\link[base]{library}}() (or \code{require()}) was called with argument \code{quietly=TRUE}.} } \value{ Returns nothing. } \author{Henrik Bengtsson} \seealso{ \code{\link[base]{packageStartupMessage}}(). } \keyword{internal} R.methodsS3/man/setGenericS3.Rd0000644000176200001440000000450613720750646015702 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 010.setGenericS3.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{setGenericS3} \alias{setGenericS3.default} \alias{setGenericS3} \title{Creates an S3 generic function} \description{ \emph{Note that this method is a internal method called by \code{\link{setMethodS3}}() and there is no reason for calling it directly!}\cr Creates a generic function in S3 style, i.e. setting a function with name \code{name} that dispatches the method \code{name} via \code{UseMethod}. If there is already a function named \code{name} that function is renamed to \code{name.default}. } \usage{ \method{setGenericS3}{default}(name, export=TRUE, envir=parent.frame(), dontWarn=getOption("dontWarnPkgs"), validators=getOption("R.methodsS3:validators:setGenericS3"), overwrite=FALSE, ...) } \arguments{ \item{name}{The name of the generic function.} \item{export}{A \code{\link[base]{logical}} setting attribute \code{"export"}.} \item{envir}{The environment for where this method should be stored.} \item{dontWarn}{If a non-generic method with the same name is found it will be "renamed" to a default method. If that method is found in a package with a name that is \emph{not} found in \code{dontWarn} a warning will be produced, otherwise it will be renamed silently.} \item{validators}{An optional \code{\link[base]{list}} of \code{\link[base]{function}}s that can be used to assert that the generated generic function meets certain criteria.} \item{...}{Not used.} \item{overwrite}{If \code{\link[base:logical]{TRUE}} an already existing generic function with the same name will be overwritten, otherwise not.} } \examples{ myCat.matrix <- function(..., sep=", ") { cat("A matrix:\n") cat(..., sep=sep) cat("\n") } myCat.default <- function(..., sep=", ") { cat(..., sep=sep) cat("\n") } setGenericS3("myCat") myCat(1:10) mat <- matrix(1:10, ncol=5) myCat(mat) } \seealso{ To define a method for a class see \code{\link{setMethodS3}}(). For more information about S3, see \code{\link[base]{UseMethod}}(). } \author{Henrik Bengtsson} \keyword{programming} \keyword{methods} R.methodsS3/man/Non-documented_objects.Rd0000644000176200001440000000220613720750646017767 0ustar liggesusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Do not modify this file since it was automatically generated from: % % 999.NonDocumentedObjects.R % % by the Rdoc compiler part of the R.oo package. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \name{Non-documented objects} \alias{Non-documented objects} \title{Non-documented objects} % Utility functions \alias{appendVarArgs} \alias{appendVarArgs.function} \alias{hasVarArgs} \alias{hasVarArgs.function} % Basic validators \alias{rccValidateFunctionName} \alias{rccValidateSetGenericS3} \alias{rccValidateSetMethodS3} \description{ This page contains aliases for all "non-documented" objects that \code{R CMD check} detects in this package. Almost all of them are \emph{generic} functions that have specific document for the corresponding method coupled to a specific class. Other functions are re-defined by \code{setMethodS3()} to \emph{default} methods. Neither of these two classes are non-documented in reality. The rest are deprecated methods. } \author{Henrik Bengtsson} \keyword{documentation} \keyword{internal} R.methodsS3/DESCRIPTION0000644000176200001440000000222313721505666014043 0ustar liggesusersPackage: R.methodsS3 Version: 1.8.1 Depends: R (>= 2.13.0) Imports: utils Suggests: codetools Title: S3 Methods Simplified Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), email = "henrikb@braju.com")) Author: Henrik Bengtsson [aut, cre, cph] Maintainer: Henrik Bengtsson Description: Methods that simplify the setup of S3 generic functions and S3 methods. Major effort has been made in making definition of methods as simple as possible with a minimum of maintenance for package developers. For example, generic functions are created automatically, if missing, and naming conflict are automatically solved, if possible. The method setMethodS3() is a good start for those who in the future may want to migrate to S4. This is a cross-platform package implemented in pure R that generates standard S3 methods. License: LGPL (>= 2.1) LazyLoad: TRUE URL: https://github.com/HenrikBengtsson/R.methodsS3 BugReports: https://github.com/HenrikBengtsson/R.methodsS3/issues NeedsCompilation: no Packaged: 2020-08-24 14:42:23 UTC; hb Repository: CRAN Date/Publication: 2020-08-26 16:20:06 UTC R.methodsS3/tests/0000755000176200001440000000000013621443352013470 5ustar liggesusersR.methodsS3/tests/getDispatchMethodS3.R0000644000176200001440000000044513346115017017422 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: getDispatchMethodS3()...") fcn <- getDispatchMethodS3("print", "default") print(fcn) tryCatch({ fcn <- getDispatchMethodS3("print", "unknown") print(fcn) }, error = function(ex) { print(ex) }) message("TESTING: getDispatchMethodS3()...DONE") R.methodsS3/tests/findDispatchMethodsS3.R0000644000176200001440000000047713346115017017753 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: findDispatchMethodS3()...") ## Odds and ends # Trying to retrieve base::.Options, but should be # detected as a non-function and return an empty result fcn <- findDispatchMethodsS3("", "Options") stopifnot(length(fcn) == 0L) message("TESTING: findDispatchMethodS3()...DONE") R.methodsS3/tests/throw.R0000644000176200001440000000054313346115017014756 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: throw()...") rbern <- function(n=1, prob=1/2) { if (prob < 0 || prob > 1) throw("Argument 'prob' is out of range: ", prob) rbinom(n=n, size=1, prob=prob) } rbern(10, 0.4) # [1] 0 1 0 0 0 1 0 0 1 0 tryCatch({ rbern(10, 10*0.4) }, error=function(ex) { print(ex) }) message("TESTING: throw()...DONE") R.methodsS3/tests/setGenericS3.R0000644000176200001440000000145313621443352016114 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: setGenericS3()...") myCat.matrix <- function(..., sep=", ") { cat("A matrix:\n") cat(..., sep=sep) cat("\n") } myCat.default <- function(..., sep=", ") { cat(..., sep=sep) cat("\n") } setGenericS3("myCat") myCat(1:10) mat <- matrix(1:10, ncol=5) myCat(mat) setGenericS3("foo", validators=list(R.methodsS3:::rccValidateSetGenericS3)) setGenericS3("foo<-") bar.default <- function(...) cat("bar.default\n") bar <- function(...) cat("bar\n") res <- tryCatch(setGenericS3("bar"), error = identity) stopifnot(inherits(res, "error")) print(getGenericS3("print")) # Your definition will redefine bar() above to bar.default(). foobar <- function() print("foobar()") setGenericS3("foobar") # Cleanup rm(list=ls()) message("TESTING: setGenericS3()...DONE") R.methodsS3/tests/setMethodS3.R0000644000176200001440000000342113621443352015755 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: setMethodS3()...") ###################################################################### # Example 1 ###################################################################### setMethodS3("foo", "default", function(x, ...) { cat("In default foo():\n") print(x, ...) }) setMethodS3("foo", "character", function(s) { cat("In foo() for class 'character':\n") print(s, ...) }) # The generic function is automatically created! print(foo) foo(123) foo("123") ###################################################################### # Example 2 # # Assume that in a loaded package there is already a function bar(), # but you also want to use the name 'bar' for the character string. # It may even be the case that you do not know of the other package, # but your users do! ###################################################################### # bar() in other package bar <- function(x, y, ...) { cat("In bar() of 'other' package.\n") } # Your definition will redefine bar() above to bar.default(). setMethodS3("bar", "character", function(object, ...) { cat("In bar() for class 'character':\n") print(object, ...) }) bar(123) bar("123") setMethodS3("bar<-", "character", function(x, value) { attr(x, "bar") <- value x }) x <- "a" bar(x) <- "hello" str(x) setMethodS3("$", "SomeClass", function(x, name) { attr(x, name) }) setMethodS3("$<-", "SomeClass", function(x, name, value) { attr(x, name) <- value x }) setMethodS3("yaa", "character", abstract=TRUE, validators=list(R.methodsS3:::rccValidateSetMethodS3)) print(getMethodS3("yaa", "character")) # Redefine setMethodS3("yaa", "character", abstract=TRUE, validators=list(R.methodsS3:::rccValidateSetMethodS3)) # Cleanup rm(list=ls()) message("TESTING: setMethodS3()...DONE") R.methodsS3/tests/pkgStartupMessage.R0000644000176200001440000000045313346115017017264 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: pkgStartupMessage()...") msg <- "Hello world!" pkgStartupMessage(msg) for (quietly in c(NA, FALSE, TRUE)) { msg <- sprintf("Hello world! (quietly=%s)", quietly) pkgStartupMessage(msg, quietly=quietly) } message("TESTING: pkgStartupMessage()...DONE") R.methodsS3/tests/appendVarArgs.R0000644000176200001440000000042213346115017016344 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: appendVarArgs()...") foobar <- function(a=1) print(a) print(foobar) foobar <- appendVarArgs(foobar) print(foobar) foobar <- appendVarArgs(foobar) print(foobar) # Cleanup rm(list=ls()) message("TESTING: appendVarArgs()...done") R.methodsS3/tests/isGenericS3S4.R0000644000176200001440000000061713346115017016142 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: isGenericS3/S4()...") FUNs <- list( isGenericS3=isGenericS3, isGenericS4=isGenericS4 ) for (name in names(FUNs)) { cat(sprintf("%s():\n", name)) FUN <- FUNs[[name]] print(FUN("print")) print(FUN("show")) print(FUN("unknown")) print(FUN(print)) print(FUN(sum)) print(FUN(function() NULL)) } message("TESTING: isGenericS3/S4()...DONE") R.methodsS3/tests/attributes.R0000644000176200001440000000066613346115017016007 0ustar liggesuserslibrary("R.methodsS3") message("TESTING: attributes()...") export <- R.methodsS3:::export `export<-` <- R.methodsS3:::`export<-` noexport <- R.methodsS3:::noexport `S3class<-` <- R.methodsS3:::`S3class<-` foo <- function() NULL str(foo) foo <- export(foo) str(foo) export(foo) <- TRUE str(foo) foo <- noexport(foo) str(foo) foo.Bar <- function(...) NULL S3class(foo.Bar) <- "Bar" str(foo) message("TESTING: attributes()...DONE") R.methodsS3/NEWS0000644000176200001440000001711113720750630013026 0ustar liggesusersPackage: R.methodsS3 ==================== Version: 1.8.1 [2020-08-24] * BUG FIXES: R.methodsS3 would produce "Warning: partial match of 'Date' to 'Date/Publication'" when attached if options(warnPartialMatchDollar=TRUE). Version: 1.8.0 [2020-02-13] SIGNIFICANT CHANGES: * Now setGenericS3() produces an error if it can not turn an existing function into a "default" function and create a new generic function. Previously, it produced a warning. NEW FEATURES: * Now setGenericS3() sets the 'S3class' attribute on any "default" methods it creates, if any. * Add internal function R.methodsS3:::makeNamespace(pkg) for producing S3method() statements to be put in a package's NAMESPACE file. CODE QUALITY: * Now formally suggesting 'codetools'. BUG FIXES: * R.methodsS3::setMethodS3() could produce 'Error in appendVarArgs( ...R.oo.definition) : could not find function "appendVarArgs"' if the R.methodsS3 package is not attached. * setMethodS3() and setGenericS3() failed to detect names 'NA_real_' etc. as R keywords due to an 11 year old bug. DEPRECATED & DEFUNCT: * R.methodsS3::throw() is deprecated. Use base::stop(), or R.oo::throw(), instead. Version: 1.7.1 [2016-02-15] SIGNIFICANT CHANGES: * CLEANUP: Package now requires R (>= 2.13.0) (April 2011). If really needed on earlier version of R, it only takes a minor tweak, but I won't do that unless really really needed. CODE QUALITY: * Explicit namespace imports also from 'utils' package. Version: 1.7.0 [2015-02-19] NEW FEATURES: * CONSISTENCY: Now isGenericS4() returns FALSE for non-existing functions, just as isGenericS3() does. CODE QUALITY: * ROBUSTNESS: Added several package tests. BUG FIXES: * isGenericS3() on a function gave error "object 'Math' of mode 'function' was not found" when the 'methods' package was not loaded, e.g. Rscript -e "R.methodsS3::isGenericS3(function(...) NULL)". * findDispatchMethodsS3() could in rare cases return an extra set of false functions in R (< 3.1.2). This was due to a bug in R (< 3.1.2) where the output of getAnywhere() contained garbage results, e.g. getAnywhere(".Options")$objs. For backward compatibility, findDispatchMethodsS3() now detects this case and works around it. This bug was only detected after adding an explicit package test for findDispatchMethodsS3(). Version: 1.6.2 [2014-05-04] CODE QUALITY: * CLEANUP: Internal directory restructuring. Version: 1.6.1 [2014-01-04] CODE QUALITY: * CLEANUP: Dropped obsolete argument 'ellipsesOnly' from setGenericS3(). It was not used. Thanks Antonio Piccolboni for reporting on this. Version: 1.6.0 [2013-11-12] BUG FIXES: * Generic function created by setGenericS3("foo<-") would not have a last argument name 'value', which 'R CMD check' complains about. Version: 1.5.3 [2013-11-05] NEW FEATURES: * ROBUSTNESS: Now setMethodS3(name, class, ...) and setGenericS3(name, ...) assert that arguments 'name' and 'class' are non-empty. Version: 1.5.2 [2013-10-06] NEW FEATURES: * BETA: Added an in-official option to make setGenericS3() and setMethodsS3() look for existing (generic) functions also in imported namespaces. This will eventually become the default. * ROBUSTNESS: Now isGenericS3() also compares to known generic functions in the 'base' package. It also does a better job on checking whether the function calls UseMethod() or not. * Added argument 'inherits' to getGenericS3(). * The above improvement of isGenericS3() means that setGenericS3() does a better job to decided whether a generic function should be created or not, which in turn means 'createGeneric = FALSE' is needed much less in setMethodS3(). Version: 1.5.1 [2013-09-15] BUG FIXES: * Forgot to explicitly import capture.output() from 'utils' which could give an error on function "capture.output" not available when setMethodS3() was used to define a "replacement" function. This was only observed on the R v3.0.1 release version but not with the more recent patched or devel versions. In addition, two other 'utils' functions are now explicitly imported. Version: 1.5.0 [2013-08-29] NEW FEATURES: * Added pkgStartupMessage() which acknowledges library(..., quietly = TRUE). Version: 1.4.5 [2013-08-23] CODE QUALITY: * CLEANUP: No longer utilizing ':::' for "self" (i.e. R.methodsS3) methods. DEPRECATED & DEFUNCT: * CLEANUP: Dropped deprecated inst/HOWTOSITE replaced by inst/CITATION. Version: 1.4.4 [2013-05-19] CODE QUALITY: * CRAN POLICY: Now all Rd \usage{} lines are at most 90 characters long. Version: 1.4.3 [2013-03-08] CODE QUALITY: * Added an Authors@R field to the DESCRIPTION. Version: 1.4.2 [2012-06-22] NEW FEATURES: * Now setMethodS3(..., appendVarArgs = TRUE) ignores 'appendVarArgs' if the method name is "==", "+", "-", "*", "/", "^", "%%", or "%/%", (in addition to "$", "$<-", "[[", "[[<-", "[", "[<-"). It will also ignore it if the name matches regular expressions "<-$" or "^%[^%]*%$". The built in RCC validators were updated accordingly. Version: 1.4.1 [2012-06-20] NEW FEATURES: * Added argument 'overwrite' to setGenericS3(). Version: 1.4.0 [2012-04-20] NEW FEATURES: * Now setMethodS3() sets attribute "S3class" to the class. * Added argument 'export' to setMethodS3() and setGenericS3(), which sets attribute "export" to the same value. Version: 1.3.0 [2012-04-16] SIGNIFICANT CHANGES: * Now only generic funcions are exported, and not all of them. * Now all S3 methods are properly declared in NAMESPACE. Version: 1.2.3 [2012-03-08] NEW FEATURES: * Now arguments '...' of setMethodS3() are passed to setGenericS3(). Version: 1.2.2 [2011-11-17] DOCUMENTATION: * CLEANUP: Dropped example(getMethodS3), which was for setMethodS3(). Version: 1.2.1 [2010-09-18] BUG FIXES: * isGenericS3(), isGenericS4(), getGenericS3() and getMethodS3() failed to locate functions created in the global environment while there exist a function with the same name in the 'base' package. The problem only affected the above functions and nothing else and it did not exist prior to R.methodsS3 v1.2.0 when the package did not yet have a namespace. Thanks John Oleynick for reporting on this problem. * isGenericS3() and isGenericS4() did not support specifying the function by name as a character string, despite it was documented to do so. Thanks John Oleynick for reporting on this. Version: 1.2.0 [2010-03-13] CODE QUALITY: * Added a NAMESPACE. Version: 1.1.0 [2010-01-02] NEW FEATURES: * Added getDispatchMethodS3() and findDispatchMethodsS3(). Version: 1.0.3 [2008-07-02] CODE QUALITY: * Renamed HISTORY file to NEWS. Version: 1.0.2 [2008-05-08] NEW FEATURES: * Added getMethodS3() and getGenericS3(). BUG FIXES: * isGenericS3() and isGenericS4() gave an error if a function was passed. Version: 1.0.1 [2008-03-06] DOCUMENTATION: * Added paper to citation("R.methodsS3"). BUG FIXES: * Regular expression pattern 'a-Z' is illegal on (at least) some locale, e.g. 'C' (where 'A-z' works). The only way to specify the ASCII alphabet is to list all characters explicitly, which we now do in all methods of the package. See the r-devel thread "invalid regular expression '[a-Z]'" on 2008-03-05 for details. Version: 1.0.0 [2007-09-17] SIGNIFICANTLY CHANGES: * Created by extracting setMethodS3() and related methods from the R.oo package. The purpose is to provide setMethodS3() without having to load (the already lightweight) R.oo package. For previous history related to the methods in this package, please see the history of the R.oo package. R.methodsS3/R/0000755000176200001440000000000013701660347012533 5ustar liggesusersR.methodsS3/R/999.package.R0000644000176200001440000000246313621443360014602 0ustar liggesusers#########################################################################/** # @RdocPackage R.methodsS3 # # \description{ # @eval "packageDescription('R.methodsS3')$Description" # This contents of this package was extracted from the # \pkg{R.oo} package [1]. # } # # \section{Installation and updates}{ # To install this package do\cr # # \code{install.packages("R.methodsS3")} # # To get the "devel" version, see # \url{https://github.com/HenrikBengtsson/R.methodsS3/}. # } # # \section{Dependencies and other requirements}{ # This package only requires a standard \R installation. # } # # \section{To get started}{ # To get started, see: # \enumerate{ # \item @see "setMethodS3" - Simple and safe creation of S3 methods # and, whenever needed, automatic creation of S3 generic function. # } # } # # \section{Further readings}{ # For a detailed introduction to the package, see [1]. # } # # \section{How to cite this package}{ # Whenever using this package, please cite [1] as\cr # # @howtocite "R.methodsS3" # } # # @author # # \section{License}{ # The releases of this package is licensed under # LGPL version 2.1 or newer. # } # # \references{ # [1] @include "../incl/BengtssonH_2003.bib.Rdoc" \cr # } #*/######################################################################### R.methodsS3/R/zzz.R0000644000176200001440000000066713701660347013524 0ustar liggesusers## covr: skip=all .onAttach <- function(libname, pkgname) { pd <- utils::packageDescription(pkgname) msg <- sprintf("%s v%s", pkgname, pd$Version) field <- intersect(c("Date/Publication", "Date"), names(pd)) if (length(field) > 0L) { date <- pd[[field[1]]] if (!is.na(date)) msg <- sprintf("%s (%s)", msg, date) } msg <- sprintf("%s successfully loaded. See ?%s for help.", msg, pkgname) pkgStartupMessage(msg) } R.methodsS3/R/getDispatchMethodS3.R0000644000176200001440000000213013621443352016454 0ustar liggesusers###########################################################################/** # @RdocDefault getDispatchMethodS3 # # @title "Gets the S3 method that a generic function would call" # # \description{ # @get "title" according to an S3 @see "base::class" @vector. # } # # @synopsis # # \arguments{ # \item{methodName}{A @character string specifying the name of a # generic function.} # \item{classNames}{A @character @vector of @see "base::class" names.} # \item{...}{Not used.} # } # # \value{ # Returns a @function, or throws an exception if not found. # } # # \seealso{ # @see "findDispatchMethodsS3". # } # # @author # # @keyword programming # @keyword methods # @keyword internal #*/########################################################################### setMethodS3("getDispatchMethodS3", "default", function(methodName, classNames, ...) { res <- findDispatchMethodsS3(methodName, classNames, firstOnly=TRUE, ...) if (length(res) == 0) { stop(sprintf("No method %s() for this class structure: %s", methodName, paste(classNames, collapse=", "))) } res[[1]]$fcn }, private=TRUE) R.methodsS3/R/rccValidators.R0000644000176200001440000000214613621443352015455 0ustar liggesusersrccValidateFunctionName <- function(name, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate 'name' # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Assert that the generic function name is a valid function name. firstLetter <- substring(gsub("^[.]*", "", name), 1,1) allowedFirst <- c("?", "$", "$<-", "[", "[<-", "[[", "[[<-") allowedFirst <- c(allowedFirst, "+", "-", "*", "^", "%") if (!is.element(firstLetter, allowedFirst)) { if (!is.element(tolower(firstLetter), letters)) stop("Except for a few operators, method/function names must begin with a letter: ", name) # Check first letter if (firstLetter == toupper(firstLetter)) stop("Method/function names should start with a lower case letter: ", name) } } export(rccValidateFunctionName) <- FALSE rccValidateSetMethodS3 <- function(name, ...) { rccValidateFunctionName(name=name) } export(rccValidateSetMethodS3) <- FALSE rccValidateSetGenericS3 <- function(name, ...) { rccValidateFunctionName(name=name) } export(rccValidateSetGenericS3) <- FALSE R.methodsS3/R/030.setMethodS3.R0000644000176200001440000003270513621443352015324 0ustar liggesusers###########################################################################/** # @RdocDefault setMethodS3 # # @title "Creates an S3 method" # # \description{ # Creates an S3 method. A function with name \code{.} will # be set to \code{definition}. The method will get the modifiers specified # by \code{modifiers}. If there exists no generic function for this method, # it will be created automatically. # } # # @synopsis # # \arguments{ # \item{name}{The name of the method.} # \item{class}{The class for which the method should be defined. If # \code{class == "default"} a function with name \code{.default} # will be created.} # \item{definition}{The method definition.} # \item{private, protected}{If \code{private=TRUE}, the method is declared # private. If \code{protected=TRUE}, the method is declared protected. # In all other cases the method is declared public.} # \item{export}{A @logical setting attribute \code{"export"}.} # \item{static}{If @TRUE this method is defined to be static, # otherwise not. Currently this has no effect expect as an indicator.} # \item{abstract}{If @TRUE this method is defined to be abstract, # otherwise not. Currently this has no effect expect as an indicator.} # \item{trial}{If @TRUE this method is defined to be a trial method, # otherwise not. A trial method is a method that is introduced to be # tried out and it might be modified, replaced or even removed in a # future release. Some people prefer to call trial versions, beta # version. Currently this has no effect expect as an indicator.} # \item{deprecated}{If @TRUE this method is defined to be deprecated, # otherwise not. Currently this has no effect expect as an indicator.} # \item{envir}{The environment for where this method should be stored.} # \item{overwrite}{If @TRUE an already existing method with the same # name (and of the same class) will be overwritten, otherwise not.} # \item{conflict}{If a method already exists with the same name (and of # the same class), different actions can be taken. If \code{"error"}, # an exception will be thrown and the method will not be created. # If \code{"warning"}, a @warning will be given and the method \emph{will} # be created, otherwise the conflict will be passed unnoticed.} # \item{createGeneric, exportGeneric}{If \code{createGeneric=TRUE}, # a generic S3/UseMethod function is defined for this method, # iff missing, and \code{exportGeneric} species attribute # \code{"export"} of it.} # \item{appendVarArgs}{If @TRUE, argument \code{...} is added with a # warning, if missing. For special methods such as \code{$} and # \code{[[}, this is never done (argument is ignored). # This will increase the chances that the method is consistent with a # generic function with many arguments and/or argument \code{...}.} # \item{validators}{An optional @list of @functions that can be used # to assert that the generated method meets certain criteria.} # \item{...}{Passed to @see "setGenericS3", iff called.} # } # # @examples "../incl/setMethodS3.Rex" # # \seealso{ # For more information about S3, see @see "base::UseMethod". # } # # @author # # @keyword "programming" # @keyword "methods" #*/########################################################################### setMethodS3.default <- function(name, class="default", definition, private=FALSE, protected=FALSE, export=FALSE, static=FALSE, abstract=FALSE, trial=FALSE, deprecated=FALSE, envir=parent.frame(), overwrite=TRUE, conflict=c("warning", "error", "quiet"), createGeneric=TRUE, exportGeneric=TRUE, appendVarArgs=TRUE, validators=getOption("R.methodsS3:validators:setMethodS3"), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'name': if (nchar(name) == 0L) { stop("Cannot set S3 method. Argument 'name' is empty.") } # Argument 'class': if (nchar(class) == 0L) { stop("Cannot set S3 method. Argument 'class' is empty.") } # Argument 'conflict': conflict <- match.arg(conflict) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Backward compatibility tests # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - args <- list(...) if (is.element("enforceRCC", names(args))) { warning("Argument 'enforceRCC' of setGenericS3() has been replaced by argument 'validators'.") # Turn off validators? if (!args$enforceRCC) validators <- NULL } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 1. Test the definition using validators # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.null(validators)) { for (validator in validators) { validator(name=name, class=class, definition=definition, private=private, protected=protected, static=static, abstract=abstract, trial=trial, deprecated=deprecated, envir=envir, overwrite=overwrite, conflict=conflict, createGeneric=createGeneric, appendVarArgs=appendVarArgs, type="setMethodS3") } } # Ignore argument 'appendVarArgs' if a "special" method # or a replacement method. if (appendVarArgs) { # (a) Do not append '...' for the following methods ignores <- c("$", "$<-", "[[", "[[<-", "[", "[<-") ignores <- c(ignores, "==") ignores <- c(ignores, "+", "-", "*", "/", "^", "%%", "%/%") appendVarArgs <- !is.element(name, ignores) if (appendVarArgs) { # (b) Neither functions with any of these name patterns ignorePatterns <- c("<-$", "^%[^%]*%$") ignores <- (sapply(ignorePatterns, FUN=regexpr, name) != -1L) appendVarArgs <- appendVarArgs && !any(ignores) } } # Check for forbidden names. if (is.element(name, R.KEYWORDS)) stop("Method names must not be same as a reserved keyword in R: ", name) if (class == "ANY") class <- "default" # Create the modifiers if (private) protection <- "private" else if (protected) protection <- "protected" else protection <- "public" modifiers <- protection if (static == TRUE) modifiers <- c(modifiers, "static") if (abstract == TRUE) modifiers <- c(modifiers, "abstract") if (deprecated == TRUE) modifiers <- c(modifiers, "deprecated") if (trial == TRUE) modifiers <- c(modifiers, "trial") if (missing(definition) && abstract == TRUE) { # Set default 'definition'. src <- paste("...R.oo.definition <- function(...) stop(\"Method \\\"", name, "\\\" is defined abstract in class \\\"", class, "\\\" and has not been overridden by any of the subclasses: \", class(list(...)[[1]])[1])", sep="") expr <- parse(text=src) # If just defining a local 'definition' function, to be used below, # one will get warnings "using .GlobalEnv instead of package:" # when loading the package *with lazy loading*. I do not understand # the reasons for it, but here follows a trick in order to not get # such warnings. It kinda borrows the 'envir' frame to define a local # function. It works, but don't ask me why. /HB 2005-02-25 eval(expr, envir=envir) definition <- get("...R.oo.definition", envir=envir) rm(list="...R.oo.definition", envir=envir) } # Create the class method 'name': methodName <- paste(name, class, sep=".") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 2. Find the environment where sys.source() loads the package, which is # the local variable (argument) of sys.source() named as "envir". # Unfortunately, the only way we can be sure which of the parent frames # are the sys.source() function frame is to compare its definition with # each of the definitions of the parent frames using sys.function(). # Comment: sys.source() is used by library() and require() for loading # packages. Also note that packages that are currently loaded are not in # the search path, cf. search(), and there and standard exists() will not # find it. *Not* checking the currently loading environment would *not* # be harmful, but it would produce too many warnings. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sys.source.def <- get("sys.source", mode="function", envir=baseenv()) loadenv <- NULL for (framePos in sys.parents()[-1L]) { if (identical(sys.source.def, sys.function(framePos))) { loadenv <- parent.frame(framePos) break } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 3. Check for preexisting functions with the same name # i) in the environment that we are saving to ('envir'), # ii) in the currently loading environment ('loadenv'), or # iii) in the environments in the search path (search()). # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - envirs <- c(envir, loadenv, lapply(search(), FUN=as.environment)) inherits <- rep(FALSE, times=length(envirs)) checkImports <- getOption("R.methodsS3:checkImports:setGenericS3", FALSE) if (checkImports) inherits[1:2] <- TRUE fcn <- .findFunction(methodName, envir=envirs, inherits=inherits) fcnDef <- fcn$fcn; fcnPkg <- fcn$pkg # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 4. Append '...' if missing. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (appendVarArgs) { if (!hasVarArgs(definition)) { warning("Added missing argument '...' to make it more compatible with a generic function: ", methodName) # definition <- appendVarArgs(definition) # As above, to avoid "using .GlobalEnv instead of package:" # warnings, we do the below trick. /HB 2005-02-25 assign("...R.oo.definition", definition, envir=envir) eval(substitute(fcn <- R.methodsS3::appendVarArgs(fcn), list(fcn=as.name("...R.oo.definition"))), envir=envir) definition <- get("...R.oo.definition", envir=envir) rm(list="...R.oo.definition", envir=envir) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 5. Validate replacement functions (since R CMD check will complain) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (regexpr("<-$", name) != -1L) { f <- formals(definition) fStr <- capture.output(args(definition))[[1]] fStr <- sub("^[\t\n\f\r ]*", "", fStr) # trim() is not available fStr <- sub("[\t\n\f\r ]*$", "", fStr) # when package loads! if (names(f)[length(f)] != "value") { ## covr: skip=2 stop("Last argument of a ", name, "() method should be named 'value': ", fStr) } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 5b. Validate arguments for 'picky' methods. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pickyMethods <- list( "$" = c(NA_character_, "name"), "$<-" = c(NA_character_, "name", "value") ) if (is.element(name, names(pickyMethods))) { f <- formals(definition) fStr <- capture.output(args(definition))[[1L]] fStr <- sub("^[\t\n\f\r ]*", "", fStr) # trim() is not available fStr <- sub("[\t\n\f\r ]*$", "", fStr) # when package loads! reqArgs <- pickyMethods[[name]] nbrOfReqArgs <- length(reqArgs) # Check for correct number of arguments if (length(f) != nbrOfReqArgs) { ## covr: skip=2 stop("There should be exactly ", nbrOfReqArgs, " arguments of a ", name, "() method: ", fStr) } for (kk in 1:nbrOfReqArgs) { if (!is.na(reqArgs[kk]) && (names(f)[kk] != reqArgs[kk])) { ## covr: skip=2 stop("Argument #", kk, " in a ", name, "() method, should be named '", reqArgs[kk], "': ", fStr) } } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 6. Assign/create the new method # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.null(fcnDef) || overwrite) { # Create expr <- substitute({ fcn <- definition `R.methodsS3_export<-` <- get("export<-", mode="function", envir=asNamespace("R.methodsS3"), inherits=FALSE) R.methodsS3_export(fcn) <- doExport rm(list="R.methodsS3_export<-") attr(fcn, "S3class") <- class attr(fcn, "modifiers") <- modifiers }, list(fcn=as.name(methodName), class=class, definition=definition, doExport=export, modifiers=modifiers) ) # Assign eval(expr, envir=envir) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 7. Report that a method was redefined? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.null(fcnDef)) { msg <- paste("Method already existed and was", if (overwrite != TRUE) " not", " overwritten: ", sep="") if (is.null(conflict)) conflict <- "quiet" if (conflict == "quiet") { } else if (conflict == "warning") { warning(msg, methodName) } else stop(msg, methodName) } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 8. Create a generic function? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (createGeneric) { setGenericS3(name, export=exportGeneric, envir=envir, validators=validators, ...) } } # setMethodS3.default() S3class(setMethodS3.default) <- "default" export(setMethodS3.default) <- FALSE setGenericS3("setMethodS3") R.methodsS3/R/throw.default.R0000644000176200001440000000212613621443352015441 0ustar liggesusers###########################################################################/** # @RdocDefault throw # # @title "Throws an exception" # # \description{ # Throws an exception by calling stop(). # # Note that \code{throw()} can be defined for specific classes, which can # then be caught (or not) using \code{\link[base:conditions]{tryCatch}}(). # # \emph{This default function will be overridden by ditto in the \pkg{R.oo} # package, if that is loaded. The latter @see "R.oo::throw" implementation # is fully backward compatible with this one, but the error object thrown # is of class @see "R.oo::Exception".} # } # # @synopsis # # \arguments{ # \item{...}{One or several strings that are concatenated and collapsed # into on message string.} # } # # \value{ # Returns nothing. # } # # @examples "../incl/throw.Rex" # # @author # # \keyword{error} #*/########################################################################### setMethodS3("throw", "default", function(...) { .Deprecated(msg = "R.methodsS3::throw() is deprecated. Use base::stop() instead, or R.oo::throw().") stop(...) }) R.methodsS3/R/makeNamespace.R0000644000176200001440000000142313621443352015404 0ustar liggesusersmakeNamespace <- function(pkg = ".", style = c("minimal", "quoted")) { if (pkg == ".") { pathname <- file.path(pkg, "DESCRIPTION") if (!file_test("-f", pathname)) stop("No such file: ", sQuote(pathname)) desc <- read.dcf(pathname) pkg <- desc[, "Package"] stopifnot(length(pkg) == 1L, !is.na(pkg)) } style <- match.arg(style) ns <- getNamespace(pkg) for (name in ls(envir = ns, all.names = TRUE)) { fcn <- get(name, envir = ns) if (!is.function(fcn)) next s3class <- attr(fcn, "S3class") if (is.null(s3class)) next name <- gsub(sprintf("[.]%s$", s3class), "", name) if (style == "minimal") { cat(sprintf('S3method(%s,%s)\n', name, s3class)) } else { cat(sprintf('S3method("%s", "%s")\n', name, s3class)) } } } R.methodsS3/R/006.fixVarArgs.R0000644000176200001440000000015413621443352015232 0ustar liggesusers# Added '...' to some base functions. These will later be # turned into default functions by setMethodS3(). R.methodsS3/R/findDispatchMethodsS3.R0000644000176200001440000000574113621443352017013 0ustar liggesusers###########################################################################/** # @RdocDefault findDispatchMethodsS3 # # @title "Finds the S3 methods that a generic function would call" # # \description{ # @get "title", ordered according to an S3 @see "base::class" @vector. # } # # @synopsis # # \arguments{ # \item{methodName}{A @character string specifying the name of a # generic function.} # \item{classNames}{A @character @vector of @see "base::class" names.} # \item{firstOnly}{If @TRUE, only the first method is returned.} # \item{...}{Not used.} # } # # \value{ # Returns a names @list structure. # } # # \seealso{ # @see "getDispatchMethodS3". # } # # @author # # @keyword programming # @keyword methods # @keyword internal #*/########################################################################### setMethodS3("findDispatchMethodsS3", "default", function(methodName, classNames, firstOnly=FALSE, ...) { # Argument 'methodName': methodName <- as.character(methodName) if (length(methodName) == 0) { stop("Argument 'methodName' is empty.") } if (length(methodName) > 1) { stop("Argument 'methodName' must only contain one element: ", paste(head(methodName), collapse=", ")) } # Argument 'classNames': classNames <- as.character(classNames) if (length(classNames) == 0) { stop("Argument 'classNames' is empty.") } # Argument 'firstOnly': firstOnly <- as.logical(firstOnly) res <- list() for (kk in seq_along(classNames)) { className <- classNames[kk] fcnName <- paste(methodName, className, sep=".") obj <- do.call(getAnywhere, list(fcnName)) if (length(obj$objs) == 0) { # No matching objects next } # WORKAROUND: In R (< 3.1.?) there is a bug in getAnywhere() # causing it to return garbage in parts of the 'objs' list. hasBug <- (length(obj$objs) > length(obj$where)) if (hasBug) { ## Rebuild 'objs' manually n <- length(obj$where) obj$objs <- vector("list", length=n) for (ii in seq_len(n)) { where <- obj$where[[ii]] tryCatch({ if (grepl("^namespace:", where)) { env <- asNamespace(gsub("^namespace:", "", where)) } else { env <- as.environment(where) } if (exists(fcnName, envir=env)) { obj$objs[[ii]] <- get(fcnName, envir=env) } }, error = function(ex) {}) } # for (ii ...) } # Keep only functions keep <- which(sapply(obj$objs, FUN=is.function)) if (length(keep) == 0) { # No functions next } # Keep the first function first <- keep[1] fcn <- obj$objs[[first]] where <- obj$where[first] resKK <- list() resKK$class <- className resKK$name <- methodName resKK$fullname <- fcnName resKK$fcn <- fcn resKK$where <- obj$where res[[className]] <- resKK # Return only the first match? if (firstOnly) { break } } # for (kk ...) res }, private=TRUE) # findDispatchMethodsS3() R.methodsS3/R/getMethodS3.R0000644000176200001440000000162213621443352015001 0ustar liggesusers###########################################################################/** # @RdocDefault getMethodS3 # # @title "Gets an S3 method" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{name}{The name of the method.} # \item{class}{The class of the method.} # \item{envir}{The @environment from which the search for the # S3 method is done.} # \item{...}{Not used.} # } # # \seealso{ # This is just a conveniency wrapper around @see "utils::getS3method" # that have arguments consistent with @see "setMethodS3". # @see "getGenericS3". # } # # @author # # @keyword programming # @keyword methods #*/########################################################################### setMethodS3("getMethodS3", "default", function(name, class="default", envir=parent.frame(), ...) { args <- list(name, class=class, optional=FALSE) do.call(getS3method, args, envir=envir) }) R.methodsS3/R/005.varArgs.R0000644000176200001440000000150313621443352014561 0ustar liggesusershasVarArgs <- function(...) UseMethod("hasVarArgs") export(hasVarArgs) <- TRUE hasVarArgs.function <- function(fcn, ...) { if (!is.function(fcn)) stop("Argument 'fcn' must be a function: ", mode(fcn)) # Get the current formals args <- formals(fcn) is.element("...", names(args)) } # hasVarArgs() S3class(hasVarArgs.function) <- "function" export(hasVarArgs.function) <- FALSE appendVarArgs <- function(...) UseMethod("appendVarArgs") export(appendVarArgs) <- TRUE appendVarArgs.function <- function(fcn, ...) { if (hasVarArgs(fcn)) return(fcn) # Get the current formals args <- formals(fcn) # Add '...' args <- c(args, formals(function(...) {})) # Set new formals formals(fcn) <- args fcn } # appendVarArgs() S3class(appendVarArgs.function) <- "function" export(appendVarArgs.function) <- FALSE R.methodsS3/R/999.NonDocumentedObjects.R0000644000176200001440000000170613621443352017263 0ustar liggesusers###########################################################################/** # @RdocDocumentation "Non-documented objects" # # % Utility functions # @alias appendVarArgs # @alias appendVarArgs.function # @alias hasVarArgs # @alias hasVarArgs.function # # % Basic validators # @alias rccValidateFunctionName # @alias rccValidateSetGenericS3 # @alias rccValidateSetMethodS3 # # \description{ # This page contains aliases for all "non-documented" objects that # \code{R CMD check} detects in this package. # # Almost all of them are \emph{generic} functions that have specific # document for the corresponding method coupled to a specific class. # Other functions are re-defined by \code{setMethodS3()} to # \emph{default} methods. Neither of these two classes are non-documented # in reality. # The rest are deprecated methods. # } # # @author # # @keyword internal #*/########################################################################### R.methodsS3/R/010.setGenericS3.R0000644000176200001440000002103713621443352015452 0ustar liggesusers###########################################################################/** # @RdocDefault setGenericS3 # # @title "Creates an S3 generic function" # # \description{ # \emph{Note that this method is a internal method called by # @see "setMethodS3" and there is no reason for calling it directly!}\cr # # Creates a generic function in S3 style, i.e. setting a # function with name \code{name} that dispatches the method \code{name} # via \code{UseMethod}. If there is already a function named \code{name} # that function is renamed to \code{name.default}. # } # # @synopsis # # \arguments{ # \item{name}{The name of the generic function.} # \item{export}{A @logical setting attribute \code{"export"}.} # \item{envir}{The environment for where this method should be stored.} # \item{dontWarn}{If a non-generic method with the same name is found it # will be "renamed" to a default method. If that method is found in # a package with a name that is \emph{not} found in \code{dontWarn} # a warning will be produced, otherwise it will be renamed silently.} # \item{validators}{An optional @list of @functions that can be used # to assert that the generated generic function meets certain # criteria.} # \item{...}{Not used.} # \item{overwrite}{If @TRUE an already existing generic function with # the same name will be overwritten, otherwise not.} # } # # @examples "../incl/setGenericS3.Rex" # # \seealso{ # To define a method for a class see @see "setMethodS3". # For more information about S3, see @see "base::UseMethod". # } # # @author # # @keyword programming # @keyword methods #*/########################################################################### setGenericS3.default <- function(name, export=TRUE, envir=parent.frame(), dontWarn=getOption("dontWarnPkgs"), validators=getOption("R.methodsS3:validators:setGenericS3"), overwrite=FALSE, ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Validate arguments # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Argument 'name': if (nchar(name) == 0L) { stop("Cannot set S3 generic method. Argument 'name' is empty.") } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Backward compatibility tests # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - args <- list(...) if (is.element("enforceRCC", names(args))) { warning("Argument 'enforceRCC' of setGenericS3() has been replaced by argument 'validators'.") # Turn off validators? if (args$enforceRCC == FALSE) validators <- NULL } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 0. Define local constants and local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 'get' is illegal, because if it is redefined in a package, library() will # maybe load and set the new get, which is then a generic function, and the # next thing it will try to get() (it uses get internally) will not be # retrieved, since get.default() might not be loaded at this time, but later. PROTECTED.NAMES <- c("get") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 1. Test the definition using validators # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (!is.null(validators)) { for (validator in validators) { validator(name=name, envir=envir, dontWarn=dontWarn, type="setGenericS3") } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 2. Check for forbidden names # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.element(name, R.KEYWORDS)) stop("Method names must not be same as a reserved keyword in R: ", name) if (is.element(name, PROTECTED.NAMES)) stop("Trying to use an unsafe generic method name (trust us, it is for a *good* reason): ", name) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 2. Find the environment where sys.source() loads the package, which is # the local variable (argument) of sys.source() named as "envir". # Unfortunately, the only way we can be sure which of the parent frames # are the sys.source() function frame is to compare its definition with # each of the definitions of the parent frames using sys.function(). # Comment: sys.source() is used by library() and require() for loading # packages. Also note that packages that are currently loaded are not in # the search path, cf. search(), and there and standard exists() will not # find it. *Not* checking the currently loading environment would *not* # be harmful, but it would produce too many warnings. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - sys.source.def <- get("sys.source", mode="function", envir=baseenv()) loadenv <- NULL for (framePos in sys.parents()[-1L]) { if (identical(sys.source.def, sys.function(framePos))) { loadenv <- parent.frame(framePos) break } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 3. Check for preexisting functions with the same name # i) in the environment that we are saving to ('envir'), # ii) in the currently loading environment ('loadenv'), or # iii) in the environments in the search path (search()). # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - envirs <- c(envir, loadenv, lapply(search(), FUN=as.environment)) inherits <- rep(FALSE, times=length(envirs)) checkImports <- getOption("R.methodsS3:checkImports:setGenericS3", FALSE) if (checkImports) inherits[1:2] <- TRUE fcn <- .findFunction(name, envir=envirs, inherits=inherits) fcnDef <- fcn$fcn fcnPkg <- fcn$pkg if (!overwrite && !is.null(fcnDef)) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 4a. Is it already a generic function? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - isGeneric <- isGenericS3(fcnDef) || isGenericS4(fcnDef) # If it is a generic function, we are done! if (isGeneric) { # TO DO: Update generic functions with '...', if missing. return() } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 4b. ... or, is there already a default function with the same name? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Search for preexisting default function in the same environments as above. nameDefault <- paste(name, ".default", sep="") fcn <- .findFunction(nameDefault, envir=envirs, inherits=inherits) defaultExists <- !is.null(fcn$fcn) defaultPkg <- fcn$pkg if (defaultExists) { msg <- paste("Could not create generic function. There is already a non-generic function named ", name, "() in package ", fcnPkg, " with the same name as an existing default function ", nameDefault, "() in ", defaultPkg, ".", sep = "") action <- Sys.getenv("R_R_METHODSS3_SETGENERICS3_ONDEFAULTEXISTS", "error") action <- getOption("R.methodsS3.setGenericS3.onDefaultExists", action) if (identical(action, "error")) { stop(msg) } else { warning(msg) return() } } ## Assign 'S3class' attribute (an R.methodsS3 thing) attr(fcnDef, "S3class") <- "default" # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 4c. "Rename" the function to a default function # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - assign(nameDefault, substitute(fcn, list(fcn=fcnDef)), envir=envir) if (!is.element(fcnPkg, dontWarn)) { warning("Renamed the preexisting function ", name, " to ", nameDefault, ", which was defined in environment ", fcnPkg, ".") } } # if (...) # By default all generic functions have '...' arguments argsStr <- "..." # Should argument 'value' be added? isReplacementFunction <- (regexpr("<-$", name) != -1L) if (isReplacementFunction) { argsStr <- paste(c(argsStr, "value"), collapse=", ") } # Create a generic function src <- sprintf("...tmpfcn <- function(%s) UseMethod(\"%s\")", argsStr, name) src <- c(src, sprintf("R.methodsS3:::export(...tmpfcn) <- %s", export)) src <- c(src, sprintf("\"%s\" <- ...tmpfcn", name)) src <- c(src, "rm(list=\"...tmpfcn\")") src <- paste(src, collapse=";\n") expr <- parse(text=src) eval(expr, envir=envir) } # setGenericS3.default() S3class(setGenericS3.default) <- "default" export(setGenericS3.default) <- FALSE setGenericS3.default("setGenericS3") # Creates itself ;) R.methodsS3/R/001.R.KEYWORDS.R0000644000176200001440000000156113621443352014623 0ustar liggesusers###########################################################################/** # @eval "Rdoc$package <- 'R.methodsS3';''" # @RdocObject "R.KEYWORDS" # # @title "Reserved words in R not to be used for object names" # # \description{ # @get "title". \code{R.KEYWORDS} is a @character @vector of all reserved # words in \R according to [1]. # } # # @author # # \references{ # [1] Section "Reserved words", R Language Definition, version 2.6.0 # (2007-09-14) DRAFT. # } # # @keyword programming # @keyword internal #*/########################################################################### R.KEYWORDS <- c( "break", "else", "for", "function", "if", "in", "next", "repeat", "while", "TRUE", "FALSE", "Inf", "NULL", "NA", "NaN", paste("NA_", c("integer", "real", "complex", "character"), "_", sep=""), "...", paste("..", 1:99, sep="") ) export(R.KEYWORDS) <- FALSE R.methodsS3/R/000.R0000644000176200001440000000364413621443352013160 0ustar liggesusers############################################################################## # This code has to come first in a library. To do this make sure this file # is named "000.R" (zeros). ############################################################################## # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # NAMESPACE: export() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Sets attribute export to TRUE export <- function(x) { attr(x, "export") <- TRUE x } export <- export(export) # Sets attribute export to 'value'. "export<-" <- export(function(x, value) { attr(x, "export") <- value x }) noexport <- export(function(x) { attr(x, "export") <- FALSE x }) # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # NAMESPACE: S3method() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Sets attribute 'S3class' to 'value'. "S3class<-" <- export(function(x, value) { attr(x, "S3class") <- value x }) # Use by setGenericS3() and setMethodS3() .findFunction <- function(name, envir, inherits=rep(FALSE, times=length(envir))) { # Argument 'envir': if (!is.list(envir)) { envir <- list(envir) } n <- length(envir) # Argument 'inherits': inherits <- as.logical(inherits) stopifnot(length(inherits) == n) fcn <- pkg <- NULL for (kk in seq_along(envir)) { env <- envir[[kk]] inh <- inherits[kk] if (exists(name, mode="function", envir=env, inherits=inh)) { fcn <- get(name, mode="function", envir=env, inherits=inh) pkg <- attr(env, "name") if (is.null(pkg)) { pkg <- "base" if (identical(env, baseenv())) { } else if (identical(env, globalenv())) { pkg <- "" } } else { pkg <- gsub("^package:", "", pkg) } break } } # for (kk ...) list(fcn=fcn, pkg=pkg) } # .findFunction() R.methodsS3/R/pkgStartupMessage.R0000644000176200001440000000474513621443352016335 0ustar liggesusers#########################################################################/** # @RdocDefault pkgStartupMessage # # @title "Generates a (package) startup message" # # \description{ # @get "title". # Contrary to @see "base::packageStartupMessage", this method does # \emph{not} output a message when \code{library()/require()} is # called with argument \code{quietly=TRUE}. # } # # @synopsis # # \arguments{ # \item{...}{Arguments passed to @see "base::packageStartupMessage".} # \item{quietly}{If @FALSE, the message is outputted, otherwise not. # If @NA, the message is \emph{not} outputted if @see "base::library" # (or \code{require()}) was called with argument \code{quietly=TRUE}.} # } # # \value{ # Returns nothing. # } # # @author # # \seealso{ # @see "base::packageStartupMessage". # } # # @keyword internal #*/######################################################################### setMethodS3("pkgStartupMessage", "default", function(..., quietly=NA) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Infer 'quietly' from argument 'argument' in library() call? # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (is.na(quietly)) { quietly <- FALSE # Just in case the below won't work one day due to R updates... tryCatch({ # The default, if not found quietly <- formals(base::library)$quietly # Identify the environment/frame of interest by making sure # it at least contains all the arguments of source(). argsToFind <- names(formals(base::library)) # Scan the call frames/environments backwards... srcfileList <- list() for (ff in sys.nframe():0) { env <- sys.frame(ff) # Does the environment look like a library() environment? exist <- sapply(argsToFind, FUN=exists, envir=env, inherits=FALSE) if (!all(exist)) { # Nope, then skip to the next one next } # Was argument 'quietly' specified? missing <- eval(expression(missing(quietly)), envir=env) if (!missing) { quietly <- get("quietly", envir=env, inherits=FALSE) break } # ...otherwise keep searching due to nested library() calls. } # for (ff ...) }, error = function() {}) } # if (is.na(quietly) # Output message? if (!quietly) { packageStartupMessage(...) } }, protected=TRUE) ## startupMessage <- pkgStartupMessage ## startupMessage.default <- pkgStartupMessage.default R.methodsS3/R/isGenericS3.R0000644000176200001440000001154013621443352014771 0ustar liggesusers###########################################################################/** # @RdocDefault isGenericS3 # # @title "Checks if a function is a S3 generic function" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fcn}{A @function or a @character string.} # \item{envir}{If argument \code{fcn} is a @character, this is the # @environment from which the search for the @function is done.} # \item{...}{Not used.} # } # # \details{ # A function is considered to be a generic S3/UseMethod function if # its name matches one of the known S3 generic functions, or if it # calls \code{UseMethod()}. # } # # \value{ # Returns @TRUE if a generic S3/UseMethod function, otherwise @FALSE. # } # # @author # # @keyword programming # @keyword methods #*/########################################################################### isGenericS3.default <- function(fcn, envir=parent.frame(), ...) { # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Local functions # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - knownInternalGenericS3 <- function(fcn, which=1:4, ...) { knownGenerics <- NULL # Get the name of all known S3 generic functions if (any(which == 1L)) { knownGenerics <- c(knownGenerics, names(.knownS3Generics)) } if (any(which == 2L)) { knownGenerics <- c(knownGenerics, .S3PrimitiveGenerics) } # tools:::.get_internal_S3_generics() if available if (any(which == 3L)) { ns <- getNamespace("tools") if (exists(".get_internal_S3_generics", envir=ns, inherits=FALSE)) { names <- get(".get_internal_S3_generics", envir=ns, inherits=FALSE)() knownGenerics <- c(knownGenerics, names) } } # Manually added, cf. ?cbind if (any(which == 4L)) { names <- c("cbind", "rbind") knownGenerics <- c(knownGenerics, names) } # Is it one of the known S3 generic functions? knownGenerics <- unique(knownGenerics) knownGenerics } # knownInternalGenericS3() isNameInternalGenericS3 <- function(fcn, ...) { is.element(fcn, knownInternalGenericS3()) } # isNameInternalGenericS3() isPrimitive <- function(fcn, ...) { switch(typeof(fcn), special=TRUE, builtin=TRUE, FALSE) } # isPrimitive() if (is.character(fcn)) { if (isNameInternalGenericS3(fcn)) return(TRUE) # Get the function fcn <- .findFunction(fcn, envir=envir, inherits=TRUE)$fcn # Does it even exist? if (is.null(fcn)) { return(FALSE) } } # Check with codetools::findGlobals(), otherwise scan the body res <- tryCatch({ fcns <- codetools::findGlobals(fcn, merge=FALSE)$functions is.element("UseMethod", fcns) }, error = function(ex) { # Scan the body of the function body <- body(fcn) if (is.call(body)) body <- deparse(body) body <- as.character(body) (length(grep("UseMethod[(]", body)) > 0L) }) if (isTRUE(res)) return(TRUE) # Check primitive functions if (isPrimitive(fcn)) { # Scan the body of the function body <- deparse(fcn) call <- grep(".Primitive[(]", body, value=TRUE) call <- gsub(".Primitive[(]\"", "", call) call <- gsub("\"[)].*", "", call) if (is.element(call, knownInternalGenericS3(2L))) return(TRUE) } # Finally, compare to all known internal generics for (name in knownInternalGenericS3()) { if (exists(name, mode="function", inherits=TRUE)) { generic <- get(name, mode="function", inherits=TRUE) if (identical(fcn, generic)) return(TRUE) } } FALSE } S3class(isGenericS3.default) <- "default" export(isGenericS3.default) <- FALSE setGenericS3("isGenericS3") ###########################################################################/** # @RdocDefault isGenericS4 # # @title "Checks if a function is a S4 generic function" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{fcn}{A @function or a @character string.} # \item{...}{Not used.} # } # # \details{ # A function is considered to be a generic S4 function if its # body, that is the source code, contains the regular pattern # \code{"standardGeneric"}. # } # # \value{ # Returns @TRUE if a generic S4 function, otherwise @FALSE. # } # # @author # # @keyword "programming" # @keyword "methods" # @keyword "internal" #*/########################################################################### isGenericS4.default <- function(fcn, envir=parent.frame(), ...) { if (is.character(fcn)) { if (!exists(fcn, mode="function", envir=envir, inherits=TRUE)) { return(FALSE) } fcn <- get(fcn, mode="function", envir=envir, inherits=TRUE) } body <- body(fcn) if (is.call(body)) body <- deparse(body) body <- as.character(body) return(length(grep("standardGeneric", body)) > 0) } S3class(isGenericS4.default) <- "default" export(isGenericS4.default) <- FALSE setGenericS3("isGenericS4") R.methodsS3/R/getGenericS3.R0000644000176200001440000000205713621443352015140 0ustar liggesusers###########################################################################/** # @RdocDefault getGenericS3 # # @title "Gets an S3 generic function" # # \description{ # @get "title". # } # # @synopsis # # \arguments{ # \item{name}{The name of the generic function.} # \item{envir}{The @environment from which the search for the # generic @function is done.} # \item{inherits}{A @logical specifying whether the enclosing frames # should be searched or not.} # \item{...}{Not used.} # } # # \seealso{ # @see "setGenericS3". # @see "getMethodS3". # @see "isGenericS3". # } # # @author # # @keyword programming # @keyword methods #*/########################################################################### setMethodS3("getGenericS3", "default", function(name, envir=parent.frame(), inherits=TRUE, ...) { fcn <- .findFunction(name, envir=envir, inherits=inherits)$fcn if (is.null(fcn)) { stop("No such function found: ", name) } else if (!isGenericS3(fcn)) { stop("The function found is not an S3 generic function: ", name) } fcn }) R.methodsS3/MD50000644000176200001440000000454313721505666012654 0ustar liggesusers378ab667af421b87f1ce178b1d71f219 *DESCRIPTION 5ba0f371553d70d18151e9da2bd50edc *NAMESPACE ceb70b52e24fdb74a17814baf56b5c6b *NEWS 544d6e098c1f8f20a9c75e7063eecf4f *R/000.R b6fedf6eec903c85f59d383d15983fc0 *R/001.R.KEYWORDS.R 51ecd8323217b75599a40978646b2407 *R/005.varArgs.R 1df04dc13e5ad8dbc137a07bad5a1af1 *R/006.fixVarArgs.R 2ec154beac75177376dd9c2778458acd *R/010.setGenericS3.R a60f9ab55d6f4a518ee449db9184db20 *R/030.setMethodS3.R 8a1ef83fe9e11779f11a04d068e7918d *R/999.NonDocumentedObjects.R 760bda3a9fc83be2df7be8e06231e10c *R/999.package.R 76d19ef014a0702fe70d226f98d5fdf1 *R/findDispatchMethodsS3.R 40363fdcbf82aab8d2c5108792bd1735 *R/getDispatchMethodS3.R 6c847d1b632efb00d941a1eb23cbf6d7 *R/getGenericS3.R 8c0c4ab88c058f9f15d17b290bc2642a *R/getMethodS3.R ce96a82dbbf247c8338a8124f2f0dc1b *R/isGenericS3.R 1b00320bdebb59cb0d86228cc839d89d *R/makeNamespace.R 2dea65413ed2dc7c64c651d060b8420a *R/pkgStartupMessage.R e57c9ff235c9417f3e46431368ee4625 *R/rccValidators.R 670bbff94e5704528abd38280b983b18 *R/throw.default.R ee9a7d3faa96202645ccd565f1a51549 *R/zzz.R 221a5cb641badf6e5da59455778861ca *inst/CITATION 5ca40d7ba68d1842ff37a487642361e5 *inst/WORDLIST e62840f5029923bb7fde68ff03c85ba7 *man/Non-documented_objects.Rd 1b3a605645f2bf15b72946858f67a3bb *man/R.KEYWORDS.Rd 4e0e780fddcd5a999d4ac9be4e415c27 *man/R.methodsS3-package.Rd 3b5bcb3544cfbf6faadca52e1ccc8c9d *man/findDispatchMethodsS3.Rd 48ee8839fd89e9512fdec95178ebf9bd *man/getDispatchMethodS3.Rd 47ca671f187d64cd06c73abfef5e20fe *man/getGenericS3.Rd 9594dc57bec938a16807c4b746ad3e78 *man/getMethodS3.Rd 0c3197129ab90808ee71e8de415dff11 *man/isGenericS3.Rd 4390144243165827fa06fd5e9077109b *man/isGenericS4.Rd 1ec8c68e31afd08566ef46903a60e5d2 *man/pkgStartupMessage.Rd d0ad086d52e72c12787dc638dd019a5a *man/setGenericS3.Rd 830bb1b41ffb0d2fe6f208157381fa61 *man/setMethodS3.Rd 08f7aee8b35261e03de5cf4e245a405a *man/throw.Rd b24a7cd174fded033c7469ca5fe4f8b9 *tests/appendVarArgs.R 2afbc200a256afc37d33c7a6b0d75f74 *tests/attributes.R 0b0e7970b79540a0248a2005ea9f0866 *tests/findDispatchMethodsS3.R 533869ce20ae7fb3e73bd7f4a60c0dc6 *tests/getDispatchMethodS3.R f2a3e7bf4f61342c91f284944d7888a2 *tests/isGenericS3S4.R 1c3c57bf749393c8dff21b2a3089688b *tests/pkgStartupMessage.R 870ea909d3e0a14c511264b8c3dc724b *tests/setGenericS3.R 7b97e880f5819a2d04e4a715aa6e8f55 *tests/setMethodS3.R b452094c7796d50a9aa77eac96407479 *tests/throw.R R.methodsS3/inst/0000755000176200001440000000000013621443360013302 5ustar liggesusersR.methodsS3/inst/CITATION0000644000176200001440000000255613621443360014447 0ustar liggesuserscitHeader("Please cite R.oo/R.methodsS3 as") citEntry( # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # BibTeX entry: # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - entry="InProceedings", author = "Henrik Bengtsson", title = "The {R.oo} package - Object-Oriented Programming with References Using Standard {R} Code", booktitle = "Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003)", year = "2003", editor = "Kurt Hornik and Friedrich Leisch and Achim Zeileis", address = "Vienna, Austria", month = "March", issn = "1609-395X", url = "https://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf", howpublished = "https://www.r-project.org/conferences/DSC-2003/Proceedings/", # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Plain-text citation: # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - textVersion = paste(sep="", "Bengtsson, H. ", "The R.oo package - Object-Oriented Programming with References Using Standard R Code, ", "Proceedings of the 3rd International Workshop on Distributed Statistical Computing (DSC 2003), ", "ISSN 1609-395X, ", "Hornik, K.; Leisch, F. & Zeileis, A. (ed.), ", "2003" ) ) R.methodsS3/inst/WORDLIST0000644000176200001440000000016213621443352014474 0ustar liggesusersAchim AppVeyor CMD conveniency DSC Friedrich Hornik Leisch macOS methodsS oo pre Pre setMethodS UseMethod Zeileis