#*************************************************************
# Copyright (c) 2015 by ZHAW.
# Please see accompanying distribution file for license.
#*************************************************************
##############################################################
#' A Reference Class representing the ACTUS concept of a
#' RiskFactorConnector
#'
#' The cash flows of ACTUS CTs may be 'linked' to (stochastic)
#' external risk factors such as interest rates or reference
#' indices. The \code{RiskFactorConnector} serves as the
#' interface. It is in fact a collection of risk factors each
#' with the corresponding 'MarketObjectCode' as it's unique
#' identifier.
#' Instances of R/Java risk factors may be added to the
#' \code{RiskFactorConnector} which then may be 'linked' to
#' a given ACTUS CT.
#'
#' @field jref A rJava java object reference
#'
#' @seealso \code{\link{RiskFactor, YieldCurve, ReferenceIndex}}
#'
## @examples
## @include
#' @export
#' @rdname rfc-classes
setRefClass("RiskFactorConnector",
fields = list(
riskfactors = "list"
))
##############################################################
#' \code{RiskFactorConnector}-class constructor
#'
#' Create an instance of \code{RiskFactorConnector} class. The
#' constructor will also create an instance of the respective
#' Java class in the running JVM. The created instance will be
#' an empty collection of \code{RiskFactor} objects.
#'
#' @param ...
#'
#' @return An object of class \code{RiskFactorConnector}
#' containing the reference to the Java object
#'
## @seealso
#'
## @include
#' @export
#' @docType methods
#' @rdname rfc-methods
#' @aliases RFConn-method
setGeneric(name = "RFConn",
def = function(...){
standardGeneric("RFConn")
})
## @include
#' @export
#' @rdname rfc-methods
## @aliases
setMethod(f = "RFConn", signature = c(),
definition = function(...){
object = new("RiskFactorConnector")
pars = list(...)
if (length(pars) > 0)
add(object, what = pars)
return(object)
})
##############################################################
#' Generic \code{add} method
#'
#' Implemented for various purposes.
#'
#' @param object The object to which to \code{add}
#'
#' @param what The object to \code{add}
#'
#' @return
#'
#' @seealso remove
#'
## @examples
## @include
#' @export
#' @docType methods
#' @rdname add-methods
#' @aliases add,RiskFactorConnector,list-method
#' @aliases add,RiskFactorConnector,RiskFactor-method
setGeneric(name = "add", useAsDefault = TRUE,
def = function(object, what, ...){
standardGeneric("add")
})
##############################################################
#' Adding a list of \code{\link{RiskFactor}} instances to the
#' \code{\link{RiskFactorConnector}}
#'
#' Each element of the \code{what} parameter is expected to be
#' an instance of \code{\link{RiskFactor}} class. All elements
#' are added to the \code{RiskFactorConnector} object for later
#' 'linking' to an ACTUS CT.
#'
#' @param object The \code{\link{RiskFactorConnector}} object
#'
#' @param what A list containing \code{\link{RiskFactor}} objects
#'
#' @param ...
#'
#' @return
#'
## @seealso
#'
#'@examples
#' yc <- YieldCurve() # create a YieldCurve object
#' tenors <- c("1W", "1M", "6M", "1Y", "2Y", "5Y")
#' rates <- c(0.001, 0.0015, 0.002, 0.01, 0.02, 0.03)
#' set(yc, what = list(MarketObjectCode = "YC_Prim",
#' Nodes = list(ReferenceDate = "2015-01-01",
#' Tenors = tenors, Rates = rates)))
#'
#' ind <- Index() # create a ReferenceIndex object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01",
#' "2019-01-01")
#' values <- c(100, 110, 120, 130, 140)
#' set(ind, what=list(MarketObjectCode = "CHF_SMI",
#' Data=list(Dates=times,Values=values)))
#'
#' fx <- FxRate() # create an FX-Rate object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01",
#' "2018-01-01", "2019-01-01")
#' values <- c(1.04, 1.05, 1.2, 1.0, 0.9)
#' set(fx, what=list(MarketObjectCode = "CHF/USD",
#' Data=list(Dates=times,Values=values)))
#'
#' rf <- RFConn() # create a RiskFactorConnector object
#' add(rf,list(yc,ind,fx)) # add all risk factors to the RiskFactorConnector
#'
## @include
#' @export
#' @docType methods
#' @rdname add-methods
#' @aliases add-method
#' @aliases add,RiskFactorConnector,RiskFactor-method
setMethod("add", signature = c("RiskFactorConnector", "list"),
definition = function(object, what, ...){
for (i in what) {
FEMS:::add(object, i, ...)
}
})
##############################################################
#' Adding a \code{\link{RiskFactor}} object to the
#' \code{\link{RiskFactorConnector}}
#'
#' Add an instance of \code{\link{RiskFactor}} class to the
#' \code{RiskFactorConnector} object for later 'linking' to an
#' ACTUS CT.
#'
#' @param object The \code{\link{RiskFactorConnector}} object
#'
#' @param what A \code{\link{RiskFactor}} object to be added
#'
#' @param ...
#'
#' @return
#'
## @seealso
#'
#'@examples
#' yc <- YieldCurve() # create a YieldCurve object
#' tenors <- c("1W", "1M", "6M", "1Y", "2Y", "5Y")
#' rates <- c(0.001, 0.0015, 0.002, 0.01, 0.02, 0.03)
#' set(yc, what = list(MarketObjectCode = "YC_Prim",
#' Nodes = list(ReferenceDate = "2015-01-01",
#' Tenors = tenors, Rates = rates)))
#'
#' rf <- RFConn() # create a RiskFactorConnector object
#' add(rf,yc) # add the single RiskFactor to the RiskFactorConnector
#'
#' @include RiskFactor.R
#' @export
#' @docType methods
#' @rdname add-methods
#' @aliases add-method
#' @aliases add,RiskFactorConnector,list-method
setMethod("add", signature = c("RiskFactorConnector", "RiskFactor"),
definition = function(object, what, ...){
id <- FEMS:::get(what, "label")
rf_list <- list(New = what)
if (length(id) == 0) {
names(rf_list) <- paste("RiskFactor_",as.character(length(object$riskfactors) + 1), sep = "")
} else {
names(rf_list) <- id
}
# object$riskfactors <- rf_list
if (any(containsID(object, id))) {
stop("ErrorIn::RiskFactorConnector:: Name of RiskFactor already exists. Choose different name !!!")
}
object$riskfactors <- c(object$riskfactors, rf_list)
})
##############################################################
#' Generic \code{remove} method
#'
#' Implemented for various purposes.
#'
#' @param object The object from which to \code{remove}
#'
#' @param what 'Key' of the element in \code{object} to \code{remove}
#'
#' @return
#'
#' @seealso add
#'
## @examples
## @include
#' @export
#' @docType methods
#' @rdname rmv-methods
#' @aliases remove,RiskFactorConnector,character-method
setGeneric(name = "remove", useAsDefault = TRUE,
def = function(object, what, ...){
standardGeneric("remove")
})
##############################################################
#' Removing a \code{\link{RiskFactor}} object from the
#' \code{\link{RiskFactorConnector}}
#'
#' Each element of the \code{what} parameter is expected to
#' point to an element in the \code{RiskFactorConnector} by
#' their 'keys'. All elements that can be found in
#' \code{RiskFactorConnector} are removed.
#'
#' @param object The \code{\link{RiskFactorConnector}} object
#'
#' @param what A character (vector) containing key(s) to
#' elements in \code{object} and which are to be removed
#'
#' @param ...
#'
#' @return
#'
## @seealso
#'
#'@examples
#' yc <- YieldCurve() # create a YieldCurve object
#' tenors <- c("1W", "1M", "6M", "1Y", "2Y", "5Y")
#' rates <- c(0.001, 0.0015, 0.002, 0.01, 0.02, 0.03)
#' set(yc, what = list(MarketObjectCode = "YC_Prim",
#' Nodes = list(ReferenceDate = "2015-01-01",
#' Tenors = tenors, Rates = rates)))
#'
#' ind <- Index() # create a ReferenceIndex object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01",
#' "2019-01-01")
#' values <- c(100, 110, 120, 130, 140)
#' set(ind, what=list(MarketObjectCode = "CHF_SMI",
#' Data=list(Dates=times,Values=values)))
#'
#' fx <- FxRate() # create an FX-Rate object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01",
#' "2018-01-01", "2019-01-01")
#' values <- c(1.04, 1.05, 1.2, 1.0, 0.9)
#' set(fx, what=list(MarketObjectCode = "CHF/USD",
#' Data=list(Dates=times,Values=values)))
#'
#' rf <- RFConn() # create a RiskFactorConnector object
#' add(rf,list(yc,ind,fx)) # add all risk factors to the RiskFactorConnector
#' containsID(rf, c("YC_Prim", "CHF_SMI", "YC_2"))
#' remove(rf, "YC_Prim")
#' containsID(rf, c("YC_Prim", "CHF_SMI", "YC_2"))
#'
## @include
#' @export
#' @docType methods
#' @rdname rmv-methods
#' @aliases remove-method
setMethod("remove", signature = c("RiskFactorConnector", "character"),
definition = function(object, what, ...){
for (i in what) {
object$riskfactors[i] <- NULL
}
})
##############################################################
#' Retrieve a \code{\link{RiskFactor}} object from the
#' \code{\link{RiskFactorConnector}}
#'
#' Each element of the \code{what} parameter is expected to
#' point to an element in the \code{RiskFactorConnector} by
#' their 'keys'. All elements that can be found in
#' \code{RiskFactorConnector} are returned.
#'
#' @param object The \code{\link{RiskFactorConnector}} object
#'
#' @param what A character (vector) containing key(s) to
#' elements in \code{object} which are to be returned
#'
#' @param ...
#'
#' @return an object of class \code{\link{RiskFactor}} with
#' 'MarketObjectCode'=\code{what} parameter
#'
#' @seealso add, remove
#'
#'@examples
#' yc <- YieldCurve() # create a YieldCurve object
#' tenors <- c("1W", "1M", "6M", "1Y", "2Y", "5Y")
#' rates <- c(0.001, 0.0015, 0.002, 0.01, 0.02, 0.03)
#' set(yc, what = list(MarketObjectCode = "YC_Prim",
#' Nodes = list(ReferenceDate = "2015-01-01",
#' Tenors = tenors, Rates = rates)))
#'
#' ind <- Index() # create a ReferenceIndex object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01",
#' "2019-01-01")
#' values <- c(100, 110, 120, 130, 140)
#' set(ind, what=list(MarketObjectCode = "CHF_SMI",
#' Data=list(Dates=times,Values=values)))
#'
#' rf <- RFConn() # create a RiskFactorConnector object
#' add(rf,list(yc,ind)) # add all risk factors to the RiskFactorConnector
#' get(rf, "YC_Prim")
#'
#' @include ContractModel.R
#' @export
#' @docType methods
#' @rdname get-methods
#' @aliases get-method
setMethod(f = "get", signature = c("RiskFactorConnector","character"),
definition = function(object, what){
if (tolower(what) == "keys") {
out <- names(object$riskfactors)
} else {
if (!any(containsID(object, what))) {
stop("ErrorIn::RiskFactorConnector:: Riskfactor with this name does not exist !!!")
}
out <- object$riskfactors[[what]]
}
return(out)
})
##############################################################
#' Check whether a \code{RiskFactorConnector} contains a
#' certain 'key'
#'
#' For each element of the \code{what} parameter a logical is
#' returned indicating whether (\code{TRUE}) or not
#' (\code{FALSE}) the \code{RiskFactorConnector} contains an
#' object with the same key.
#'
#' @param object The \code{\link{RiskFactorConnector}} object
#'
#' @param what A character (vector) containing keys to be
#' checked
#'
#' @param ...
#'
#' @return \code{logical} indicating whether or not a key exists
#'
#' @seealso add, remove
#'
#'@examples
#' yc <- YieldCurve() # create a YieldCurve object
#' tenors <- c("1W", "1M", "6M", "1Y", "2Y", "5Y")
#' rates <- c(0.001, 0.0015, 0.002, 0.01, 0.02, 0.03)
#' set(yc, what = list(MarketObjectCode = "YC_Prim",
#' Nodes = list(ReferenceDate = "2015-01-01",
#' Tenors = tenors, Rates = rates)))
#'
#' ind <- Index() # create a ReferenceIndex object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01",
#' "2019-01-01")
#' values <- c(100, 110, 120, 130, 140)
#' set(ind, what=list(MarketObjectCode = "CHF_SMI",
#' Data=list(Dates=times,Values=values)))
#'
#' fx <- FxRate() # create an FX-Rate object
#' times <- c("2015-01-01", "2016-01-01", "2017-01-01",
#' "2018-01-01", "2019-01-01")
#' values <- c(1.04, 1.05, 1.2, 1.0, 0.9)
#' set(fx, what=list(MarketObjectCode = "CHF/USD",
#' Data=list(Dates=times,Values=values)))
#'
#' rf <- RFConn() # create a RiskFactorConnector object
#' add(rf,list(yc,ind,fx)) # add all risk factors to the RiskFactorConnector
#' containsID(rf, c("YC_Prim", "CHF_SMI", "YC_2"))
#'
## @include
#' @export
#' @docType methods
#' @rdname cid-methods
#' @aliases containsID,RiskFactorConnector,character-method
setGeneric(name = "containsID",
def = function(object, id, ...){
standardGeneric("containsID")
})
## @include
#' @export
#' @rdname cid-methods
#' @aliases containsID-method
setMethod(f = "containsID", signature = c("RiskFactorConnector","character"),
definition = function(object, id){
out <- logical(length(id))
names(out) <- id
for(i in id) {
if (i %in% names(object$riskfactors)) {
out[i] <- TRUE
}
}
return(out)
})
## @include
#' @export
setMethod(f = "names", signature = c("RiskFactorConnector"),
definition = function(x){
return(names(x$riskfactors))
})
## @include
#' @export
setMethod(f = "show", signature = c("RiskFactorConnector"),
definition = function(object){
x <- names(object)
cl <- character()
for (key in x) {
cl <- c(cl, class(get(object, key))[1])
}
names(cl) <- x
print(cl)
})
## @include
#' @export
setMethod("[[", signature = c("RiskFactorConnector", "character"),
definition = function(x, i) {
if ( !is.element(i, get(x, "keys")) )
return(NULL)
else
get(x, what=i)
}
)
## @include
#' @export
setMethod("[[<-", signature = c("RiskFactorConnector", "ANY"),
definition = function(x, i, value) {
if (containsID (x, i)) {
remove(x, i)
}
add (x, value)
x
# stop("Method '[[<-' not available for object of class RiskFactorConnector")
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.