PortfolioAnalytics - ROI optimize.rebalancing using redenominated monthly prices produces incorrect result?

907 Views Asked by At

Hope that someone could help or has experienced a similar situation to point me in the direction of what is going wrong.

Here is my setup (see hopefully reproducible code further below):

  • build a list of symbols
  • get instrument data via FinancialInstrument from Yahoo
  • get EURUSD exchange rates from Quandl - auth token required
  • redenominate prices to base currency of the portfolio
  • build monthly returns from 2004-03-31 to today for assets in their currency and for the redenominated prices (here EUR)
  • run an ROI optimization with rebalancing

The issue:

Using the returns from redenominated prices seems to produce incorrect results in the optimization when rebalancing on months (see picture), as the returns do not warrant such return curve as the majority of the portfolio is invested in "TLT" - 20yr Treasuries.

This gives a result in the optimization as displayed in the following image:

enter image description here


This is part of a larger system, but I hope I created a reproducible code that shows the issue which only seems to apply when using rebalancing, which indicated to me that there might be an issue with the index or dates. However when exporting both return xts to Excel I could not see any difference.

I added multiple charts to the end of the code as I am not allowed to post more than two pictures at the moment.

Any help or tips much appreciated to point me to what is going on...

packages <- c('quantmod', 'FinancialInstrument', 'PortfolioAnalytics', 'Quandl')

for(i in 1:length(packages))
  library(packages[i], character.only = TRUE, quietly = TRUE)

.baseOptions <- list()
# set base CCY
.baseOptions$portf$portfolio.base.ccy <- "EUR"

# set date from which the analysis should be started
.baseOptions$portf$analyse.from <- "2004-03-31/"

# set symbols
symbol.list <- c("LQD", #iShares Investment Grade Corporate Bonds
                 "SHY", #iShares 1-3 year TBonds
                 "IEF", #iShares 3-7 year TBonds
                 "TLT" #iShares 20+ year Bonds
)

# get symbols while adjusting to dividends & splits
getSymbols(symbol.list, auto.assign = TRUE, from = "1990-01-01", to = as.character(Sys.Date()), adjust = TRUE)

# set CCY
currency(c("USD", "EUR"))

# set exchange_rate
exchange_rate("EURUSD")

# get exchange_rate
EURUSD <- Quandl('ECB/EURUSD', type = "xts", collapse = "daily", order = "asc")

stock(symbol.list, currency = "USD")

# get Fininstrument Data
update_instruments.yahoo(symbol.list)
#View(instrument.table(ls_instruments()))

# build price xts - usually part of larger sytem with different CCY incl. JPY, GBP, USD, HKD etc. 
asset.CCY.prices <- foreach(i=1:length(symbol.list), .combine = 'cbind', .packages=c('quantmod')) %dopar% {
  asset.CCY.prices <- Cl(get(symbol.list[i]))
}

# set to analysis period & monthly
asset.CCY.prices <- asset.CCY.prices[endpoints(asset.CCY.prices, on = "months")][.baseOptions$portf$analyse.from]

# redenominate to EUR
base.CCY.prices <- foreach (i=1:length(colnames(asset.CCY.prices)), .combine = 'cbind', .packages=c('FinancialInstrument')) %dopar% {

  current.instrument <- gsub(".Close", "", colnames(asset.CCY.prices)[i])
  current.instrument.CCY <- getInstrument(gsub(".Close", "", colnames(asset.CCY.prices)[i]))$currency

  if(current.instrument.CCY != .baseOptions$portf$portfolio.base.ccy)
    base.CCY.prices <- redenominate(asset.CCY.prices[,i], 
                                    new_base = .baseOptions$portf$portfolio.base.ccy, 
                                    old_base = current.instrument.CCY) 
}
rm(current.instrument, current.instrument.CCY, i, packages)
# set the colnames in the basee.CCY price .xts
colnames(base.CCY.prices) <- colnames(asset.CCY.prices) # unlist(lapply(symbol.list, function(x) paste(x, .baseOptions$portf$portfolio.base.ccy, sep = ".")))

# build returns
asset.CCY.R <- ROC(asset.CCY.prices)
base.CCY.R <- ROC(base.CCY.prices)

# portfolio optimization
#
#
#-----------------------------------
# Specify initial portfolio
if(exists("portf.init")) rm(portf.init)
portf.init <- portfolio.spec(assets=colnames(asset.CCY.R))
portf.init <- add.constraint(portfolio=portf.init, type="weight_sum", min_sum=0.99, max_sum=1.01)
portf.init <- add.constraint(portfolio=portf.init, type="long_only")
#portf.init <- add.constraint(portfolio=portf.init, type="position_limit", max_pos=15)

#' Add objective to maximize mean
portf.init <- add.objective(portfolio=portf.init, type="return", name="mean")

#----------------------------------
# Global Minimum Variance Portfolio
# 
if(exists("GMV")) rm(GMV)
GMV <- add.constraint(portfolio=portf.init, type="weight_sum", min_sum=0.90, max_sum=1.01, indexnum = 1) 
# Add box constraint
GMV <- add.constraint(GMV, type="box", min=0, max=0.99)
# Add var objective - risk is always minimised
GMV <- add.objective(GMV, type = "risk", name = "var")

# optimization in asset.CCY
opt.asset.CCY = optimize.portfolio.rebalancing(R = asset.CCY.R, portfolio = GMV, rebalance_on = "months", optimize_method = "ROI")
port.data.asset.CCY <- Return.portfolio(R = asset.CCY.R, weights = extractWeights(opt.asset.CCY), verbose=TRUE)

#optimization in base.CCY
opt.base.CCY = optimize.portfolio.rebalancing(R = base.CCY.R, portfolio = GMV, rebalance_on = "months", optimize_method = "ROI")
port.data.base.CCY <- Return.portfolio(R = base.CCY.R, weights = extractWeights(opt.base.CCY), verbose=TRUE)
opt.base.CCY.simple = optimize.portfolio(R = base.CCY.R, portfolio = GMV, optimize_method = "ROI")
port.data.base.CCY.simple <- Return.portfolio(R = base.CCY.R, weights = extractWeights(opt.base.CCY.simple), verbose=TRUE)


#--------- START EDIT 04.01.2016 ---------
#
class(index(asset.CCY.R))
indexTZ(asset.CCY.R)
# Indexed by Class Date - XTS though shows TZ = UTC
# this should however not cause any issues
all.equal(index(asset.CCY.R), index(base.CCY.R))
# TRUE

# Weights after rebalancing
class(index(extractWeights(opt.asset.CCY)))
# "POSIXct" "POSIXt" which should be fine as well
all.equal(index(extractWeights(opt.asset.CCY)), 
          index(extractWeights(opt.base.CCY)))
# TRUE
#
#--------- END EDIT 04.01.2016 ---------


# charts
#
op <- par(mfrow = c(2, 2), pty = "m") 

# chart the time series
chart.TimeSeries(asset.CCY.prices, main = 'Timeseries - Asset.CCY', legend.loc = "top")
# chart the performance summaries
chart.CumReturns(asset.CCY.R, main = "Cum Returns - Asset.CCY")
# chart the time series
chart.TimeSeries(base.CCY.prices, main = 'Base.CCY', legend.loc = "top")
# chart the performance summaries
chart.CumReturns(base.CCY.R, main = "Cum Returns - Base.CCY")

# Optimized returns - rebalancing
chart.CumReturns(port.data.asset.CCY$returns, main=paste("Asset.CCY", "Opt Return" , sep= " - "))
chart.CumReturns(port.data.base.CCY$returns, main=paste("Base.CCY", "Opt Return" , sep= " - "))

# Optimized returns - no rebalancing
chart.CumReturns(port.data.base.CCY.simple$returns, main=paste("Base.CCY.simple", "Opt Return" , sep= " - "))

# optimizes EOP Value Charts
chart.StackedBar(port.data.asset.CCY$EOP.Value[ , !apply(port.data.asset.CCY$EOP.Value==0,2,all)], main=paste("Asset.CCY", "Value" , sep= " - "))
chart.StackedBar(port.data.base.CCY$EOP.Value[ , !apply(port.data.base.CCY$EOP.Value==0,2,all)], main=paste("Base.CCY", "Value" , sep= " - "))

# Optimized EOP Value - no rebalancing
chart.StackedBar(port.data.base.CCY.simple$EOP.Value[ , !apply(port.data.base.CCY.simple$EOP.Value==0,2,all)], main=paste("Base.CCY.simple", "Value" , sep= " - "))

# optmized Contribution charts
chart.StackedBar(port.data.asset.CCY$contribution[ , !apply(port.data.asset.CCY$contribution==0,2,all)], main=paste("Asset.CCY", "Contribution" , sep= " - "))
chart.StackedBar(port.data.base.CCY$contribution[ , !apply(port.data.base.CCY$contribution==0,2,all)], main=paste("Base.CCY", "Contribution" , sep= " - "))

# optmized Contribution charts - no rebalancing
chart.StackedBar(port.data.base.CCY.simple$contribution[ , !apply(port.data.base.CCY.simple$contribution==0,2,all)], main=paste("Base.CCY.simple", "Contribution" , sep= " - "))

# restore usual charting
par(op)

sessionInfo()
R version 3.2.2 (2015-08-14)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8 x64 (build 9200)

locale:
[1] LC_COLLATE=English_United Kingdom.1252  LC_CTYPE=English_United Kingdom.1252    LC_MONETARY=English_United Kingdom.1252
[4] LC_NUMERIC=C                            LC_TIME=English_United Kingdom.1252    

attached base packages:
[1] parallel  stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] PortfolioAnalytics_1.0.3636   XML_3.98-1.3                  FinancialInstrument_1.2.0     RColorBrewer_1.1-2           
 [5] reshape2_1.4.1                doParallel_1.0.10             iterators_1.0.8               rCharts_0.4.5                
 [9] RcppDE_0.1.4                  timeDate_3012.100             sqldf_0.4-10                  RSQLite_1.0.0                
[13] DBI_0.3.1                     gsubfn_0.6-6                  proto_0.3-10                  stringr_1.0.0                
[17] ggplot2_1.0.1                 xlsx_0.5.7                    xlsxjars_0.6.1                rJava_0.9-7                  
[21] quantmod_0.4-5                TTR_0.23-0                    Quandl_2.7.0                  ProjectTemplate_0.6          
[25] PerformanceAnalytics_1.4.3541 foreach_1.4.3                 xts_0.9-7                     zoo_1.7-12

EDIT 04/01/2016 Just looked again into this issue as it remains problematic for the redenominated test portfolios.

I assumed that the issue may be caused by some time zone effects and added a few checks (see code above before charts). Indices of the return-xts-objects as well as the weight-xts-objects remain equal (all.equal() returns TRUE).

Debugging into the return.portfolio() function,

  • base.CCY.R and asset.CCY.R are identified as monthly frequency and start date 2004-03-30.
  • weights are identified as xts (line 55), and provide following first index.

Following checks are all equal for the weights in asset or base currency:

Sys.timezone()
# [1] "Europe/Berlin"
first(index(weights))
# [1] "2007-03-30 CEST"
as.numeric(first(index(weights)))
# [1] 1175205600
class(index(weights))
# [1] "POSIXct" "POSIXt"   
as.Date(first(index(weights)) 
# [1] "2007-03-29"

As per help page for as.Date this assumes "UTC" for 'POSIXct' and hence I assume the difference however following also returns the 29th:

as.Date(first(index(weights), tz = "Europe/Berlin"))
# [1] "2007-03-29"

This is not clear to me but it is consistent for both weight xts and not part of this question.

In line 72 return.portfolio now reduces the return xts to the same start index by executing:

R <- R[paste0(as.Date(index(weights[1, ])) + 1, "/")]

Following this, the Return.portfolio.geometric() is called and here it shows that the weights for the optimization in the redenominated prices leads to weights below the max 1.01.

Which can also be seen by doing a rowSum() on the extracted weights:

#--------- START EDIT 04.01.2016 ---------
rowSums(extractWeights(opt.asset.CCY))
# [1] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [12] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [23] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [34] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [45] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [56] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [67] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [78] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [89] 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01 1.01
# [100] 1.01 1.01 1.01 1.01 1.01 1.01 1.01

rowSums(extractWeights(opt.base.CCY))
# [1] 0.9000000 0.9000000 0.9000000 0.9000000 0.9000000
# [6] 0.9000000 0.9000000 0.9000000 0.9000000 0.9000000
# [11] 0.9000000 0.9000000 0.9000000 0.9000000 0.9000000
# [16] 0.9000000 0.9000000 0.9000000 0.9000000 1.0100000
# [21] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [26] 1.0100000 0.9000000 0.9000000 0.9000000 0.9000000
# [31] 0.9000000 0.9000000 0.9000000 0.9000000 0.9937606
# [36] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [41] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [46] 1.0100000 1.0100000 1.0100000 0.9666945 0.9000000
# [51] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [56] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [61] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [66] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [71] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [76] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [81] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [86] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [91] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [96] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [101] 1.0100000 1.0100000 1.0100000 1.0100000 1.0100000
# [106] 1.0100000

#--------- END EDIT 04.01.2016 ---------

EDIT 06/01/2016

After further looking into the code of Return.portfolio.geometric() from the PerformanceAnaytics package which is called by Return.portfolio():

  1. Iteration and return calculation

In line 49:

ret[k] = eop_value_total[k]/end_value - 1 

This calculates the portfolio return and in the example it would be 0.877/1 - 1 which obviously must lead to a return of -12.3%.

If I see this right, it would mean that the expectation is that weights are equal to 100% as end_value is, if not provided by the user in the value setting during the Return.portfolio() call, set to 1 or 100%.

end_value for the next iteration is then 0.877

end_value = eop_value_total[k]
  1. Iteration and return calc

and the new portfolio start value for the next period 0.877 multiplied by the next periods weight of again 90% or 0.90 = 0.7893

bop_value[k, ] = end_value * weights[i, ]

Same as in the first iteration, the negative return will be again overstated due to the 90% total weight calculated by the PortfolioAnalytics package due to the weight_sum constraint.

ret[k] = eop_value_total[k]/end_value - 1

Translates into 0.78/0.877 - 1 = -0.111

Questions that come to me then:

  • How are the correct returns to be calculated when the weights are <> 100% or 1?
  • Does a weight_sum constraint of <> 100% actually sense? In a real life scenario the missing % would likely be cash/short term bonds?
  • Based on this - options could be to add cash returns into the optimization while using full_investment constraint or alternatively would it not be an option to either adjust the geometric return function to warn of weights <> 100% or include logic for weights <> 100%?

Last but not least, alternatively there is still something wrong with my date indexes?

Not sure if anyone is still reading this but again, any support or insight would be much appreciated. Many thanks!

0

There are 0 best solutions below