« back to all changes in this revision
Viewing changes to R/PortfolioPlots.R
- browse files at revision 8
- compare with another revision
- compare with revision 8
- download diff
- download tarball
- view history from revision 8
- Committer: Bazaar Package Importer
- Author(s): Dirk Eddelbuettel
- Date: 2008-12-04 11:36:54 UTC
- mfrom: (1.1.6 upstream) (2.1.3 squeeze)
- Revision ID: james.westby@ubuntu.com-20081204113654-gr832nfs44blp5ph
Tags: 280.74-1
* New upstream release
* Finally uploading as r-cran-rglpk is out of NEW after five weeks
* debian/control: Updated (Build-)Depends: and Suggests:
* debian/control: Set (Build-)Depends: to current R version
* debian/control: Set Standards-Version: to current version
* Finally uploading as r-cran-rglpk is out of NEW after five weeks
* debian/control: Updated (Build-)Depends: and Suggests:
* debian/control: Set (Build-)Depends: to current R version
* debian/control: Set Standards-Version: to current version
- files added:
- NAMESPACE
- data
- files removed:
- R/ConstrainedCVaRPortfolio.R
- inst/doc
- inst/doc/Rdonlp2
- inst/doc/Rdonlp2/demo
- files modified:
- DESCRIPTION *
- R/zzz.R *
- inst/COPYRIGHT.html *
- inst/DocCopying.pdf *
- tests/doRUnit.R *
added
removed
R/PortfolioPlots.R
1
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.
6
#
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.
11
#
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,
15
# MA 02111-1307 USA
16
17
# Copyrights (C)
18
# for this R-port:
19
# 1999 - 2007, Diethelm Wuertz, GPL
20
# Diethelm Wuertz <wuertz@itp.phys.ethz.ch>
21
# info@rmetrics.org
22
# www.rmetrics.org
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
26
# and other sources
27
# see Rmetrics's copyright file
28
29
30
################################################################################
31
# FUNCTION: EFFICIENT FRONTIER PLOT AND ADDONS:
32
# frontierPlot Plots efficient Frontier
33
# .minvariancePlot Adds Minimum Variance point
34
# .cmlPlot Adds Market Portfolio and Capital Market Line
35
# .tangencyPlot Adds Tangency Portfolio point and line
36
# .equalWeightsPlot Adds point of equal weights portfolio
37
# .singleAssetPlot Adds points of single asset portfolios
38
# .twoAssetsPlot Adds EF for all combinations of two assets
39
# .wheelPiePlot Adds pie chart of weights on EF
40
# .monteCarloPlot Adds randomly produced feasible portfolios
41
# .sharpeRatioPlot Adds Sharpe Ratio
42
# .notStackedWeightsPlot Plots the not stacked weights of potfolio
43
# .addlegend Adds legend to sliders
44
# FUNCTION: FRONTIER BAR PLOTS:
45
# weightsPlot Plots staggered weights
46
# attributesPlot Plots weighted means
47
# covRiskBudgetsPlot Plots covariance risk budgets
48
# tailRiskBudgetsPlot Plots tail risk budgets
49
# FUNCTION: PORTFOLIO PIE PLOTS:
50
# weightsPie Plots staggered weights
51
# attributesPie Plots weighted means
52
# covRiskBudgetsPie Plots covariance risk budgets
53
# tailRiskBudgetsPie Plots tail risk budgets
54
# FUNCTION: DESCRIPTION:
55
# covEllipsesPlot Plots covariance ellipses
56
################################################################################
57
58
59
frontierPlot =
60
function(object, frontier = c("both", "lower", "upper"),
61
col = c("black", "grey"), add = FALSE, ...)
62
{ # A function implemented by Rmetrics
63
64
# Description:
65
# Plots the efficient frontier
66
67
# FUNCTION:
68
69
# Check Colors:
70
stopifnot(length(col) == 2)
71
72
# Settings:
73
frontier = match.arg(frontier)
74
75
# Frontier:
76
fullFrontier = getFrontier(object, frontier = "both")
77
upperFrontier = getFrontier(object, frontier = "upper")
78
lowerFrontier = getFrontier(object, frontier = "lower")
79
80
# Check for 'xlim' Argument:
81
Arg <- match.call(expand.dots = TRUE)
82
m <- match(c("xlim", "ylim"), names(Arg), Arg)
83
xArg <- as.character(Arg[c(1, m)])[2]
84
yArg <- as.character(Arg[c(1, m)])[3]
85
86
# Plot:
87
if(xArg == "NULL" & yArg == "NULL") {
88
yLim = range(fullFrontier[, 2])
89
xRange = range(fullFrontier[, 1])
90
xDiff = diff(xRange)
91
xLim = c(xRange[1] - 2.5*xDiff/10, xRange[2] + xDiff/10)
92
93
# Plot:
94
if(!add){
95
if(frontier == "upper" | frontier == "both") {
96
plot(upperFrontier, col = col[1], xlim = xLim, ylim = yLim, ...)
97
} else {
98
if( frontier == "both") {
99
points(fullFrontier, col = col[2],
100
xlim = xLim, ylim = yLim, ...)
101
}
102
if(frontier == "lower" ) {
103
plot(lowerFrontier, col = col[2],
104
xlim = xLim, ylim = yLim, ...)
105
}
106
}
107
}
108
if(frontier == "upper" | frontier == "both") {
109
points(upperFrontier, col = col[1], ...)
110
}
111
if(frontier == "lower" | frontier == "both") {
112
points(lowerFrontier, col = col[2], ...)
113
}
114
} else if (xArg != "NULL" & yArg == "NULL") {
115
# In this case only xlim is specified in the argument list
116
yLim = range(fullFrontier[, 2])
117
# Plot:
118
if(!add){
119
if(frontier == "upper" | frontier == "both") {
120
plot(upperFrontier, col = col[1], ylim = yLim, ...)
121
} else {
122
if( frontier == "both") {
123
points(fullFrontier, col = col[2], ylim = yLim, ...)
124
}
125
if(frontier == "lower" ) {
126
plot(fullFrontier, col = col[2], ylim = yLim, ...)
127
}
128
}
129
}
130
if(frontier == "upper" | frontier == "both") {
131
points(upperFrontier, col = col[1], ...)
132
}
133
if(frontier == "lower" | frontier == "both") {
134
points(lowerFrontier, col = col[2], ...)
135
}
136
} else if(xArg == "NULL" & yArg != "NULL") {
137
# In this only ylim is specified in the argument list
138
xRange = range(fullFrontier[, 1])
139
xDiff = diff(xRange)
140
xLim = c(xRange[1] - 2.5*xDiff/10, xRange[2] + xDiff/10)
141
# Plot:
142
if(!add){
143
if(frontier == "upper" | frontier == "both") {
144
plot(upperFrontier, col = col[1], xlim = xLim, ...)
145
} else {
146
if( frontier == "both") {
147
points(fullFrontier, col = col[2], xlim = xLim, ...)
148
}
149
if(frontier == "lower" ) {
150
plot(lowerFrontier, col = col[2], xlim = xLim, ...)
151
}
152
}
153
}
154
if(frontier == "upper" | frontier == "both") {
155
points(upperFrontier, col = col[1], ...)
156
}
157
if(frontier == "lower" | frontier == "both") {
158
points(lowerFrontier, col = col[2], ...)
159
}
160
} else if (xArg != "NULL" & yArg != "NULL"){
161
# If both xlim and ylim are not defined in argument list ...
162
if(!add){
163
if(frontier == "upper" | frontier == "both") {
164
plot(fullFrontier, type = "n", ...)
165
points(upperFrontier, col = col[1], ...)
166
}
167
if(frontier == "both") {
168
points(lowerFrontier, col = col[2], ...)
169
}
170
if(frontier == "lower") {
171
plot(lowerFrontier, col = col[2], ...)
172
}
173
} else{
174
if(frontier == "upper" | frontier == "both") {
175
points(upperFrontier, col = col[1], ...)
176
}
177
if(frontier == "lower" | frontier == "both") {
178
points(lowerFrontier, col = col[2], ...)
179
}
180
}
181
}
182
183
# Add Info:
184
mtext(paste(getType(object), "|", getSolver(object)),
185
side = 4, adj = 0, col = "grey", cex = 0.7)
186
187
# Return Value:
188
invisible()
189
}
190
191
192
# ------------------------------------------------------------------------------
193
194
195
.sharpeRatioPlot =
196
function(object, ...)
197
{ # A function implemented by Rmetrics
198
199
# Description:
200
# Adds Sharpe Ratio
201
202
# FUNCTION:
203
204
# Get Portfolio Slots:
205
Data = getSeries(object)
206
Spec = getSpec(object)
207
Constraints = getConstraints(object)
208
Type = getType(object)
209
210
# CVaR ?
211
if (Type == "CVaR") {
212
cat("\n\tOnly for Mean-Variance Portfolios\n")
213
return()
214
}
215
216
# Efficient Frontier:
217
x = getTargetRisk(object)[, 1]
218
y = getTargetReturn(object)[, 1]
219
220
# Tangency Portfolio:
221
tangencyPortfolio = tangencyPortfolio(Data, Spec, Constraints)
222
x.tg = getTargetReturn(tangencyPortfolio)
223
224
# Normalization to fit in EF Plot:
225
norm = x.tg / max(y/x)
226
index = 2:length(x)
227
index = index[diff(x) > 0]
228
x = x[index]
229
y = y[index]
230
y.norm = (y/x*norm)
231
points(x, y.norm, ...)
232
233
# Add Tailored Labels - 2 may be a good Number ...
234
x.tg = x.tg[index]
235
norm2 = x.tg / max(y)
236
Range = range(y/x * norm)
237
238
# Take a reasonable number of significant digits to plot, e.g. 2 ...
239
nPrecision = 3
240
Labels = signif(Range, nPrecision)
241
axis(4, at = Range, labels = c(" ", " "), cex.axis = 0.75)
242
axis(4, at = mean(Range), labels = paste(Labels[1], " ", Labels[2]),
243
cex.axis = 0.75)
244
245
# Add Axis Labels and Title:
246
mtext("Sharpe Ratio", side = 4, line = 2, cex = 0.75)
247
248
# Return Value:
249
invisible()
250
}
251
252
253
# ------------------------------------------------------------------------------
254
255
256
.minvariancePlot =
257
function(object, ...)
258
{ # A function implemented by Rmetrics
259
260
# Description:
261
# Adds the minimum risk point to a MV and CVaR portfolio plot
262
263
# FUNCTION:
264
265
# Get Portfolio Slots:
266
Data = getSeries(object)
267
Spec = getSpec(object)
268
Constraints = getConstraints(object)
269
270
# Add Minimum Variance Point:
271
mvPortfolio = minvariancePortfolio(Data, Spec, Constraints)
272
assets = getFrontier(mvPortfolio)
273
points(assets, ...)
274
275
# Return Value:
276
invisible()
277
}
278
279
280
# ------------------------------------------------------------------------------
281
282
283
.tangencyPlot =
284
function(object, ...)
285
{ # A function implemented by Rmetrics
286
287
# Description:
288
# Adds tangency point and line to a MV and CVaR portfolio plot
289
290
# FUNCTION:
291
292
# Get Portfolio Slots:
293
Data = getSeries(object)
294
Spec = getSpec(object)
295
Constraints = getConstraints(object)
296
297
# Compute Tangency Portfolio:
298
tgPortfolio = tangencyPortfolio(Data, Spec, Constraints)
299
300
# Add Tangency Point:
301
points(getFrontier(tgPortfolio), ...)
302
303
# Add Tangency Line:
304
slope = getTargetReturn(tgPortfolio) / getTargetRisk(tgPortfolio)[1]
305
abline(0, slope, ...)
306
307
# Return Value:
308
invisible()
309
}
310
311
312
# ------------------------------------------------------------------------------
313
314
315
.cmlPlot =
316
function(object, ...)
317
{ # A function implemented by Rmetrics
318
319
# Description:
320
# Adds the capital market line to a portfolio plot
321
322
# FUNCTION:
323
324
# Get Portfolio Statistics:
325
Data = getSeries(object)
326
Spec = getSpec(object)
327
Constraints = getConstraints(object)
328
Type = getType(object)
329
330
# Add Capital Market Line:
331
if (Type == "MV") {
332
# Compute Tangency Portfolio:
333
cmlPortfolio = cmlPortfolio(Data, Spec, Constraints)
334
# Add Tangency Point:
335
points(getFrontier(cmlPortfolio), ...)
336
# Add Tangency Line - if slope is positive:
337
# riskFreeRate = getPortfolio(cmlPortfolio)$riskFreeRate
338
riskFreeRate = object@spec$spec@portfolio$riskFreeRate
339
slope = ((getTargetReturn(cmlPortfolio)[1] - riskFreeRate) /
340
getTargetRisk(cmlPortfolio)[1])
341
if(slope > 0) abline(b = slope, a = riskFreeRate, ...)
342
} else if (Type == "CVaR") {
343
cat("\n\tNot Yet Implemented\n")
344
}
345
346
# Return Value:
347
invisible(object)
348
}
349
350
351
# ------------------------------------------------------------------------------
352
353
354
.singleAssetPlot =
355
function(object, ...)
356
{ # A function implemented by Rmetrics
357
358
# Description:
359
# Adds all single assets returns and risks to a portfolio plot
360
361
# FUNCTION:
362
363
# Add Single Assets:
364
Statistics = getStatistics(object)
365
Type = getType(object)
366
367
Return = getStatistics(object)$mu
368
if (Type == "MV") {
369
Risk = sqrt(diag(Statistics$Sigma))
370
} else if (Type == "CVaR") {
371
nAssets = getNumberOfAssets(object)
372
Data = getSeries(object)
373
alpha = getTargetAlpha(object)
374
Risk = NULL
375
for (i in 1:nAssets) Risk = c(Risk, -.cvarRisk(Data[ ,i], 1, alpha))
376
}
377
assets = cbind(Risk = Risk, Return = Return)
378
points(assets, ...)
379
380
# Return Value:
381
invisible()
382
}
383
384
385
# ------------------------------------------------------------------------------
386
387
388
.equalWeightsPlot =
389
function(object, ...)
390
{ # A function implemented by Rmetrics
391
392
# Description:
393
# Adds equal weights portfolio to a portfolio plot
394
395
# FUNCTION:
396
397
# Get Portfolio Statistics:
398
Data = getSeries(object)
399
Spec = getSpec(object)
400
Constraints = getConstraints(object)
401
Type = getType(object)
402
403
# Add Equal Weights Portfolio:
404
ewPortfolio = feasiblePortfolio(Data, Spec, Constraints)
405
if (Type == "MV") {
406
assets = getFrontier(ewPortfolio)
407
} else if (Type == "CVaR") {
408
assets = getFrontier(ewPortfolio) * c(-1, 1)
409
}
410
points(assets, ...)
411
412
# Return Value:
413
invisible()
414
}
415
416
417
# ------------------------------------------------------------------------------
418
419
420
.twoAssetsPlot =
421
function(object, ...)
422
{ # A function implemented by Rmetrics
423
424
# Description:
425
# Adds efficient long-only frontier of all portfolio pairs
426
427
# Note:
428
# Only supported for "Short" and "LongOnly" Constraints!
429
430
# FUNCTION:
431
432
# Supported ?
433
check = rev(attr(object@constraints, "model"))[1]
434
# stopifnot(check == "Short" | check == "LongOnly")
435
436
# Get Portfolio Statistics:
437
Data = getSeries(object)
438
Spec = getSpec(object)
439
Constraints = getConstraints(object)
440
Type = getType(object)
441
442
# Add Frontiers for all Two-Assets Portfolios:
443
N = getNumberOfAssets(getData(object))
444
for ( i in 1:(N-1) ) {
445
for (j in (i+1):N ) {
446
index = c(i, j)
447
Data2 = Data[, index]
448
# Zero-One Constraints2 ?
449
ans = portfolioFrontier(data = Data2, spec = Spec)
450
lines(getFrontier(ans), ...)
451
}
452
}
453
454
# Return Value:
455
invisible()
456
}
457
458
459
# ------------------------------------------------------------------------------
460
461
462
.weightsWheel =
463
function(object, piePos = NULL, pieR = NULL, pieOffset = NULL, ...)
464
{ # A function implemented by Rmetrics
465
466
# Description:
467
# Adds a pie plot of weights for MV and CVaR Portfolios
468
469
# Details:
470
# The default settings are:
471
# piePos - Position of tangency Portfolio
472
# pieR - 10% of the Risk Range: diff(range(targetRisk(object)))/10
473
474
# FUNCTION:
475
476
# Extraction coordinates
477
p = par()$usr/15
478
dx = p[2]-p[1]
479
dy = p[4]-p[3]
480
481
# Pie Position:
482
if(is.null(piePos)) {
483
Data = getSeries(object)
484
Spec = getSpec(object)
485
Constraints = getConstraints(object)
486
tg = getTargetReturn(tangencyPortfolio(Data, Spec, Constraints))
487
ef = as.vector(getTargetReturn(object))
488
piePos = which(diff(sign(ef-tg)) > 0)
489
}
490
491
# Pie Radius:
492
if(is.null(pieR)) {
493
pieR = c(1, 1)
494
}
495
496
# Pie Offset:
497
if(is.null(pieOffset)) {
498
pieOffset = c(-2*dx, 0)
499
}
500
501
# Plot Circle:
502
weights = getWeights(object)[piePos, ]
503
nWeights = length(weights)
504
Sign = rep("+", nWeights)
505
Sign[(1:nWeights)[weights < 0]] = "-"
506
x = getTargetRisk(object)[piePos]
507
y = getTargetReturn(object)[piePos]
508
phi = seq(0, 2*pi, length = 360)
509
X = x + pieOffset[1] + pieR[1] * sin(phi) * dx
510
Y = y + pieOffset[2] + pieR[2] * cos(phi) * dy
511
lines(X, Y)
512
513
# Add Center Point:
514
points(x, y, col = "red", pch = 19, cex = 1.5)
515
516
# Add Arrow:
517
lines(c(x, x+pieOffset[1]), c(y, y+pieOffset[2]))
518
519
# Add Color Wheel:
520
psi = 2*pi*c(0, cumsum(abs(weights)/sum(abs(weights))))
521
for (i in 1 : length(weights) ) {
522
# Plotting Only Pie pieces with Weights > 5%
523
if(psi[i+1]-psi[i] > 0.05 * 2*pi) {
524
Psi = psi[i] + (0:100) * (psi[i+1]-psi[i])/100
525
polyX = x + pieOffset[1] + pieR[1]*c(0, sin(Psi), 0) * dx
526
polyY = y + pieOffset[2] + pieR[2]*c(0, cos(Psi), 0) * dy
527
polygon(polyX, polyY, col = rainbow(nWeights)[i])
528
# Adding the Asset Signs:
529
text(x + pieOffset[1] + 0.75*pieR[1]* sin(Psi[51]) * dx,
530
y + pieOffset[2] + 0.75*pieR[2]* cos(Psi[51]) * dy,
531
col = "white", Sign[i])
532
}
533
}
534
535
# Return Value:
536
invisible()
537
}
538
539
540
# ------------------------------------------------------------------------------
541
542
543
.attributesWheel =
544
function(object, piePos = NULL, pieR = NULL, pieOffset = NULL, ...)
545
{ # A function implemented by Rmetrics
546
547
# Description:
548
# Adds a pie plot of the weights
549
550
# Details:
551
# The default settings are:
552
# piePos - Position of tangency Portfolio
553
# pieR - 10% of the Risk Range: diff(range(targetRisk(object)))/10
554
555
# FUNCTION:
556
557
# Extraction coordinates
558
p = par()$usr/15
559
dx = p[2]-p[1]
560
dy = p[4]-p[3]
561
562
# Pie Position:
563
if(is.null(piePos)) {
564
Data = getSeries(object)
565
Spec = getSpec(object)
566
Constraints = getConstraints(object)
567
tg = getTargetReturn(tangencyPortfolio(Data, Spec, Constraints))
568
ef = as.vector(getTargetReturn(object))
569
piePos = which(diff(sign(ef-tg)) > 0)
570
}
571
572
# Pie Radius:
573
if(is.null(pieR)) {
574
pieR = c(1, 1)
575
}
576
577
# Pie Offset:
578
if(is.null(pieOffset)) {
579
pieOffset = c(2*dx, 0)
580
}
581
582
# Plot Circle - Get weighted Returns:
583
weights = getWeights(object)
584
dim = dim(weights)
585
returns = getStatistics(object)$mu
586
weightedReturns = NULL
587
for(i in 1:dim[2]){
588
nextWeightedReturns = weights[,i]*returns[i]
589
weightedReturns = cbind(weightedReturns, nextWeightedReturns)
590
}
591
colnames(weightedReturns) = colnames(weights)
592
weightedReturns = weightedReturns[piePos, ]
593
nWeights = length(weightedReturns)
594
Sign = rep("+", times = nWeights)
595
Sign[(1:nWeights)[weightedReturns < 0]] = "-"
596
x = getTargetRisk(object)[piePos]
597
y = getTargetReturn(object)[piePos]
598
phi = seq(0, 2*pi, length = 360)
599
X = x + pieOffset[1] + pieR[1] * sin(phi) * dx
600
Y = y + pieOffset[2] + pieR[2] * cos(phi) * dy
601
lines(X, Y)
602
603
# Add Center Point:
604
points(x, y, col = "red", pch = 19, cex = 1.5)
605
606
# Add Arrow:
607
lines(c(x, x+pieOffset[1]), c(y, y+pieOffset[2]))
608
609
# Add Color Wheel:
610
psi = 2*pi*c(0, cumsum(abs(weightedReturns)/sum(abs(weightedReturns))))
611
for (i in 1 : nWeights) {
612
# Plotting Only Pie pieces with Weights > 5%
613
if(psi[i+1]-psi[i] > 0.05 * 2*pi) {
614
Psi = psi[i] + (0:100) * (psi[i+1]-psi[i])/100
615
polyX = x + pieOffset[1] + pieR[1]*c(0, sin(Psi), 0) * dx
616
polyY = y + pieOffset[2] + pieR[2]*c(0, cos(Psi), 0) * dy
617
polygon(polyX, polyY, col = rainbow(nWeights)[i])
618
# Adding the Asset Signs:
619
text(x + pieOffset[1] + 0.75*pieR[1]* sin(Psi[51]) * dx,
620
y + pieOffset[2] + 0.75*pieR[2]* cos(Psi[51]) * dy,
621
col = "white", Sign[i])
622
}
623
}
624
625
# Return Value:
626
invisible()
627
}
628
629
630
# ------------------------------------------------------------------------------
631
632
633
.monteCarloPlot =
634
function(object, mcSteps, ...)
635
{ # A function implemented by Rmetrics
636
637
# Description:
638
# Adds randomly feasible portfolios to a plot
639
640
# FUNCTION:
641
642
# Get Portfolio Statistics:
643
Statistics = getStatistics(object)
644
Type = getType(object)
645
mu = Statistics$mu
646
Sigma = Statistics$Sigma
647
N = length(mu)
648
649
# Get Specification:
650
if (Type == "MV") {
651
# Get Constraints Model:
652
Model = rev(attr(object@constraints, "model"))[1]
653
if (Model == "Short" | object@constraints == "Short") {
654
# Monte Carlo Loop - Short:
655
for (k in 1:mcSteps) {
656
s = sign(rnorm(N, mean = rnorm(1)))
657
weights = s * abs(rcauchy(N))
658
weights = weights / sum(weights)
659
Return = as.numeric(mu %*% weights)
660
Risk = sqrt( as.numeric( t(weights) %*% Sigma %*% (weights) ) )
661
points(Risk, Return, ...)
662
}
663
} else if (Model == "LongOnly" | object@constraints == "LongOnly") {
664
# Monte Carlo Loop - Long Only:
665
for (k in 1:mcSteps) {
666
weights = abs(rcauchy(N))
667
weights = weights / sum(weights)
668
Return = as.numeric(mu %*% weights)
669
Risk = sqrt( as.numeric( t(weights) %*% Sigma %*% (weights) ) )
670
points(Risk, Return, ...)
671
}
672
} else {
673
cat("\n\tOnly for Short and LongOnly Portfolios\n")
674
}
675
} else if (Type == "CVaR") {
676
# Monte Carlo Loop - Long Only:
677
x = getSeries(object)
678
alpha = getTargetAlpha(object)
679
for (k in 1:mcSteps) {
680
weights = abs(rcauchy(N))
681
weights = weights / sum(weights)
682
Return = as.numeric(mu %*% weights)
683
Risk = .cvarRisk(x, weights, alpha)
684
points(-Risk, Return, ...)
685
}
686
}
687
688
# Return Value:
689
invisible()
690
}
691
692
693
#-------------------------------------------------------------------------------
694
695
696
.notStackedWeightsPlot =
697
function(object, col = NULL)
698
{ # A function implemented by Rmetrics
699
700
# Description:
701
702
# Arguments:
703
# object - an object of class 'fPORTFOLIO'
704
# col - a color palette, by default the rainbow palette
705
706
# FUNCTION:
707
708
# Settings:
709
weights = getWeights(object)
710
N = ncol(weights)
711
targetRisk = getTargetRisk(object)[, 1]
712
targetReturn = getTargetReturn(object)[, 1]
713
nSigma = length(targetRisk)
714
715
# Select Colors if not specified ...
716
if (is.null(col)) col = rainbow(N)
717
718
# Plot first asset ...
719
plot(weights[, 1], col = col[1], type = "l", ylim = c(min(weights),
720
max(weights)), xaxt = "n", xlab = "", ylab = "")
721
722
# Add vertical Line at minimum risk:
723
minIndex = which.min(targetRisk)
724
minRisk = min(targetRisk)
725
726
# Big Point at minimum risk for first asset ...
727
points(x = minIndex, y = weights[minIndex, 1], col = col[1], pch = 19,
728
xaxt = "n", yaxt = "n", cex = 2)
729
730
# ... and all other assets
731
for(i in 1:(N-1)){
732
points(weights[, i+1], col = col[i+1], type = "l", xaxt = "n",
733
yaxt = "n")
734
points(x = minIndex, y = weights[minIndex, i+1], col = col[i+1],
735
pch = 19, xaxt = "n", yaxt = "n", cex = 2)
736
}
737
grid()
738
abline(h = 0, col = "grey", lty = 3)
739
lines(x = c(minIndex, minIndex), y = c(0, 1), col = "black", lwd = 2)
740
741
# Add Tailored Labels - 6 may be a good Number ...
742
nLabels = 6
743
M = c(0, ( 1: (nSigma %/% nLabels) ) ) * nLabels + 1
744
text(minIndex, 1, "Min Risk", pos = 4)
745
minRiskValue = as.character(signif(minRisk, 3))
746
minReturnValue = as.character(signif(targetReturn[minIndex], 3))
747
mtext(minRiskValue, side = 1, at = minIndex, cex = 0.7)
748
mtext(minReturnValue, side = 3, line = 0.5, at = minIndex, cex = 0.7)
749
750
# Take a reasonable number of significant digits to plot, e.g. 2 ...
751
nPrecision = 3
752
axis(1, at = M, labels = signif(targetRisk[M], nPrecision))
753
axis(3, at = M, labels = signif(targetReturn[M], nPrecision))
754
755
# Add Axis Labels and Title:
756
mtext("Target Risk", side = 1, line = 2, cex = 0.7)
757
mtext("Target Return", side = 3, line = 2, cex = 0.7)
758
mtext("Weight", side = 2, line = 2, cex = 0.7)
759
760
# Add Info:
761
mtext(paste(getType(object), "|", getSolver(object)),
762
side = 4, adj = 0, col = "grey", cex = 0.7)
763
764
# Add Title:
765
mtext("Weights", adj = 0, line = 2.5, font = 2, cex = 0.8)
766
767
# Return Value:
768
invisible()
769
}
770
771
772
#-------------------------------------------------------------------------------
773
774
775
.addlegend =
776
function(object, control = list())
777
{ # A function implemented by Rmetrics
778
779
# Description:
780
# Adds a perdefined legend to sliders
781
782
# Arguments:
783
# object - an object of class 'fPORTFOLIO'
784
# control - control list for colors and symbols
785
786
# FUNCTION:
787
788
# Settings:
789
dim = getNumberOfAssets(object)
790
namesSingleAsset = names(object@data$statistics$mu)
791
# Check if polt is used for forntierSlider...
792
if(control$sliderFlag == "frontier"){
793
legendtext = c("Efficient Frontier", "Sharpe Ratio", "Minimum Variance",
794
"Tangency Portfolio", "Market Portfolio", "Equal Weights",
795
namesSingleAsset)
796
color = c("black", control$sharpeRatio.col, control$minvariance.col,
797
control$tangency.col, control$cml.col, control$equalWeights.col,
798
control$singleAsset.col)
799
sym = c(19, 19, control$minvariance.pch, control$tangency.pch,
800
control$cml.pch, control$equalWeights.pch,
801
rep(control$singleAsset.pch, times = dim))
802
# ... else is the weightsSlider case
803
} else {
804
legendtext = c("Efficient Frontier", "Minimum Variance",
805
"Tangency Portfolio", namesSingleAsset)
806
color = c("black", control$minvariance.col,
807
control$tangency.col, control$singleAsset.col)
808
sym = c(19, control$minvariance.pch, control$tangency.pch,
809
rep(control$singleAsset.pch, times = dim))
810
}
811
812
# Adding Legend:
813
legend("topleft", legend = legendtext, col = color, pch = sym, cex = .8,
814
bty = "n")
815
816
# Return Value:
817
invisible()
818
819
}
820
821
822
################################################################################
823
824
825
weightsPlot =
826
function(object, col = NULL, legend = TRUE)
827
{ # A function implemented by Rmetrics
828
829
# Description:
830
# Plots a bar chart of weights
831
832
# Arguments:
833
# object - an object of class 'fPORTFOLIO'
834
# col - a color palette, by default the rainbow palette
835
836
# FUNCTION:
837
838
# Select Colors if not specified ...
839
if (is.null(col)) col = rainbow(ncol(object@portfolio$weights))
840
841
# Get Type:
842
Type = getType(object)
843
844
# Get Weights:
845
weights = getWeights(object)
846
pos.weights = +0.5 * (abs(weights) + weights)
847
neg.weights = -0.5 * (abs(weights) - weights)
848
849
# Define Plot Range:
850
ymax = max(rowSums(pos.weights))
851
ymin = min(rowSums(neg.weights))
852
range = ymax - ymin
853
ymax = ymax + 0.005 * range
854
ymin = ymin - 0.005 * range
855
dim = dim(weights)
856
range = dim[1]
857
xmin = 0
858
xmax = range + 0.2 * range
859
860
# Create Bar Plots:
861
if(!legend){
862
barplot(t(pos.weights), space = 0, ylab = "",
863
ylim = c(ymin, ymax), col = col, border = "grey")
864
} else {
865
legendtext = names(getStatistics(object)$mu)
866
if(is.null(legendtext)){
867
for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")}
868
}
869
barplot(t(pos.weights), space = 0, ylab = "", xlim = c(xmin, xmax),
870
ylim = c(ymin, ymax), col = col, border = "grey")
871
legend("topright", legend = legendtext, bty = "n", cex = 0.8,
872
fill = col)
873
}
874
barplot(t(neg.weights), space = 0, add = TRUE, col = col, border = "grey")
875
876
# Add Tailored Labels - 6 may be a good Number ...
877
targetRisk = getTargetRisk(object)
878
targetReturn = getTargetReturn(object)
879
nSigma = length(targetRisk)
880
nLabels = 6
881
M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1
882
883
# Take a reasonable number of significant digits to plot, e.g. 2 ...
884
nPrecision = 3
885
axis(1, at = M, labels = signif(targetRisk[M], nPrecision))
886
axis(3, at = M, labels = signif(targetReturn[M], nPrecision))
887
888
# Add Axis Labels and Title:
889
mtext("Target Risk", side = 1, line = 2, cex = 0.7)
890
mtext("Target Return", side = 3, line = 2, cex = 0.7)
891
mtext("Weight", side = 2, line = 2, cex = 0.7)
892
893
# Add Weights 0 and 1 Reference Lines
894
lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3)
895
lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3)
896
897
# Add vertical Line at minimum risk:
898
minIndex = which.min(targetRisk[, 1])
899
minRisk = signif(min(targetRisk[, 1]), 3)
900
abline(v = minIndex, col = "black", lty = 1, lwd = 2)
901
902
# Add Info:
903
mtext(paste(
904
getType(object), "|", getSolver(object), "|", "minRisk =", minRisk),
905
side = 4, adj = 0, col = "grey", cex = 0.7)
906
907
# Add Title:
908
mtext("Weights", adj = 0, line = 2.5, font = 2, cex = 0.8)
909
910
# Complete to draw box ...
911
box()
912
913
# Return Value:
914
invisible()
915
}
916
917
918
# ------------------------------------------------------------------------------
919
920
921
attributesPlot =
922
function(object, col = NULL, legend = TRUE)
923
{ # A function implemented by Rmetrics
924
925
# Description:
926
# Plots ...
927
928
# Arguments:
929
# object - an object of class 'fPORTFOLIO'
930
# col - a color palette, by default the rainbow palette
931
932
# FUNCTION:
933
934
# Select Colors if not specified ...
935
if (is.null(col)) col = rainbow(ncol(object@portfolio$weights))
936
937
# Get weighted Returns:
938
weights = getWeights(object)
939
dim = dim(weights)
940
returns = getStatistics(object)$mu
941
weightedReturns = NULL
942
for(i in 1:dim[2]){
943
nextWeightedReturns = weights[,i]*returns[i]
944
weightedReturns = cbind(weightedReturns, nextWeightedReturns)
945
}
946
colnames(weightedReturns) = colnames(weights)
947
pos.weightedReturns = +0.5 * (abs(weightedReturns) + weightedReturns)
948
neg.weightedReturns = -0.5 * (abs(weightedReturns) - weightedReturns)
949
950
# Define Plot Range:
951
ymax = max(rowSums(pos.weightedReturns))
952
ymin = min(rowSums(neg.weightedReturns))
953
range = ymax - ymin
954
ymax = ymax + 0.005 * range
955
ymin = ymin - 0.005 * range
956
range = dim[1]
957
xmin = 0
958
xmax = range + 0.2 * range
959
960
# Create Bar Plots:
961
if(!legend){
962
barplot(t(pos.weightedReturns), space = 0, ylab = "",
963
ylim = c(ymin, ymax), col = col, border = "grey")
964
} else {
965
legendtext = names(getStatistics(object)$mu)
966
if(is.null(legendtext)){
967
for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")}
968
}
969
barplot(t(pos.weightedReturns), space = 0, ylab = "",
970
xlim = c(xmin, xmax), ylim = c(ymin, ymax), col = col,
971
border = "grey")
972
legend("topright", legend = legendtext, bty = "n", cex = 0.8,
973
fill = col)
974
}
975
barplot(t(neg.weightedReturns), space = 0, add = TRUE, col = col,
976
border = "grey")
977
978
# Add Tailored Labels - 6 may be a good Number ...
979
targetRisk = getTargetRisk(object)[, 1]
980
targetReturn = getTargetReturn(object)[, 1]
981
nSigma = length(targetRisk)
982
nLabels = 6
983
M = c(0, ( 1: (nSigma %/% nLabels) ) ) *nLabels + 1
984
# Take a reasonable number of significant digits to plot, e.g. 2 ...
985
nPrecision = 3
986
axis(1, at = M, labels = signif(targetRisk[M], nPrecision))
987
axis(3, at = M, labels = signif(targetReturn[M], nPrecision))
988
989
# Add Axis Labels and Title:
990
mtext("Target Risk", side = 1, line = 2, cex = 0.7)
991
mtext("Target Return", side = 3, line = 2, cex = 0.7)
992
mtext("Return", side = 2, line = 2, cex = 0.7)
993
994
# Add Weights 0 and 1 Reference Lines
995
lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3)
996
lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3)
997
998
# Add vertical Line at minimum risk:
999
minIndex = which.min(targetRisk)
1000
minRisk = signif(min(targetRisk))
1001
abline(v = minIndex, col = "black", lty = 1, lwd = 2)
1002
1003
# Add Info:
1004
mtext(paste(
1005
getType(object), "|", getSolver(object), "|", "minRisk =", minRisk),
1006
side = 4, adj = 0, col = "grey", cex = 0.7)
1007
1008
# Add Title:
1009
mtext("Investments", adj = 0, line = 2.5, font = 2, cex = 0.8)
1010
1011
# Complete to draw box ...
1012
box()
1013
1014
# Return Value:
1015
invisible()
1016
}
1017
1018
1019
# ------------------------------------------------------------------------------
1020
1021
1022
covRiskBudgetsPlot =
1023
function(object, col = NULL, legend = TRUE)
1024
{ # A function implemented by Rmetrics
1025
1026
# Description:
1027
# Plots a bar chart of covariance risk budgets
1028
1029
# Arguments:
1030
# object - an object of class 'fPORTFOLIO'
1031
# col - a color palette, by default the rainbow palette
1032
1033
# FUNCTION:
1034
1035
# Select Colors if not specified ...
1036
if (is.null(col)) col = rainbow(ncol(object@portfolio$weights))
1037
1038
# Get Type:
1039
Type = getType(object)
1040
1041
# Get Budgets:
1042
budgets = getCovRiskBudgets(object)
1043
pos.budgets = +0.5 * (abs(budgets) + budgets)
1044
neg.budgets = -0.5 * (abs(budgets) - budgets)
1045
1046
# Define Plot Range:
1047
ymax = max(rowSums(pos.budgets))
1048
ymin = min(rowSums(neg.budgets))
1049
range = ymax - ymin
1050
ymax = ymax + 0.005 * range
1051
ymin = ymin - 0.005 * range
1052
dim = dim(budgets)
1053
range = dim[1]
1054
xmin = 0
1055
xmax = range + 0.2 * range
1056
1057
# Create Bar Plots:
1058
if(!legend){
1059
barplot(t(pos.budgets), space = 0, ylab = "",
1060
ylim = c(ymin, ymax), col = col, border = "grey")
1061
} else {
1062
legendtext = names(getStatistics(object)$mu)
1063
if(is.null(legendtext)){
1064
for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")}
1065
}
1066
barplot(t(pos.budgets), space = 0, ylab = "", xlim = c(xmin, xmax),
1067
ylim = c(ymin, ymax), col = col, border = "grey")
1068
legend("topright", legend = legendtext, bty = "n", cex = 0.8,
1069
fill = col)
1070
}
1071
barplot(t(neg.budgets), space = 0, add = TRUE, col = col, border = "grey")
1072
1073
# Add Tailored Labels - 6 may be a good Number ...
1074
targetRisk = getTargetRisk(object)[, 1]
1075
targetReturn = getTargetReturn(object)[, 1]
1076
nSigma = length(targetRisk)
1077
nLabels = 6
1078
M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1
1079
1080
# Take a reasonable number of significant digits to plot, e.g. 2 ...
1081
nPrecision = 3
1082
axis(1, at = M, labels = signif(targetRisk[M], nPrecision))
1083
axis(3, at = M, labels = signif(targetReturn[M], nPrecision))
1084
1085
# Add Axis Labels and Title:
1086
mtext("Target Risk", side = 1, line = 2, cex = .7)
1087
mtext("Target Return", side = 3, line = 2, cex = .7)
1088
mtext("Weight", side = 2, line = 2, cex = .7)
1089
1090
# Add Budgets 0 and 1 Reference Lines
1091
lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3)
1092
lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3)
1093
1094
# Add vertical Line at minimum risk:
1095
minIndex = which.min(targetRisk)
1096
minRisk = signif(min(targetRisk), 3)
1097
abline(v = minIndex, col = "black", lty = 1, lwd = 2)
1098
1099
# Add Info:
1100
mtext(paste(
1101
getType(object), "|", getSolver(object), "|", "minRisk =", minRisk),
1102
side = 4, adj = 0, col = "grey", cex = 0.7)
1103
1104
# Add Title:
1105
mtext("Cov Budgets", adj = 0, line = 2.5, font = 2, cex = 0.8)
1106
1107
# Complete to draw box ...
1108
box()
1109
1110
# Return Value:
1111
invisible()
1112
}
1113
1114
1115
# ------------------------------------------------------------------------------
1116
1117
1118
tailRiskBudgetsPlot =
1119
function(object, col = NULL, legend = TRUE)
1120
{ # A function implemented by Rmetrics
1121
1122
# Description:
1123
# Plots a bar chart of tail risk budgets
1124
1125
# Arguments:
1126
# object - an object of class 'fPORTFOLIO'
1127
# col - a color palette, by default the rainbow palette
1128
1129
# FUNCTION:
1130
1131
# Select Colors if not specified ...
1132
if (is.null(col)) col = rainbow(ncol(object@portfolio$weights))
1133
1134
# Get Type:
1135
Type = getType(object)
1136
1137
# Get Budgets:
1138
budgets = getTailRiskBudgets(object)
1139
budgets[is.na(budgets)] = 0
1140
pos.budgets = +0.5 * (abs(budgets) + budgets)
1141
neg.budgets = -0.5 * (abs(budgets) - budgets)
1142
1143
# Define Plot Range:
1144
ymax = max(rowSums(pos.budgets))
1145
ymin = min(rowSums(neg.budgets))
1146
range = ymax - ymin
1147
ymax = ymax + 0.005 * range
1148
ymin = ymin - 0.005 * range
1149
dim = dim(budgets)
1150
range = dim[1]
1151
xmin = 0
1152
xmax = range + 0.2 * range
1153
1154
# Create Bar Plots:
1155
if(!legend){
1156
barplot(t(pos.budgets), space = 0, ylab = "",
1157
ylim = c(ymin, ymax), col = col, border = "grey")
1158
} else {
1159
legendtext = names(getStatistics(object)$mu)
1160
if(is.null(legendtext)){
1161
for(i in 1:dim[2]){legendtext[i] = paste("Asset", i, sep = " ")}
1162
}
1163
barplot(t(pos.budgets), space = 0, ylab = "", xlim = c(xmin, xmax),
1164
ylim = c(ymin, ymax), col = col, border = "grey")
1165
legend("topright", legend = legendtext, bty = "n", cex = 0.8,
1166
fill = col)
1167
}
1168
barplot(t(neg.budgets), space = 0, add = TRUE, col = col, border = "grey")
1169
1170
# Add Tailored Labels - 6 may be a good Number ...
1171
targetRisk = getTargetRisk(object)[, 1]
1172
targetReturn = getTargetReturn(object)[, 1]
1173
nSigma = length(targetRisk)
1174
nLabels = 6
1175
M = c(0, ( 1:(nSigma %/% nLabels) ) ) *nLabels + 1
1176
1177
# Take a reasonable number of significant digits to plot, e.g. 2 ...
1178
nPrecision = 3
1179
axis(1, at = M, labels = signif(targetRisk[M], nPrecision))
1180
axis(3, at = M, labels = signif(targetReturn[M], nPrecision))
1181
1182
# Add Axis Labels and Title:
1183
mtext("Target Risk", side = 1, line = 2, cex = .7)
1184
mtext("Target Return", side = 3, line = 2, cex = .7)
1185
mtext("Weight", side = 2, line = 2, cex = .7)
1186
1187
# Add Budgets 0 and 1 Reference Lines
1188
lines(x = c(0, nSigma), c(1, 1), col = "grey", lty = 3)
1189
lines(x = c(0, nSigma), c(0, 0), col = "grey", lty = 3)
1190
1191
# Add vertical Line at minimum risk:
1192
minIndex = which.min(targetRisk)
1193
minRisk = signif(min(targetRisk), 3)
1194
abline(v = minIndex, col = "black", lty = 1, lwd = 2)
1195
1196
# Add Info:
1197
mtext(paste(
1198
getType(object), "|", getSolver(object), "|", "minRisk =", minRisk),
1199
side = 4, adj = 0, col = "grey", cex = 0.7)
1200
1201
# Add Title:
1202
mtext("Tail Budgets", adj = 0, line = 2.5, font = 2, cex = 0.8)
1203
1204
# Complete to draw box ...
1205
box()
1206
1207
# Return Value:
1208
invisible()
1209
}
1210
1211
1212
################################################################################
1213
1214
1215
weightsPie =
1216
function(object, pos = NULL, col = NULL, box = TRUE, legend = TRUE)
1217
{ # A function implemented by Rmetrics
1218
1219
# Description:
1220
# Plots a Pie Chart of Weigths
1221
1222
# Arguments:
1223
# object - an object of class 'fPORTFOLIO'
1224
# col - a color palette, by default the rainbow palette
1225
1226
# Example:
1227
# weightsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
1228
# title(main = "Tangency Portfolio Weights")
1229
1230
# FUNCTION:
1231
1232
# Extracting weights position, if specified
1233
if(!is.null(pos)){
1234
Object = object
1235
object@portfolio$weights = getWeights(Object)[pos, ]
1236
}
1237
1238
# Plot Circle:
1239
weights = getWeights(object)
1240
nWeights = length(weights)
1241
# if(length(weights) != nWeights) stop("Plot position is not specified")
1242
Sign = rep("+", nWeights)
1243
Sign[(1:nWeights)[weights < 0]] = "-"
1244
1245
# Color Palette:
1246
if (is.null(col)) col = rainbow(nWeights)
1247
1248
# Pie Chart:
1249
Weights = abs(weights)
1250
Index = (1:nWeights)[Weights > 0]
1251
col = col[Index]
1252
names = names(weights)
1253
legendAssets = names[Index]
1254
Labels = paste(names, Sign)
1255
Labels = Labels[Weights > 0]
1256
Weights = Weights[Weights > 0]
1257
Radius = 0.8
1258
if (length(Weights) > 10) Radius = 0.65
1259
pie(Weights, labels = Labels, col = col, radius = Radius)
1260
if (box) box()
1261
1262
# Add Title:
1263
title(main = "Weights")
1264
1265
# Add Info:
1266
mtext(paste(getType(object), "|", getSolver(object)),
1267
side = 4, adj = 0, col = "grey", cex = 0.7)
1268
1269
# Add Legend:
1270
if (legend) {
1271
# Add Legend:
1272
legend("topleft", legend = legendAssets, bty = "n", cex = 0.8,
1273
fill = col)
1274
1275
# Add Legend:
1276
legendWeights = as.character(round(100*Weights, digits = 1))
1277
legendWeights = paste(Sign[Index], legendWeights, sep = "")
1278
legendWeights = paste(legendWeights, "%")
1279
legend("topright", legend = legendWeights, bty = "n", cex = 0.8,
1280
fill = col)
1281
}
1282
1283
# Return Value:
1284
invisible()
1285
}
1286
1287
1288
1289
# ------------------------------------------------------------------------------
1290
1291
1292
attributesPie =
1293
function(object, pos = NULL, col = NULL, box = TRUE, legend = TRUE)
1294
{ # A function implemented by Rmetrics
1295
1296
# Description:
1297
# Adds a pie plot of the weights
1298
1299
# Example:
1300
# attributesPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
1301
# title(main = "Tangency Portfolio Weights")
1302
1303
# FUNCTION:
1304
1305
# Extracting weights position, if specified
1306
if(!is.null(pos)){
1307
Object = object
1308
object@portfolio$weights = getWeights(Object)[pos, ]
1309
}
1310
1311
# Get weighted Returns:
1312
weights = getWeights(object)
1313
names = names(weights)
1314
nWeights = length(weights)
1315
# if(length(weights) != nWeights) stop("Plot position is not specified")
1316
returns = getStatistics(object)$mu
1317
weightedReturns = weights * returns
1318
1319
# Plot Circle:
1320
Sign = rep("+", nWeights)
1321
Sign[(1:nWeights)[weightedReturns < 0]] = "-"
1322
names = substr(names, 1, 3)
1323
1324
# Color Palette:
1325
if (is.null(col)) col = rainbow(nWeights)
1326
1327
# Pie Chart:
1328
WeightedReturns = abs(weightedReturns)
1329
Index = (1:nWeights)[WeightedReturns > 0]
1330
col = col[Index]
1331
names = names(weights)
1332
legendAssets = names[Index]
1333
Labels = paste(names, Sign)
1334
Labels = Labels[WeightedReturns > 0]
1335
WeightedReturns = WeightedReturns[WeightedReturns > 0]
1336
Radius = 0.8
1337
if (length(WeightedReturns) > 10) Radius = 0.65
1338
pie(WeightedReturns, labels = Labels, col = col, radius = Radius)
1339
if (box) box()
1340
1341
# Add Title:
1342
title(main = "Investments")
1343
1344
# Add Info:
1345
mtext(paste(getType(object), "|", getSolver(object)),
1346
side = 4, adj = 0, col = "grey", cex = 0.7)
1347
1348
# Add Legend:
1349
if (legend) {
1350
# Add Legend:
1351
legend("topleft", legend = legendAssets, bty = "n", cex = 0.8,
1352
fill = col)
1353
1354
# Add Legend:
1355
sumWeightedReturns = sum(WeightedReturns)
1356
legendWeights = as.character(round(100*WeightedReturns/
1357
sumWeightedReturns, digits = 1))
1358
legendWeights = paste(Sign[Index], legendWeights)
1359
legendWeights = paste(legendWeights, "%")
1360
legend("topright", legend = legendWeights, bty = "n", cex = 0.8,
1361
fill = col)
1362
}
1363
1364
# Return Value:
1365
invisible()
1366
}
1367
1368
1369
# ------------------------------------------------------------------------------
1370
1371
1372
covRiskBudgetsPie =
1373
function(object, pos = NULL, col = NULL, box = TRUE, legend = TRUE)
1374
{ # A function implemented by Rmetrics
1375
1376
# Description:
1377
# Plots a Pie Chart of Risk Budgets
1378
1379
# Arguments:
1380
# object - an object of class 'fPORTFOLIO'
1381
# col - a color palette, by default the rainbow palette
1382
1383
# Example:
1384
# riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
1385
# title(main = "Tangency Portfolio Weights")
1386
1387
# FUNCTION:
1388
1389
# Extracting weights position, if specified
1390
if(!is.null(pos)){
1391
Object = object
1392
object@portfolio$weights = getWeights(Object)[pos, ]
1393
}
1394
1395
# Plot Circle:
1396
riskBudgets = getCovRiskBudgets(object)
1397
nRiskBudgets = length(riskBudgets)
1398
if(length(riskBudgets) != nRiskBudgets)
1399
stop("Plot position is not specified")
1400
Sign = rep("+", nRiskBudgets)
1401
Sign[(1:nRiskBudgets)[riskBudgets < 0]] = "-"
1402
1403
# Color Palette:
1404
if (is.null(col)) col = rainbow(nRiskBudgets)
1405
1406
# Pie Chart:
1407
RiskBudgets = abs(riskBudgets)
1408
Index = (1:nRiskBudgets)[RiskBudgets > 0]
1409
col = col[Index]
1410
names = names(RiskBudgets)
1411
legendAssets = names[Index]
1412
Labels = paste(names, Sign)
1413
Labels = Labels[RiskBudgets > 0]
1414
RiskBudgets = RiskBudgets[RiskBudgets > 0]
1415
Radius = 0.8
1416
if (length(RiskBudgets) > 10) Radius = 0.65
1417
pie(RiskBudgets, labels = Labels, col = col, radius = Radius)
1418
if (box) box()
1419
1420
# Add Title:
1421
title(main = "Cov Risk Budgets")
1422
1423
# Add Info:
1424
mtext(paste(getType(object), "|", getSolver(object)),
1425
side = 4, adj = 0, col = "grey", cex = 0.7)
1426
1427
# Add Legend:
1428
if (legend) {
1429
# Add Legend:
1430
legend("topleft", legend = legendAssets, bty = "n", cex = 0.8,
1431
fill = col)
1432
1433
# Add Legend:
1434
legendRiskBudgets = as.character(round(100*RiskBudgets, digits = 1))
1435
legendRiskBudgets = paste(Sign[Index], legendRiskBudgets)
1436
legendRiskBudgets = paste(legendRiskBudgets, "%")
1437
legend("topright", legend = legendRiskBudgets, bty = "n", cex = 0.8,
1438
fill = col)
1439
}
1440
1441
# Return Value:
1442
invisible()
1443
}
1444
1445
1446
# ------------------------------------------------------------------------------
1447
1448
1449
tailRiskBudgetsPie =
1450
function(object, pos = NULL, col = NULL, box = TRUE, legend = TRUE)
1451
{ # A function implemented by Rmetrics
1452
1453
# Description:
1454
# Plots a Pie Chart of Tail Risk Budgets
1455
1456
# Arguments:
1457
# object - an object of class 'fPORTFOLIO'
1458
# col - a color palette, by default the rainbow palette
1459
1460
# Example:
1461
# riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
1462
# title(main = "Tangency Portfolio Weights")
1463
1464
# FUNCTION:
1465
1466
# Extracting weights position, if specified
1467
if(!is.null(pos)){
1468
Object = object
1469
object@portfolio$weights = getWeights(Object)[pos, ]
1470
}
1471
1472
# Plot Circle:
1473
riskBudgets = getTailRiskBudgets(object)
1474
nRiskBudgets = length(riskBudgets)
1475
if(length(riskBudgets) != nRiskBudgets)
1476
stop("Plot position is not specified")
1477
Sign = rep("+", nRiskBudgets)
1478
Sign[(1:nRiskBudgets)[riskBudgets < 0]] = "-"
1479
1480
# Color Palette:
1481
if (is.null(col)) col = rainbow(nRiskBudgets)
1482
1483
# Pie Chart:
1484
RiskBudgets = abs(riskBudgets)
1485
Index = (1:nRiskBudgets)[RiskBudgets > 0]
1486
col = col[Index]
1487
names = names(RiskBudgets)
1488
legendAssets = names[Index]
1489
Labels = paste(names, Sign)
1490
Labels = Labels[RiskBudgets > 0]
1491
RiskBudgets = RiskBudgets[RiskBudgets > 0]
1492
Radius = 0.8
1493
if (length(RiskBudgets) > 10) Radius = 0.65
1494
pie(RiskBudgets, labels = Labels, col = col, radius = Radius)
1495
if (box) box()
1496
1497
# Add Title:
1498
title(main = "Tail Risk Budgets")
1499
1500
# Add Info:
1501
mtext(paste(getType(object), "|", getSolver(object)),
1502
side = 4, adj = 0, col = "grey", cex = 0.7)
1503
1504
# Add Legend:
1505
if (legend) {
1506
# Add Legend:
1507
legend("topleft", legend = legendAssets, bty = "n", cex = 0.8,
1508
fill = col)
1509
1510
# Add Legend:
1511
legendRiskBudgets = as.character(round(100*RiskBudgets, digits = 1))
1512
legendRiskBudgets = paste(Sign[Index], legendRiskBudgets)
1513
legendRiskBudgets = paste(legendRiskBudgets, "%")
1514
legend("topright", legend = legendRiskBudgets, bty = "n", cex = 0.8,
1515
fill = col)
1516
}
1517
1518
# Return Value:
1519
invisible()
1520
}
1521
1522
1523
################################################################################
1524
1525
1526
covEllipsesPlot =
1527
function(x = list(), ...)
1528
{
1529
# Description:
1530
# Plots covariance ellipses
1531
1532
# Source:
1533
# Partly based on function covfmEllipsesPlot() from
1534
# Package: robust 0.2-2, 2006-03-24
1535
# Maintainer: Kjell Konis <konis@stats.ox.ac.uk>
1536
# Description: A package of robust methods.
1537
# License: Insightful Robust Library License (see license.txt)
1538
1539
# FUNCTION:
1540
1541
# Settings:
1542
if (length(x) == 0)
1543
stop("Input must be a list of at least 2 covariance matrices!")
1544
nModels = length(x)
1545
p = dim(x[[1]])[1]
1546
1547
# Graphics Frame:
1548
plot(0, 0, xlim = c(0, p+1), ylim = c(0, p+1), type = "n",
1549
axes = FALSE, xlab = "", ylab = "", ...)
1550
box()
1551
1552
# Correlation Ellipses:
1553
for(k in 1:nModels) {
1554
s = sqrt(diag(x[[k]]))
1555
X = x[[k]] / (s %o% s)
1556
xCenters = matrix(rep(1:p, p), byrow = TRUE, ncol = p)
1557
yCenters = matrix(rep(p:1, p), ncol = p)
1558
points = rep((c(0:180, NA) * pi)/90, (p^2 - p) / 2)
1559
cors = as.vector(rbind(matrix(X[row(X) < col(X)], nrow = 181,
1560
ncol = (p^2 - p)/2, byrow = TRUE), rep(NA, (p^2 - p)/2)))
1561
xs = 0.475 * cos(points + acos(cors)/2) +
1562
rep(xCenters[row(xCenters) < col(xCenters)], each = 182)
1563
ys = 0.475 * cos(points - acos(cors)/2) +
1564
rep(yCenters[row(xCenters) < col(xCenters)], each = 182)
1565
polygon(x = xs, y = ys, density = 0, col = k)
1566
shift = max(0.2, (p - 8)/88 + 0.2)
1567
xs = xCenters[row(xCenters) > col(xCenters)]
1568
ys = yCenters[row(yCenters) > col(yCenters)]
1569
cors = X[row(X) > col(X)]
1570
text(xs, ys + (((shift*(nModels - 1))/2) - shift*(k - 1)),
1571
labels = round(cors, digits = max(1, floor(20/p))),
1572
col = k, cex = min(1, 90/(p^2)))
1573
}
1574
1575
# Diagonal Line:
1576
lines(c(0.5, p+0.5), c(p+0.5, 0.5), lwd = 2)
1577
1578
# Correlation - Text:
1579
text(x = cbind(1:p, rep(p + 0.7, p)),
1580
labels = dimnames(X)[[2]], cex = 1, adj = 0)
1581
text(x = cbind(rep(0.5, p), p:1),
1582
labels = dimnames(X)[[1]], cex = 1, adj = 1)
1583
legend(x = (p+1)/2, y = 0, legend = unlist(paste("-", names(x), "-")),
1584
xjust = 0.5, yjust = 0, text.col = 1:nModels, bty = "n")
1585
1586
# Return Value:
1587
invisible()
1588
}
1589
1590
1591
################################################################################
1592
Loggerhead is a web-based interface for Breezy
Version: 2.0.1