SCM

SCM Repository

[rmetrics] Annotation of /pkg/fPortfolio/R/weightsPie.R
ViewVC logotype

Annotation of /pkg/fPortfolio/R/weightsPie.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2920 - (view) (download)

1 : wuertz 2653
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 : wuertz 2864 # 1999 - Diethelm Wuertz, GPL
20 :     # 2007 - Rmetrics Foundation, GPL
21 : wuertz 2653 # Diethelm Wuertz <wuertz@itp.phys.ethz.ch>
22 : wuertz 2864 # for code accessed (or partly included) from other sources:
23 :     # see Rmetric's copyright and license files
24 : wuertz 2653
25 :    
26 :     ################################################################################
27 :     # FUNCTION: PORTFOLIO PIE PLOTS:
28 : wuertz 2920 # weightsPie Plots weights
29 :     # weightedReturnsPie Plots weighted means
30 : wuertz 2653 # covRiskBudgetsPie Plots covariance risk budgets
31 : wuertz 2920 # tailRiskBudgetsPie Plots copulae tail risk budgets
32 : wuertz 2653 ################################################################################
33 :    
34 :    
35 : wuertz 2676 weightsPie <-
36 : wuertz 2920 function(object, pos = NULL, labels = TRUE, col = NULL,
37 :     box = TRUE, legend = TRUE, radius = 0.8, ...)
38 : wuertz 2676 {
39 :     # A function implemented by Rmetrics
40 : wuertz 2653
41 :     # Description:
42 :     # Plots a Pie Chart of Weigths
43 :    
44 :     # Arguments:
45 : wuertz 2920 # object - an object of class 'fPORTFOLIO'.
46 :     # pos - a numeric value, determining the position on the efficient
47 :     # frontier plotting the pie, by default NULL, i.e. expecting
48 :     # an object having only one set of weights like the tangency
49 :     # portfolio.
50 :     # box - a logical value, determining whether a frame (box) should
51 :     # be plotted around the pie, by default TRUE.
52 :     # col - a color palette, by default the rainbow palette.
53 :     # legend - a logical value, determining whether a legend with
54 :     # the names of the assets should be plotted, by default TRUE.
55 : wuertz 2653
56 :     # Example:
57 :     # weightsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
58 :     # title(main = "Tangency Portfolio Weights")
59 :    
60 :     # FUNCTION:
61 :    
62 : wuertz 2920 # Default Settings:
63 :     Title = "Weights"
64 :     if (is.null(col)) col = seqPalette(getNAssets(object), "Blues")
65 :     if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7
66 :    
67 :     # Extracting weights position on the efficient frontier:
68 : wuertz 2653 if(!is.null(pos)){
69 : wuertz 2920 object = object
70 :     object@portfolio$weights = getWeights(object)[pos, ]
71 : wuertz 2653 }
72 :    
73 : wuertz 2920 # Get Weights:
74 :     X = getWeights(object)
75 : wuertz 2653
76 : wuertz 2920 # Check for Negative Pie Segments:
77 :     nX = getNAssets(object)
78 :     Sign = rep("+", nX)
79 :     Sign[(1:nX)[X < 0]] = "-"
80 :     absX = abs(X)
81 :     Index = (1:nX)[X > 0]
82 : wuertz 2653
83 : wuertz 2920 # Take care of labels, they are also used by the function pie():
84 :     if (!is.logical(labels)) {
85 :     Names = pieLabels = labels
86 :     labels = FALSE
87 :     } else {
88 :     Names = pieLabels = getNames(object)
89 :     }
90 :    
91 : wuertz 2653 # Pie Chart:
92 :     col = col[Index]
93 : wuertz 2920 legendAssets = Names[Index]
94 :     Labels = paste(Names, Sign)
95 :     Labels = Labels[X > 0]
96 :     Y = X[X > 0]
97 : wuertz 2653
98 : wuertz 2920 # Plot:
99 :     if (labels) {
100 :     pie(Y, labels = Labels, col = col, radius = radius, cex = CEX)
101 :     } else {
102 :     pie(Y, labels = pieLabels, col = col, radius = radius, ...)
103 :     }
104 :    
105 : wuertz 2653 # Add Title:
106 : wuertz 2920 if (title) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1)
107 : wuertz 2653
108 :     # Add Info:
109 : wuertz 2920 if (title) {
110 :     mtext(paste(getType(object), "|", getSolver(object)),
111 :     side = 4, adj = 0, col = "grey", cex = 0.7)
112 :     }
113 : wuertz 2653
114 :     # Add Legend:
115 :     if (legend) {
116 : wuertz 2920 legend("topleft", legend = legendAssets, bty = "n", cex = CEX,
117 : wuertz 2653 fill = col)
118 : wuertz 2920 legendY = as.character(round(100*Y, digits = 1))
119 :     legendY = paste(Sign[Index], legendY, sep = "")
120 :     legendY = paste(legendY, "%")
121 :     legend("topright", legend = legendY, bty = "n", cex = CEX,
122 : wuertz 2653 fill = col)
123 :     }
124 :    
125 : wuertz 2920 # Add Box:
126 :     if (box) box()
127 :    
128 : wuertz 2653 # Return Value:
129 : wuertz 2920 invisible(Y)
130 : wuertz 2653 }
131 :    
132 :    
133 :     # ------------------------------------------------------------------------------
134 :    
135 :    
136 : wuertz 2920 weightedReturnsPie <-
137 :     function(object, pos = NULL, labels = TRUE, col = NULL,
138 :     box = TRUE, legend = TRUE, radius = 0.8, ...)
139 : wuertz 2676 {
140 :     # A function implemented by Rmetrics
141 : wuertz 2653
142 :     # Description:
143 :     # Adds a pie plot of the weights
144 :    
145 : wuertz 2920 # Arguments:
146 :     # object - an object of class 'fPORTFOLIO'.
147 :     # pos - a numeric value, determining the position on the efficient
148 :     # frontier plotting the pie, by default NULL, i.e. expecting
149 :     # an object having only one set of weights like the tangency
150 :     # portfolio.
151 :     # box - a logical value, determining whether a frame (box) should
152 :     # be plotted around the pie, by default TRUE.
153 :     # col - a color palette, by default the rainbow palette.
154 :     # legend - a logical value, determining whether a legend with
155 :     # the names of the assets should be plotted, by default TRUE.
156 :    
157 : wuertz 2653 # Example:
158 :     # attributesPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
159 :     # title(main = "Tangency Portfolio Weights")
160 :    
161 :     # FUNCTION:
162 :    
163 : wuertz 2920 # Default Settings:
164 :     Title = "Weighted Returns"
165 :     if (is.null(col)) col = seqPalette(getNAssets(object), "Blues")
166 :     if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7
167 :    
168 : wuertz 2653 # Extracting weights position, if specified
169 :     if(!is.null(pos)){
170 : wuertz 2920 object = object
171 :     object@portfolio$weights = getWeights(object)[pos, ]
172 : wuertz 2653 }
173 :    
174 : wuertz 2920 # Get Weighted Returns:
175 : wuertz 2653 weights = getWeights(object)
176 :     returns = getStatistics(object)$mu
177 : wuertz 2920 X = weights * returns
178 : wuertz 2653
179 : wuertz 2920 # Check for Negative Pie Segments:
180 :     nX = getNAssets(object)
181 :     Sign = rep("+", nX)
182 :     Sign[(1:nX)[X < 0]] = "-"
183 :     absX = abs(X)
184 :     Index = (1:nX)[X > 0]
185 : wuertz 2653
186 : wuertz 2920 # Take care of labels, they are also used by the function pie():
187 :     if (!is.logical(labels)) {
188 :     Names = pieLabels = labels
189 :     labels = FALSE
190 :     } else {
191 :     Names = pieLabels = getNames(object)
192 :     }
193 :    
194 : wuertz 2653 # Pie Chart:
195 :     col = col[Index]
196 : wuertz 2920 legendAssets = Names[Index]
197 :     Labels = paste(Names, Sign)
198 :     Labels = Labels[X > 0]
199 :     Y = X[X > 0]
200 : wuertz 2653
201 : wuertz 2920 # Plot:
202 :     if (labels) {
203 :     pie(Y, labels = Labels, col = col, radius = radius, cex = CEX)
204 :     } else {
205 :     pie(Y, labels = pieLabels, col = col, radius = radius, ...)
206 :     }
207 :    
208 : wuertz 2653 # Add Title:
209 : wuertz 2920 if (title) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1)
210 : wuertz 2653
211 :     # Add Info:
212 : wuertz 2920 if (title) {
213 :     mtext(paste(getType(object), "|", getSolver(object)),
214 :     side = 4, adj = 0, col = "grey", cex = 0.7)
215 :     }
216 : wuertz 2653
217 :     # Add Legend:
218 :     if (legend) {
219 : wuertz 2920 legend("topleft", legend = legendAssets, bty = "n", cex = CEX,
220 : wuertz 2653 fill = col)
221 : wuertz 2920 legendY = as.character(round(100*Y, digits = 1))
222 :     legendY = paste(Sign[Index], legendY, sep = "")
223 :     legendY = paste(legendY, "%")
224 :     legend("topright", legend = legendY, bty = "n", cex = CEX,
225 : wuertz 2653 fill = col)
226 :     }
227 :    
228 : wuertz 2920 # Add Box:
229 :     if (box) box()
230 :    
231 : wuertz 2653 # Return Value:
232 : wuertz 2920 invisible(Y)
233 : wuertz 2653 }
234 :    
235 :    
236 :     # ------------------------------------------------------------------------------
237 :    
238 :    
239 : wuertz 2676 covRiskBudgetsPie <-
240 : wuertz 2920 function(object, pos = NULL, labels = TRUE, col = NULL,
241 :     box = TRUE, legend = TRUE, radius = 0.8, ...)
242 : wuertz 2676 {
243 :     # A function implemented by Rmetrics
244 : wuertz 2653
245 : wuertz 2920 # Arguments:
246 :     # object - an object of class 'fPORTFOLIO'.
247 :     # pos - a numeric value, determining the position on the efficient
248 :     # frontier plotting the pie, by default NULL, i.e. expecting
249 :     # an object having only one set of weights like the tangency
250 :     # portfolio.
251 :     # box - a logical value, determining whether a frame (box) should
252 :     # be plotted around the pie, by default TRUE.
253 :     # col - a color palette, by default the rainbow palette.
254 :     # legend - a logical value, determining whether a legend with
255 :     # the names of the assets should be plotted, by default TRUE.
256 :    
257 : wuertz 2653 # Description:
258 :     # Plots a Pie Chart of Risk Budgets
259 :    
260 :     # Arguments:
261 :     # object - an object of class 'fPORTFOLIO'
262 :     # col - a color palette, by default the rainbow palette
263 :    
264 :     # Example:
265 :     # riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
266 :     # title(main = "Tangency Portfolio Weights")
267 :    
268 :     # FUNCTION:
269 :    
270 : wuertz 2920 # Default Settings:
271 :     Title = "Covariance Risk Budgets"
272 :     if (is.null(col)) col = seqPalette(getNAssets(object), "Blues")
273 :     if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7
274 :    
275 : wuertz 2653 # Extracting weights position, if specified
276 :     if(!is.null(pos)){
277 : wuertz 2920 object@portfolio$weights = getWeights(object)[pos, ]
278 :     object@portfolio$covRiskBudgets = getCovRiskBudgets(object)[pos, ]
279 : wuertz 2653 }
280 :    
281 : wuertz 2920 # Get Covariance Risk Budgets:
282 :     X = getCovRiskBudgets(object)
283 : wuertz 2653
284 : wuertz 2920 # Check for Negative Pie Segments:
285 :     nX = getNAssets(object)
286 :     Sign = rep("+", nX)
287 :     Sign[(1:nX)[X < 0]] = "-"
288 :     absX = abs(X)
289 :     Index = (1:nX)[X > 0]
290 : wuertz 2653
291 : wuertz 2920 # Take care of labels, they are also used by the function pie():
292 :     if (!is.logical(labels)) {
293 :     Names = pieLabels = labels
294 :     labels = FALSE
295 :     } else {
296 :     Names = pieLabels = getNames(object)
297 :     }
298 :    
299 :     # Legend Labels:
300 : wuertz 2653 col = col[Index]
301 : wuertz 2920 legendAssets = Names[Index]
302 :     Labels = paste(Names, Sign)
303 :     Labels = Labels[X > 0]
304 :     Y = X[X > 0]
305 : wuertz 2653
306 : wuertz 2920 # Plot:
307 :     if (labels) {
308 :     pie(Y, labels = Labels, col = col, radius = radius, cex = CEX)
309 :     } else {
310 :     pie(Y, labels = pieLabels, col = col, radius = radius, ...)
311 :     }
312 :    
313 : wuertz 2653 # Add Title:
314 : wuertz 2920 if (title) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1)
315 : wuertz 2653
316 :     # Add Info:
317 : wuertz 2920 if (title) {
318 :     mtext(paste(getType(object), "|", getSolver(object)),
319 :     side = 4, adj = 0, col = "grey", cex = 0.7)
320 :     }
321 : wuertz 2653
322 :     # Add Legend:
323 :     if (legend) {
324 : wuertz 2920 legend("topleft", legend = legendAssets, bty = "n", cex = CEX,
325 : wuertz 2653 fill = col)
326 : wuertz 2920 legendY = as.character(round(100*Y, digits = 1))
327 :     legendY = paste(Sign[Index], legendY, sep = "")
328 :     legendY = paste(legendY, "%")
329 :     legend("topright", legend = legendY, bty = "n", cex = CEX,
330 : wuertz 2653 fill = col)
331 :     }
332 :    
333 : wuertz 2920 # Add Box:
334 :     if (box) box()
335 :    
336 : wuertz 2653 # Return Value:
337 : wuertz 2920 invisible(Y)
338 : wuertz 2653 }
339 :    
340 :    
341 :     # ------------------------------------------------------------------------------
342 :    
343 :    
344 : wuertz 2676 tailRiskBudgetsPie <-
345 : wuertz 2920 function(object, pos = NULL, labels = TRUE, col = NULL,
346 :     box = TRUE, legend = TRUE, radius = 0.8, ...)
347 : wuertz 2676 {
348 :     # A function implemented by Rmetrics
349 : wuertz 2653
350 : wuertz 2920 # Arguments:
351 :     # object - an object of class 'fPORTFOLIO'.
352 :     # pos - a numeric value, determining the position on the efficient
353 :     # frontier plotting the pie, by default NULL, i.e. expecting
354 :     # an object having only one set of weights like the tangency
355 :     # portfolio.
356 :     # box - a logical value, determining whether a frame (box) should
357 :     # be plotted around the pie, by default TRUE.
358 :     # col - a color palette, by default the rainbow palette.
359 :     # legend - a logical value, determining whether a legend with
360 :     # the names of the assets should be plotted, by default TRUE.
361 :    
362 : wuertz 2653 # Description:
363 :     # Plots a Pie Chart of Tail Risk Budgets
364 :    
365 :     # Arguments:
366 :     # object - an object of class 'fPORTFOLIO'
367 :     # col - a color palette, by default the rainbow palette
368 :    
369 :     # Example:
370 :     # riskBudgetsPie(tangencyPortfolio(dutchPortfolioData(), portfolioSpec()))
371 :     # title(main = "Tangency Portfolio Weights")
372 :    
373 :     # FUNCTION:
374 :    
375 : wuertz 2920 # Default Settings:
376 :     Title = "Tail Risk Budgets"
377 :     if (is.null(col)) col = seqPalette(getNAssets(object), "Blues")
378 :     if (sum(c(par()$mfrow, par()$mfcol)) == 4) CEX = 0.9 else CEX = 0.7
379 :    
380 : wuertz 2653 # Extracting weights position, if specified
381 :     if(!is.null(pos)){
382 : wuertz 2920 object = object
383 :     object@portfolio$weights = getWeights(object)[pos, ]
384 : wuertz 2653 }
385 :    
386 : wuertz 2920 # Check:
387 :     stop("Not yet implemented")
388 :     tailRiskMatrix = getTailRisk(object)
389 :     X = getCovRiskBudgets(object)
390 : wuertz 2653
391 : wuertz 2920 # Check for Negative Pie Segments:
392 :     nX = getNAssets(object)
393 :     Sign = rep("+", nX)
394 :     Sign[(1:nX)[X < 0]] = "-"
395 :     absX = abs(X)
396 :     Index = (1:nX)[X > 0]
397 : wuertz 2653
398 : wuertz 2920 # Take care of labels, they are also used by the function pie():
399 :     if (!is.logical(labels)) {
400 :     Names = pieLabels = labels
401 :     labels = FALSE
402 :     } else {
403 :     Names = pieLabels = getNames(object)
404 :     }
405 :    
406 :     # Legend Labels:
407 : wuertz 2653 col = col[Index]
408 : wuertz 2920 legendAssets = Names[Index]
409 :     Labels = paste(Names, Sign)
410 :     Labels = Labels[X > 0]
411 :     Y = X[X > 0]
412 : wuertz 2653
413 : wuertz 2920 # Plot:
414 :     if (labels) {
415 :     pie(Y, labels = Labels, col = col, radius = radius, cex = CEX)
416 :     } else {
417 :     pie(Y, labels = pieLabels, col = col, radius = radius, ...)
418 :     }
419 :    
420 : wuertz 2653 # Add Title:
421 : wuertz 2920 if (title) mtext(Title, adj = 0, line = 2.5, font = 2, cex = CEX+0.1)
422 : wuertz 2653
423 :     # Add Info:
424 : wuertz 2920 if (title) {
425 :     mtext(paste(getType(object), "|", getSolver(object)),
426 :     side = 4, adj = 0, col = "grey", cex = 0.7)
427 :     }
428 : wuertz 2653
429 :     # Add Legend:
430 :     if (legend) {
431 : wuertz 2920 legend("topleft", legend = legendAssets, bty = "n", cex = CEX,
432 : wuertz 2653 fill = col)
433 : wuertz 2920 legendY = as.character(round(100*Y, digits = 1))
434 :     legendY = paste(Sign[Index], legendY, sep = "")
435 :     legendY = paste(legendY, "%")
436 :     legend("topright", legend = legendY, bty = "n", cex = CEX,
437 : wuertz 2653 fill = col)
438 :     }
439 :    
440 : wuertz 2920 # Add Box:
441 :     if (box) box()
442 :    
443 : wuertz 2653 # Return Value:
444 : wuertz 2920 invisible(Y)
445 : wuertz 2653 }
446 :    
447 :    
448 :     ################################################################################
449 :    

R-Forge@R-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business University of Wisconsin - Madison Powered By FusionForge