thestockman27
commented
3 years ago Little update here. Work got crazy so I have really only just begun...
I have decided to optimize via two objective functions. The first is simply the current Yield-to-Worst. The second uses a common proxy for risk, Duration times Spread (DTS). There are other more advanced ways to measure and then optimize risk, but this will work for now.
Here is a look at the objective function I am using: dts.objfun <- function(R, weights, d){ R <- tail(R, 1) date <- tail(index(R) ,1) d2 <- d[date] weights <- matrix(weights, ncol=ncol(R)) dts <- as.numeric(sum(weights * d2)) return(dts) }
It takes the latest observation from the returns xts and uses that date to reference the corresponding DTS xts passed into the function as d. Everything seems to go fairly well when running portfolio optimization. See below:
`opt.dts <- optimize.portfolio(R, init, optimize_method="DEoptim", search_size=2000, trace=TRUE, traceDE=0,itermax = 50) opt.dts
PortfolioAnalytics Optimization
Call: optimize.portfolio(R = R, portfolio = init, optimize_method = "DEoptim", search_size = 2000, trace = TRUE, traceDE = 0, itermax = 50)
Optimal Weights: Aaa Aa A Baa Ba B Caa Ca-D 0.2340 0.2280 0.1919 0.0570 0.0520 0.1260 0.0540 0.0500
Objective Measures: dts.objfun 7.942 ytw.objfun 3.053 `
However, when I try to create an efficient frontier using create.EfficientFrontier, only one point is returned.
dts.ef <- create.EfficientFrontier(R=R, portfolio=init, type="DEoptim",match.col="dts.objfun.dts.objfun",n.portfolios = 25) dts.ef$frontier dts.objfun.dts.objfun ytw.objfun.ytw.objfun out w.Aaa w.Aa w.A w.Baa w.Ba w.B w.Caa w.Ca-D opt 7.98124 3.017703 4.963537 0.246 0.244 0.24 0.05 0.05 0.054 0.07 0.054 attr(,"class") [1] "frontier"
I'm guessing that something must be wrong with my objective functions, but I have not been able to locate a similar objective function on which I could base my code off of. Additionally, you'll notice that my reference to match.col is the objective function's name repeated. This was done because of how the objective measures are stored in the portfolio object. ExtractStats() was unable to locate them unless the name was repeated.
Full Code (You'll need access to bloomberg's API to pull the data): `library(dplyr) library(Rblpapi) blpConnect() library(xts) indices <- c("LU3ATRUU Index", # AAA "LU2ATRUU Index", # AA "LU1ATRUU Index", # A "LUBATRUU Index", # Baa "BCBATRUU Index", # Ba "BCBHTRUU Index", # B "BCAUTRUU Index", # Caa "I00191US Index" # Ca-D )
fields1 <- c("PX_LAST") opt <- c("periodicitySelection" = "MONTHLY") table1 <- bdh(indices,fields1, start.date = as.Date(Sys.Date()-3650, format = "%m/%d/%Y"), end.date = as.Date(Sys.Date(), format = "%m/%d/%Y"),options = opt)
table2 <- table1[[1]] for(i in 2:length(table1)){ t2 <- table1[[i]] table2 <- left_join(table2,t2, by = "date" ) }
colnames(table2) <- c("date","Aaa","Aa","A","Baa","Ba","B","Caa","Ca-D") prices <- table2 prices.xts <- as.xts(prices[,-1], order.by = prices[,1]) returns <- Return.calculate(prices.xts,method = "difference") R <- returns[-1,]
fields2 <- c("DU375") opt <- c("periodicitySelection" = "MONTHLY") table1 <- bdh(indices,fields2, start.date = as.Date(Sys.Date()-3650, format = "%m/%d/%Y"), end.date = as.Date(Sys.Date(), format = "%m/%d/%Y"),options = opt)
table2 <- table1[[1]] for(i in 2:length(table1)){ t2 <- table1[[i]] table2 <- left_join(table2,t2, by = "date" ) }
colnames(table2) <- c("date","Aaa","Aa","A","Baa","Ba","B","Caa","Ca-D") durations <- table2 dur.xts <- as.xts(durations[,-1], order.by = durations[,1]) dur.xts <- dur.xts[-1,]
fields3 <- c("INDEX_OAS_TSY") opt <- c("periodicitySelection" = "MONTHLY") table1 <- bdh(indices,fields3, start.date = as.Date(Sys.Date()-3650, format = "%m/%d/%Y"), end.date = as.Date(Sys.Date(), format = "%m/%d/%Y"),options = opt)
table2 <- table1[[1]] for(i in 2:length(table1)){ t2 <- table1[[i]] table2 <- left_join(table2,t2, by = "date" ) }
colnames(table2) <- c("date","Aaa","Aa","A","Baa","Ba","B","Caa","Ca-D") spreads <- table2 spread.xts <- as.xts(spreads[,-1], order.by = spreads[,1]) spread.xts <- spread.xts[-1,]
DTS.xts <- dur.xts * spread.xts
fields4 <- c("YIELD_TO_WORST") opt <- c("periodicitySelection" = "MONTHLY") table1 <- bdh(indices,fields4, start.date = as.Date(Sys.Date()-3650, format = "%m/%d/%Y"), end.date = as.Date(Sys.Date(), format = "%m/%d/%Y"),options = opt)
table2 <- table1[[1]] for(i in 2:length(table1)){ t2 <- table1[[i]] table2 <- left_join(table2,t2, by = "date" ) }
colnames(table2) <- c("date","Aaa","Aa","A","Baa","Ba","B","Caa","Ca-D") ytw <- table2 ytw.xts <- as.xts(ytw[,-1], order.by = ytw[,1]) ytw.xts <- ytw.xts[-1,]
library(PortfolioAnalytics) library(ROI) require(ROI.plugin.quadprog) require(ROI.plugin.glpk) library(Rglpk) library(DEoptim)
funds <- colnames(R)
init <- portfolio.spec(assets=funds) init <- add.constraint(portfolio=init, type="box", min=0.05, max=0.25) init <- add.constraint(portfolio=init, type="weight_sum",min_sum=0.99, max_sum=1.01)
dts.objfun <- function(R, weights, d){ R <- tail(R, 1) date <- tail(index(R) ,1) d2 <- d[date] weights <- matrix(weights, ncol=ncol(R)) dts <- as.numeric(sum(weights * d2)) return(dts)
} dts.objfun.dts.objfun <- function(R, weights , d ){ R <- tail(R, 1) date <- tail(index(R) ,1) d2 <- d[date] weights <- matrix(weights, ncol=ncol(R)) dts <- as.numeric(sum(weights * d2)) return(dts)
}
ytw.objfun <- function(R, weights, y){ R <- tail(R, 1) date <- index(R) y2 <- y[date] weights <- matrix(weights, ncol=ncol(R)) yield <- as.numeric(sum(weights * y2)) return(yield)
} ytw.objfun.ytw.objfun <- function(R, weights, y){ R <- tail(R, 1) date <- index(R) y2 <- y[date] weights <- matrix(weights, ncol=ncol(R)) yield <- as.numeric(sum(weights * y2)) return(yield)
}
init <- add.objective(portfolio=init, type="risk", name="dts.objfun", arguments=list(d=DTS.xts)) init <- add.objective(portfolio=init, type="return", name="ytw.objfun", arguments = list(y=ytw.xts))
opt.dts <- optimize.portfolio(R, init, optimize_method="DEoptim", search_size=2000, trace=TRUE, traceDE=0,itermax = 50)
dts.ef <- create.EfficientFrontier(R=R, portfolio=init, type="DEoptim",match.col="dts.objfun.dts.objfun",n.portfolios = 25) dts.ef summary(dts.ef, digits=2) dts.ef$frontier s <- extractStats(opt.dts)
chart.EfficientFrontier(opt.dts, match.col="dts.objfun.dts.objfun", type = 'l' ,RAR.text="Sharpe Ratio", pch=4,d = DTS.xts)
chart.EfficientFrontier(dts.ef, match.col=colnames(extractStats(opt.dts))[1], type = 'l' ,RAR.text="Sharpe Ratio", pch=4,d = DTS.xts)
plot(x=dts.ef$frontier[,"dts.objfun.dts.objfun"], y=dts.ef$frontier[,"ytw.objfun.ytw.objfun"], ylab="YTW", xlab="Duration times Spread", main='Alternative Efficient Frontier for Fixed Income Portfolios'
xlim=xlim, ylim=ylim, axes=FALSE)
)
points(x=dts.ef$frontier[,"dts.objfun.dts.objfun"][1], y=dts.ef$frontier[,"ytw.objfun.ytw.objfun"][1], pch=16)`
Hi there,
I was going to take a crack at using this package to optimize a fixed income portfolio. Just wanted to touch base with you to see if you were aware of any vignettes or examples that may be helpful. I have read through many of them already, definitely some useful info.
Anyways, I think the critical aspect of trying this seems to be the objective function. I have noticed that the objective functions detailed in this package all work off of the asset returns (typically noted as R), whereas I will be looking to optimize off of both return and duration (maybe convexity too eventually). I'm planning to have a separate dataset containing all the durations that I can reference in the objective function by CUSIP and date.
So I guess I'm really just checking in with the sherpas before I start scaling the mountain. Any advice, examples, etc.?
Thanks for all your work on this and the other packages, btw.