2
# This library is free software; you can redistribute it and/or
3
# modify it under the terms of the GNU Library General Public
4
# License as published by the Free Software Foundation; either
5
# version 2 of the License, or (at your option) any later version.
7
# This library is distributed in the hope that it will be useful,
8
# but WITHOUT ANY WARRANTY; without even the implied warranty of
9
# MERCHANTABILITY or FITNESS FOR A PARTICULAR Description. See the
10
# GNU Library General Public License for more details.
12
# You should have received a copy of the GNU Library General
13
# Public License along with this library; if not, write to the
14
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
19
# 1999 - 2007, Diethelm Wuertz, GPL
20
# Diethelm Wuertz <wuertz@itp.phys.ethz.ch>
23
# for the code accessed (or partly included) from other R-ports:
24
# see R's copyright and license files
25
# for the code accessed (or partly included) from contributed R-ports
27
# see Rmetrics's copyright file
30
################################################################################
31
# FUNCTION: PORTFOLIO DATA EXTRACTORS:
32
# getData Extracts data slot from a 'fPORTFOLIO' object
33
# getSeries Extracts series from a 'fPORTFOLIO' object
34
# getStatistics Extracts statistics from a 'fPORTFOLIO' object
35
# getNumberOfAssets Extracts number of assets from a 'fPORTFOLIO' object
36
# getSpec PORTFOLIO SPEC EXTRACTORS:
42
# getConstraints PORTFOLIO CONSTRAINTS EXTRACTORS:
51
# FUNCTION: GENERAL EXTRACTORS:
55
################################################################################
58
################################################################################
63
# specification = "list",
64
# constraints = "character",
66
# title = "character",
67
# description = "character")
70
# ------------------------------------------------------------------------------
75
{ # A function implemented by Rmetrics
78
# Extracts data slot from a 'fPORTFOLIO' object
81
# object - an object of S4 class fPORTFOLIO as returned by the
82
# functions *Portfolio().
87
ans = object@data$data
94
# ------------------------------------------------------------------------------
97
getSeries.fPORTFOLIO =
99
{ # A function implemented by Rmetrics
102
# Extracts series from a 'fPORTFOLIO' object
105
# object - an object of S4 class fPORTFOLIO as returned by the
106
# functions *Portfolio().
111
ans = getSeries(getData(object))
118
# ------------------------------------------------------------------------------
121
getStatistics.fPORTFOLIO =
123
{ # A function implemented by Rmetrics
126
# Extracts statistics from a 'fPORTFOLIO' object
129
# object - an object of S4 class fPORTFOLIO as returned by the
130
# functions *Portfolio().
135
ans = getStatistics(getData(object))
142
# ------------------------------------------------------------------------------
145
getNumberOfAssets.fPORTFOLIO =
147
{ # A function implemented by Rmetrics
150
# Extracts number of assets from a 'fPORTFOLIO' object
153
# object - an object of S4 class fPORTFOLIO as returned by the
154
# functions *Portfolio().
159
ans = getNumberOfAssets(getData(object))
166
# ------------------------------------------------------------------------------
171
{ # A function implemented by Rmetrics
174
# Extracts the specification slot from a 'fPORTFOLIO' object
177
# object - an object of S4 class fPORTFOLIO as returned by the
178
# functions *Portfolio().
183
ans = object@spec$spec
190
# ------------------------------------------------------------------------------
195
{ # A function implemented by Rmetrics
198
# Extracts the specification-type slot from a 'fPORTFOLIO' object
201
# object - an object of S4 class fPORTFOLIO as returned by the
202
# functions *Portfolio().
207
ans = getType(getSpec(object))
214
# ------------------------------------------------------------------------------
217
getEstimator.fPORTFOLIO =
219
{ # A function implemented by Rmetrics
222
# Extracts the specification-estimator slot from a 'fPORTFOLIO' object
225
# object - an object of S4 class fPORTFOLIO as returned by the
226
# functions *Portfolio().
231
ans = getEstimator(getSpec(object))
238
# ------------------------------------------------------------------------------
241
getParams.fPORTFOLIO =
243
{ # A function implemented by Rmetrics
246
# Extracts the specification-params slot from a 'fPORTFOLIO' object
249
# object - an object of S4 class fPORTFOLIO as returned by the
250
# functions *Portfolio().
255
ans = getParams(getSpec(object))
262
# ------------------------------------------------------------------------------
265
getSolver.fPORTFOLIO =
267
{ # A function implemented by Rmetrics
270
# Extracts the specification-solver slot from a 'fPORTFOLIO' object
273
# object - an object of S4 class fPORTFOLIO as returned by the
274
# functions *Portfolio().
279
ans = getSolver(getSpec(object))
286
# ------------------------------------------------------------------------------
289
getTrace.fPORTFOLIO =
291
{ # A function implemented by Rmetrics
294
# Extracts the specification-trace slot from a 'fPORTFOLIO' object
297
# object - an object of S4 class fPORTFOLIO as returned by the
298
# functions *Portfolio().
303
ans = getTrace(getSpec(object))
310
# ------------------------------------------------------------------------------
313
getConstraints.fPORTFOLIO =
315
{ # A function implemented by Rmetrics
318
# Extracts the statistics from a 'fPORTFOLIO' object
321
# object - an object of S4 class fPORTFOLIO as returned by the
322
# functions *Portfolio().
327
ans = object@constraints
334
################################################################################
337
getPortfolio.fPORTFOLIO =
339
{ # A function implemented by Rmetrics
342
# Extracts the statistics from a 'fPORTFOLIO' object
345
# object - an object of S4 class fPORTFOLIO as returned by the
346
# functions *Portfolio().
351
ans = object@portfolio
358
# ------------------------------------------------------------------------------
361
getWeights.fPORTFOLIO =
363
{ # A function implemented by Rmetrics
366
# Extracts the weights from a 'fPORTFOLIO' object
369
# object - an object of S4 class fPORTFOLIO as returned by the
370
# functions *Portfolio().
375
ans = object@portfolio$weights
382
# ------------------------------------------------------------------------------
385
getTargetReturn.fPORTFOLIO =
387
{ # A function implemented by Rmetrics
390
# Extracts the target Return from a 'fPORTFOLIO' object
393
# object - an object of S4 class fPORTFOLIO as returned by the
394
# functions *Portfolio().
399
ans = object@portfolio$targetReturn
406
# ------------------------------------------------------------------------------
409
getTargetRisk.fPORTFOLIO =
411
{ # A function implemented by Rmetrics
414
# Extracts the target Risk from a 'fPORTFOLIO' object
417
# object - an object of S4 class fPORTFOLIO as returned by the
418
# functions *Portfolio().
423
ans = object@portfolio$targetRisk
430
# ------------------------------------------------------------------------------
433
getTargetAlpha.fPORTFOLIO =
435
{ # A function implemented by Rmetrics
438
# Extracts the target Alpha from a 'fPORTFOLIO' object
441
# object - an object of S4 class fPORTFOLIO as returned by the
442
# functions *Portfolio().
447
ans = object@portfolio$targetAlpha
454
# ------------------------------------------------------------------------------
457
getRiskFreeRate.fPORTFOLIO =
459
{ # A function implemented by Rmetrics
462
# Extracts the risk free rate from a 'fPORTFOLIO' object
465
# object - an object of S4 class fPORTFOLIO as returned by the
466
# functions *Portfolio().
471
ans = object@portfolio$riskFreeRate
478
# ------------------------------------------------------------------------------
481
getNFrontierPoints.fPORTFOLIO =
483
{ # A function implemented by Rmetrics
486
# Extracts the Number of Frontier Points from a 'fPORTFOLIO' object
489
# object - an object of S4 class fPORTFOLIO as returned by the
490
# functions *Portfolio().
495
ans = object@portfolio$nFrontierPoints
501
# ------------------------------------------------------------------------------
504
getStatus.fPORTFOLIO =
506
{ # A function implemented by Rmetrics
509
# Extracts the status from a 'fPORTFOLIO' object
512
# object - an object of S4 class fPORTFOLIO as returned by the
513
# functions *Portfolio().
518
ans = object@portfolio$status
525
################################################################################
528
getFrontier.fPORTFOLIO =
529
function(object, frontier = c("both", "lower", "upper"), doplot = FALSE, ...)
530
{ # A function implemented by Rmetrics
533
# Extracts the efficient frontier from a 'fPORTFOLO' object
536
# object - an object of S4 class fPORTFOLIO as returned by the
537
# functions *Portfolio().
542
frontier = match.arg(frontier)
544
# Get Efficient Frontier:
545
Type = getType(object)
546
targetRisk = getTargetRisk(object)[ ,1]
547
targetReturn = getTargetReturn(object)[ , 1]
550
# ans = cbind(Risk = targetRisk, Return = targetReturn)
551
#} else if (Type == "CVaR") {
552
# if (is.matrix(targetRisk)) {
553
# Risk = targetRisk[, 1]
555
# Risk = targetRisk[1]
557
ans = cbind(Risk = targetRisk, Return = targetReturn)
559
#rownames(ans) = NULL
561
# Extract upper part of frontier
562
if(frontier == "upper"){
563
index = 1:length(ans[, 1])
564
test = c(-1, diff(ans[, 1]))
565
index = index[test > 0]
567
} else if(frontier == "lower"){
568
index = 1:length(ans[, 1])
569
test = c(-1, diff(ans[, 1]))
570
index = index[test < 0]
571
if (length(index) == 1) {
572
ans = matrix(ans[index, ], ncol = 2)
579
colnames(ans) = c("targetRisk", "targetReturn")
582
if(doplot) plot(ans, ...)
589
# ------------------------------------------------------------------------------
592
getCovRiskBudgets.fPORTFOLIO =
594
{ # A function implemented by Rmetrics
597
# Extracts risk budgets from a portfolio object
601
# Covariance Risk Budgets:
602
weights = object@portfolio$weights
604
Sigma = object@data$data@statistics$Sigma
605
if (is.null(dim(weights))) {
606
# Single Portfolio ...
607
ans1 = as.vector(weights %*% Sigma %*% weights)
608
ans2 = as.vector(weights * Sigma %*% weights)
609
ans = round(ans2/ans1, digits = 4)
610
names(ans) = names(weights)
613
Names = colnames(weights)
615
for (i in 1:(dim(weights)[1])) {
616
ans1 = as.vector(weights[i, ] %*% Sigma %*% weights[i, ])
617
ans2 = as.vector(weights[i, ] * Sigma %*% weights[i, ])
618
ans = rbind(ans, ans2/ans1)
620
colnames(ans) = Names
628
# ------------------------------------------------------------------------------
631
getTailRiskBudgets.fPORTFOLIO =
633
{ # A function implemented by Rmetrics
636
# Extracts tail risk budgets from a portfolio object
639
# object - an object of S4 class fPORTFOLIO as returned by the
640
# functions *Portfolio().
644
# Check if available:
645
Lambda = object@spec$spec@model$tailRisk$lower
646
if (is.null(Lambda)) return(NA)
649
weights = getWeights(object)
651
if (is.null(dim(weights))) {
652
ans1 = as.vector(weights %*% Lambda %*% weights)
653
ans2 = as.vector(weights * Lambda %*% weights)
655
ans = round(ans2/ans1, digits = 4)
656
names(ans) = names(weights)
659
Names = colnames(weights)
661
for (i in 1:(dim(weights)[1])) {
662
ans1 = as.vector(weights[i, ] %*% Lambda %*% weights[i, ])
663
ans2 = as.vector(weights[i, ] * Lambda %*% weights[i, ])
665
ans = rbind(ans, ans2/ans1)
667
colnames(ans) = Names
675
################################################################################