[Quantmod-commits] r594 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Dec 31 06:55:30 CET 2012
Author: jryan
Date: 2012-12-31 06:55:29 +0100 (Mon, 31 Dec 2012)
New Revision: 594
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/TA.R
pkg/R/getSymbols.R
pkg/R/zzz.R
pkg/man/getFX.Rd
pkg/man/getMetals.Rd
pkg/man/getSymbols.Rd
pkg/man/quantmod-package.Rd
Log:
o TA.R returned to previous state for legend() definitions within chartTA and chartSetUp
o getSymbols et al now default to env=parent.env(), which is in-line with the behavior
of load() in base. This may cause some edge case differences in user-land, but is
'the right thing to do' Possible extension to this will involve a new environment
which is currently being attached via .onAttach called .quantmodEnv and accessible via
quantmodenv(). The latter may be used now, but isn't (yet) the default. This is pending
further feedback.
o DESCRIPTION updates
o package docs updates
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/DESCRIPTION 2012-12-31 05:55:29 UTC (rev 594)
@@ -1,7 +1,7 @@
Package: quantmod
Type: Package
Title: Quantitative Financial Modelling Framework
-Version: 0.3-23
+Version: 0.3-24
Date: 2012-12-27
Author: Jeffrey A. Ryan
Depends: Defaults, xts(>= 0.9-0), zoo, TTR(>= 0.2), methods
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/NAMESPACE 2012-12-31 05:55:29 UTC (rev 594)
@@ -1,3 +1,6 @@
+export(quantmodenv)
+S3method(print, quantmodEnv)
+
# NAMESPACE file for quantmod
importFrom(graphics,plot)
importFrom(stats,predict)
Modified: pkg/R/TA.R
===================================================================
--- pkg/R/TA.R 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/R/TA.R 2012-12-31 05:55:29 UTC (rev 594)
@@ -125,22 +125,18 @@
1:NCOL(tav)
} else x at params$order
- if(is.null(x at params$legend))
- #legend <- function(...) {}
- body(legend) <- {}
+ if(is.null(x at params$legend)) legend <- function(legend,text.col,...) {}
if(is.character(x at params$legend) && x at params$legend != "auto") {
legend("topleft", legend=x at params$legend, bty='n', y.inter=0.95)
- #legend <- function(...) { }
- body(legend) <- {}
+ legend <- function(legend,text.col,...) { }
}
if(!x at new) {
- #legend <- function(legend,text.col,...) { list(legend=legend,text.col=text.col) }
- formals(legend) <- formals(graphics::legend)
- text.col <- NULL # make check happy, this function is going away anyway, so..
- body(legend) <- { list(legend=legend, text.col=text.col) }
+ legend <- function(legend,text.col,...) { list(legend=legend,text.col=text.col) }
}
+
+ #formals(legend) <- alist(legend=,text.col=,...=) #formals(graphics::legend) # all have the same formals now
legend.text <- list()
# possibly able to handle newTA functionality
@@ -191,89 +187,87 @@
# chartSetUp {{{
`chartSetUp` <-
function(x) {
- .Deprecated("layout",msg="For multiple charts on one device, use chart_Series and the R layout() function")
-# spacing <- x at params$spacing
-# width <- x at params$width
-#
-# x.range <- x at params$xrange
-# x.range <- seq(x.range[1],x.range[2]*spacing)
-#
-# tav <- x at TA.values
-#
-# if(x at new) {
-# y.range <- if(is.null(x at params$yrange) || length(x at params$yrange) != 2) {
-# seq(min(tav * 0.975, na.rm = TRUE), max(tav * 1.05, na.rm = TRUE),
-# length.out=length(x.range))
-# } else seq(x at params$yrange[1],x at params$yrange[2],length.out=length(x.range))
-#
-# plot(x.range,y.range,type='n',axes=FALSE,ann=FALSE)
-# coords <- par('usr')
-# rect(coords[1],coords[3],coords[2],coords[4],col=x at params$colors$area)
-# grid(NA,NULL,col=x at params$colors$grid.col)
-# }
-#
-# pars <- x at params$pars[[1]]
-# pars <- lapply(pars,
-# function(x) {
-# len <- NCOL(tav)
-# if(length(x) < len) {
-# rep(list(x), length.out=len)
-# } else rep(list(x),length.out=len)
-# })
-## pars <- x at params$pars#[[1]]
-## pars <- lapply(pars, function(x) rep(x, length.out=NCOL(tav)))
-#
-# col.order <- if(is.null(x at params$order)) {
-# 1:NCOL(tav)
-# } else x at params$order
-#
-# if(is.null(x at params$legend)) legend <- function(...) {}
-# if(is.character(x at params$legend) && x at params$legend != "auto") {
-# legend("topleft", legend=x at params$legend, bty='n', y.inter=0.95)
-# legend <- function(...) { }
-# }
-#
-# if(!x at new) {
-# legend <- function(legend,text.col) { list(legend=legend,text.col=text.col) }
-# formals(legend) <- formals(graphics::legend)
-# }
-#
-# legend.text <- list()
-#
-# # possibly able to handle newTA functionality
-# if(is.null(x at params$legend.name)) x at params$legend.name <- deparse(x at call[-1][[1]])
-#
-# if(NCOL(tav) == 1) {
-# tmp.pars <- lapply(pars,function(x) x[[1]][[1]])
-## if(x at params$isLogical) {
-## do.call('rect',c(list(shading(tav)$start*spacing), list(par('usr')[3]),
-## list(shading(tav)$end*spacing), list(par('usr')[4]), tmp.pars))
-## } else
-## do.call('lines',c(list(seq(1,length(x.range),by=spacing)), list(tav), tmp.pars))
-# legend.text[[1]] <- legend('topleft',
-# legend=c(paste(x at params$legend.name,":"),sprintf("%.3f",last(na.omit(tav)))),
-# text.col=c(x at params$colors$fg.col,last(pars$col[[1]])),bty='n',y.inter=.95)
-# } else {
-# for(cols in col.order) {
-# tmp.pars <- lapply(pars,function(x) x[[cols]][[cols]])
-## do.call('lines',c(list(seq(1,length(x.range),by=spacing)), list(tav[,cols]), tmp.pars))
-# if(cols==1) {
-# legend.text[[cols]] <- legend('topleft',
-# legend=c(paste(x at params$legend.name,":")),
-# text.col=c(x at params$colors$fg.col,last(pars$col[[cols]])),bty='n',y.inter=.95)
-# }
-# # for each column, add colname: value
-# Col.title <- colnames(tav)[cols]
-# legend.text[[cols]] <- legend('topleft',
-# legend=c(rep('',cols),paste(Col.title,":",
-# sprintf("%.3f",last(na.omit(tav[,cols]))))),
-# text.col=pars$col[[cols]][cols],bty='n',y.inter=.95)
-# }
-# }
-#
-# axis(2)
-# box(col=x at params$colors$fg.col)
-# invisible(legend.text)
+ spacing <- x at params$spacing
+ width <- x at params$width
+
+ x.range <- x at params$xrange
+ x.range <- seq(x.range[1],x.range[2]*spacing)
+
+ tav <- x at TA.values
+
+ if(x at new) {
+ y.range <- if(is.null(x at params$yrange) || length(x at params$yrange) != 2) {
+ seq(min(tav * 0.975, na.rm = TRUE), max(tav * 1.05, na.rm = TRUE),
+ length.out=length(x.range))
+ } else seq(x at params$yrange[1],x at params$yrange[2],length.out=length(x.range))
+
+ plot(x.range,y.range,type='n',axes=FALSE,ann=FALSE)
+ coords <- par('usr')
+ rect(coords[1],coords[3],coords[2],coords[4],col=x at params$colors$area)
+ grid(NA,NULL,col=x at params$colors$grid.col)
+ }
+
+ pars <- x at params$pars[[1]]
+ pars <- lapply(pars,
+ function(x) {
+ len <- NCOL(tav)
+ if(length(x) < len) {
+ rep(list(x), length.out=len)
+ } else rep(list(x),length.out=len)
+ })
+# pars <- x at params$pars#[[1]]
+# pars <- lapply(pars, function(x) rep(x, length.out=NCOL(tav)))
+
+ col.order <- if(is.null(x at params$order)) {
+ 1:NCOL(tav)
+ } else x at params$order
+
+ if(is.null(x at params$legend)) legend <- function(legend,text.col,...) {}
+ if(is.character(x at params$legend) && x at params$legend != "auto") {
+ legend("topleft", legend=x at params$legend, bty='n', y.inter=0.95)
+ legend <- function(legend,text.col,...) { }
+ }
+
+ if(!x at new) {
+ legend <- function(legend,text.col,...) { list(legend=legend,text.col=text.col) }
+ }
+
+ legend.text <- list()
+
+ # possibly able to handle newTA functionality
+ if(is.null(x at params$legend.name)) x at params$legend.name <- deparse(x at call[-1][[1]])
+
+ if(NCOL(tav) == 1) {
+ tmp.pars <- lapply(pars,function(x) x[[1]][[1]])
+# if(x at params$isLogical) {
+# do.call('rect',c(list(shading(tav)$start*spacing), list(par('usr')[3]),
+# list(shading(tav)$end*spacing), list(par('usr')[4]), tmp.pars))
+# } else
+# do.call('lines',c(list(seq(1,length(x.range),by=spacing)), list(tav), tmp.pars))
+ legend.text[[1]] <- legend('topleft',
+ legend=c(paste(x at params$legend.name,":"),sprintf("%.3f",last(na.omit(tav)))),
+ text.col=c(x at params$colors$fg.col,last(pars$col[[1]])),bty='n',y.inter=.95)
+ } else {
+ for(cols in col.order) {
+ tmp.pars <- lapply(pars,function(x) x[[cols]][[cols]])
+# do.call('lines',c(list(seq(1,length(x.range),by=spacing)), list(tav[,cols]), tmp.pars))
+ if(cols==1) {
+ legend.text[[cols]] <- legend('topleft',
+ legend=c(paste(x at params$legend.name,":")),
+ text.col=c(x at params$colors$fg.col,last(pars$col[[cols]])),bty='n',y.inter=.95)
+ }
+ # for each column, add colname: value
+ Col.title <- colnames(tav)[cols]
+ legend.text[[cols]] <- legend('topleft',
+ legend=c(rep('',cols),paste(Col.title,":",
+ sprintf("%.3f",last(na.omit(tav[,cols]))))),
+ text.col=pars$col[[cols]][cols],bty='n',y.inter=.95)
+ }
+ }
+
+ axis(2)
+ box(col=x at params$colors$fg.col)
+ invisible(legend.text)
} # }}}
# setTA {{{
Modified: pkg/R/getSymbols.R
===================================================================
--- pkg/R/getSymbols.R 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/R/getSymbols.R 2012-12-31 05:55:29 UTC (rev 594)
@@ -1,7 +1,7 @@
# getSymbols {{{
"getSymbols" <-
function(Symbols=NULL,
- env=.GlobalEnv,
+ env=parent.frame(),
reload.Symbols=FALSE,
verbose=FALSE,
warnings=TRUE,
@@ -74,9 +74,8 @@
all.symbols <- c(all.symbols,old.Symbols)[unique(names(c(all.symbols,old.Symbols)))]
if(auto.assign) {
assign('.getSymbols',all.symbols,env);
- if(identical(env, .GlobalEnv))
- return(req.symbols)
- return(env)
+ return(req.symbols)
+ #return(env)
}
} else {
warning('no Symbols specified')
@@ -86,7 +85,6 @@
loadSymbols <- getSymbols
loadSymbols.formals <- formals(getSymbols)
-loadSymbols.formals$env <- substitute(.GlobalEnv)
formals(loadSymbols) <- loadSymbols.formals
@@ -520,7 +518,7 @@
# getFX {{{
`getFX` <-
function(Currencies,from=Sys.Date()-499,to=Sys.Date(),
- env=.GlobalEnv,
+ env=parent.frame(),
verbose=FALSE,warning=TRUE,
auto.assign=TRUE,...) {
importDefaults("getFX")
@@ -546,7 +544,7 @@
# getMetals {{{
`getMetals` <-
function(Metals,from=Sys.Date()-500,to=Sys.Date(),
- base.currency="USD",env=.GlobalEnv,
+ base.currency="USD",env=parent.frame(),
verbose=FALSE,warning=TRUE,
auto.assign=TRUE,...) {
importDefaults("getMetals")
@@ -953,7 +951,7 @@
# removeSymbols {{{
"removeSymbols" <-
-function(Symbols=NULL,env=.GlobalEnv) {
+function(Symbols=NULL,env=parent.frame()) {
if(exists('.getSymbols',env,inherits=FALSE)) {
getSymbols <- get('.getSymbols',env,inherits=FALSE)
if(is.null(Symbols)) {
@@ -977,7 +975,7 @@
# showSymbols {{{
"showSymbols" <-
-function(env=.GlobalEnv) {
+function(env=parent.frame()) {
if(exists('.getSymbols',env,inherits=FALSE)) {
return(unlist(get('.getSymbols',env)))
} else { return(NULL) }
@@ -986,7 +984,7 @@
# saveSymbols {{{
"saveSymbols"<-
-function(Symbols=NULL,file.path=stop("must specify 'file.path'"),env=.GlobalEnv) {
+function(Symbols=NULL,file.path=stop("must specify 'file.path'"),env=parent.frame()) {
if(exists('.getSymbols',env,inherits=FALSE)) {
getSymbols <- get('.getSymbols',env,inherits=FALSE)
if(is.null(Symbols)) {
Modified: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/R/zzz.R 2012-12-31 05:55:29 UTC (rev 594)
@@ -3,7 +3,15 @@
# cat("Version 0.3-7, Revision 461\n")
# cat("http://www.quantmod.com\n\n")
#}
+quantmodenv <- function() as.environment(".quantmodEnv")
+print.quantmodEnv <- function(x, ...) {
+ print("<environment: quantmodEnv>")
+}
+.onAttach <- function(libname,pkgname) {
+ attach(NULL, pos=2, name='.quantmodEnv')
+}
+
setOldClass("zoo");
setOldClass("xts");
setOldClass("Date");
Modified: pkg/man/getFX.Rd
===================================================================
--- pkg/man/getFX.Rd 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/man/getFX.Rd 2012-12-31 05:55:29 UTC (rev 594)
@@ -9,7 +9,7 @@
getFX(Currencies,
from = Sys.Date() - 499,
to = Sys.Date(),
- env = .GlobalEnv,
+ env = parent.frame(),
verbose = FALSE,
warning = TRUE,
auto.assign = TRUE, ...)
@@ -31,7 +31,7 @@
}
\value{
The results of the call will be the data will be assigned
-automatically to the environment specified (global by default). Additionally
+automatically to the environment specified (parent by default). Additionally
a vector of downloaded symbol names will be returned.
See \code{getSymbols} and \code{getSymbols.oanda} for more detail.
Modified: pkg/man/getMetals.Rd
===================================================================
--- pkg/man/getMetals.Rd 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/man/getMetals.Rd 2012-12-31 05:55:29 UTC (rev 594)
@@ -10,7 +10,7 @@
from = Sys.Date() - 500,
to = Sys.Date(),
base.currency="USD",
- env = .GlobalEnv,
+ env = parent.frame(),
verbose = FALSE,
warning = TRUE,
auto.assign = TRUE, ...)
@@ -41,7 +41,7 @@
}
\value{
Data will be assigned
-automatically to the environment specified (global by default).
+automatically to the environment specified (parent by default).
If auto.assign is set to FALSE, the data from a single metal
request will simply be returned from the function call.
Modified: pkg/man/getSymbols.Rd
===================================================================
--- pkg/man/getSymbols.Rd 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/man/getSymbols.Rd 2012-12-31 05:55:29 UTC (rev 594)
@@ -23,7 +23,7 @@
}
\usage{
getSymbols(Symbols = NULL,
- env = .GlobalEnv,
+ env = parent.frame(),
reload.Symbols = FALSE,
verbose = FALSE,
warnings = TRUE,
@@ -33,7 +33,7 @@
...)
loadSymbols(Symbols = NULL,
- env = .GlobalEnv,
+ env = parent.frame(),
reload.Symbols = FALSE,
verbose = FALSE,
warnings = TRUE,
@@ -42,11 +42,11 @@
auto.assign = TRUE,
...)
-showSymbols(env=.GlobalEnv)
-removeSymbols(Symbols=NULL,env=.GlobalEnv)
+showSymbols(env=parent.frame())
+removeSymbols(Symbols=NULL,env=parent.frame())
saveSymbols(Symbols = NULL,
file.path=stop("must specify 'file.path'"),
- env = .GlobalEnv)
+ env = parent.frame())
}
\arguments{
\item{Symbols}{ a character vector specifying
@@ -70,7 +70,7 @@
\code{getSymbols} is a wrapper to load data from
different sources - be them local or remote. Data is
fetched through one of the available \code{getSymbols} methods
-and saved in the \code{env} specified - the .GlobalEnv
+and saved in the \code{env} specified - the parent.frame()
by default. Data is loaded in much the same way that \code{load}
behaves. By default, it is assigned automatically
to a variable in the specified environment, \emph{without} the
@@ -83,9 +83,10 @@
behavior can be overridden by setting auto.assign to FALSE,
though it is not advised.
-Previous versions of getSymbols assigned each object into the user's
+The early (pre 2009) versions of getSymbols assigned each object into the user's
.GlobalEnv by name. This behavior is now supported by setting
-env=.GlobalEnv (the current transitional default),
+env=.GlobalEnv (the current default is to the calling \sQuote{parent.frame()},
+which in interactive use may be the global environment,
or by using the wrapper \code{loadSymbols}. Many
thanks to Kurt Hornik and Achim Zeileis for suggesting this change.
@@ -101,8 +102,8 @@
loaded symbol(s) names returned upon exit if that environment
is the .GlobalEnv.
-By default, a new environment is returned which contains
-all the objects loaded into it.
+%By default, a new environment is returned which contains
+%all the objects loaded into it.
If auto.assign is set to FALSE
the data will be returned from the call, and will require
Modified: pkg/man/quantmod-package.Rd
===================================================================
--- pkg/man/quantmod-package.Rd 2012-12-27 17:22:39 UTC (rev 593)
+++ pkg/man/quantmod-package.Rd 2012-12-31 05:55:29 UTC (rev 594)
@@ -1,6 +1,7 @@
\name{quantmod-package}
\alias{quantmod-package}
\alias{quantmod}
+\alias{quantmodenv}
\docType{package}
\title{
Quantitative Financial Modelling Framework
@@ -12,9 +13,9 @@
\tabular{ll}{
Package: \tab quantmod\cr
Type: \tab Package\cr
-Version: \tab 0.3-1\cr
-Date: \tab 2011-11-03\cr
-Depends: \tab xts(>=0.8),Defaults\cr
+Version: \tab 0.3-241\cr
+Date: \tab 2012-12-31\cr
+Depends: \tab xts(>=0.9-1),Defaults\cr
Suggests: \tab DBI,RMySQL,TTR,fSeries,its\cr
LazyLoad: \tab yes\cr
License: \tab GPL-3\cr
@@ -29,7 +30,8 @@
\emph{What quantmod IS}
-A rapid prototyping environment,
+A rapid prototyping environment, with comprehensive
+tools for data management and visualization.
where quant traders can quickly
and cleanly explore and build trading models.
More information about the Quantmod-commits
mailing list