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

« back to all changes in this revision

Viewing changes to R/solveRquadprog.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:
 
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
#  solveRquadprog               Portfolio interface to solver Rquadprog
 
21
#  .rquadprogArguments          Returns arguments for solver
 
22
#  .rquadprog                   Wrapper to solver function
 
23
#  .rquadprogControl            Returns default controls for solver
 
24
################################################################################
 
25
 
 
26
 
 
27
solveRquadprog <-
 
28
    function(data, spec, constraints)
 
29
{
 
30
    # Description:
 
31
    #   Portfolio interface to solver Rquadprog
 
32
 
 
33
    # Example:
 
34
    #   solveRquadprog(data, spec, constraints)[-3]
 
35
    #   solveRquadprog(.lppData, .mvSpec, "LongOnly")[-3]
 
36
    #   solveRquadprog(.lppData, .mvSpec, "LongOnly")$optim$args
 
37
    #   solveRquadprog(.lppData, .mvSpec, c("LongOnly", "partial"))$optim$args
 
38
    #   solveRquadprog(.lppData, .mvSpec, .BoxGroups)[-3]
 
39
    #   portfolioTest("MV", "minRisk", "solveRquadprog", "LongOnly")
 
40
    #   portfolioTest("MV", "minRisk", "solveRquadprog", "BoxGroup")
 
41
    
 
42
    # FUNCTION:   
 
43
 
 
44
    # Transform Data:
 
45
    Data = portfolioData(data, spec)
 
46
    nAssets = getNAssets(Data)
 
47
    
 
48
    # Solve:
 
49
    if(nAssets == 2) {
 
50
 
 
51
        # Solve two Assets Portfolio Analytically:
 
52
        ans = .mvSolveTwoAssets(data, spec, constraints)
 
53
        # ... this is only  for 'unlimited' LongOnly constraints,
 
54
        # box and group constraints are discarded here.
 
55
            
 
56
    } else {
 
57
        
 
58
        # Compile Arguments for Solver:
 
59
        args = .rquadprogArguments(data, spec, constraints)
 
60
        
 
61
        # Solve Multiassets Portfolio:
 
62
        ans = .rquadprog(
 
63
            Dmat = args$Dmat, 
 
64
            dvec = args$dvec, 
 
65
            Amat = args$Amat, 
 
66
            bvec = args$bvec, 
 
67
            meq = args$meq)
 
68
         
 
69
        # Save Arguments:
 
70
        ans$optim$args = args
 
71
            
 
72
    }
 
73
 
 
74
    # Return Value:
 
75
    ans
 
76
}
 
77
 
 
78
 
 
79
################################################################################
 
80
 
 
81
 
 
82
.rquadprogArguments <-
 
83
    function(data, spec, constraints)
 
84
{
 
85
    # Description:
 
86
    #   Returns quadprog conform arguments for the solver
 
87
    
 
88
    # Example:
 
89
    #   .rquadprogArguments(.lppData, .mvSpec, "LongOnly")
 
90
    #   .rquadprogArguments(.lppData, .mvSpec, .BoxGroups)
 
91
    
 
92
    # FUNCTION:
 
93
    
 
94
    # Data and Constraints as S4 Objects:
 
95
    Data = portfolioData(data, spec)
 
96
    Sigma = getSigma(Data)
 
97
    nAssets = getNAssets(Data)
 
98
    
 
99
    # Set up A_mat of Constraints:
 
100
    eqsumW = eqsumWConstraints(data, spec, constraints)
 
101
    minsumW = minsumWConstraints(data, spec, constraints)
 
102
    maxsumW = maxsumWConstraints(data, spec, constraints)
 
103
    Amat = rbind(eqsumW[, -1], diag(nAssets), -diag(nAssets))
 
104
    if(!is.null(minsumW)) Amat = rbind(Amat, minsumW[, -1])
 
105
    if(!is.null(maxsumW)) Amat = rbind(Amat, -maxsumW[, -1])
 
106
 
 
107
    # Set up Vector A_mat >= bvec of Constraints:
 
108
    minW = minWConstraints(data, spec, constraints)
 
109
    maxW = maxWConstraints(data, spec, constraints)
 
110
    bvec = c(eqsumW[, 1], minW, -maxW)
 
111
    if(!is.null(minsumW)) bvec = c(bvec, minsumW[, 1])
 
112
    if(!is.null(maxsumW)) bvec = c(bvec, -maxsumW[, 1])
 
113
 
 
114
    # Part (meq=1) or Full (meq=2) Investment, the Default ?
 
115
    meq = nrow(eqsumW)
 
116
    
 
117
    # Directions:
 
118
    dir = c(
 
119
        rep("==", times = meq),
 
120
        rep(">=", times = length(bvec) - meq))
 
121
    
 
122
    # Return Value:
 
123
    list(
 
124
        Dmat = Sigma, dvec = rep(0, nAssets), 
 
125
        Amat = t(Amat), bvec = bvec, meq = meq, dir = dir)
 
126
}
 
127
 
 
128
 
 
129
################################################################################
 
130
 
 
131
 
 
132
.rquadprog <-
 
133
    function(Dmat, dvec, Amat, bvec, meq)
 
134
{
 
135
    # Description:
 
136
    #   Goldfarb and Idnani's quadprog solver function
 
137
    
 
138
    # Note:
 
139
    #   Requires to load contributed R package quadprog from which we use
 
140
    #   the Fortran subroutine of the quadratic solver.
 
141
    
 
142
    # Package: quadprog
 
143
    #   Title: Functions to solve Quadratic Programming Problems.
 
144
    #   Author: S original by Berwin A. Turlach <berwin.turlach@anu.edu.au>
 
145
    #       R port by Andreas Weingessel <Andreas.Weingessel@ci.tuwien.ac.at>
 
146
    #   Maintainer: Andreas Weingessel <Andreas.Weingessel@ci.tuwien.ac.at>
 
147
    #   Description: This package contains routines and documentation for
 
148
    #       solving quadratic programming problems.
 
149
    #   License: GPL-2
 
150
    
 
151
    # Value of slove.QP():
 
152
    #   solution - vector containing the solution of the quadratic
 
153
    #       programming problem.
 
154
    #   value - scalar, the value of the quadratic function at the
 
155
    #       solution
 
156
    #   unconstrained.solution - vector containing the unconstrained
 
157
    #       minimizer of the quadratic function.
 
158
    #   iterations - vector of length 2, the first component contains
 
159
    #       the number of iterations the algorithm needed, the second
 
160
    #       indicates how often constraints became inactive after
 
161
    #       becoming active first. vector with the indices of the
 
162
    #       active constraints at the solution.
 
163
 
 
164
    # FUNCION:
 
165
    
 
166
    # Settings:
 
167
    n = nrow(Dmat)
 
168
    q = ncol(Amat)
 
169
    r = min(n, q)
 
170
    work = rep(0, 2 * n + r * (r + 5)/2 + 2 * q + 1)
 
171
 
 
172
    # Optimize:
 
173
    optim = .Fortran("qpgen2",
 
174
        as.double(Dmat),
 
175
        dvec = as.double(dvec),
 
176
        as.integer(n),
 
177
        as.integer(n),
 
178
        sol = as.double(rep(0, n)),
 
179
        crval = as.double(0),
 
180
        as.double(Amat),
 
181
        as.double(bvec),
 
182
        as.integer(n),
 
183
        as.integer(q),
 
184
        as.integer(meq),
 
185
        iact = as.integer(rep(0, q)),
 
186
        nact = as.integer(0),
 
187
        iter = as.integer(rep(0, 2)),
 
188
        work = as.double(work),
 
189
        ierr = as.integer(0),
 
190
        PACKAGE = "quadprog")
 
191
          
 
192
    # Set Tiny Weights to Zero:
 
193
    weights = .checkWeights(optim$sol)
 
194
    attr(weights, "invest") = sum(weights) 
 
195
    
 
196
    # Compose Output List:
 
197
    ans = list(
 
198
        type = "MV",
 
199
        solver = "solveRquadprog",
 
200
        optim = optim,
 
201
        weights = weights,
 
202
        targetReturn = bvec[1],
 
203
        targetRisk = sqrt(optim$sol %*% Dmat %*% optim$sol)[[1,1]],
 
204
        objective = sqrt(optim$sol %*% Dmat %*% optim$sol)[[1,1]],
 
205
        status = optim$ierr,
 
206
        message = NA)
 
207
            
 
208
    # Return Value:
 
209
    ans
 
210
}
 
211
 
 
212
 
 
213
################################################################################
 
214
 
 
215
 
 
216
.rquadprogControl <-
 
217
    function()
 
218
{
 
219
    # Description:
 
220
    #   Returns default quadprog control settings
 
221
    
 
222
    # Arguments:
 
223
    #   none
 
224
    
 
225
    # FUNCTION:
 
226
    
 
227
    # This algorithm comes with no control parameter list
 
228
    
 
229
    NA
 
230
}
 
231
 
 
232
 
 
233
################################################################################
 
234