SCM

SCM Repository

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

Annotation of /pkg/fPortfolio/R/ConstrainedMVPortfolio.R

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1546 - (view) (download)
Original Path: pkg/fPortfolio/R/3B-ConstrainedMVPortfolio.R

1 : wuertz 1390
2 : wuertz 1221 # 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: SINGLE PORTFOLIOS:
32 :     # .feasibleConstrainedMVPortfolio Returns a constrained feasible MV-PF
33 : wuertz 1520 # .efficientConstrainedMVPortfolio Returns a constrained frontier MV-PF
34 : wuertz 1221 # .cmlConstrainedMVPortfolio Returns constrained CML-Portfolio
35 : wuertz 1504 # .tangencyConstrainedMVPortfolio Returns constrained tangency MV-PF
36 : wuertz 1221 # .minvarianceConstrainedMVPortfolio Returns constrained min-Variance-PF
37 :     # FUNCTION: PORTFOLIO FRONTIER:
38 :     # .portfolioConstrainedMVFrontier Returns the EF of a constrained MV-PF
39 :     ################################################################################
40 :    
41 :    
42 :     .feasibleConstrainedMVPortfolio =
43 : wuertz 1393 function(data, spec, constraints)
44 : wuertz 1354 { # A function implemented by Rmetrics
45 :    
46 : wuertz 1221 # Description:
47 :     # Computes Risk and Return for a feasible portfolio
48 :    
49 :     # Arguments:
50 : wuertz 1546 # data - a list with two named elements.
51 :     # $series holding the time series which may be any rectangular,
52 :     # object or if not specified holding NA;
53 :     # $statistics holding a named two element list by itself,
54 :     # $mu the location of the asset returns by default the mean
55 :     # and $Sigma the scale of the asset returns by default the
56 :     # covariance matrix.
57 :     # spec - specification object of the portfolio
58 :     # constraints - string value or vector of constraints
59 : wuertz 1221
60 :     # Note:
61 : wuertz 1546 # In contrast to the functions *Portfolio(), which only require either
62 :     # the statistics or the series the functions .*Portfolio() require both
63 :     # as input.
64 : wuertz 1221
65 :     # Example:
66 :     # .feasibleConstrainedMVPortfolio()
67 :    
68 :     # FUNCTION:
69 :    
70 :     # Get Statistics:
71 : wuertz 1497 if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
72 : wuertz 1221 mu = data$statistics$mu
73 :     Sigma = data$statistics$Sigma
74 : wuertz 1504 nAssets = length(mu)
75 : wuertz 1221
76 : wuertz 1504 # Get Weights:
77 : wuertz 1221 weights = spec@portfolio$weights
78 : wuertz 1504 if(is.null(weights)) weights = rep(1/nAssets, times = nAssets)
79 : wuertz 1492 names(weights) = names(mu)
80 :    
81 : wuertz 1504 # Target Return:
82 : wuertz 1492 targetReturn = as.numeric(mu %*% weights)
83 : wuertz 1520 names(targetReturn) <- spec@model$estimator[1]
84 : wuertz 1492
85 : wuertz 1504 # Target Risk:
86 :     targetRisk = sqrt( as.numeric( weights %*% Sigma %*% weights ) )
87 : wuertz 1520 names(targetRisk) <- spec@model$estimator[2]
88 : wuertz 1221
89 :     # Return Value:
90 :     new("fPORTFOLIO",
91 :     call = match.call(),
92 :     data = data,
93 : wuertz 1450 specification = list(spec = spec),
94 : wuertz 1393 constraints = as.character(constraints),
95 : wuertz 1221 portfolio = list(
96 :     weights = weights,
97 :     targetReturn = targetReturn,
98 : wuertz 1504 targetRisk = targetRisk),
99 : wuertz 1221 title = "Feasible Portfolio",
100 : wuertz 1492 description = .description())
101 : wuertz 1221 }
102 :    
103 :    
104 : wuertz 1520 #-------------------------------------------------------------------------------
105 :    
106 :    
107 :     .efficientConstrainedMVPortfolio =
108 :     function(data, spec, constraints)
109 :     { # A function implemented by Rmetrics
110 :    
111 :     # Description:
112 :     # Computes Risk and Return for a feasible portfolio
113 :    
114 :     # Arguments:
115 :     # data - portfolio of assets
116 :     # spec - specification of the portfolio
117 :     # constraints - string of constraints
118 :    
119 :     # Note:
120 : wuertz 1546 # In contrast to the functions *Portfolio(), which only require
121 :     # either the statistics or the series the functions .*Portfolio()
122 :     # require both as input
123 : wuertz 1520 # Calls solveRQuadprog()
124 :     # Calls solveRDonlp2()
125 :    
126 :     # Example:
127 :     # .feasibleConstrainedMVPortfolio()
128 :    
129 :     # FUNCTION:
130 :    
131 :     # Get Statistics:
132 :     if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
133 :     mu = data$statistics$mu
134 :     Sigma = data$statistics$Sigma
135 :     nAssets = length(mu)
136 :    
137 : wuertz 1546 # Check Constraints:
138 :     # If there are risk budget constraints then the solver must
139 :     # be of type "RDonlp2"!
140 :    
141 : wuertz 1520 # Calling Solver:
142 :     solver = spec@solver$type
143 : wuertz 1546 stopifnot(solver == "RQuadprog" | solver == "RDonlp2")
144 : wuertz 1520 if (solver == "RQuadprog") {
145 :     portfolio = solveRQuadprog(data, spec, constraints)
146 :     } else if (solver == "RDonlp2") {
147 :     portfolio = solveRDonlp2(data, spec, constraints)
148 :     }
149 :    
150 :     # Get Weights:
151 :     weights = portfolio$weights
152 :     attr(weights, "status") <- portfolio$status
153 :     names(weights) = names(mu)
154 :    
155 :     # Get Target Risk:
156 : wuertz 1523 targetReturn = as.numeric(mu %*% weights)
157 : wuertz 1520 names(targetReturn) <- spec@model$estimator[1]
158 :    
159 :     # Get Target Risk:
160 : wuertz 1523 targetRisk = as.numeric( sqrt( weights %*% Sigma %*% weights ) )
161 : wuertz 1520 names(targetRisk) <- spec@model$estimator[2]
162 :    
163 :     # Return Value:
164 :     new("fPORTFOLIO",
165 :     call = match.call(),
166 :     data = data,
167 :     specification = list(spec = spec),
168 :     constraints = as.character(constraints),
169 :     portfolio = list(
170 :     weights = weights,
171 :     targetReturn = targetReturn,
172 :     targetRisk = targetRisk,
173 :     status = portfolio$status),
174 :     title = paste("Constrained MV Portfolio - Solver:", solver),
175 :     description = .description())
176 :     }
177 :    
178 :    
179 : wuertz 1221 #-------------------------------------------------------------------------------
180 :    
181 :    
182 :     .cmlConstrainedMVPortfolio =
183 : wuertz 1393 function(data, spec, constraints)
184 : wuertz 1221 {
185 :     # Description:
186 :     # Computes Computes Risk, Return and Weight for CML portfolio
187 :    
188 : wuertz 1504 # Arguments:
189 :     # data - portfolio of assets
190 :     # spec - specification of the portfolio
191 :     # constraints - string of constraints
192 :    
193 : wuertz 1492 # Note:
194 :     # Calls .efficientConstrainedMVPortfolio()
195 :     # Calls efficientPortfolio()
196 :    
197 : wuertz 1221 # Example:
198 :     # .cmlConstrainedMVPortfolio()
199 :    
200 :     # FUNCTION:
201 :    
202 :     # Get Statistics:
203 : wuertz 1497 if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
204 : wuertz 1221 mu = data$statistics$mu
205 :     Sigma = data$statistics$Sigma
206 : wuertz 1504 nAssets = length(mu)
207 : wuertz 1221
208 : wuertz 1504 # Compose function to be minimized:
209 : wuertz 1221 .sharpeRatioFun =
210 : wuertz 1393 function(x, data, spec, constraints) {
211 : wuertz 1221 spec@portfolio$targetReturn = x
212 : wuertz 1393 ans = .efficientConstrainedMVPortfolio(data = data, spec = spec,
213 :     constraints = constraints)
214 : wuertz 1504 f = (x - spec@portfolio$riskFreeRate) / getTargetRisk(ans)
215 :     attr(f, "targetRisk") <- getTargetRisk(ans)
216 :     attr(f, "weights") <- getWeights(ans)
217 :     f
218 : wuertz 1221 }
219 :    
220 : wuertz 1504 # Optimize Sharpe Ratio:
221 : wuertz 1221 cml = optimize(.sharpeRatioFun, interval = range(mu), maximum = TRUE,
222 : wuertz 1393 data = data, spec = spec, constraints = constraints,
223 : wuertz 1221 tol = .Machine$double.eps^0.5)
224 : wuertz 1492
225 :     # Get Weights:
226 : wuertz 1504 weights = attr(cml$objective, "weights")
227 : wuertz 1492 names(weights) = names(mu)
228 : wuertz 1221
229 : wuertz 1504 # Get Target Return:
230 : wuertz 1523 targetReturn = spec@portfolio$targetReturn = as.numeric(cml$maximum)
231 : wuertz 1520 names(targetReturn) <- spec@model$estimator[1]
232 : wuertz 1504
233 :     # Get Target Return:
234 : wuertz 1523 targetRisk = as.numeric(attr(cml$objective, "targetRisk"))
235 : wuertz 1520 names(targetRisk) <- spec@model$estimator[2]
236 : wuertz 1504
237 : wuertz 1221 # Return Value:
238 :     new("fPORTFOLIO",
239 :     call = match.call(),
240 :     data = data,
241 : wuertz 1450 specification = list(spec = spec),
242 : wuertz 1393 constraints = as.character(constraints),
243 : wuertz 1221 portfolio = list(
244 : wuertz 1223 weights = weights,
245 :     targetReturn = targetReturn,
246 : wuertz 1504 targetRisk = targetRisk),
247 : wuertz 1221 title = "CML Portfolio",
248 :     description = .description())
249 :     }
250 :    
251 :    
252 :     #-------------------------------------------------------------------------------
253 :    
254 :    
255 :     .tangencyConstrainedMVPortfolio =
256 : wuertz 1393 function(data, spec, constraints)
257 : wuertz 1221 {
258 :     # Description:
259 :     # Computes Risk, Return and Weight for the tangency portfolio
260 :    
261 : wuertz 1504 # Arguments:
262 :     # data - portfolio of assets
263 :     # spec - specification of the portfolio
264 :     # constraints - string of constraints
265 :    
266 : wuertz 1492 # Note:
267 :     # Calls .cmlConstrainedMVPortfolio()
268 :     # Calls .efficientConstrainedMVPortfolio()
269 :    
270 : wuertz 1221 # Example:
271 :     # .tangencyConstrainedMVPortfolio()
272 :    
273 :     # FUNCTION:
274 :    
275 :     # Set Risk Free Rate:
276 :     spec@portfolio$riskFreeRate = 0
277 :    
278 : wuertz 1504 # Call cmlPorfolio unction:
279 : wuertz 1393 ans = .cmlConstrainedMVPortfolio(data, spec, constraints)
280 : wuertz 1221 ans@call = match.call()
281 :     ans@title = "Tangency Portfolio"
282 :    
283 : wuertz 1526 # Return Value:
284 : wuertz 1221 ans
285 :     }
286 :    
287 :    
288 :     #-------------------------------------------------------------------------------
289 :    
290 :    
291 :     .minvarianceConstrainedMVPortfolio =
292 : wuertz 1393 function(data, spec, constraints)
293 : wuertz 1221 {
294 :     # Description:
295 :     # Computes Risk, Return and Weight for minimum variance portfolio
296 :    
297 : wuertz 1504 # Arguments:
298 :     # data - portfolio of assets
299 :     # spec - specification of the portfolio
300 :     # constraints - string of constraints
301 :    
302 : wuertz 1492 # Note:
303 :     # Calls .efficientConstrainedMVPortfolio()
304 :     # Calls efficientPortfolio()
305 :    
306 : wuertz 1221 # Example:
307 :     # .minvarianceConstrainedMVPortfolio()
308 :    
309 :     # FUNCTION:
310 :    
311 :     # Get Statistics:
312 : wuertz 1497 if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
313 : wuertz 1221 mu = data$statistics$mu
314 :     Sigma = data$statistics$Sigma
315 : wuertz 1504 nAssets = length(mu)
316 : wuertz 1221
317 : wuertz 1520 # Compose Function to be Minimized:
318 : wuertz 1221 .minVariancePortfolioFun =
319 : wuertz 1393 function(x, data, spec, constraints) {
320 : wuertz 1221 spec@portfolio$targetReturn = x
321 : wuertz 1393 ans = .efficientConstrainedMVPortfolio(data = data, spec = spec,
322 :     constraints = constraints)
323 : wuertz 1504 f = getTargetRisk(ans)
324 :     attr(f, "targetReturn") <- getTargetReturn(ans)
325 :     attr(f, "weights") <- getWeights(ans)
326 :     f
327 : wuertz 1221 }
328 :    
329 : wuertz 1504 # Optimize Minimum Risk Function:
330 : wuertz 1221 minVar = optimize(.minVariancePortfolioFun, interval = range(mu),
331 : wuertz 1393 data = data, spec = spec, constraints = constraints,
332 : wuertz 1221 tol = .Machine$double.eps^0.5)
333 : wuertz 1504
334 :     # Get Weights:
335 :     weights = attr(minVar$objective, "weights")
336 : wuertz 1492 names(weights) = names(mu)
337 : wuertz 1504
338 :     # Get Target Return:
339 :     targetReturn = spec@portfolio$targetReturn =
340 : wuertz 1523 as.numeric(attr(minVar$objective, "targetReturn"))
341 : wuertz 1520 names(targetReturn) <- spec@model$estimator[1]
342 : wuertz 1504
343 :     # Get Target Risk:
344 : wuertz 1523 targetRisk = as.numeric(minVar$objective)
345 : wuertz 1520 names(targetRisk) <- spec@model$estimator[2]
346 : wuertz 1504
347 : wuertz 1221 # Return Value:
348 :     new("fPORTFOLIO",
349 :     call = match.call(),
350 :     data = data,
351 : wuertz 1450 specification = list(spec = spec),
352 : wuertz 1393 constraints = as.character(constraints),
353 : wuertz 1221 portfolio = list(
354 : wuertz 1223 weights = weights,
355 :     targetReturn = targetReturn,
356 : wuertz 1504 targetRisk = targetRisk),
357 : wuertz 1221 title = "Minimum Variance Portfolio",
358 :     description = .description())
359 :     }
360 :    
361 :    
362 : wuertz 1523 ################################################################################
363 : wuertz 1221
364 :    
365 :     .portfolioConstrainedMVFrontier =
366 : wuertz 1393 function(data, spec, constraints)
367 : wuertz 1221 {
368 :     # Description:
369 :     # Evaluates the EF for a given set of box and or sector constraints
370 :    
371 :     # Arguments:
372 : wuertz 1504 # data - portfolio of assets
373 : wuertz 1221 # spec - specification of the portfolio
374 : wuertz 1393 # constraints - string of constraints
375 : wuertz 1221
376 :     # FUNCTION:
377 :    
378 :     # Get Statistics:
379 : wuertz 1497 if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
380 : wuertz 1221 mu = data$statistics$mu
381 :     Sigma = data$statistics$Sigma
382 : wuertz 1504 nAssets = length(mu)
383 : wuertz 1221
384 :     # Settings:
385 :     nFrontierPoints = spec@portfolio$nFrontierPoints
386 :    
387 :     # Calculate Efficient Frontier:
388 :     targetMu = targetSigma = nextWeights = rep(0, times = nFrontierPoints)
389 : wuertz 1504 targetWeights = error = NULL
390 : wuertz 1221
391 : wuertz 1393 # Loop over .efficientConstrainedMVPortfolio
392 : wuertz 1400 Spec = spec
393 : wuertz 1492 solver = spec@solver$type
394 : wuertz 1504 # Start Weights:
395 :     Spec@portfolio$weights = rep(1/nAssets, nAssets)
396 : wuertz 1492 k = 0
397 : wuertz 1520 solverType = spec@solver$type
398 :     status = NULL
399 : wuertz 1504 for (nTargetReturn in seq(min(mu), max(mu), length = nFrontierPoints)) {
400 : wuertz 1520
401 : wuertz 1452 k = k + 1
402 : wuertz 1504 setTargetReturn(Spec) <- nTargetReturn
403 :     nextPortfolio = .efficientConstrainedMVPortfolio(
404 : wuertz 1492 data = data, spec = Spec, constraints = constraints)
405 : wuertz 1520
406 : wuertz 1504 # Start Weights for Donlp2:
407 :     Spec@portfolio$weights = nextPortfolio@portfolio$weights
408 : wuertz 1520
409 : wuertz 1504 # Target Return and Risk:
410 :     targetMu[k] = nextPortfolio@portfolio$targetReturn
411 :     targetSigma[k] = nextPortfolio@portfolio$targetRisk
412 :     nextWeights = nextPortfolio@portfolio$weights
413 : wuertz 1492 names(nextWeights) = names(mu)
414 : wuertz 1520
415 :     if (solverType == "RQuadprog")
416 :     status = c(status, nextPortfolio@portfolio$status)
417 : wuertz 1504 targetWeights = rbind(targetWeights, t(nextWeights))
418 : wuertz 1221 }
419 :    
420 : wuertz 1520 Index = (1:length(status))[status == 0]
421 :    
422 : wuertz 1504 # Get Weights:
423 :     weights = targetWeights
424 : wuertz 1520 colnames(weights) = names(mu)
425 :     if (solverType == "RQuadprog") weights = weights[Index, ]
426 : wuertz 1504
427 :     # Get TargetReturn:
428 :     targetReturn = targetMu
429 : wuertz 1521 names(targetReturn) <- NULL # spec@model$estimator[1]
430 : wuertz 1520 if (solverType == "RQuadprog") targetReturn = targetReturn[Index]
431 : wuertz 1504
432 :     # Get Target Risk:
433 :     targetRisk = targetSigma
434 : wuertz 1521 names(targetRisk) = NULL # spec@model$estimator[2]
435 : wuertz 1520 if (solverType == "RQuadprog") targetRisk = targetRisk[Index]
436 :    
437 : wuertz 1221 # Return Value:
438 :     new("fPORTFOLIO",
439 :     call = match.call(),
440 :     data = data,
441 : wuertz 1450 specification = list(spec = spec),
442 : wuertz 1393 constraints = as.character(constraints),
443 : wuertz 1221 portfolio = list(
444 : wuertz 1504 weights = weights,
445 :     targetReturn = targetReturn,
446 :     targetRisk = targetRisk),
447 : wuertz 1221 title = "Constrained MV Frontier",
448 :     description = .description())
449 :     }
450 :    
451 :    
452 :     ################################################################################
453 :    

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