Asset Pricing[9c : Regime Switching]

Now that we have (Gods willing) aligned fund returns,regime indices and state probabilities by time,we can finally turn to the fifth issue in the previously defined list and examine in-sample performance along the following lines :

  1. Standard-deviation-Scaled difference across state means (as per the paper)
  2. Cumulative returns and drawdowns when states are known versus unknown
  3. Event-state mean vs non-event-state mean for the chosen fund across all economic regimes.

 

[5] In-Sample Performance

To every element in the Aligned list object from the end of the previous post,
l

#[7.3] Fund Performance : In-sample
 Regimes <- list()
 Regimes <- lapply(Aligned,function(x) FundPerf(x))

 plot.list <- list()
 plot.list <- lapply(Regimes,function(x) FundMeanPlot(x))

l
I applied the custom FundPerf() function to calculate among other things, the scaled differences in means.
l

#########################################################################################
# Fund Performance
#########################################################################################
FundPerf <- function(aligned.list.element){

	col.turb <- names(aligned.list.element)[1]
	aligned.sub <- select(aligned.list.element,eval(parse(text=col.turb)),Normal.Class:Funds.Of.Funds)
 	std.smpl <- apply(aligned.sub[,-c(1:3)],2,sd)

	event.ret <- select(aligned.sub,Convertible.Arbitrage:Funds.Of.Funds)*aligned.sub[,'Event.Class']
  event.mean <- colMeans(event.ret[which(aligned.sub[,'Event.Class']==1),])

	nonevent.ret <- select(aligned.sub,Convertible.Arbitrage:Funds.Of.Funds)*aligned.sub[,'Normal.Class']
  nonevent.mean <- colMeans(nonevent.ret[which(aligned.sub[,'Normal.Class']==1),])

	result.df <- data.frame(Fund=colnames(aligned.list.element[-c(1:5)]),EventMean=event.mean,NonEventMean=nonevent.mean,Stdev=std.smpl)
	fund.result <- mutate(result.df,Perf=(event.mean-nonevent.mean)/std.smpl)

	return(list(Aligned.df = aligned.sub,
		     			Event.df = event.ret,
		     			NonEvent.df = nonevent.ret,
		     			FundPerf.df = fund.result
		     )
	)
}
#########################################################################################

l
To give a sense of the output that this function returns. the following shows a snapshot of the returned list object for the Regimes$Growth case :

  • A subset of the original aligned data frame now containing only the time series of the regime variable index,state maps and fund returns.

d1

  •  A data frame which contains the time series of fund returns multiplied by a vector (of zeros and ones) corresponding to the event state.

d2

  • A data frame which contains the time series of fund returns multiplied by a vector (of zeros and ones) corresponding to the normal state.

d3

  • A data frame which contains the fund names,the event mean,the non event mean and the final scaled value (given in the paper as event mean minus non event mean divided by standard deviation)

d4

 

The FundMeanPlot() function is then used to generate a ggplot on the basis of this output  :
l

#########################################################################################
# Fund Perormance event/non event mean plot
#########################################################################################
FundMeanPlot <- function(regime.obj){

	localenv <- environment()

	dfdata <- regime.obj$FundPerf.df
	regime.name <- names(regime.obj$Aligned.df)[1]

	min.ret <- round(min(dfdata[,'Perf']),1)
	max.ret <- round(max(dfdata[,'Perf']),1)

	ggp <- ggplot(dfdata,aes(x=Fund,y=Perf),environment=localenv)+
				    theme_economist(base_size=5)+
						geom_bar(stat='identity',position=position_dodge(),aes(fill=(dfdata$Perf)))+
						scale_y_continuous(limits=c(min.ret-0.2,max.ret+0.2),breaks=seq(min.ret-0.2,max.ret+0.2,length=5))+
						labs(x='',title=paste('Scaled Difference in Means for',regime.name,'regime',sep=' '),y='Values')+
						theme(legend.position = "none",panel.grid.major = element_blank(), panel.grid.minor = element_blank())+
						coord_flip()

return(ggp)
}
#########################################################################################

l
In addition to the in-sample scaled performance score calculated above,I also tried to look at how cumulative returns varied depending on one’s knowledge of the estimated states in each regime. I simply multiplied the chosen fund return by the state map for each economic regime variable (so that fund returns are multiplied by 1 in the case of a normal state and 0 of an event state),calculated the cumulative return as well as drawdowns for that series (using the PerformanceAnalytics package) and compared the results to the case where states are unknown.

I don’t know if these steps make sense or if my implementation is correct but that is what i did in any case. Although the data for this is already available from previous code segments,I purposefully started afresh so I can toy with it more easily (eg.multiplying by -1 in the event state as opposed to 0). Here is the code to create the data frame to be passed to the custom CumuCalc() function.
l

#[7.3.2] Comparing Cumulative returns when states are known vs unknown

n.regimes <- num.turbs
regimes.names <- names.turbs
fund.names <- names(edhec.xts)

CompareCumu <- list()
for(i in 1:n.funds){

	CompareCumu[[i]] <- list()
	names(CompareCumu)[i] <- fund.names[i]

	for(j in 1:n.regimes){
		CompareCumu[[i]][[j]] <- list()
		names(CompareCumu[[i]])[[j]] <- regimes.names[j]

		CompareCumu[[i]][[j]]$name.str <- paste(regimes.names[j],'::',fund.names[i],'Fund')
		CompareCumu[[i]][[j]]$data.orig <- data.frame(TimeIdx   = as.Date(rownames(Regimes[[j]]$Aligned.df)),
																						 FundReturn     = Regimes[[j]]$Aligned.df[,fund.names[i]],
																						 State			    = Regimes[[j]]$Aligned.df$Normal.Class
																				)
		temp.store <- CompareCumu[[i]][[j]]$data.orig

		CompareCumu[[i]][[j]]$data.new <- mutate(temp.store,State.new=ifelse(State==1,1,0),FundReturn.new=State.new*FundReturn)
		CompareCumu[[i]][[j]]$plot <- CumuCalc(CompareCumu[[i]][[j]])
	}
}

l
The most important issue here is the call to the CumuCalc() function which returns a ggplot of cumulative returns and drawdowns for the chosen fund/regime combination.The nested list structure of the CompareCumu variable alows us to [1] loop over all funds and [2] within each fund loop over all regime variables,simplifying data access to a command like : CompareCumu$Short.Selling$Inflation for example.

For the sake of completeness,the code for that function is given here :
l

#########################################################################################
# Cumulative  Calculation and ggplots saved
#########################################################################################

CumuCalc <- function(fund.df){

	tindex <- as.Date(fund.df$data.new$TimeIdx)
	fund.names <- fund.df$name.str
	orig.ret <- fund.df$data.new[,'FundReturn']
	orig.cumu.ret <- cumprod(orig.ret+1)-1

	state.ret <- fund.df$data.new[,'FundReturn.new']
	state.cumu.ret <- cumprod(state.ret+1)-1

	orig.dd <- Drawdowns(orig.ret)
	state.dd <- Drawdowns(state.ret)

	ggplot.df <- data.frame(TimeIdx  = tindex,
		                      Ret.Original = orig.cumu.ret,
		                      Ret.Markov   = state.cumu.ret,
													DD.Original  = orig.dd,
													DD.Markov    = state.dd,
		                      stringsAsFactors=F
	             )
	lbl.df <- data.frame(lbl.x=rep(max(ggplot.df$TimeIdx)-300,2),lbl.y=c(last(ggplot.df$Ret.Original),last(ggplot.df$Ret.Markov)),lbl.txt=c('Original','Markov'),stringsAsFactors=F)
	ggp1 <- ggplot(data=ggplot.df,aes(x=TimeIdx))+
 				  theme_economist(base_size=5)+
		      geom_line(aes(x=TimeIdx,y=Ret.Original,colour='Original'),size = 1)+
				  geom_line(aes(x=TimeIdx,y=Ret.Markov,colour='Markov'),size = 1)+
          scale_colour_manual("",breaks = c('Markov','Original'),values=c('skyblue4','cyan'))+
				  labs(x='',y='Values')+
		      theme(legend.position=c(0.3,1),legend.key.size=unit(0.2, "cm"),legend.key.width=unit(2,'cm'),legend.direction='horizontal',panel.grid.major = element_blank(), panel.grid.minor = element_blank())

	ggp2 <- ggplot(data=ggplot.df,aes(x=TimeIdx))+
 				  theme_economist(base_size=5)+
		      geom_line(aes(x=TimeIdx,y=DD.Original,colour='Original'),size=1)+
				  geom_line(aes(x=TimeIdx,y=DD.Markov,colour='Markov'),size=1)+
 		      scale_colour_manual("Legend : ",breaks = c('Markov','Original'),values=c('skyblue4','cyan'))+
				  labs(x='Time',y='Values')+
		      theme(legend.position='none',panel.grid.major = element_blank(), panel.grid.minor = element_blank())

	return(list(ggp1,ggp2))

}
####################################################################################################

l
This function simply returns a list object with two elements, ggplots of cumulative returns and drawdowns for the chosen fund and regime combination when states are known versus when they are unknown.

A final issue I tried to address,so as to make the dashboard less empty, was to compare the event-state mean with its non event counterpart for the chosen fund and economic regime variable. Once again,although all the necessary data frames are already in place,I dealt with this issue separately to ease my pain :
l

#[7.3.4] Facet Plot Date frame and graph

Facet.obj <- list()
for(i in 1:n.funds){
	Facet.obj[[i]] <- list()
	names(Facet.obj)[i] <- fund.names[i]

	values.matrix <- NULL
	for(j in 1:n.regimes){
		temp <- select(Regimes[[j]]$FundPerf.df,c(Fund,EventMean:NonEventMean))
		filtered <- filter(temp,Fund==fund.names[i])[,-1]
		values.matrix <- rbind(values.matrix,filtered)
	}

	Facet.obj[[i]]$df <- data.frame(Regime=regimes.names,Event=values.matrix[,1],Normal=values.matrix[,2])

	Facet.obj[[i]]$reshaped.df <- gather(Facet.obj[[i]]$df,variable,value,-Regime)
	colnames(Facet.obj[[i]]$reshaped.df)[-1] <- c('State','Mean')
}

FacetPlot.list <- lapply(Facet.obj,function (x) FacetPlot(x))

l
The FacetPlot() function called at the end there simply returns a ggplot of ‘dodged’ barcharts of average returns across regimes and states for the chosen fund.
l

#########################################################################################
# Facet Plotter
#########################################################################################

FacetPlot <- function(plot.obj){
	plotdf <- plot.obj$reshaped.df

		ggbb <- ggplot(plotdf)+
        			theme_economist(base_size=5)+
						  geom_bar(data = plotdf,aes(x=Regime,y=Mean,fill=State),stat = "identity",position='dodge') +
		  				scale_fill_brewer(palette='Set1')+
							labs(title='Average returns across\nRegimes & States')+
      				coord_flip()+
      			  theme(axis.ticks=element_blank(),legend.position='none',axis.title=element_blank(),axis.text.x=element_blank(),panel.grid.major = element_blank(), panel.grid.minor = element_blank())

	return(ggbb)
}
#########################################################################################

ll
Across these three posts,we have gathered all the inputs necessary for our final dashboard.Let’s save these into a single list and pass it to the DashboardPlot() function in the next post.
l

#[7.3.3] Dashboard
dashboard.list <- list(FundRet.list=edhec.ret,
	                     Turbulence.plot=Turbulence.plot,
	                     Turbulence1.tbl=Turbulence1.tbl,
	                     Turbulence2.tbl=Turbulence2.tbl,
	                     plot.list=plot.list,
	                     CompareCumu=CompareCumu,
	                     FacetPlot=FacetPlot.list,
	                     FacetObj=Facet.obj,
	                     MarkovPlots=MarkovEstPlots)

l

Advertisements
1 comment

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: