← Back to branch summary

~ubuntu-branches/ubuntu/trusty/fportfolio/trusty

« back to all changes in this revision

Viewing changes to R/ShortMVPortfolio.R

  • 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

Show diffs side-by-side

added added

removed removed

Lines of Context:
R/ShortMVPortfolio.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:                      SINGLE PORTFOLIOS:
32
 
#  .feasibleShortMVPortfolio      Returns a feasible MV portfolio
33
 
#  .efficientShortMVPortfolio     Returns a frontier MV portfolio
34
 
#  .cmlShortMVPortfolio           Returns a capital market line
35
 
#  .tangencyShortMVPortfolio      Returns the tangency MV portfolio
36
 
#  .minvarianceShortMVPortfolio   Returns the minimum variance portfolio
37
 
# FUNCTION:                      PORTFOLIO FRONTIER:
38
 
#  .portfolioShortMVFrontier      Returns the EF of a short selling MV portfolio
39
 
################################################################################
40
 
 
41
 
 
42
 
.feasibleShortMVPortfolio =
43
 
function(data, spec = portfolioSpec(), constraints = NULL)
44
 
{   # A function implemented by Rmetrics
45
 
 
46
 
    # Description:
47
 
    #   Computes Risk and Return for a feasible portfolio
48
 
    
49
 
    # Arguments:
50
 
    #   data - portfolio of assets
51
 
    #   spec - specification of the portfolio
52
 
    #   constraints - string of constraints
53
 
    
54
 
    # Note:
55
 
    #   In contrast to the functions *Portfolio(), which only require either the
56
 
    #   statistics or the series the functions .*Portfolio() require both as
57
 
    #   input
58
 
    
59
 
    # Example:
60
 
    #   .feasibleShortMVPortfolio(engelsPortfolioData())
61
 
    
62
 
    # FUNCTION:
63
 
       
64
 
    # Get Statistics:
65
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
66
 
    mu = getStatistics(data)$mu
67
 
    Sigma = getStatistics(data)$Sigma
68
 
    nAssets = getNumberOfAssets(data)
69
 
    
70
 
    # Get Alpha:
71
 
    targetAlpha = getTargetAlpha(spec)
72
 
    
73
 
    # Get Weights:
74
 
    weights = getWeights(spec)
75
 
    if(is.null(weights)) weights = rep(1/nAssets, times = nAssets)  
76
 
    names(weights) = names(mu)
77
 
    
78
 
    # Target Return:
79
 
    targetReturn = matrix(as.numeric(mu %*% weights), nrow = 1)
80
 
    colnames(targetReturn) <- getEstimator(spec)[1]
81
 
    
82
 
    # Compute Target Risks:
83
 
    covTargetRisk = sqrt( as.numeric( weights %*% Sigma %*% weights ) )
84
 
    x = getSeries(data)@Data %*% weights
85
 
    VaR = quantile(x, targetAlpha, type = 1)
86
 
    CVaR = VaR - 0.5*mean(((VaR-x) + abs(VaR-x))) / targetAlpha
87
 
    targetRisk = matrix(c(covTargetRisk, CVaR, VaR), nrow = 1)
88
 
    colnames(targetRisk) <- 
89
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
90
 
   
91
 
    # Status:
92
 
    status = 0
93
 
    
94
 
    # Return Value:
95
 
    new("fPORTFOLIO", 
96
 
        call = match.call(),
97
 
        data = list(data = data), 
98
 
        spec = list(spec = spec),
99
 
        constraints = as.character(constraints),
100
 
        portfolio = list(
101
 
            weights = weights,  
102
 
            targetReturn = targetReturn, 
103
 
            targetRisk = targetRisk,
104
 
            targetAlpha = targetAlpha,
105
 
            status = status),
106
 
        title = "Feasible Portfolio", 
107
 
        description = .description())  
108
 
}
109
 
 
110
 
 
111
 
# ------------------------------------------------------------------------------
112
 
 
113
 
 
114
 
.efficientShortMVPortfolio =
115
 
function(data, spec = portfolioSpec(), constraints = NULL)
116
 
{   # A function implemented by Rmetrics
117
 
 
118
 
    # Description:
119
 
    #   Computes target risk and weights for an efficient portfolio
120
 
    
121
 
    # Arguments:
122
 
    #   data - portfolio of assets
123
 
    #   spec - specification of the portfolio
124
 
    #   constraints - string of constraints
125
 
    
126
 
    # Example:
127
 
    #   .efficientShortMVPortfolio(engelsPortfolioData())
128
 
    
129
 
    # FUNCTION:
130
 
    
131
 
    # Get Statistics:
132
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
133
 
    mu = getStatistics(data)$mu
134
 
    Sigma = getStatistics(data)$Sigma
135
 
    nAssets = getNumberOfAssets(data)
136
 
    
137
 
    # Get or Set Target Alpha:
138
 
    targetAlpha = getTargetAlpha(spec)
139
 
    
140
 
    # Parameter Settings:
141
 
    C0 = 1
142
 
    one = rep(1, times = length(mu))
143
 
    invSigma = solve(Sigma)
144
 
    a = as.numeric(mu %*% invSigma %*% mu)
145
 
    b = as.numeric(mu %*% invSigma %*% one)
146
 
    c = as.numeric(one %*% invSigma %*% one)
147
 
    d = as.numeric(a*c - b^2)
148
 
    
149
 
    # Compute Target Return:
150
 
    targetReturn = getTargetReturn(spec) 
151
 
    if (is.null(targetReturn))  
152
 
        targetReturn = getTargetReturn(.tangencyShortMVPortfolio(data, spec))
153
 
    targetReturn = matrix(targetReturn, nrow = 1)
154
 
    colnames(targetReturn) = getEstimator(spec)[1]
155
 
    
156
 
    # Get Weights:
157
 
    weights = as.vector(invSigma %*% ((a-b*mu)*C0 + (c*mu-b)*targetReturn )/d)
158
 
    names(weights) = names(mu)
159
 
    
160
 
    # Compute Target Risk:
161
 
    covTargetRisk = sqrt((c*targetReturn^2 - 2*b*C0*targetReturn + a*C0^2) / d)
162
 
    x = getSeries(data)@Data %*% weights
163
 
    VaR = quantile(x, targetAlpha, type = 1)
164
 
    CVaR = VaR - 0.5*mean(((VaR-x) + abs(VaR-x))) / targetAlpha
165
 
    targetRisk = matrix(c(covTargetRisk, CVaR, VaR), nrow = 1)
166
 
    colnames(targetRisk) <- 
167
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
168
 
    
169
 
    # Status:
170
 
    status = 0
171
 
    
172
 
    # Return Value:
173
 
    new("fPORTFOLIO", 
174
 
        call = match.call(),
175
 
        data = list(data = data), 
176
 
        spec = list(spec = spec),
177
 
        constraints = as.character(constraints),
178
 
        portfolio = list(
179
 
            weights = weights,  
180
 
            targetReturn = targetReturn, 
181
 
            targetRisk = targetRisk,
182
 
            targetAlpha = targetAlpha,
183
 
            status = status),
184
 
        title = "Frontier MV Portfolio", 
185
 
        description = .description())  
186
 
}
187
 
 
188
 
 
189
 
# ------------------------------------------------------------------------------
190
 
 
191
 
 
192
 
.cmlShortMVPortfolio =
193
 
function(data, spec = portfolioSpec(), constraints = NULL)
194
 
{   # A function implemented by Rmetrics
195
 
 
196
 
    # Description:
197
 
    #   Computes capital market line
198
 
    
199
 
    # Arguments:
200
 
    #   data - portfolio of assets
201
 
    #   spec - specification of the portfolio
202
 
    #   constraints - string of constraints
203
 
    
204
 
    # Example:
205
 
    #   .cmlShortMVPortfolio(engelsPortfolioData())
206
 
    
207
 
    # FUNCTION:
208
 
    
209
 
    # Get Statistics:
210
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
211
 
    mu = getStatistics(data)$mu
212
 
    Sigma = getStatistics(data)$Sigma
213
 
    nAssets = getNumberOfAssets(data)
214
 
    
215
 
    # Get or Set Target Alpha:
216
 
    targetAlpha = getTargetAlpha(spec)
217
 
    
218
 
    # Risk-Free Rate:
219
 
    riskFreeRate = getRiskFreeRate(spec)
220
 
    
221
 
    # Parameter Settings:
222
 
    C0 = 1
223
 
    one = rep(1, times = length(mu))
224
 
    invSigma = solve(Sigma)
225
 
    a = as.numeric(mu %*% invSigma %*% mu)
226
 
    b = as.numeric(mu %*% invSigma %*% one)
227
 
    c = as.numeric(one %*% invSigma %*% one)
228
 
    d = as.numeric(a*c - b^2)
229
 
       
230
 
    # Capital Market Line:
231
 
    A = (a - b*riskFreeRate)
232
 
    B = (b - c*riskFreeRate)/C0
233
 
    
234
 
    # Get Weights:
235
 
    weights = C0 * as.vector(invSigma %*% (mu - riskFreeRate) ) / B
236
 
    names(weights) = names(mu)
237
 
    
238
 
    # Get Target Return:
239
 
    targetReturn = A / B
240
 
    targetReturn = matrix(targetReturn, nrow = 1)
241
 
    colnames(targetReturn) = getEstimator(spec)[1]
242
 
    
243
 
    # Get Target Risk:
244
 
    covTargetRisk = sqrt(c*riskFreeRate^2 - 2*b*riskFreeRate + a) / B
245
 
    x = getSeries(data)@Data %*% weights
246
 
    VaR = quantile(x, targetAlpha, type = 1)
247
 
    CVaR = VaR - 0.5*mean(((VaR-x) + abs(VaR-x))) / targetAlpha
248
 
    targetRisk = matrix(c(covTargetRisk, CVaR, VaR), nrow = 1)
249
 
    colnames(targetRisk) <- 
250
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
251
 
    
252
 
    # Status:
253
 
    status = 0
254
 
    
255
 
    # Return Value:
256
 
    new("fPORTFOLIO", 
257
 
        call = match.call(),
258
 
        data = list(data = data), 
259
 
        spec = list(spec = spec),
260
 
        constraints = as.character(constraints),
261
 
        portfolio = list(
262
 
            weights = weights,  
263
 
            targetReturn = targetReturn, 
264
 
            targetRisk = targetRisk,
265
 
            targetAlpha = targetAlpha,
266
 
            status = status),
267
 
        title = "Capital Market Line", 
268
 
        description = .description())  
269
 
}
270
 
 
271
 
 
272
 
# ------------------------------------------------------------------------------
273
 
 
274
 
 
275
 
.tangencyShortMVPortfolio =
276
 
function(data, spec = portfolioSpec(), constraints = NULL)
277
 
{   # A function implemented by Rmetrics
278
 
 
279
 
    # Description:
280
 
    #   Computes target risk and weights for the tangency portfolio
281
 
    
282
 
    # Arguments:
283
 
    #   data - portfolio of assets
284
 
    #   spec - specification of the portfolio
285
 
    #   constraints - string of constraints
286
 
    
287
 
    # Example:
288
 
    #   .tangencyShortMVPortfolio(engelsPortfolioData())
289
 
    
290
 
    # FUNCTION:
291
 
    
292
 
    # Get Statistics:
293
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
294
 
    mu = getStatistics(data)$mu
295
 
    Sigma = getStatistics(data)$Sigma
296
 
    nAssets = getNumberOfAssets(data)
297
 
    
298
 
    # Get or Set Target Alpha:
299
 
    targetAlpha = getTargetAlpha(spec)
300
 
    
301
 
    # Parameter Settings:
302
 
    C0 = 1
303
 
    one = rep(1, times = length(mu))
304
 
    invSigma = solve(Sigma)
305
 
    a = as.numeric(mu %*% invSigma %*% mu)
306
 
    b = as.numeric(mu %*% invSigma %*% one)
307
 
    c = as.numeric(one %*% invSigma %*% one)
308
 
    d = as.numeric(a*c - b^2)
309
 
    
310
 
    # Get Weights:
311
 
    weights = C0 * as.vector(invSigma %*% mu ) / b 
312
 
    names(weights) = names(mu)
313
 
    
314
 
    # Get Target Return:
315
 
    targetReturn = (a/b)*C0
316
 
    targetReturn = matrix(targetReturn, nrow = 1)
317
 
    colnames(targetReturn) = spec@model$estimator[1]
318
 
    
319
 
    # Get Target Risk:
320
 
    covTargetRisk = (sqrt(a)/b)*C0
321
 
    x = getSeries(data)@Data %*% weights
322
 
    VaR = quantile(x, targetAlpha, type = 1)
323
 
    CVaR = VaR - 0.5*mean(((VaR-x) + abs(VaR-x))) / targetAlpha
324
 
    targetRisk = matrix(c(covTargetRisk, CVaR, VaR), nrow = 1)
325
 
    colnames(targetRisk) <- 
326
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
327
 
        
328
 
    # Status:
329
 
    status = 0
330
 
    
331
 
    # Return Value:
332
 
    new("fPORTFOLIO", 
333
 
        call = match.call(),
334
 
        data = list(data = data), 
335
 
        spec = list(spec = spec),
336
 
        constraints = as.character(constraints),
337
 
        portfolio = list(
338
 
            weights = weights,  
339
 
            targetReturn = targetReturn, 
340
 
            targetRisk = targetRisk,
341
 
            targetAlpha = targetAlpha,
342
 
            status = status),
343
 
        title = "Tangency MV Portfolio", 
344
 
        description = .description())  
345
 
}
346
 
 
347
 
 
348
 
# ------------------------------------------------------------------------------
349
 
 
350
 
 
351
 
.minvarianceShortMVPortfolio =
352
 
function(data, spec = portfolioSpec(), constraints = NULL)
353
 
{   # A function implemented by Rmetrics
354
 
 
355
 
    # Description:
356
 
    #   Computes target risk and weights for the minimum variance portfolio
357
 
    
358
 
    # Arguments:
359
 
    #   data - portfolio of assets
360
 
    #   spec - specification of the portfolio
361
 
    #   constraints - string of constraints
362
 
    
363
 
    # Example:
364
 
    #   .minvarianceShortMVPortfolio(engelsPortfolioData())
365
 
    
366
 
    # FUNCTION:
367
 
    
368
 
    # Get Statistics:
369
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
370
 
    mu = getStatistics(data)$mu
371
 
    Sigma = getStatistics(data)$Sigma
372
 
    nAssets = getNumberOfAssets(data)
373
 
    
374
 
    # Get or Set Target Alpha:
375
 
    targetAlpha = getTargetAlpha(spec)
376
 
    
377
 
    # Parameter Settings:
378
 
    C0 = 1
379
 
    one = rep(1, times = length(mu))
380
 
    invSigma = solve(Sigma)
381
 
    a = as.numeric(mu %*% invSigma %*% mu)
382
 
    b = as.numeric(mu %*% invSigma %*% one)
383
 
    c = as.numeric(one %*% invSigma %*% one)
384
 
    d = as.numeric(a*c - b^2)
385
 
    
386
 
    # Get Weights:
387
 
    weights = as.vector(invSigma %*% ((a-b*mu)*C0 + (c*mu-b)*(b/c)*C0 )/d)
388
 
    names(weights) = names(mu)
389
 
    
390
 
    # Get Target Return:
391
 
    targetReturn = (b/c)*C0
392
 
    targetReturn = matrix(targetReturn, nrow = 1)
393
 
    colnames(targetReturn) = getEstimator(spec)[1]
394
 
    
395
 
    # Get Target Risk:
396
 
    covTargetRisk = C0/sqrt(c)
397
 
    x = getSeries(data)@Data %*% weights
398
 
    VaR = quantile(x, targetAlpha, type = 1)
399
 
    CVaR = VaR - 0.5*mean(((VaR-x) + abs(VaR-x))) / targetAlpha
400
 
    targetRisk = matrix(c(covTargetRisk, CVaR, VaR), nrow = 1)
401
 
    colnames(targetRisk) <- 
402
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
403
 
 
404
 
    # Status:
405
 
    status = 0
406
 
    
407
 
    # Return Value:
408
 
    new("fPORTFOLIO", 
409
 
        call = match.call(),
410
 
        data = list(data = data), 
411
 
        spec = list(spec = spec),
412
 
        constraints = as.character(constraints),
413
 
        portfolio = list(
414
 
            weights = weights,  
415
 
            targetReturn = targetReturn, 
416
 
            targetRisk = targetRisk,
417
 
            targetAlpha = targetAlpha,
418
 
            status = status),
419
 
        title = "Minimum Variance MV Portfolio", 
420
 
        description = .description())  
421
 
}
422
 
 
423
 
 
424
 
################################################################################
425
 
 
426
 
 
427
 
.portfolioShortMVFrontier = 
428
 
function(data, spec = portfolioSpec(), constraints = NULL)
429
 
{   # A function implemented by Diethelm Wuertz
430
 
 
431
 
    # Description:
432
 
    #   Calculates the efficient frontier, short selling allowed
433
 
    
434
 
    # Details  from a matrix
435
 
    #   Calculates the efficient frontier (short selling allowed) from a
436
 
    #   a matrix of either market or simulated assets given in matrix "x". 
437
 
    #   Each time series represents a column in this matrix.
438
 
    
439
 
    # Arguments:
440
 
    #   data - portfolio of assets
441
 
    #   spec - specification of the portfolio
442
 
    #   constraints - string of constraints
443
 
    
444
 
    # Example:
445
 
    #   .shortMVFrontier(engelsPortfolioData())
446
 
    
447
 
    # FUNCTION:
448
 
    
449
 
    # Get Statistics:
450
 
    if (!inherits(data, "fPFOLIODATA")) data = portfolioData(data, spec)
451
 
    mu = getStatistics(data)$mu
452
 
    Sigma = getStatistics(data)$Sigma
453
 
    nAssets = getNumberOfAssets(data)
454
 
    
455
 
    # Get or Set Target Alpha:
456
 
    targetAlpha = getTargetAlpha(spec)
457
 
    
458
 
    # Specification:
459
 
    riskFreeRate = getRiskFreeRate(spec)
460
 
    nFrontierPoints = getNFrontierPoints(spec)
461
 
    
462
 
    # Parameter Settings:
463
 
    C0 = 1
464
 
    one = rep(1, times = length(mu))
465
 
    invSigma = solve(Sigma)
466
 
    a = as.numeric(mu %*% invSigma %*% mu)
467
 
    b = as.numeric(mu %*% invSigma %*% one)
468
 
    c = as.numeric(one %*% invSigma %*% one)
469
 
    d = as.numeric(a*c - b^2)
470
 
    
471
 
    # Ranges for mean and Standard Deviation:
472
 
    muRange = range(mu)+ 0.25*c(-diff(range(mu)), diff(range(mu)))
473
 
    sqrtSig = sqrt(diag(Sigma))
474
 
    sigmaRange = c(min(sqrtSig), max(sqrtSig))+
475
 
        0.25*c(-diff(range(sqrtSig)), diff(range(sqrtSig)))
476
 
               
477
 
    # Efficient Frontier Portfolios:
478
 
    targetReturn = seq(muRange[1], muRange[2], length = nFrontierPoints)
479
 
    targetReturn = as.vector(targetReturn)
480
 
    targetRisk = sqrt((c*targetReturn^2 - 2*b*C0*targetReturn + a*C0^2)/d)
481
 
    covTargetRisk = as.vector(targetRisk)
482
 
    weights = NULL
483
 
    Spec = spec
484
 
    series = getSeries(data)@Data
485
 
    targetRisk = NULL
486
 
    for (i in 1:nFrontierPoints) {
487
 
        Spec@portfolio$targetReturn = targetReturn[i]
488
 
        nextWeight = getWeights(.efficientShortMVPortfolio(data, Spec))
489
 
        weights = rbind(weights, t(nextWeight))    
490
 
        # Get Target Risk:
491
 
        x = series %*% nextWeight
492
 
        nextVaR = quantile(x, targetAlpha, type = 1)
493
 
        nextCVaR = nextVaR-0.5*mean(((nextVaR-x)+abs(nextVaR-x))) / targetAlpha
494
 
        nextTargetRisk = matrix(c(covTargetRisk[i], nextCVaR, nextVaR), nrow = 1)
495
 
        targetRisk = rbind(targetRisk, nextTargetRisk)        
496
 
    }
497
 
     colnames(targetRisk) <- 
498
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
499
 
 
500
 
    # Get TargetReturn:
501
 
    targetReturn = matrix(targetReturn, ncol = 1)
502
 
    colnames(targetReturn) = getEstimator(spec)[1]
503
 
    
504
 
    # Get Target Risk:
505
 
    colnames(targetRisk) <- 
506
 
        c("cov", paste(c("CVaR.", "VaR."), targetAlpha*100, "%", sep = ""))
507
 
    
508
 
    # Status:
509
 
    status = 0
510
 
   
511
 
    # Return Value:
512
 
    new("fPORTFOLIO",
513
 
        call = match.call(),
514
 
        data = list(data = data), 
515
 
        spec = list(spec = spec),
516
 
        constraints = as.character(constraints),
517
 
        portfolio = list(
518
 
            weights = weights,  
519
 
            targetReturn = targetReturn, 
520
 
            targetRisk = targetRisk,
521
 
            targetAlpha = targetAlpha,
522
 
            status = status),
523
 
        title = "Short Selling Portfolio Frontier", 
524
 
        description = .description())
525
 
}
526
 
        
527
 
    
528
 
################################################################################
529