[Blotter-commits] r926 - in pkg/FinancialInstrument: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Feb 19 03:11:46 CET 2012
Author: gsee
Date: 2012-02-19 03:11:45 +0100 (Sun, 19 Feb 2012)
New Revision: 926
Added:
pkg/FinancialInstrument/R/all.equal.instrument.R
pkg/FinancialInstrument/man/all.equal.instrument.Rd
Modified:
pkg/FinancialInstrument/DESCRIPTION
pkg/FinancialInstrument/NAMESPACE
pkg/FinancialInstrument/R/instrument.R
pkg/FinancialInstrument/man/ls_instruments.Rd
Log:
- add instrument all.equal method to compare two instrument objects
- is.instrument.name checks if is.character first
- Version 0.11.0
Modified: pkg/FinancialInstrument/DESCRIPTION
===================================================================
--- pkg/FinancialInstrument/DESCRIPTION 2012-02-15 16:26:44 UTC (rev 925)
+++ pkg/FinancialInstrument/DESCRIPTION 2012-02-19 02:11:45 UTC (rev 926)
@@ -11,7 +11,7 @@
meta-data and relationships. Provides support for
multi-asset class and multi-currency portfolios. Still
in heavy development.
-Version: 0.10.10
+Version: 0.11.0
URL: https://r-forge.r-project.org/projects/blotter/
Date: $Date$
Depends:
@@ -46,3 +46,4 @@
'ls_expiries.R'
'saveSymbols.R'
'Tick2Sec.R'
+ 'all.equal.instrument.R'
Modified: pkg/FinancialInstrument/NAMESPACE
===================================================================
--- pkg/FinancialInstrument/NAMESPACE 2012-02-15 16:26:44 UTC (rev 925)
+++ pkg/FinancialInstrument/NAMESPACE 2012-02-19 02:11:45 UTC (rev 926)
@@ -1,11 +1,12 @@
+export(.to_daily)
+export(bond_series)
export(bond)
-export(bond_series)
+export(build_series_symbols)
+export(build_spread_symbols)
export(buildBasket)
export(buildHierarchy)
export(buildRatio)
-export(build_series_symbols)
export(buildSpread)
-export(build_spread_symbols)
export(butterfly)
export(C2M)
export(currency)
@@ -14,21 +15,21 @@
export(format_id)
export(formatSpreadPrice)
export(fund)
+export(future_series)
export(future)
-export(future_series)
export(getInstrument)
export(getSymbols.FI)
export(guaranteed_spread)
+export(ICS_root)
export(ICS)
-export(ICS_root)
-export(instrument)
export(instrument_attr)
export(instrument.auto)
export(instrument.table)
+export(instrument)
+export(is.currency.name)
export(is.currency)
-export(is.currency.name)
+export(is.instrument.name)
export(is.instrument)
-export(is.instrument.name)
export(load.instruments)
export(loadInstruments)
export(ls_AUD)
@@ -45,22 +46,22 @@
export(ls_expires)
export(ls_expiries)
export(ls_funds)
+export(ls_future_series)
export(ls_futures)
-export(ls_future_series)
export(ls_FX)
export(ls_GBP)
export(ls_guaranteed_spreads)
export(ls_HKD)
+export(ls_ICS_roots)
export(ls_ICS)
-export(ls_ICS_roots)
+export(ls_instruments_by)
export(ls_instruments)
-export(ls_instruments_by)
export(ls_JPY)
export(ls_non_currencies)
export(ls_non_derivatives)
export(ls_NZD)
+export(ls_option_series)
export(ls_options)
-export(ls_option_series)
export(ls_puts)
export(ls_SEK)
export(ls_spreads)
@@ -74,9 +75,9 @@
export(MC2N)
export(month_cycle2numeric)
export(next.future_id)
+export(option_series.yahoo)
+export(option_series)
export(option)
-export(option_series)
-export(option_series.yahoo)
export(parse_id)
export(parse_suffix)
export(prev.future_id)
@@ -88,12 +89,12 @@
export(rm_derivatives)
export(rm_exchange_rates)
export(rm_funds)
+export(rm_future_series)
export(rm_futures)
-export(rm_future_series)
export(rm_instruments)
export(rm_non_derivatives)
+export(rm_option_series)
export(rm_options)
-export(rm_option_series)
export(rm_spreads)
export(rm_stocks)
export(rm_synthetics)
@@ -104,15 +105,15 @@
export(sort_ids)
export(spread)
export(stock)
-export(synthetic)
export(synthetic.instrument)
export(synthetic.ratio)
-export(.to_daily)
+export(synthetic)
export(to_secBATV)
export(update_instruments.TTR)
export(update_instruments.yahoo)
export(volep)
importFrom(zoo,as.Date)
+S3method(all.equal,instrument)
S3method(print,id.list)
S3method(print,instrument)
S3method(print,suffix.list)
Added: pkg/FinancialInstrument/R/all.equal.instrument.R
===================================================================
--- pkg/FinancialInstrument/R/all.equal.instrument.R (rev 0)
+++ pkg/FinancialInstrument/R/all.equal.instrument.R 2012-02-19 02:11:45 UTC (rev 926)
@@ -0,0 +1,98 @@
+#' 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.
+#' @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
+#' of the character vector will be compared separately.
+#' @method all.equal instrument
+#' @S3method all.equal instrument
+#' @author Garrett See
+#' @note ALPHA code. Subject to change
+#' @keywords internal utilities
+#' @examples
+#' \dontrun{
+#' currency("USD")
+#' stock("SPY", "USD", validExchanges=c("SMART", "ARCA", "BATS", "BEX"))
+#' stock("DIA", "USD", validExchanges=c("SMART", "ARCA", "ISLAND"),
+#' ExtraField="something")
+#'
+#' all.equal(getInstrument("SPY"), getInstrument("DIA"))
+#' all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5)
+#' all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5, collapse=NULL)
+#'
+#' 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
+ 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?)
+ }
+ nx <- names(target)
+ ny <- names(current)
+ if (!all(nx %in% ny))
+ msg <- c(msg, paste("Names in target that are not in current: <",
+ paste(nx[!nx %in% ny], collapse=", "), ">"))
+ if (!all(ny %in% nx))
+ msg <- c(msg, paste("Names in current that are not in target: <",
+ paste(ny[!ny %in% nx], collapse=", "), ">"))
+ do.compare <- function(target, current, i) {
+ if (!isTRUE(all.equal(target[[i]], current[[i]]))) {
+ ti <- target[[i]]
+ ci <- current[[i]]
+ if (is.null(ti)) ti <- "NULL"
+ 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)))
+ return(paste(i, out, sep="$"))
+ }
+ if (length(ti) > char.n && is.character(ti)) {
+ out <- NULL
+ if (!all(ti %in% ci))
+ out <- paste(i, "in target but not in current: <",
+ paste(ti[!ti %in% ci], collapse=", "), ">")
+ if (!all(ci %in% ti))
+ 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.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
+}
\ No newline at end of file
Modified: pkg/FinancialInstrument/R/instrument.R
===================================================================
--- pkg/FinancialInstrument/R/instrument.R 2012-02-15 16:26:44 UTC (rev 925)
+++ pkg/FinancialInstrument/R/instrument.R 2012-02-19 02:11:45 UTC (rev 926)
@@ -32,6 +32,7 @@
#' @param x object
#' @export
is.instrument.name <- function(x) {
+ if (!is.character(x)) return(FALSE)
x <- suppressWarnings(getInstrument(x, silent=TRUE))
inherits(x, 'instrument')
}
@@ -50,6 +51,7 @@
#' @param x character string to test.
#' @export
is.currency.name <- function( x ) {
+ if (!is.character(x)) return(FALSE)
x <- suppressWarnings(getInstrument(x, type='currency', silent=TRUE))
inherits( x, "currency" )
}
Added: pkg/FinancialInstrument/man/all.equal.instrument.Rd
===================================================================
--- pkg/FinancialInstrument/man/all.equal.instrument.Rd (rev 0)
+++ pkg/FinancialInstrument/man/all.equal.instrument.Rd 2012-02-19 02:11:45 UTC (rev 926)
@@ -0,0 +1,45 @@
+\name{all.equal.instrument}
+\alias{all.equal.instrument}
+\title{instrument all.equal method}
+\usage{
+ \method{all.equal}{instrument} (target, current,
+ char.n = 2, collapse = ";", ...)
+}
+\arguments{
+ \item{char.n}{If length of a character vector is
+ \code{char.n} or less it will be treated as a single
+ element.}
+
+ \item{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 of the character vector will be compared
+ separately.}
+}
+\description{
+ instrument all.equal method
+}
+\note{
+ ALPHA code. Subject to change
+}
+\examples{
+\dontrun{
+currency("USD")
+stock("SPY", "USD", validExchanges=c("SMART", "ARCA", "BATS", "BEX"))
+stock("DIA", "USD", validExchanges=c("SMART", "ARCA", "ISLAND"),
+ ExtraField="something")
+
+all.equal(getInstrument("SPY"), getInstrument("DIA"))
+all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5)
+all.equal(getInstrument("SPY"), getInstrument("DIA"), char.n=5, collapse=NULL)
+
+all.equal(getInstrument("DIA"), getInstrument("USD"))
+}
+}
+\author{
+ Garrett See
+}
+\keyword{internal}
+\keyword{utilities}
+
Modified: pkg/FinancialInstrument/man/ls_instruments.Rd
===================================================================
--- pkg/FinancialInstrument/man/ls_instruments.Rd 2012-02-15 16:26:44 UTC (rev 925)
+++ pkg/FinancialInstrument/man/ls_instruments.Rd 2012-02-19 02:11:45 UTC (rev 926)
@@ -5,8 +5,8 @@
\alias{ls_derivatives}
\alias{ls_exchange_rates}
\alias{ls_funds}
+\alias{ls_future_series}
\alias{ls_futures}
-\alias{ls_future_series}
\alias{ls_FX}
\alias{ls_guaranteed_spreads}
\alias{ls_ICS}
@@ -14,8 +14,8 @@
\alias{ls_instruments}
\alias{ls_non_currencies}
\alias{ls_non_derivatives}
+\alias{ls_option_series}
\alias{ls_options}
-\alias{ls_option_series}
\alias{ls_puts}
\alias{ls_spreads}
\alias{ls_stocks}
@@ -25,13 +25,13 @@
\alias{rm_derivatives}
\alias{rm_exchange_rates}
\alias{rm_funds}
+\alias{rm_future_series}
\alias{rm_futures}
-\alias{rm_future_series}
\alias{rm_FX}
\alias{rm_instruments}
\alias{rm_non_derivatives}
+\alias{rm_option_series}
\alias{rm_options}
-\alias{rm_option_series}
\alias{rm_spreads}
\alias{rm_stocks}
\alias{rm_synthetics}
More information about the Blotter-commits
mailing list