[Returnanalytics-commits] r2231 - in pkg/PortfolioAnalytics: R man sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 12 12:06:12 CEST 2012
Author: hezkyvaron
Date: 2012-08-12 12:06:11 +0200 (Sun, 12 Aug 2012)
New Revision: 2231
Added:
pkg/PortfolioAnalytics/man/indexes.Rd
Modified:
pkg/PortfolioAnalytics/R/optimize.portfolio.R
pkg/PortfolioAnalytics/sandbox/sample_pso.R
pkg/PortfolioAnalytics/sandbox/testing_ROI.R
Log:
- ROI is working perfectly, the testing_ROI script is finalized
- sample_pso is just there for comparing portfolio optimiztion solutions with DEoptim
- index.Rd is added, please edit description and source if needed
Modified: pkg/PortfolioAnalytics/R/optimize.portfolio.R
===================================================================
--- pkg/PortfolioAnalytics/R/optimize.portfolio.R 2012-08-10 09:10:36 UTC (rev 2230)
+++ pkg/PortfolioAnalytics/R/optimize.portfolio.R 2012-08-12 10:06:11 UTC (rev 2231)
@@ -273,14 +273,15 @@
upper = list(ind = seq.int(1L, N), val = as.numeric(constraints$max)))
# retrive the objectives to minimize, these should either be "var" and/or "mean"
# we can eight miniminze variance or maximize quiadratic utility (we will be minimizing the neg. quad. utility)
- moments <- list(mean=rep(0, N), var=NULL)
+ moments <- list(mean=rep(0, N))
alpha <- 0.05
+ target <- NA
for(objective in constraints$objectives){
if(objective$enabled){
if(!any(c(objective$name == "mean", objective$name == "var", objective$name == "CVaR")))
stop("ROI only solves mean, var, or sample CVaR type business objectives, choose a different optimize_method.")
- moments[[objective$name]] <- eval(as.symbol(objective$name))(R)
- target <- ifelse(!is.null(objective$target),objective$target, NA)
+ moments[[objective$name]] <- try(eval(as.symbol(objective$name))(R), silent=TRUE)
+ target <- ifelse(!is.null(objective$target),objective$target, target)
alpha <- ifelse(!is.null(objective$alpha), objective$alpha, alpha)
lambda <- ifelse(!is.null(objective$risk_aversion), objective$risk_aversion, 1)
}
@@ -293,13 +294,15 @@
rhs.vec <- c(constraints$min_sum, constraints$max_sum)
if(!is.na(target)) {
Amat <- rbind(Amat, moments$mean)
- dir.vec <- cbind(dir.vec, "==")
- rhs.vec <- cbind(rhs.vec, target)
+ dir.vec <- c(dir.vec, "==")
+ rhs.vec <- c(rhs.vec, target)
}
if(any(names(moments)=="CVaR")) {
Rmin <- ifelse(is.na(target), 0, target)
- ROI_objective <- ROI:::L_objective(c(rep(0,N), rep(-1/(alpha*T),T), -1))
- Amat <- rbind(cbind(rbind(1,1,moments$mean)), matrix(0,nrow=3, ncol=T+1), cbind(R, diag(T), 1))
+ ROI_objective <- ROI:::L_objective(c(rep(0,N), rep(1/(alpha*T),T), 1))
+ Amat <- cbind(rbind(1, 1, moments$mean, coredata(R)), rbind(0, 0, 0, cbind(diag(T), 1)))
+ #lower <- cbind(matrix(0,nrow=T,ncol=N),diag(T),0)
+ #Amat <- rbind(Amat, lower)
dir.vec <- c(">=","<=",">=",rep(">=",T))
rhs.vec <- c(constraints$min_sum, constraints$max_sum, Rmin ,rep(0, T))
}
@@ -324,7 +327,7 @@
if( is.list(dotargs) ){
pm <- pmatch(names(dotargs), PSOcargs, nomatch = 0L)
names(dotargs[pm > 0L]) <- PSOcargs[pm]
- DEcformals$maxit <- maxit
+ PSOcformals$maxit <- maxit
if(!hasArg(reltol)) PSOcformals$reltol=.000001 # 1/1000 of 1% change in objective is significant
if(!hasArg(fnscale)) PSOcformals$fnscale=1
if(!hasArg(abstol)) PSOcformals$asbtol=-Inf
@@ -335,7 +338,7 @@
upper = constraints$max
lower = constraints$min
- controlPSO <- do.call(psoptim.control,PSOcformals)
+ controlPSO <- PSOcformals
minw = try(psoptim( constrained_objective , lower = lower[1:N] , upper = upper[1:N] ,
control = controlPSO, R=R, constraints=constraints, nargs = dotargs , ...=...)) # add ,silent=TRUE here?
Added: pkg/PortfolioAnalytics/man/indexes.Rd
===================================================================
--- pkg/PortfolioAnalytics/man/indexes.Rd (rev 0)
+++ pkg/PortfolioAnalytics/man/indexes.Rd 2012-08-12 10:06:11 UTC (rev 2231)
@@ -0,0 +1,21 @@
+\name{indexes}
+\alias{indexes}
+\docType{data}
+\title{Six Major Economic Indexes}
+\description{Monthly data of five indexes beginning on 2000-01-31 and ending 2009-12-31.
+The indexes are: US Bonds, US Equities, International Equities, Commodities, US T-Bills, and Inflation}
+\usage{data(indexes)}
+\format{CSV converted into xts object with montly observations}
+\details{ }
+\source{ }
+\references{ }
+\examples{
+data(indexes)
+
+#preview the data
+head(indexes)
+
+#summary period statistics
+summary(indexes)
+}
+\keyword{datasets}
Modified: pkg/PortfolioAnalytics/sandbox/sample_pso.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/sample_pso.R 2012-08-10 09:10:36 UTC (rev 2230)
+++ pkg/PortfolioAnalytics/sandbox/sample_pso.R 2012-08-12 10:06:11 UTC (rev 2231)
@@ -4,10 +4,12 @@
library(quantmod)
library(PerformanceAnalytics)
library(DEoptim)
+library(pso)
data(edhec)
R <- edhec
N <- ncol(edhec)
+T <- nrow(edhec)
mu <- colMeans(R)
sigma <- cov(R)
@@ -35,3 +37,36 @@
test <- psoptim(rep(NA,N), obj, lower=0, upper=5, control=list(abstol=1e-8))
test$value
wts.pso <- test$par/sum(test$par)
+
+
+cvar.obj <- function(w){
+ if (sum(w)==0) {w <- w + 1e-2}
+ w <- w/sum(w)
+ CVaR <- ES(R=R,
+ weights= w,
+ method="historical")
+ out <- CVaR$ES
+}
+
+historical.cvar <- function(w){
+ if (sum(w)==0) {w <- w + 1e-2}
+ w <- w/sum(w)
+ PR <- R %*% w
+ VaR <- quantile(PR, 0.05)
+ es <- VaR - PR
+ return(VaR + (1/T)*(1/0.05)*sum(es[es > 0]))
+}R
+
+cvar.check <- psoptim(rep(NA, N), historical.cvar, lower=0, upper=5)
+cvar.wts <- cvar.check$par/sum(cvar.check$par)
+
+
+
+
+
+
+
+
+
+
+
Modified: pkg/PortfolioAnalytics/sandbox/testing_ROI.R
===================================================================
--- pkg/PortfolioAnalytics/sandbox/testing_ROI.R 2012-08-10 09:10:36 UTC (rev 2230)
+++ pkg/PortfolioAnalytics/sandbox/testing_ROI.R 2012-08-12 10:06:11 UTC (rev 2231)
@@ -17,6 +17,7 @@
data(edhec)
funds <- names(edhec)
mu.port <- mean(colMeans(edhec))
+N <- length(funds)
gen.constr <- constraint(assets = colnames(edhec), min=-Inf, max =Inf, min_sum=1, max_sum=1, risk_aversion=1)
gen.constr <- add.objective(constraints=no.box.constr, type="return", name="mean", enabled=FALSE, multiplier=0, target=mu.port)
@@ -28,8 +29,8 @@
# Max return under box constraints, fully invested
#
max.port <- gen.constr
-max.port$min <- 0.01
-max.port$max <- 0.30
+max.port$min <- rep(0.01,N)
+max.port$max <- rep(0.30,N)
max.port$objectives[[1]]$enabled <- TRUE
max.port$objectives[[1]]$target <- NULL
max.solution <- optimize.portfolio(edhec, max.port, "ROI")
@@ -69,6 +70,7 @@
#
cvar.port <- gen.constr
cvar.port$objectives[[1]]$enabled <- TRUE
+cvar.port$objectives[[1]]$target <- NULL
cvar.port$objectives[[3]]$enabled <- TRUE
cvar.solution <- optimize.portfolio(edhec, cvar.port, "ROI")
More information about the Returnanalytics-commits
mailing list