← Back to branch summary

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

« back to all changes in this revision

Viewing changes to R/portfolioSpec.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/portfolioSpec.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
 
 
18
################################################################################
 
19
# FUNCTION:                     DESCRIPTION:
 
20
#  portfolioSpec                 Specifies a portfolio to be optimized
 
21
#  .checkWeights                 Forces tiny weights to zero
 
22
#  .checkSpecVsConstraints       Stops if spec and constraints do not match
 
23
################################################################################
 
24
 
 
25
 
 
26
portfolioSpec <-
 
27
function(
 
28
    model = list(
 
29
         type = "MV",                   # Alt: "LPM", "CVaR"
 
30
         optimize = "minRisk",          # Alt: "maxReturn"
 
31
         estimator = "covEstimator",    # Alt: "shrinkEstimator", 
 
32
                                        #      "lpmEstimator"
 
33
         tailRisk = list(),
 
34
         params = list(alpha = 0.05, a = 1)),
 
35
    portfolio = list(
 
36
         weights = NULL,
 
37
         targetReturn = NULL,
 
38
         targetRisk = NULL,
 
39
         riskFreeRate = 0,
 
40
         nFrontierPoints = 50,
 
41
         status = 0),
 
42
    optim = list(
 
43
         solver = "solveRquadprog",     # Alt: "solveRdonlp2" 
 
44
                                        #      "solveRglpk", 
 
45
                                        #      "solveRsocp"
 
46
         objective = NULL,
 
47
         params = list(meq = 2),
 
48
         control = list(),
 
49
         trace = FALSE)
 
50
    )
 
51
{
 
52
    # Description:
 
53
    #   Specifies a portfolio to be optimized
 
54
 
 
55
    # Example:
 
56
    #   portfolioSpec(portfolio = list(targetReturn = 1.5))
 
57
 
 
58
    # FUNCTION:
 
59
 
 
60
    # Compose Checklists:
 
61
    # model.type = c("MV", "CVaR")
 
62
    # model.estimator.mean = "mean"
 
63
    # model.estimator.cov = c("cov", "mcd", "Mcd", "shrink")
 
64
    # optim.solver = c("solveRquadprog", "solveRdonlp2", "solveRglpk")
 
65
    # optim.trace = FALSE
 
66
 
 
67
    # Check Arguments:
 
68
    # stopifnot(model$type %in% model.type)
 
69
    # stopifnot(model$estimator[1] %in% model.estimator.mean)
 
70
    # stopifnot(model$estimator[2] %in% model.estimator.cov)
 
71
    # stopifnot(optim$solver %in% optim.solver)
 
72
 
 
73
    # Model Slot:
 
74
    Model = list(
 
75
        type = "MV",
 
76
        optimize = "minRisk",
 
77
        estimator = "covEstimator",
 
78
        tailRisk = NULL,
 
79
        params = list())
 
80
    model$type = model$type[1]
 
81
    Model[(Names <- names(model))] <- model
 
82
 
 
83
    # Portfolio Slot:
 
84
    Portfolio = list(
 
85
        weights = NULL,
 
86
        targetReturn = NULL,
 
87
        targetRisk = NULL,
 
88
        riskFreeRate = 0,
 
89
        nFrontierPoints = 50,
 
90
        status = 0)
 
91
    Portfolio[(Names <- names(portfolio))] <- portfolio
 
92
 
 
93
    # Check Portfolio - weights, targetReturn, targetRisk:
 
94
    # ... at least two of them must be set to NULL!
 
95
    checkPortfolio = 0
 
96
    if(!is.null(portfolio$weights)) checkPortfolio = checkPortfolio + 1
 
97
    if(!is.null(portfolio$targetReturn)) checkPortfolio = checkPortfolio + 1
 
98
    stopifnot(checkPortfolio <= 1)
 
99
 
 
100
    # Optim Slot:
 
101
    Optim = list(
 
102
        solver = "solveRquadprog",
 
103
        trace = FALSE)
 
104
    Optim[(Names <- names(optim))] <- optim
 
105
 
 
106
    # Return Value:
 
107
    new("fPFOLIOSPEC",
 
108
        model = Model,
 
109
        portfolio = Portfolio,
 
110
        optim = Optim)
 
111
}
 
112
 
 
113
 
 
114
# ------------------------------------------------------------------------------
 
115
 
 
116
 
 
117
.checkWeights <-
 
118
    function(weights, eps = sqrt(.Machine$double.eps))
 
119
{    
 
120
    # A function implemented by Diethelm Wuertz
 
121
    
 
122
    # Description:
 
123
    #   Sets tiny weights to zero
 
124
    
 
125
    # Arguments:
 
126
    #   weights - a numeric vector of portfolio weights
 
127
    #   eps - a numeric value, lower bounds of weigths
 
128
    
 
129
    # FUNCTOION:
 
130
    
 
131
    # Check:
 
132
    for(i in 1:length(weights)) {
 
133
        if(abs(weights[i]) < eps) weights[i] = 0
 
134
    }
 
135
    
 
136
    # Return Value:
 
137
    weights
 
138
}
 
139
 
 
140
 
 
141
# ------------------------------------------------------------------------------
 
142
 
 
143
 
 
144
.checkSpecVsConstraints <-
 
145
    function(spec, constraints)
 
146
{    
 
147
    # A function implemented by Diethelm Wuertz
 
148
    
 
149
    # Description:
 
150
    #   Stops if spec versus constraints do mot match
 
151
    
 
152
    # Arguments:
 
153
    #   spec - portfolio specification as fPFOLIOSPEC object
 
154
    #   constraints - as charvec or as fPFOLIOSPEC object
 
155
    
 
156
    # FUNCTOION:
 
157
    
 
158
    # Check:
 
159
    if(class(constraints) == "fPFOLIOCON")
 
160
        constraints = constraints@stringConstraints
 
161
    if(any(constraints == "Short")) {
 
162
        stopifnot(getSolver(spec) == "solveRshortExact")
 
163
    }
 
164
    
 
165
    # Return Value:
 
166
    invisible()
 
167
}
 
168
 
 
169
 
 
170
# ------------------------------------------------------------------------------
 
171
 
 
172
 
 
173
.checkTargetReturn <-
 
174
    function(spec)
 
175
{    
 
176
    # Description:
 
177
    #   Check if target Return is defined
 
178
    
 
179
    # Arguments:
 
180
    #   spec - specification object
 
181
    
 
182
    # FUNCTOION:
 
183
    
 
184
    # Check:
 
185
    targetReturn = getTargetReturn(spec)
 
186
    if(is.null(targetReturn))
 
187
        stop("The target return is not available")
 
188
    
 
189
    # Return Value:
 
190
    invisible(targetReturn)
 
191
}
 
192
 
 
193
 
 
194
 
 
195
################################################################################
 
196