[Blotter-commits] r927 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 19 23:05:42 CET 2012
Author: gsee
Date: 2012-02-19 23:05:42 +0100 (Sun, 19 Feb 2012)
New Revision: 927
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/R/all.equal.instrument.R
pkg/FinancialInstrument/R/instrument.R
pkg/FinancialInstrument/R/instrument.table.R
pkg/FinancialInstrument/man/all.equal.instrument.Rd
Log:
- all.equal is better at handling nested lists with named vectors
like memberlist in guaranteed_spreads (and some other all.equal tweaks)
- NULL identifiers for currencies were not being converted to empty list
- instrument.table was looking in .GlobalEnv for .instrument instead of
FinancialInstrument:::.instrument
- Version 0.11.1
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2012-02-19 02:11:45 UTC (rev 926)
+++ pkg/FinancialInstrument/DESCRIPTION 2012-02-19 22:05:42 UTC (rev 927)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.11.0
+Version: 0.11.1
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
Modified: pkg/FinancialInstrument/R/all.equal.instrument.R
===================================================================
--- pkg/FinancialInstrument/R/all.equal.instrument.R 2012-02-19 02:11:45 UTC (rev 926)
+++ pkg/FinancialInstrument/R/all.equal.instrument.R 2012-02-19 22:05:42 UTC (rev 927)
@@ -1,7 +1,8 @@
#' instrument all.equal method
#'
#' @param char.n If length of a character vector is \code{char.n} or less it
-#' will be treated as a single element.
+#' will be treated as a single element. A negative value for \code{char.n} will
+#' be treated as if it were positive \code{Inf}.
#' @param collapse Only used if a character vector is of length less than
#' \code{char.n}. Unless \code{collapse} is \code{NULL}, it will be used in a
#' call to \code{\link{paste}}. If \code{collapse} is \code{NULL}, each element
@@ -9,6 +10,8 @@
#' @method all.equal instrument
#' @S3method all.equal instrument
#' @author Garrett See
+#' @seealso \code{\link{getInstrument}}, \code{\link{instrument.table}},
+#' \code{\link{buildHierarchy}}
#' @note ALPHA code. Subject to change
#' @keywords internal utilities
#' @examples
@@ -16,7 +19,7 @@
#' currency("USD")
#' stock("SPY", "USD", validExchanges=c("SMART", "ARCA", "BATS", "BEX"))
#' stock("DIA", "USD", validExchanges=c("SMART", "ARCA", "ISLAND"),
-#' ExtraField="something")
+#' ExtraField="something")
#'
#' all.equal(getInstrument("SPY"), getInstrument("DIA"))
#' all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5)
@@ -25,16 +28,28 @@
#' all.equal(getInstrument("DIA"), getInstrument("USD"))
#' }
all.equal.instrument <- function (target, current, char.n=2, collapse=";", ...) {
- # loosely based on code from base all.equal.R
+ if (char.n < 0) char.n <- Inf
msg <- NULL
- # Same type?
- if (!isTRUE(all.equal(class(target), class(current)))) {
- msg <- paste("Classes: ",
- class(target)[!class(target) %in% "instrument"], ", ",
- class(current)[!class(current) %in% "instrument"], sep="")
- # since all instruments inherit "instrument" class, don't include
- # "instrument in comparison. (Maybe we shouldn't include any that are
- # the same?)
+ # Same class?
+ tc <- class(target)
+ cc <- class(current)
+ # all instruments have the instrument class, so don't need to compare it
+ tc <- tc[!tc %in% "instrument"]
+ cc <- cc[!cc %in% "instrument"]
+ if (!isTRUE(all.equal(tc, cc))) {
+ if (is.null(collapse)) {
+ out <- NULL
+ if (!all(tc %in% cc))
+ out <- paste("Classes of target that are not classes of current: <",
+ paste(tc[!tc %in% cc], collapse=", "), ">")
+ if (!all(cc %in% tc))
+ out <- c(out, paste("Classes of current that are not classes of target: <",
+ paste(cc[!cc %in% tc], collapse=", "), ">"))
+ msg <- c(msg, out)
+ } else {
+ msg <- paste("Classes: ", paste(paste(tc, collapse=collapse),
+ paste(cc, collapse=collapse), sep=", "), sep="")
+ }
}
nx <- names(target)
ny <- names(current)
@@ -44,6 +59,9 @@
if (!all(ny %in% nx))
msg <- c(msg, paste("Names in current that are not in target: <",
paste(ny[!ny %in% nx], collapse=", "), ">"))
+ uniqueNames <- function(target, current) {
+ unique(c(names(target), names(current)))
+ }
do.compare <- function(target, current, i) {
if (!isTRUE(all.equal(target[[i]], current[[i]]))) {
ti <- target[[i]]
@@ -52,11 +70,20 @@
if (is.null(ci)) ci <- "NULL"
if (is.list(ti)) {
unames <- uniqueNames(ti, ci)
- out <- do.call(c,
- lapply(unames, function(x) do.compare(ti, ci, x)))
+ out <- do.call(c, lapply(unames, function(x) {
+ if (length(ti) == 1 && ti == "NULL") {
+ paste("NULL, <", names(ci), ">")
+ } else if (length(ci) == 1 && ci == "NULL") {
+ paste("<", names(ti), ">, NULL")
+ } else do.compare(ti, ci, x)
+ }))
return(paste(i, out, sep="$"))
}
- if (length(ti) > char.n && is.character(ti)) {
+ if (is.xts(ti)) {
+ ae <- all.equal(ti, ci)
+ if (!isTRUE(ae)) return(paste(i, ae, sep=": "))
+ }
+ if (max(length(ti), length(ci)) > char.n && is.character(ti)) {
out <- NULL
if (!all(ti %in% ci))
out <- paste(i, "in target but not in current: <",
@@ -65,33 +92,24 @@
out <- c(out, paste(i, "in current but not in target: <",
paste(ci[!ci %in% ti], collapse=", "), ">"))
return(out)
- } else if (is.character(ti)) {
- if (!is.null(collapse)) {
- out <- paste(paste(ti, collapse=collapse),
- paste(ci, collapse=collapse), sep=", ")
- out <- paste(i, ": ", out, sep="")
- return(out)
+ }
+ if (!is.null(collapse)) {
+ out <- if (isTRUE(all.equal(ti, ci, check.attributes=FALSE))) {
+ all.equal(ti, ci)
+ } else {
+ paste(paste(ti, collapse=collapse),
+ paste(ci, collapse=collapse), sep=", ")
}
+ return(paste(i, ": ", out, sep=""))
}
- if (is.xts(ti)) {
- ae <- all.equal(ti, ci)
- if (!isTRUE(ae)) return(paste(i, ae, sep=": "))
- }
-
out <- paste(ti, ci, sep=", ")
out <- paste(i, ": ", out, sep="")
-
return(out)
}
}
- uniqueNames <- function(target, current) {
- unique(c(names(target), names(current)))
- }
nxy <- uniqueNames(target, current)
-
msg <- c(msg,
do.call(c, lapply(nxy, function(x) do.compare(target, current, x))))
-
if (is.null(msg))
TRUE
else msg
Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R 2012-02-19 02:11:45 UTC (rev 926)
+++ pkg/FinancialInstrument/R/instrument.R 2012-02-19 22:05:42 UTC (rev 927)
@@ -577,9 +577,10 @@
#' @rdname instrument
currency <- function(primary_id, identifiers = NULL, assign_i=TRUE, ...){
if (length(primary_id) > 1) return(unname(sapply(primary_id, currency, identifiers=identifiers, ...=...)))
+ if (is.null(identifiers)) identifiers <- list()
ccy <- try(getInstrument(primary_id,type='currency',silent=TRUE))
if (is.instrument(ccy)) {
- if (!is.null(identifiers)) {
+ if (length(identifiers) > 0) {
if (!is.list(identifiers)) identifiers <- list(identifiers)
for (nm in names(ccy$identifiers)[names(ccy$identifiers) %in% names(identifiers)]) {
ccy$identifiers[[nm]] <- identifiers[[nm]]
Modified: pkg/FinancialInstrument/R/instrument.table.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.table.R 2012-02-19 02:11:45 UTC (rev 926)
+++ pkg/FinancialInstrument/R/instrument.table.R 2012-02-19 22:05:42 UTC (rev 927)
@@ -43,8 +43,8 @@
#' @export
instrument.table <- function(symbols=NULL, exclude = NULL, attrs.of = NULL) {
#TODO check for numeric/character
- if (is.null(symbols)) symbols <- ls(pos=.instrument, all.names=TRUE) #ls_instruments()
- if (is.null(attrs.of)) attrs.of <- ls(pos=.instrument, all.names=TRUE) #ls_instruments()
+ if (is.null(symbols)) symbols <- ls_instruments()
+ if (is.null(attrs.of)) attrs.of <- symbols
attr.names <- NULL
for (symbol in attrs.of) {
Modified: pkg/FinancialInstrument/man/all.equal.instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/all.equal.instrument.Rd 2012-02-19 02:11:45 UTC (rev 926)
+++ pkg/FinancialInstrument/man/all.equal.instrument.Rd 2012-02-19 22:05:42 UTC (rev 927)
@@ -8,7 +8,8 @@
\arguments{
\item{char.n}{If length of a character vector is
\code{char.n} or less it will be treated as a single
- element.}
+ element. A negative value for \code{char.n} will be
+ treated as if it were positive \code{Inf}.}
\item{collapse}{Only used if a character vector is of
length less than \code{char.n}. Unless \code{collapse}
@@ -28,7 +29,7 @@
currency("USD")
stock("SPY", "USD", validExchanges=c("SMART", "ARCA", "BATS", "BEX"))
stock("DIA", "USD", validExchanges=c("SMART", "ARCA", "ISLAND"),
- ExtraField="something")
+ ExtraField="something")
all.equal(getInstrument("SPY"), getInstrument("DIA"))
all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5)
@@ -40,6 +41,11 @@
\author{
Garrett See
}
+\seealso{
+ \code{\link{getInstrument}},
+ \code{\link{instrument.table}},
+ \code{\link{buildHierarchy}}
+}
\keyword{internal}
\keyword{utilities}
More information about the Blotter-commits
mailing list