R.methodsS3/0000755000176000001440000000000012471566563012372 5ustar ripleyusersR.methodsS3/inst/0000755000176000001440000000000012471523324013333 5ustar ripleyusersR.methodsS3/inst/CITATION0000644000176000001440000000255612471523324014500 0ustar ripleyuserscitHeader("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 = "http://www.r-project.org/conferences/DSC-2003/Proceedings/Bengtsson.pdf", howpublished = "http://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/tests/0000755000176000001440000000000012471523324013520 5ustar ripleyusersR.methodsS3/tests/pkgStartupMessage.R0000644000176000001440000000045312471523324017316 0ustar ripleyuserslibrary("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/attributes.R0000644000176000001440000000072112471523324016031 0ustar ripleyuserslibrary("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/tests/throw.R0000644000176000001440000000054312471523325015011 0ustar ripleyuserslibrary("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/isGenericS3S4.R0000644000176000001440000000061712471523324016174 0ustar ripleyuserslibrary("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/setGenericS3.R0000644000176000001440000000134512471523324016144 0ustar ripleyuserslibrary("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") setGenericS3("bar") print(getGenericS3("print")) # Your defintion will redefine bar() above to bar.default(). foobar <- function() print("foobar()") setGenericS3("foobar") # Cleanup rm(list=ls()) message("TESTING: setGenericS3()...DONE") R.methodsS3/tests/findDispatchMethodsS3.R0000644000176000001440000000051212471523324017773 0ustar ripleyuserslibrary("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/appendVarArgs.R0000644000176000001440000000042212471523324016376 0ustar ripleyuserslibrary("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/setMethodS3.R0000644000176000001440000000342012471523324016004 0ustar ripleyuserslibrary("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 defintion 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/getDispatchMethodS3.R0000644000176000001440000000046412471523324017455 0ustar ripleyuserslibrary("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/NAMESPACE0000644000176000001440000000326312471523324013601 0ustar ripleyusers# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # IMPORTS # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - importFrom("utils", "capture.output") importFrom("utils", "getAnywhere") importFrom("utils", "getS3method") ## When package depends on R (>= 2.6.0) ## importFrom("codetools", "findGlobals") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 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/NEWS0000644000176000001440000001350612471523324013062 0ustar ripleyusersPackage: R.methodsS3 ==================== Version: 1.7.0 [2015-02-19] o ROBUSTNESS: Added several package tests. o CONSISTENCY: Now isGenericS4() returns FALSE for non-existing functions, just as isGenericS3() does. o BUG FIX: 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)". o BUG FIX/WORKAROUND: 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] o CLEANUP: Internal directory restructuring. Version: 1.6.1 [2014-01-04] o 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] o BUG FIX: 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] o ROBUSTNESS: Now setMethodS3(name, class, ...) and setGenericS3(name, ...) assert that arguments 'name' and 'class' are non-empty. Version: 1.5.2 [2013-10-06] o 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. o 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. o Added argument 'inherits' to getGenericS3(). o 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] o BUG FIX: 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] o Added pkgStartupMessage() which acknowledges library(..., quietly=TRUE). Version: 1.4.5 [2013-08-23] o CLEANUP: Dropped deprecated inst/HOWTOSITE replaced by inst/CITATION. o CLEANUP: No longer utilizing ':::' for "self" (i.e. R.methodsS3) methods. Version: 1.4.4 [2013-05-19] o CRAN POLICY: Now all Rd \usage{} lines are at most 90 characters long. Version: 1.4.3 [2013-03-08] o Added an Authors@R field to the DESCRIPTION. Version: 1.4.2 [2012-06-22] o 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] o Added argument 'overwrite' to setGenericS3(). Version: 1.4.0 [2012-04-20] o Now setMethodS3() sets attribute "S3class" to the class. o Added argument 'export' to setMethodS3() and setGenericS3(), which sets attribute "export" to the same value. Version: 1.3.0 [2012-04-16] o Now only generic funcions are exported, and not all of them. o Now all S3 methods are properly declared in NAMESPACE. Version: 1.2.3 [2012-03-08] o Now arguments '...' of setMethodS3() are passed to setGenericS3(). Version: 1.2.2 [2011-11-17] o CLEANUP: Dropped example(getMethodS3), which was for setMethodS3(). Version: 1.2.1 [2010-09-18] o BUG FIX: 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 affects 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. o BUG FIX: 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] o Added a NAMESPACE. Version: 1.1.0 [2010-01-02] o Added getDispatchMethodS3() and findDispatchMethodsS3(). Version: 1.0.3 [2008-07-02] o Renamed HISTORY file to NEWS. Version: 1.0.2 [2008-05-08] o Added getMethodS3() and getGenericS3(). o BUG FIX: isGenericS3() and isGenericS4() gave an error if a function was passed. Version: 1.0.1 [2008-03-06] o Added paper to citation("R.methodsS3"). o BUG FIX: 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] o 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/0000755000176000001440000000000012471523324012557 5ustar ripleyusersR.methodsS3/R/pkgStartupMessage.R0000644000176000001440000000530212471523324016353 0ustar ripleyusers#########################################################################/** # @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 outputed, 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 ############################################################################ # HISTORY: # 2013-08-29 # o Added pkgStartupMessage(). ############################################################################ R.methodsS3/R/000.R0000644000176000001440000000644712471523324013214 0ustar ripleyusers############################################################################## # 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() ############################################################################ # HISTORY: # 2013-10-06 # o Added .findFunction(). # 2012-04-17 # o Added S3class() function. # o Added export() and noexport() functions. # 2007-09-17 # o Removed support for R v2.2.0 and before by removing patch for missing # baseenv(). # 2007-04-07 # o Removed support for R v2.0.0 and before. # 2006-02-09 # o Added baseenv() for R versions (< v2.2.0) where it does not exist. # This is used in setGenericS3() and setMethodS3() from R v2.3.0. # 2005-02-15 # o Now require() is only called for R v1.9.1 or eariler. # 2005-02-10 # o Moved R.KEYWORDS into its own source file. # 2003-05-06 # o Added require(methods) to make sure getMethods() etc works. # 2002-11-21 # o Added "..." to R.KEYWORDS. # 2002-10-17 # o Removed obsolete "modifiers<-"(). # o Added also "Object" to the class attribute to make static methods to # work. # 2002-10-16 # o There are times when # generic <- function(...) UseMethod() # is not working, for example # fcn <- get("generic"); fcn(myObj, ...); # For this reason, always do method dispatching using the name explicitly; # generic <- function(...) UseMethod("generic") # # 2002-10-15 # o Created from R.oo Object.R and ideas as described on # http://www.maths.lth.se/help/R/ ############################################################################ R.methodsS3/R/001.R.KEYWORDS.R0000644000176000001440000000233612471523324014654 0ustar ripleyusers###########################################################################/** # @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; ############################################################################ # HISTORY: # 2007-09-17 # o Updated. Added 'NA__' keywords. # 2005-02-10 # o Moved into its own source code file. Extracted from 000.GLOBALS.R. # 2002-11-21 # o Added "..." to R.KEYWORDS. ############################################################################ R.methodsS3/R/getMethodS3.R0000644000176000001440000000244312471523324015033 0ustar ripleyusers###########################################################################/** # @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); }) ############################################################################ # HISTORY: # 2011-11-17 # o CLEANUP: Dropped example(getMethodS3), which was for setMethodS3(). # 2010-09-18 # o BUG FIX: getMethodS3() failed to locate S3 methods created in the # global enviroment. # 2008-05-08 # o Added getMethodS3(). ############################################################################ R.methodsS3/R/isGenericS3.R0000644000176000001440000001411412471523324015021 0ustar ripleyusers###########################################################################/** # @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(), if available, # otherwise scan the body res <- tryCatch({ ns <- getNamespace("codetools"); findGlobals <- get("findGlobals", mode="function", envir=ns); fcns <- 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"); ############################################################################ # HISTORY: # 2015-01-13 # o CONSISTENCY: Now isGenericS4() returns FALSE for non-existing # functions, just as isGenericS3() does. # o BUG FIX: 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)". # 2013-10-05 # o 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. # 2010-09-18 # o BUG FIX: 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. # 2004-10-18 # o Added Rdoc comments for isGenericS3() and isGenericS4(). # 2002-10-15 # o Created from R.oo Object.R and ideas as described on # http://www.maths.lth.se/help/R/ ############################################################################ R.methodsS3/R/findDispatchMethodsS3.R0000644000176000001440000000707512471523324017045 0ustar ripleyusers###########################################################################/** # @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) { throw("Argument 'methodName' is empty."); } if (length(methodName) > 1) { throw("Argument 'methodName' must only contain one element: ", paste(head(methodName), collapse=", ")); } # Argument 'classNames': classNames <- as.character(classNames); if (length(classNames) == 0) { throw("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() ############################################################################ # HISTORY: # 2015-02-02 # o WORKAROUND: In R (< 3.1.?) there is a bug in getAnywhere() causing it # to return garbage in parts of the 'objs' list. This bug has been # there all the time, but was only detected now when a package test # for findDispatchMethodsS3() was added. # 2010-12-02 # o Added Rdoc comments. # o Made findDispatchMethodsS3() a default method. # 2009-11-20 # o Added findDispatchMethodsS3(). ############################################################################ R.methodsS3/R/rccValidators.R0000644000176000001440000000265212471523324015507 0ustar ripleyusersrccValidateFunctionName <- 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)) throw("Except for a few operators, method/function names must begin with a letter: ", name); # Check first letter if (firstLetter == toupper(firstLetter)) throw("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; ############################################################################ # HISTORY: # 2012-06-22 # o Now rccValidateFunctionName() also accepts names starting with # symbols "+", "-", "*", "^", and "%". # 200x-xx-xx # o Created. ############################################################################ R.methodsS3/R/030.setMethodS3.R0000644000176000001440000004240712471523324015354 0ustar ripleyusers###########################################################################/** # @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 defintion.} # \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 unnotice.} # \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 <- 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, "name"), "$<-" = c(NA, "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"); ############################################################################ # HISTORY: # 2013-11-05 # o ROBUSTNESS: Now setMethodS3(name, class, ...) asserts that arguments # 'name' and 'class' are non-empty. # 2013-10-06 # o CLEANUP: setGenericS3() utilizes new .findFunction(). # 2012-08-23 # o No longer utilizing ':::' for "self" (i.e. R.methods3) methods. # 2012-06-22 # o 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 "^%[^%]*%$". # 2012-04-17 # o Added argument 'exportGeneric' to setMethodS3(). # o Added argument 'export' to setMethodS3() and setGenericS3(). # o Now setMethodS3() sets attribute "S3class" to the class. This will # make S3 methods such as a.b.c() non abigous, because it will be possible # to infer whether the generic function is a() or a.b(). The reason for # not using an attribute "S3method" = c("a.b", "c") is that the generic # function should automaticly change if someone does d.e.c <- a.b.c. # 2012-03-08 # o Now arguments '...' of setMethodS3() are passed to setGenericS3(). # 2007-09-17 # o Replaced 'enforceRCC' argument with more generic 'validators'. # 2007-06-09 # o Removed (incorrect) argument name 'list' from all substitute() calls. # 2006-02-09 # o Removed all usage of NULL environments. get(envir=NULL) is replaced # with get(envir=baseenv()). # 2005-11-23 # o Added validation of arguments in replacement functions. # o Added RCC validation of arguments in 'picky' methods, e.g. $()". # 2005-06-14 # o BUG FIX: Argument 'enforceRCC' was not passed to setGenericS3(). # 2005-02-28 # o Now appendVarArgs is ignore if replacement function, i.e. named "nnn<-". # 2005-02-25 # o Tracked down the source of "using .GlobalEnv instead of package:" # warnings. They occured when defining abstract methods. They also occured # when automatically adding missing '...' arguments. Made an ad hoc fix # for this, which I do not really understand why it works, or rather why # it did not work before. # 2005-02-20 # o Abstract methods are now defined with '...' as the only argument(s). # This will please R CMD check for some methods, e.g. open(). # 2005-02-15 # o Added argument 'addVarArgs' if missing. # o Added arguments '...' in order to match any generic functions. # 2003-04-24 # o From R v1.7.0, 'if (vector == scalar)' gives a warning. Had to do # conflict <- match.arg(conflict), which is more correct. # 2003-01-18 # o Replaced all occurences of getClass() with data.class(). Will change # the use of getClass() in the future to return a Class object. # 2002-12-05 # o Spell correction in error message. # 2002-12-02 # o Change to argument 'overwrite=TRUE'. # 2002-12-01 # o Added argument 'overwrite=FALSE' and 'conflict=c("error", "warning", # "quiet")' to setMethodS3(). # 2002-11-29 # o Updated some error messages. # o Now it is possible to create methods (also generic) with one (or several) # . (period) as a prefix of the name. Such a method should be considered # private in the same manner as fields with a period are private. # 2002-10-17 # o Removed obsolete "modifiers<-"(). # o Added also "Object" to the class attribute to make static methods to # work. # 2002-10-16 # o There are times when # generic <- function(...) UseMethod() # is not working, for example # fcn <- get("generic"); fcn(myObj, ...); # For this reason, always do method dispatching using the name explicitly; # generic <- function(...) UseMethod("generic") # 2002-10-15 # o Created from R.oo Object.R and ideas as described on # http://www.maths.lth.se/help/R/ ############################################################################ R.methodsS3/R/005.varArgs.R0000644000176000001440000000202412471523324014610 0ustar ripleyusershasVarArgs <- 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; ############################################################################ # HISTORY: # 2005-02-15 # o Created. ############################################################################ R.methodsS3/R/006.fixVarArgs.R0000644000176000001440000000050312471523324015260 0ustar ripleyusers# Added '...' to some base functions. These will later be # turned into default functions by setMethodS3(). ############################################################################ # HISTORY: # 2005-02-15 # o Created to please R CMD check. ############################################################################ R.methodsS3/R/010.setGenericS3.R0000644000176000001440000002604012471523324015501 0ustar ripleyusers###########################################################################/** # @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) { warning("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, "."); return(); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # 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 ;) ############################################################################ # HISTORY: # 2014-01-04 # o CLEANUP: Dropped obsolete argument 'ellipsesOnly' from setGenericS3(). # It was not used internally anyway. Thanks Antonio Piccolboni for # reporting on this. # 2013-11-12 # o BUG FIX: Generic function created by setGenericS3("foo<-") would not # have a last argument name 'value', which 'R CMD check' complains about. # 2013-11-05 # o ROBUSTNESS: Now setGenericS3(name, ...) asserts that argument # 'name' is non-empty. # 2013-10-06 # o CLEANUP: setGenericS3() utilizes new .findFunction(). # 2013-10-05 # o Now setGenericS3() fully utilizes isGenericS3(). # o Now setGenericS3() looks for existing generic functions also in # imported namespaces. # 2012-06-17 # o Added argument 'overwrite' to setGenericS3(). # 2012-04-17 # o Added argument 'export' to setMethodS3() and setGenericS3(). # 2007-09-17 # o Replaced 'enforceRCC' argument with more generic 'validators'. # 2007-06-09 # o Removed (incorrect) argument name 'list' from all substitute() calls. # 2006-02-09 # o Removed all usage of NULL environments. get(envir=NULL) is replaced # with get(envir=baseenv()). # 2005-06-14 # o Now setGenericS3() allows a few methods that starts with a non-letter # as the first character. See code for details. # 2005-02-15 # o Added arguments '...' in order to match any generic functions. # 2004-06-27 # o Added known generic function 'as.vector()'. # 2003-07-07 # o Removed obsolete argument 'force' in Rdoc. # 2002-11-29 # o Updated some error messages. # o Now it is possible to create generic methods with one (or several) # . (period) as a prefix of the name. Such a method should be considered # private in the same manner as fields with a period are private. # 2002-11-28 # o SPELL CHECK: "...name name..." in one of setGenericS3()'s error messages. # 2002-11-10 # o Updated setGenericS3() to assert that the environment variable 'envir' # is actually the one in the frame of the sys.source() function call. This # is done by comparing function defintions. # o Changed setGenericS3() to *always* create generic functions with no # arguments except "...". # 2002-10-21 # o Made ellipsesOnly=TRUE by default. # 2002-10-17 # o Removed obsolete "modifiers<-"(). # o Added also "Object" to the class attribute to make static methods to # work. # 2002-10-16 # o There are times when # generic <- function(...) UseMethod() # is not working, for example # fcn <- get("generic"); fcn(myObj, ...); # For this reason, always do method dispatching using the name explicitly; # generic <- function(...) UseMethod("generic") # # 2002-10-15 # o Created from R.oo Object.R and ideas as described on # http://www.maths.lth.se/help/R/ ############################################################################ R.methodsS3/R/999.NonDocumentedObjects.R0000644000176000001440000000223512471523324017311 0ustar ripleyusers###########################################################################/** # @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 #*/########################################################################### ############################################################################ # HISTORY: # 2005-02-10 # o Created to please R CMD check. ############################################################################ R.methodsS3/R/999.package.R0000644000176000001440000000242712471523324014633 0ustar ripleyusers#########################################################################/** # @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{http://www.braju.com/R/}. # } # # \section{Dependancies 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/getGenericS3.R0000644000176000001440000000275612471523324015176 0ustar ripleyusers###########################################################################/** # @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)) { throw("No such function found: ", name); } else if (!isGenericS3(fcn)) { throw("The function found is not an S3 generic function: ", name); } fcn; }) ############################################################################ # HISTORY: # 2013-10-06 # o Now getGenericS3() uses .findFunction(). # 2013-10-05 # o Added argument 'inherits' to getGenericS3(). # 2010-09-18 # o BUG FIX: getGenericS3() failed to locate generic functions created # in the global enviroment. # 2008-05-08 # o Added getGenericS3(). ############################################################################ R.methodsS3/R/zzz.R0000644000176000001440000000103712471523324013540 0ustar ripleyusers## covr: skip=all .onAttach <- function(libname, pkgname) { # Set up RCC validators for R.methodsS3 validators <- getOption("R.methodsS3:validators:setGenericS3", list()) validators <- c(validators, list(rccValidateSetGenericS3)) validators <- getOption("R.methodsS3:validators:setMethodS3", list()) validators <- c(validators, list(rccValidateSetMethodS3)) pi <- utils::packageDescription(pkgname) pkgStartupMessage(pkgname, " v", pi$Version, " (", pi$Date, ") successfully loaded. See ?", pkgname, " for help.") } R.methodsS3/R/throw.default.R0000644000176000001440000000363412471523324015476 0ustar ripleyusers###########################################################################/** # @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(...) { stop(...); }) ############################################################################ # HISTORY: # 2005-09-17 # o Added to R.methodsS3 since it is so commonly used by my packages. # 2005-02-20 # o Updated broken link to tryCatch(). # 2005-02-10 # o Making use of tryCatch() only. # 2002-10-17 # o Now throw() always throws an Exception. # 2002-05-25 # * Bug fix in Rd \examples{}. Forgot a comment. # 2002-04-21 # * Redefined throw.default() so it takes several arguments, which are then # pasted together with sep="". In other words, instead of doing # stop(paste("bla bla", "value:", x, ".\n", sep="")) # one can just do # throw("bla bla", "value:", x, ".\n") # This is also a step towards the new exception model that supports # classes. # * Extract the throw() functions from trycatch.R, which relies on them, but # the throw()'s are stand-alone. ############################################################################ R.methodsS3/R/getDispatchMethodS3.R0000644000176000001440000000261012471523324016507 0ustar ripleyusers###########################################################################/** # @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) { throw(sprintf("No method %s() for this class structure: %s", methodName, paste(classNames, collapse=", "))); } res[[1]]$fcn; }, private=TRUE) ############################################################################ # HISTORY: # 2010-12-02 # o Added Rdoc comments. # o Made getDispatchMethodS3() a default method. # 2009-11-20 # o Added getDispatchMethodS3(). ############################################################################ R.methodsS3/MD50000644000176000001440000000437712471566563012715 0ustar ripleyusers313d917cfb8006fb52235de6132a3c04 *DESCRIPTION f2de135e6d9960bdb3af2a8cbe691496 *NAMESPACE b9f3d04596af355e6c25c7396dfe6feb *NEWS 2e86e8b470b9e59384be62210c3da00b *R/000.R 576ff223c1df906b32590e3e78d06d57 *R/001.R.KEYWORDS.R 1b1f9bd06d558a455d3f9374d2a378a3 *R/005.varArgs.R f1d34d487e5092e88713531cf6f10a6c *R/006.fixVarArgs.R 085e40e0b603eb14de11e0fb86e6187b *R/010.setGenericS3.R c2ca3d6adab3aefe4ff7ed3729583f70 *R/030.setMethodS3.R a4ab3969cbc2da96a8a2c1c2ed77b206 *R/999.NonDocumentedObjects.R 18dce216cff64556a53b1cd3916184f8 *R/999.package.R dfaf4d7589eb5a039b562e3cb6d447f2 *R/findDispatchMethodsS3.R 919beccc0425b2a5bd93bfe4fbf78264 *R/getDispatchMethodS3.R 0628c16ffde62e06702c6a4570bb9123 *R/getGenericS3.R 11769e9934d6e9fae57f15b583f57d0a *R/getMethodS3.R 44f342186a376d7e38555b28de85936e *R/isGenericS3.R 91b40723acbdd29d4143330b862d61b3 *R/pkgStartupMessage.R a1103ffdfd1c7ed50b0366f939d8549f *R/rccValidators.R 0e0caf77368e0fbee1650a5161a72a42 *R/throw.default.R 778b1ae1c9ef6801f7f9c1bf6344135d *R/zzz.R d8150d1411942582b7175c2bd26bf5eb *inst/CITATION e62840f5029923bb7fde68ff03c85ba7 *man/Non-documented_objects.Rd 1b3a605645f2bf15b72946858f67a3bb *man/R.KEYWORDS.Rd af63cbe05b850b79cfa16ebb9b0acd42 *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 1e7a7b30b80214fe3325a50d61a998b5 *man/pkgStartupMessage.Rd d0ad086d52e72c12787dc638dd019a5a *man/setGenericS3.Rd 519552cddec0a9e862f9401ad0eb1206 *man/setMethodS3.Rd 08f7aee8b35261e03de5cf4e245a405a *man/throw.Rd b24a7cd174fded033c7469ca5fe4f8b9 *tests/appendVarArgs.R 082b8b68b44a100236505a95ab9d6589 *tests/attributes.R ed696bed0b50020f8ed486c34dd58219 *tests/findDispatchMethodsS3.R 0f76ef7503849bf045737401e47a3a3d *tests/getDispatchMethodS3.R f2a3e7bf4f61342c91f284944d7888a2 *tests/isGenericS3S4.R 1c3c57bf749393c8dff21b2a3089688b *tests/pkgStartupMessage.R 292f96279990101660ccb20487c0f851 *tests/setGenericS3.R c200d5724ee5e90a244a72643f106394 *tests/setMethodS3.R b452094c7796d50a9aa77eac96407479 *tests/throw.R R.methodsS3/DESCRIPTION0000644000176000001440000000202512471566563014077 0ustar ripleyusersPackage: R.methodsS3 Version: 1.7.0 Depends: R (>= 2.2.0) Imports: utils Date: 2015-02-19 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 NeedsCompilation: no Packaged: 2015-02-20 03:15:35 UTC; hb Repository: CRAN Date/Publication: 2015-02-20 09:16:51 R.methodsS3/man/0000755000176000001440000000000012471523324013131 5ustar ripleyusersR.methodsS3/man/R.KEYWORDS.Rd0000644000176000001440000000140412471523324015066 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/getMethodS3.Rd0000644000176000001440000000174512471523324015555 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/isGenericS3.Rd0000644000176000001440000000234312471523324015540 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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.Rd0000644000176000001440000001217412471523324015567 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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 defintion.} \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 unnotice.} \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 defintion; 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/throw.Rd0000644000176000001440000000250612471523324014566 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/findDispatchMethodsS3.Rd0000644000176000001440000000240212471523324017550 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/getGenericS3.Rd0000644000176000001440000000203612471523324015703 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/getDispatchMethodS3.Rd0000644000176000001440000000223112471523324017224 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/pkgStartupMessage.Rd0000644000176000001440000000232512471523324017073 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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 outputed, 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/isGenericS4.Rd0000644000176000001440000000204212471523324015535 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/setGenericS3.Rd0000644000176000001440000000450612471523324015723 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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/R.methodsS3-package.Rd0000644000176000001440000000476012471523324017071 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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{http://www.braju.com/R/}. } \section{Dependancies 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{http://www.r-project.org/conferences/DSC-2003/Proceedings/} \cr } \keyword{package} R.methodsS3/man/Non-documented_objects.Rd0000644000176000001440000000220612471523324020010 0ustar ripleyusers%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % 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}