...
 
Commits (3)
Package: CLA
Version: 0.90-0
Date: 2017-09-25
Version: 0.90-1
Date: 2018-01-25
Title: Critical Line Algorithm in Pure R
Author: Yanhao Shi <syhelena@163.com>,
Martin Maechler <maechler@stat.math.ethz.ch>
Maintainer: Martin Maechler <maechler@stat.math.ethz.ch>
Depends: R (>= 3.2.0)
Imports: stats, graphics
Imports: stats, grDevices, graphics
Suggests: fGarch, FRAPO, Matrix
Description: Implements 'Markovitz' Critical Line Algorithm ('CLA') for
classical mean-variance portfolio optimization. Care has been taken for
......
......@@ -3,9 +3,14 @@
importFrom("stats",
cor, predict, uniroot)
## importFrom(, ..)
importFrom("grDevices", adjustcolor)
importFrom("graphics", plot)# including the plot.default() method
## not yet on CRAN : importFrom("sfsmisc", funEnv)
## -------------- CLA Exports -----------------------
export(CLA
, MS
, findSig, findMu
......@@ -13,3 +18,4 @@ export(CLA
)
S3method(print, CLA)
S3method(plot, CLA)
......@@ -194,4 +194,34 @@ print.CLA <- function(x, ...) {
invisible(x)
}
## TODO: plot method -- efficient frontier
### TODO: plot method -- efficient frontier
## As basically from .../YanhaoShi/R/Functions/Plot.R :
MS_plot <- function(ms, type = "o",
main = "Efficient Frontier",
xlab = expression(sigma(w)),
ylab = expression(mu(w)),
col = adjustcolor("blue", alpha.f = 0.5),
pch = 16, ...) {
## list of weights_set, legend...
stopifnot(is.matrix(ms), ncol(ms) == 2)
plot(ms[,"Sig"], ms[,"Mu"], type=type, pch=pch, col=col,
xlab = xlab, ylab=ylab, main=main, ...)
}
## FIXME:
## 1) Learn from Tobias Setz to plot the lower part of the feasible region
## 2) Better title, using 'call'
## 3) mark some critical points particularly
## 4) give information about the *number* critical points / weights sets
## 5) consider using a 'add = FALSE' argument and then use 'lines()'
plot.CLA <- function(x, type = "o", main = "Efficient Frontier",
xlab = expression(sigma(w)),
ylab = expression(mu(w)),
col = adjustcolor("blue", alpha.f = 0.5),
pch = 16, ...) {
stopifnot(is.matrix(ms <- x$MSweights))
plot(ms[,"Sig"], ms[,"Mu"], type=type, pch=pch, col=col,
xlab=xlab, ylab=ylab, main=main, ...)
}
##-*- org -*--> Emacs .. [Tab] key + [Org] menu; C-c C-o to follow links
* Before release of package
** DONE CLA() should return a (S3) class, "CLA"
*** TODO --> print() and plot() (S3) methods**** plot(): plot efficient frontier
** check arguments e.g., lB <= uB, sum upper Bounds >= 1
** TODO References -->
*** 1) Master thesis: I'd like the thesis to be on our web page
*** 2) References from the thesis, including the "buried" python-paper with *WRONG* algo
** DONE CLA() should return a (S3) class, "CLA" w/ print() and plot() methods
* With more time, also, e.g., for a short R Journal paper
** SparseMatrix plot of the weights
......@@ -3,6 +3,12 @@ require(CLA)
b64 <- .Machine$sizeof.pointer == 8
cat(sprintf("%d bit platform type '%s'\n", if(b64) 64 else 32, .Platform$OS.type))
(nonWindows <- .Platform$OS.type != "windows")
arch <- Sys.info()[["machine"]]
.M <- .Machine; str(.M[grep("^sizeof", names(.M))]) ## differentiate long-double..
## Do we have 64bit but no-long-double ?
b64nLD <- (arch == "x86_64" && .M$sizeof.longdouble != 16)
if(b64nLD) arch <- paste0(arch, "--no-long-double")
arch
data(muS.sp500)
......@@ -104,18 +110,39 @@ b32.n0[nn] <- b64.n0[nn] + 1L
nn <- c("AET", "BCR", "CI", "CL", "ED", "FE", "HAL", "MCD", "SII", "SYK")
b32.n0[nn] <- b64.n0[nn] - 1L
## 64-bit Linux -no-long-double:
b64nLD.n0 <- b64.n0
nn <- c("AZO", "BAX", "BNI", "CCE", "DVN", "GILD", "INTU", "JNJ", "LH",
"MDT", "NOC", "PBG", "SYMC")
b64nLD.n0[nn] <- b64.n0[nn] + 1L
nn <- c("ADSK", "BCR", "BDX", "BUD", "CTL", "FE", "MCD", "SII", "SYK")
b64nLD.n0[nn] <- b64.n0[nn] - 1L
b64nLD.n0[["XTO"]] <- 99L # = b... - 3L
non.0.TARG <- if(b64) { if(b64nLD) b64nLD.n0 else b64.n0
} else b32.n0
## see on all platforms what we get; typically no diff on 64bit
if(all(non.0.assets == if(b64) b64.n0 else b32.n0)) { ## show differences:
if(all(non.0.assets == non.0.TARG)) { ## show differences:
cat("Asset results == non.0.TARG; showing differences b32 - b64 :\n")
print(table(b32.n0 -b64.n0))
dput(names(b64.n0)[b32.n0 -b64.n0 == +1])
dput(names(b64.n0)[b32.n0 -b64.n0 == -1])
} else {
cat("\n'non.0.assets' differing from non.0.TARG:\n")
cat("+1:\n"); dput(names(b64.n0)[non.0.assets - non.0.TARG == +1])
cat("-1:\n"); dput(names(b64.n0)[non.0.assets - non.0.TARG == -1])
if(any(isB <- abs(non.0.assets - non.0.TARG) > 1)) {
cat("more different, showing differences:\n")
dput((non.0.assets - non.0.TARG)[isB])
}
}
## They have the same names and only differ by +/- 1:
stopifnot(
identical(names(b64.n0), names(b32.n0))
## ______ ______
, if(b64) identical(non.0.assets, b64.n0)
, if(b64) identical(non.0.assets, non.0.TARG)
else if(nonWindows) identical(non.0.assets, b32.n0)
else ## 32-bit Windows
TRUE ## for now
......