[Quantmod-commits] r617 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 7 20:03:43 CET 2014
Author: bodanker
Date: 2014-12-07 20:03:43 +0100 (Sun, 07 Dec 2014)
New Revision: 617
Added:
pkg/R/Defaults.R
pkg/man/Defaults.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/man/quantmod-package.Rd
Log:
- Copy required Defaults functionality from Defaults package, and remove
dependency on Defaults. Documentation still needs work. Bump version.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-12-07 18:55:39 UTC (rev 616)
+++ pkg/DESCRIPTION 2014-12-07 19:03:43 UTC (rev 617)
@@ -1,10 +1,10 @@
Package: quantmod
Type: Package
Title: Quantitative Financial Modelling Framework
-Version: 0.4-2
-Date: 2014-10-08
+Version: 0.4-3
+Date: 2014-12-08
Author: Jeffrey A. Ryan
-Depends: xts(>= 0.9-0), zoo, TTR(>= 0.2), methods, Defaults(>= 2.0-0)
+Depends: xts(>= 0.9-0), zoo, TTR(>= 0.2), methods
Suggests: DBI,RMySQL,RSQLite,timeSeries,its
Maintainer: Joshua M. Ulrich <josh.m.ulrich at gmail.com>
Description: Specify, build, trade, and analyse quantitative financial trading strategies
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-12-07 18:55:39 UTC (rev 616)
+++ pkg/NAMESPACE 2014-12-07 19:03:43 UTC (rev 617)
@@ -2,7 +2,7 @@
S3method(print, quantmodEnv)
# NAMESPACE file for quantmod
-import(methods, zoo, xts, TTR, Defaults)
+import(methods, zoo, xts, TTR)
importFrom(graphics,plot)
importFrom(stats,predict)
importFrom(stats,lag)
@@ -256,6 +256,13 @@
matchChart
)
+# Defaults functionality
+export(
+ importDefaults,
+ setDefaults,
+ unsetDefaults,
+ getDefaults
+ )
# S3 methods
S3method(seriesHi,default)
Added: pkg/R/Defaults.R
===================================================================
--- pkg/R/Defaults.R (rev 0)
+++ pkg/R/Defaults.R 2014-12-07 19:03:43 UTC (rev 617)
@@ -0,0 +1,163 @@
+"importDefaults" <-
+function(calling.fun=NULL) {
+ sc <- sys.call(-1)
+ if(is.null(calling.fun)) calling.fun <- as.character(sc[[1]])
+ if(is.function(calling.fun)) calling.fun <- deparse(substitute(calling.fun))
+ if(is.null(sc))
+ stop("importDefaults is only valid inside a function call")
+ if(as.character(sc[[1]]) != calling.fun) return()
+ #calling.fun <- as.character(match.call(call=as.call(sys.call(-1)))[1])
+ all.defaults <- getDefaults(calling.fun)
+ if(is.null(all.defaults)) return()
+ envir <- as.environment(-1)
+ #passed.args <- names(sapply(match.call(call=as.call(sys.call(-1)))[-1],deparse))
+ passed.args <- names(as.list(match.call(
+ definition=eval(parse(text=calling.fun)),
+ call=as.call(sys.call(-1)))))[-1]
+ formal.args <- names(formals(as.character(sys.call(-1))))
+ default.args <- names(which(sapply(all.defaults,function(x) !is.null(x))==TRUE))
+ for(arg in formal.args) {
+ if(!arg %in% passed.args) {
+ if(arg %in% default.args) {
+ if(typeof(all.defaults[arg][[1]])=='list') {
+ assign(arg, as.vector(all.defaults[arg][[1]]),envir=envir)
+ }
+ else if(typeof(all.defaults[arg][[1]]) %in% c('symbol','language')) {
+ assign(arg, all.defaults[arg][[1]],envir=envir)
+ }
+ else if(typeof(all.defaults[arg][[1]])=="character") {
+ if(length(all.defaults[arg][[1]])==1) {
+ assign(arg, eval(parse(text=all.defaults[arg][[1]])),envir=envir)
+ } else {
+ assign(arg, as.character(parse(text=all.defaults[arg][[1]])),envir=envir)
+ }
+ }
+ else {
+ assign(arg, as.vector(unlist(all.defaults[arg][[1]])),envir=envir)
+ }
+ }
+ }
+ }
+}
+`setDefaults` <-
+function (name, ...)
+{
+ if (is.function(name))
+ name <- deparse(substitute(name))
+ if(!is.function(eval(parse(text=name))))
+ stop("argument 'name' must be a function")
+
+ default.name <- paste(name, "Default", sep = ".")
+ old.defaults <- getDefaults(name)
+ new.defaults <- list(...)
+ avail.defaults <- formals(name)
+ matched.defaults <- list()
+ for(arg in names(new.defaults)) {
+ if(!is.na(pmatch(arg,names(avail.defaults)))) {
+ # if partial match is made:
+ arg.name <- match.arg(arg,names(avail.defaults))
+ mc <- match.call()[[arg]]
+ if(typeof(mc)=='language') mc <- eval(mc)
+ if(is.character(mc))
+ new.defaults[[arg]] <- paste("'", mc, "'", sep = "")
+ if(is.name(mc))
+ new.defaults[[arg]] <- as.character(mc)
+ matched.defaults[[arg.name]] <- new.defaults[[arg]]
+ if(is.null(new.defaults[[arg]])) old.defaults[[arg.name]]<-NULL
+ } else {
+ warning(paste(
+ sQuote(arg),"was not set, possibly not a formal arg for",
+ sQuote(name)))
+ }
+ }
+ # merge original and new, then take first value only
+ all.and.matched <- c(matched.defaults,old.defaults)
+ all.and.matched <- all.and.matched[unique(names(all.and.matched))]
+ if (length(all.and.matched) == 0) {
+ if(!is.null(getDefaults(name))) unsetDefaults(name, confirm = FALSE)
+ }
+ else {
+ env <- as.environment(-1)
+ eval(parse(text = paste("options(", default.name, "=list(",
+ paste(paste(names(all.and.matched), "=", lapply(all.and.matched,
+ function(x) {
+ if (is.character(x)) {
+ deparse(x)
+ }
+ else {
+ x
+ }
+ })), collapse = ","), "))", sep = "")), envir = env)
+ }
+}
+
+
+`unsetDefaults` <-
+function(name,confirm=TRUE) {
+ importDefaults(calling.fun='unsetDefaults')
+ if(is.function(name)) name <- deparse(substitute(name))
+ if(is.null(getDefaults(name)))
+ invisible(return())
+ #stop(paste("no Defaults set for",sQuote(name)))
+ remove.yes <- TRUE
+ if(confirm) {
+ CONFIRMATION <- readline(prompt=
+ paste("Are you sure you want to remove",
+ sQuote(name),"defaults? (N): "))
+ if(toupper(substr(CONFIRMATION,1,1))!="Y") {
+ remove.yes <- FALSE
+ cat(paste(sQuote(name),"Defaults NOT removed\n"))
+ } else {
+ if(confirm)
+ cat(paste(sQuote(name),"Defaults removed!\n"))
+ }
+ }
+ if(remove.yes) {
+ default.name <- paste(name,"Default",sep=".")
+ env <- as.environment(-1)
+ eval(parse(text=paste('options(',default.name,'=NULL)',sep='')),envir=env)
+ }
+}
+"getDefaults" <-
+function(name=NULL,arg=NULL) {
+ if(is.function(name)) name <- deparse(substitute(name))
+ if(!is.null(name)) {
+ if(length(name) > 1) {
+ if(!is.character(name))
+ stop(paste(sQuote('name'),"must be a character vector",
+ "or visible function"))
+ all.names=list()
+ }
+ for(each.name in name) {
+ default.name <- paste(each.name,"Default",sep=".")
+ if(is.null(arg)) {
+ if(exists('all.names',inherits=FALSE)) {
+ all.names[[each.name]] <- options(default.name)[[1]]
+ } else {
+ return(options(default.name)[[1]])
+ }
+ } else {
+ default.list <- list()
+ for(each.arg in arg) {
+ default.list[[each.arg]] <- options(default.name)[[1]][[each.arg]]
+ }
+ if(exists('all.names',inherits=FALSE)) {
+ all.names[[each.name]] <- default.list
+ } else {
+ return(default.list)
+ }
+ }
+ }
+ return(all.names)
+ } else {
+ all.options <- names(options())
+ all.Defaults <-as.character(
+ sapply(all.options[grep('.Default$',all.options)],
+ FUN=function(x) {
+ gsub('.Default$','',x)
+ })
+ )
+ if(identical(all.Defaults,character(0))) return(NULL)
+ return(all.Defaults)
+ }
+}
Added: pkg/man/Defaults.Rd
===================================================================
--- pkg/man/Defaults.Rd (rev 0)
+++ pkg/man/Defaults.Rd 2014-12-07 19:03:43 UTC (rev 617)
@@ -0,0 +1,105 @@
+\name{Defaults}
+\alias{importDefaults}
+\alias{getDefaults}
+\alias{setDefaults}
+\alias{unsetDefaults}
+\title{ Manage quantmod Default Argument Values }
+\description{
+Use globally specified defaults, if set, in place of formally specified
+default argument values. Allows user to specify function defaults
+different than formally supplied values, e.g. to change poorly performing
+defaults, or satisfy a different preference.
+}
+\usage{
+importDefaults(calling.fun)
+getDefaults(name = NULL, arg = NULL)
+setDefaults(name, ...)
+unsetDefaults(name, confirm = TRUE)
+}
+\arguments{
+ \item{calling.fun}{ name of function to act upon }
+ \item{name}{ name of function, quoted or unquoted }
+ \item{arg}{ values to retrieve }
+ \item{\dots}{ name=value default pairs }
+ \item{confirm}{ prompt before unsetting defaults }
+}
+\details{
+Placed immediately after the function declaration, a call to
+\code{importDefaults} checks the user's environment for globally
+specified default values for the called function. These defaults can be
+specified by the user with a call to \code{setDefaults}, and will override
+any default formal parameters, in effect replacing the original defaults
+with user supplied values instead.
+
+Any values specified by the user in a in the parent function (that is, the
+function containing \code{importDefaults}) will override the values
+set in the global default environment.
+}
+\value{
+\code{importDefaults} is used for its side-effect of loading all non-NULL
+default values specified by the user into the current function's
+environment, effectively changing the default values passed in the parent
+function call. \code{importDefaults} values, like formally defined
+defaults in the function definition, take lower precedence than arguments
+specified by the user in the function call.
+
+\code{getDefaults} returns a named list of defaults and associated
+values, similar to \code{formals}, only returning \code{setDefaults} set
+values for the \code{name} function. Single arguments need not be quoted,
+multiples must be as a character vector. Calling \code{getDefaults()}
+without arguments results in a character vector of all functions
+currently having Defaults set (by \code{setDefaults}).
+
+\code{setDefaults} is used for its side-effect of setting a list of
+default arguments by function.
+}
+\author{ Jeffrey A. Ryan }
+\note{
+It is important to note that when a function implements
+\code{importDefaults}, non-named arguments \emph{may} be ignored if a
+global default has been set (i.e. not NULL). If this is the case, simply
+name the arguments in the calling function.
+
+This \emph{should} also work for functions
+retrieving formal parameter values
+from \code{options}, as
+it assigns a value to the parameter in
+a way that looks like it was passed in
+the function call. So any check on \code{options}
+would presumably disregard \code{importDefaults}
+values if an argument
+was passed to the function (what \code{useDefaults}
+does)
+
+Like \code{options}, default settings are \emph{NOT} kept across sessions.
+Currently, it is \emph{NOT} possible to pass values for \dots arguments,
+only formally specified arguments in the original function definition.
+
+\code{unsetDefaults} removes the \emph{all} entries from the \code{options}
+lists for the specified function. To remove single function default values
+simply set the name of the argument to NULL in \code{setDefaults}.
+}
+\seealso{
+ \code{\link{options}}
+}
+\examples{
+my.fun <- function(x=3)
+{
+ importDefaults('my.fun')
+ x ^ 2
+}
+
+my.fun() #returns 9
+
+setDefaults(my.fun,x=10)
+my.fun() #returns 100
+my.fun(x=4) #returns 16
+
+getDefaults(my.fun)
+formals(my.fun)
+unsetDefaults(my.fun,confirm=FALSE)
+getDefaults(my.fun)
+
+my.fun() #returns 9
+}
+\keyword{ utilities }
Modified: pkg/man/quantmod-package.Rd
===================================================================
--- pkg/man/quantmod-package.Rd 2014-12-07 18:55:39 UTC (rev 616)
+++ pkg/man/quantmod-package.Rd 2014-12-07 19:03:43 UTC (rev 617)
@@ -13,9 +13,9 @@
\tabular{ll}{
Package: \tab quantmod\cr
Type: \tab Package\cr
-Version: \tab 0.4-2\cr
-Date: \tab 2014-10-08\cr
-Depends: \tab xts(>= 0.9-0),zoo,TTR(>= 0.2),methods,Defaults(>=2.0-0)\cr
+Version: \tab 0.4-3\cr
+Date: \tab 2014-12-08\cr
+Depends: \tab xts(>= 0.9-0),zoo,TTR(>= 0.2),methods\cr
Suggests: \tab DBI,RMySQL,RSQLite,timeSeries,its\cr
LazyLoad: \tab yes\cr
License: \tab GPL-3\cr
More information about the Quantmod-commits
mailing list