[Returnanalytics-commits] r2639 - pkg/PerformanceAnalytics/sandbox/pulkit/week5
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 24 16:06:04 CEST 2013
Author: pulkit
Date: 2013-07-24 16:06:04 +0200 (Wed, 24 Jul 2013)
New Revision: 2639
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R
Log:
REDD COPS multi asset
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-24 11:10:58 UTC (rev 2638)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R 2013-07-24 14:06:04 UTC (rev 2639)
@@ -39,7 +39,7 @@
#'@export
#'
-REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,sharpe=NULL,...){
+REDDCOPS<-function(R ,delta,Rf,h,geometric = TRUE,asset = c("one","two","three"),...){
# DESCRIPTION
# Calculates the dynamic weights for single and double risky asset portfolios
# using Rolling Economic Drawdown
@@ -51,32 +51,65 @@
# FUNCTION:
x = checkData(R)
columns = ncol(x)
- n = nrow(x)
columnnames = colnames(x)
- rf = checkData(Rf)
- nr = length(Rf)
+ sharpe = SharpeRatio(x,FUN="StdDev",Rf ,p=0.95)
+ sd = StdDev(x)
+ rho = cor(x)
+ if(asset == "two" && columns != 2 ){
+ stop("The number of series should be two")
+ }
+
+ if(asset == "three" && columns != 3){
+ stop("The number of series should be three")
+ }
+ dynamicPort<-function(x,column){
- if(is.null(sharpe)){
- sharpe = SharpeRatio(R,FUN="StdDev",Rf ,p=0.95)
+ if(asset == "one"){
+ factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta^2)
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+ if(asset == "two"){
+ if(column == 1){
+ factor = (sharpe[,1] + 0.5*sd[,1]-rho[1,1]*(sharpe[,2] + 0.5*sd[,2]))/sd[,1]
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+ if(column == 2){
+ factor = (sharpe[,2] + 0.5*sd[,2]-rho[1,1]*(sharpe[,1] + 0.5*sd[,1]))/sd[,2]
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+
}
- dynamicPort<-function(x){
- sd = StdDev(R)
- factor = (as.vector(sharpe)/as.vector(sd)+0.5)/(1-delta^2)
- redd = rollDrawdown(R,Rf,h,geometric)
- xt = max(0,(delta-redd)/(1-redd))
+ if(asset == "three"){
+ if(column == 1){
+ factor = ((sharpe[,1] + 0.5*sd[,1])*(1-rho[2,3]^2)-(rho[2,3]*rho[1,3]-rho[1,2])*(sharpe[,2] + 0.5*sd[,2])+(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,1]
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+ if(column == 2){
+ factor = ((sharpe[,2] + 0.5*sd[,2])*(1-rho[1,3]^2)-(rho[1,3]*rho[2,3]-rho[1,2])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,3] + 0.5*sd[,3]))/sd[,2]
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+
+ if(column == 3){
+ factor = ((sharpe[,3] + 0.5*sd[,3])*(1-rho[1,2]^2)-(rho[2,3]*rho[1,2]-rho[1,3])*(sharpe[,1] + 0.5*sd[,1])+(rho[1,3]*rho[1,2]-rho[2,3])*(sharpe[,2] + 0.5*sd[,2]))/sd[,3]
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ }
+
+ }
return(xt)
}
+ redd = rollDrawdown(R,Rf,h,geometric)
+
for(column in 1:columns){
- column.xt <- as.xts(apply((x[,column],MARGIN = 1,FUN = dynamicPort)))
+ column.xt <- na.skip(redd[,column],FUN = dynamicPort,column = column)
if(column == 1)
xt = column.xt
else xt = merge(xt, column.xt)
}
colnames(xt) = columnnames
- xt = reclass(xt, x)
return(xt)
}
+
###############################################################################
# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
#
More information about the Returnanalytics-commits
mailing list