← Back to branch summary

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

« back to all changes in this revision

Viewing changes to R/weightsSlider.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/weightsSlider.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 - Diethelm Wuertz, GPL
 
20
#   2007 - Rmetrics Foundation, GPL
 
21
#   Diethelm Wuertz <wuertz@itp.phys.ethz.ch>
 
22
# for code accessed (or partly included) from other sources:
 
23
#   see Rmetric's copyright and license files
 
24
 
 
25
 
 
26
################################################################################
 
27
# FUNCTION:                     EDUCATIONAL PORTFOLIO SLIDERS:
 
28
#  weightsSlider                 Weights Slider
 
29
################################################################################
 
30
 
 
31
 
 
32
.counterWeightsSlider <-  NA
 
33
 
 
34
 
 
35
# ------------------------------------------------------------------------------
 
36
 
 
37
 
 
38
weightsSlider <-
 
39
    function(object, control = list(), ...)
 
40
{
 
41
    # A function implemented by Rmetrics
 
42
 
 
43
    # Description:
 
44
    #    Interactive view of Portfolio Weights
 
45
 
 
46
    # FUNCTION:
 
47
 
 
48
    # Global Variables:
 
49
    object <<- object
 
50
    nFrontierPoints <- length(getTargetRisk(object)[ ,1])
 
51
    dim = dim(getWeights(object))[2]
 
52
 
 
53
    # Use default, if xlim and ylim is not specified ...
 
54
    mu = getStatistics(object)$mu
 
55
    Sigma = getStatistics(object)$Sigma
 
56
    yLim = range(mu) + 0.25*c(-diff(range(mu)), diff(range(mu)))
 
57
 
 
58
    # First, take care that all assets appear on the plot ...
 
59
    sqrtSig = sqrt(diag(Sigma))
 
60
    xLimAssets = c(min(sqrtSig), max(sqrtSig))+
 
61
         c(-0.4*diff(range(sqrtSig)), 0.1*diff(range(sqrtSig)))
 
62
 
 
63
    # ... second take care that the whole frontier appears on the plot:
 
64
    fullFrontier = frontierPoints(object)
 
65
    xLimFrontier = range(fullFrontier[, 1])
 
66
    xLim = range(c(xLimAssets, xLimFrontier))
 
67
    xLim[1] = xLim[1]-diff(xLim)/5
 
68
 
 
69
    # Control Parameters:
 
70
    con <<- list(
 
71
        sliderResolution = 1,
 
72
        sliderFlag = "weights",
 
73
        runningPoint.col  = "red",
 
74
        minvariance.col = "red",
 
75
        tangency.col = "steelblue",
 
76
        singleAsset.col = rainbow(dim),
 
77
        minvariance.pch = 19,
 
78
        singleAsset.pch = 19,
 
79
        tangency.pch = 17,
 
80
        runningPoint.cex = 1.5,
 
81
        minvariance.cex = 1,
 
82
        tangency.cex = 1.25,
 
83
        singleAsset.cex = 1,
 
84
        xlim = xLim,
 
85
        ylim = yLim
 
86
        )
 
87
    con[(Names <- names(control))] <- control
 
88
 
 
89
    # Internal Function:
 
90
    refresh.code = function(...)
 
91
    {
 
92
        # Startup Counter:
 
93
        .counterWeightsSlider <- getRmetricsOptions(".counterWeightsSlider") + 1
 
94
        setRmetricsOptions(.counterWeightsSlider = .counterWeightsSlider)
 
95
        if (.counterWeightsSlider < 1) return ()
 
96
 
 
97
        # Sliders:
 
98
        N = .sliderMenu(no = 1)
 
99
 
 
100
        # Reset Frame:
 
101
        par(mfrow = c(2, 2))
 
102
 
 
103
        # Plot 1 - Frontier Plot:
 
104
 
 
105
        frontier = frontierPoints(object)
 
106
 
 
107
        fPoint = frontier[N, ]
 
108
 
 
109
        frontierPlot(object, xlim = con$xlim, ylim = con$ylim,
 
110
            xlab = "", ylab = "", pch = 19, cex = 0.7, title = FALSE)
 
111
 
 
112
        mtext("Target Risk", side = 1, line = 2, adj = 1, cex = 0.7)
 
113
        mtext("Target Return", side = 2, line = 2, adj = 1, cex = 0.7)
 
114
 
 
115
        points(fPoint[1], fPoint[2], col = con$runningPoint.col, pch = 19,
 
116
            cex = con$runningPoint.cex)
 
117
 
 
118
        tangencyLines(object, col = con$tangency.col, pch = con$tangency.pch)
 
119
        tangencyPoints(object, col = con$tangency.col)
 
120
 
 
121
        singleAssetPoints(object, col = con$singleAsset.col,
 
122
            cex = con$singleAsset.cex, pch = con$singleAsset.pch)
 
123
 
 
124
        minvariancePoints(object, col = con$minvariance.col,
 
125
            cex = con$minvariancePlot.cex, pch = con$minvariance.pch)
 
126
 
 
127
        Title = paste(
 
128
            "Return =", signif(fPoint[2], 2), "|",
 
129
            "Risk = ", signif(fPoint[1], 2))
 
130
 
 
131
        Title = "Efficient Frontier"
 
132
        mtext(Title, adj = 0, line = 2.5, font = 2, cex = 0.7)
 
133
 
 
134
        grid()
 
135
 
 
136
 
 
137
        # Plot 2 - Weights Pie:
 
138
        weightsPie(object, pos = N)
 
139
 
 
140
        # Plot 3 - Weights Plot:
 
141
        weightsPlot(object)
 
142
        abline(v = N, col = "black")
 
143
 
 
144
        # Plot 4 - Single Weights Plot:
 
145
        weightsLinePlot(object)
 
146
        abline(v = N, col = "black")
 
147
 
 
148
    }
 
149
 
 
150
    # Open Slider Menu:
 
151
    setRmetricsOptions(.counterWeightsSlider = 0)
 
152
    Start <- which.min(getTargetRisk(object)[ , 1])
 
153
    .sliderMenu(refresh.code, title = "Weights Slider",
 
154
       names =       c(                 "N"),
 
155
       minima =      c(                   1),
 
156
       maxima =      c(     nFrontierPoints),
 
157
       resolutions = c(con$sliderResolution),
 
158
       starts =      c(               Start))
 
159
 
 
160
    # Return Value:
 
161
    invisible()
 
162
}
 
163
 
 
164
 
 
165
################################################################################
 
166