R.methodsS3/0000755000176200001440000000000014251731556012334 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/0000755000176200001440000000000014251653247013107 5ustar liggesusersR.methodsS3/man/getMethodS3.Rd0000644000176200001440000000174514251654067015534 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.Rd0000644000176200001440000000240214251654067017527 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.Rd0000644000176200001440000000223114251654067017203 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.Rd0000644000176200001440000000270514251654067014546 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 \bold{R.oo} package, if that is loaded. The latter \code{R.oo::throw()} implementation is fully backward compatible with this one, but the error object thrown is of class \code{R.oo::Exception}.} \emph{WARNING: This function is deprecated in favor of \code{R.oo::throw()}, or alternatively, just \code{stop()}.} } \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} \keyword{internal} R.methodsS3/man/R.methodsS3-package.Rd0000644000176200001440000000500114251654067017035 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 originates from the \bold{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 } } \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.Rd0000644000176200001440000000203614251654067015662 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.Rd0000644000176200001440000000204214251654067015514 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.Rd0000644000176200001440000000234314251654067015517 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.Rd0000644000176200001440000001225514251654067015546 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 generic function and 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.Rd0000644000176200001440000000140414251654066015044 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.Rd0000644000176200001440000000232614251654067017053 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.Rd0000644000176200001440000000450614251654066015701 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.Rd0000644000176200001440000000220614251654067017767 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/DESCRIPTION0000644000176200001440000000222314251731556014041 0ustar liggesusersPackage: R.methodsS3 Version: 1.8.2 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: 2022-06-13 18:23:35 UTC; hb Repository: CRAN Date/Publication: 2022-06-13 22:00:14 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/R/0000755000176200001440000000000014251654041012526 5ustar liggesusersR.methodsS3/R/999.package.R0000644000176200001440000000246114143306333014576 0ustar liggesusers#########################################################################/** # @RdocPackage R.methodsS3 # # \description{ # @eval "packageDescription('R.methodsS3')$Description" # This contents of this package originates from the # \bold{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.R0000644000176200001440000000131714104174456013514 0ustar liggesusers## covr: skip=all .onLoad <- function(libname, pkgname) { value <- getOption("R.methodsS3:useSearchPath", NULL) if (is.null(value)) { value <- Sys.getenv("R_R_METHODSS3_USE_SEARCH_PATH", "TRUE") value <- isTRUE(as.logical(value)) options("R.methodsS3:useSearchPath" = value) } } .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.R0000644000176200001440000003300514126755466015333 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 generic function and 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))) { .Defunct(msg = "Argument 'enforceRCC' of setMethodS3() has been replaced by argument 'validators'.") } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 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) (optional) in the environments in the search path. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - envirs <- c(envir, loadenv) if (getOption("R.methodsS3:useSearchPath", TRUE)) { envirs <- c(envirs, 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.R0000644000176200001440000000235214251654041015441 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 \bold{R.oo} # package, if that is loaded. The latter \code{R.oo::throw()} implementation # is fully backward compatible with this one, but the error object thrown # is of class \code{R.oo::Exception}.} # # \emph{WARNING: This function is deprecated in favor of \code{R.oo::throw()}, # or alternatively, just \code{stop()}.} # } # # @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} # \keyword{internal} #*/########################################################################### 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.R0000644000176200001440000002106014126755355015460 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))) { .Defunct(msg = "Argument 'enforceRCC' of setGenericS3() has been replaced by argument 'validators'.") } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 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) (optional) in the environments in the search path. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - envirs <- c(envir, loadenv) if (getOption("R.methodsS3:useSearchPath", TRUE)) { envirs <- c(envirs, 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 ", sQuote(fcnPkg), " with the same name as an existing default function ", nameDefault, "() in ", sQuote(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.R0000644000176200001440000000406714104176013013152 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) if (!exists("environmentName", mode="function")) { environmentName <- function(env) attr(env, "name") } 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 <- environmentName(env) if (is.null(pkg)) { pkg <- "" if (identical(env, baseenv())) { pkg <- "base" } 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/NEWS.md0000644000176200001440000002007314251700220013414 0ustar liggesusers# Version 1.8.2 [2022-06-13] ## Deprecated & Defunct * Very old, deprecated argument `enforceRCC` for `setGenericS3()` and `setMethodS3()` is now defunct in favor of argument `validators`. # 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/MD50000644000176200001440000000454614251731556012655 0ustar liggesusers966471e938ff0593e6b97238d5d13d5e *DESCRIPTION 5ba0f371553d70d18151e9da2bd50edc *NAMESPACE 086956b09ea25af7739c4a38f088a6a0 *NEWS.md 8e57a35c304df1d3e43c214f865e3257 *R/000.R b6fedf6eec903c85f59d383d15983fc0 *R/001.R.KEYWORDS.R 51ecd8323217b75599a40978646b2407 *R/005.varArgs.R 1df04dc13e5ad8dbc137a07bad5a1af1 *R/006.fixVarArgs.R b54b6152d5d455b6d4b19b90e88a630c *R/010.setGenericS3.R cdd7cb1700f54b56410b52d9d648b708 *R/030.setMethodS3.R 8a1ef83fe9e11779f11a04d068e7918d *R/999.NonDocumentedObjects.R ba6e8edb7bf5b13b013669b8d2d23be6 *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 da2b5a662415b628f77dd1911995afbb *R/throw.default.R bfb121dc087ecdd9014c72f4be1a8f00 *R/zzz.R 221a5cb641badf6e5da59455778861ca *inst/CITATION 5ca40d7ba68d1842ff37a487642361e5 *inst/WORDLIST e62840f5029923bb7fde68ff03c85ba7 *man/Non-documented_objects.Rd 1b3a605645f2bf15b72946858f67a3bb *man/R.KEYWORDS.Rd db64d608aed8d55dd26a5dace5cab546 *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 e846120baebc61ce19fa1eb7511ced6c *man/setMethodS3.Rd d18865149cd8dc51c8435b5fe661c3a5 *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