#".onLoad" <- function(lib,pkg) {
# cat("quantmod: Quantitative Financial Modelling Framework\n\n")
# cat("Version 0.3-7, Revision 461\n")
# cat("http://www.quantmod.com\n\n")
#}
.plotEnv <- new.env()
.quantmodEnv <- new.env()
quantmodenv <- function() as.environment(".quantmodEnv")
print.quantmodEnv <- function(x, ...) {
print("<environment: quantmodEnv>")
}
.onAttach <- function(libname,pkgname) {
packageStartupMessage("Version 0.4-0 included new data defaults. See ?getSymbols.")
# --as-cran check is complaining of this, as a NOTE
#attach(NULL, name='.quantmodEnv')
}
setOldClass("zoo");
setOldClass("xts");
setOldClass("Date");
setClassUnion("xtsORzoo", c("xts","zoo"))
setClass("quantmod",representation(
model.id="character",
model.spec="formula",
model.formula="formula",
model.target="character",
model.inputs="character",
build.inputs="character",
symbols="character",
product="character",
price.levels="ANY",
training.data="ANY",
build.date="character",
fitted.model="ANY",
model.data="ANY",
quantmod.version="numeric"
)
);
setClass("quantmodReturn",representation(
results="xtsORzoo",
returns="xtsORzoo",
CAGR="numeric",
HPR="numeric",
accuracy="xtsORzoo",
directional.accuracy="list",
dist.of.returns="list",
returnsBy="ANY"
)
);
#setClass("quantmodResults",representation(
# model="quantmod",
# signal="zoo",
# return="quantmodReturn"
# )
# );
#setClass("tradeLog",representation(
# action="character",
# quantity="numeric",
# underlying="character",
# price="numeric",
# currency="character",
# date="Date",
# trade.id="numeric"),
# prototype = list(action='',
# quantity=0,
# underlying='',
# price=0,
# currency='USD',
# date=as.Date('2007-01-01'),
# trade.id=1)
# )
#setMethod("show","tradeLog",
# function(object)
# {
# tradeLog <- cbind(object@date,object@trade.id,object@price,object@quantity)
# print(zoo(tradeLog,order.by=object@date))
# })
setMethod("show", "chobTA",
function(object) {
plot.chobTA(object)
}
)
setMethod("show","quantmod", function(object) {
cat("\nquantmod object: ",
object@model.id,"\tBuild date: ",
paste(object@build.date),"\n");
cat("\nModel Specified: \n ",
gsub("[ ]+"," ",deparse(object@model.spec)),"\n");
cat("\nModel Target: ",object@model.target,"\t\t",
"Product: ",object@product,"\n");
cat("Model Inputs: ",
paste(object@model.inputs,collapse=", "),"\n\n");
cat("Fitted Model: \n\n");
if(class(object@fitted.model)[1]=="NULL") {
cat("\tNone Fitted\n");
} else {
cat("\tModelling procedure: ",
class(object@fitted.model),"\n");
cat("\tTraining window: ",
length(object@training.data)," observations from ",
paste(object@training.data[c(1,length(object@training.data))],
collapse=" to "));
cat("\n")
print(object@fitted.model)
}
}
)
setMethod("summary","quantmod", function(object) {
cat("\nquantmod object: ",
object@model.id,"\tBuild date: ",
paste(object@build.date),"\n");
cat("\nModel Specified: \n ",
gsub("[ ]+"," ",deparse(object@model.spec)),"\n");
cat("\nModel Target: ",object@model.target,"\t\t",
"Product: ",object@product,"\n");
cat("Model Inputs: ",
paste(object@model.inputs,collapse=", "),"\n\n");
cat("Fitted Model: \n\n");
if(class(object@fitted.model)[1]=="NULL") {
cat("\tNone Fitted\n");
} else {
cat("\tModelling procedure: ",
class(object@fitted.model),"\n");
cat("\tTraining window: ",
length(object@training.data)," observations from ",
paste(object@training.data[c(1,length(object@training.data))],
collapse=" to "));
cat("\n")
summary(object@fitted.model)
}
})
#setMethod("show","quantmodResults", function(object) {
# cat("\n Model: ",object@model@model.id,"\n")
# cat("\n C.A.G.R.: ",sprintf("%04.2f%%",object@return@CAGR*100),"\tH.P.R.: ",
# sprintf("%04.2f%%",object@return@HPR*100),"\n");
# to.date.ret <- sprintf("%04.2f%%",object@return@returnsBy[NROW(object@return@returnsBy),-1]*100)
# to.date.ret <- as.data.frame(t(to.date.ret),row.names=" ")
#
# colnames(to.date.ret) <- colnames(object@return@returnsBy[,-1])
# cat("\n Returns by period summary:\n\n")
# print(as.data.frame(lapply(as.data.frame(object@return@returnsBy[,-1]),
# function(x) sprintf("%04.2f%%",(rev(as.numeric(summary(x))[1:6]*100)))),
# row.names=c(' Max.',' 3rd Qu.',' Mean',' Median',' 2rd Qu.',' Min.')))
# cat("\n Period to date returns:\n\n")
# print(to.date.ret)
#}
#)
"fittedModel"<-function(object) {object@fitted.model}
#setGeneric("fittedModel<-", function(x,...,value) {standardGeneric("fittedModel<-")})
setGeneric("fittedModel<-", function(object,value) {standardGeneric("fittedModel<-")})
#setReplaceMethod("fittedModel","quantmod", function(x,...,value)
setReplaceMethod("fittedModel","quantmod", function(object,value)
{
object@fitted.model <- value
}
)
## setGeneric('plot', function(x,y,...) { standardGeneric('plot') });
## setMethod("plot","tR.results", function(x,y,...) {
## object <- x
## ret.by <- object@return@returnsBy
## plot(ret.by,type=c('l',rep('h',ncol(ret.by)-1)))
## }
## )
## setMethod("plot",signature("ANY","ANY"),function(x,y,...) { UseMethod('plot') } )
#####################################################
###
### Default S3 method and definition for predictModel
###
#####################################################
"predictModel" <-
function(object,data,...)
{
UseMethod("predictModel");
}
"predictModel.default" <-
function(object,data,...)
{
predict(object,data,...);
}
'plot.quantmodResults' <-
function(x,...)
{
ret.by <- x@return@returnsBy
plot(ret.by,type=c('l',rep('h',ncol(ret.by)-1)),...)
}
'formula.quantmod' <-
function(x,...)
{
x@model.formula
}
'coef.quantmod' <-
function(object,...)
{
if(!is.null(fittedModel(object)))
coef(fittedModel(object),...)
}
'coefficients.quantmod' <- coef.quantmod
'fitted.quantmod' <-
function(object,...)
{
if(!is.null(fittedModel(object)))
fitted(fittedModel(object),...)
}
'fitted.values.quantmod' <- fitted.quantmod
'residuals.quantmod' <-
function(object,...)
{
if(!is.null(fittedModel(object)))
residuals(fittedModel(object,...))
}
'resid.quantmod' <- residuals.quantmod
'vcov.quantmod' <-
function(object,...)
{
if(!is.null(fittedModel(object)))
vcov(fittedModel(object,...))
}
'logLik.quantmod' <-
function(object, ...)
{
if(!is.null(fittedModel(object)))
logLik(fittedModel(object),...)
}
'anova.quantmod' <-
function(object,...)
{
if(!is.null(fittedModel(object)))
anova(fittedModel(object),...)
}
'plot.quantmod' <-
function(x,...)
{
if(!is.null(fittedModel(x)))
plot(fittedModel(x),...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.