Asset Pricing [9d : Regime Switching]

The final task we have set ourselves, and which also happens to be a welcome initiation to the excellent ggplot2 package for me, is concerned with summarising the previously saved plots and tables into a single (and hopefully useful) dashboard. I have attempted to reduce clutter as much as possible by omitting axis ticks,values and legends in those cases where interpretation is forthcoming. After exhausting the template themes available from the ggthemes package, I have settled on the economist theme for all the plots in the dashboard,finding it to be the most pleasing on the eyes. The function that collects and arranges all the outputs from previous steps is the custom DashboardPlot() function which accepts as arguments the following :[1] List object of dashboard elements,[2]Fund name of choice ,[3] Regime name of choice.
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)

#Dashboard for Global Macro fund in Inflation regime
# DashboardPlot(Inputs=dashboard.list,
# 	            Fund='Global.Macro',
# 	            Regime='Inflation')

#Dashboard for all regimes/fund combinations
for(i in fund.names){
	for(j in regimes.names){
		DashboardPlot(Inputs=dashboard.list,
			            Fund=i,
		              Regime=j
		)
	}
}
########################################################################################

l
This results in n.funds(13)*n.regimes(4)= 52 pdf files, each representing a unique combination of a particular fund and a particular regime.

I have uploaded the pdf files into wordpress and they should be available for viewing by clicking on the links in the following table :

l

Funds | Regimes Equity Currency Inflation Growth
Convertible Arbitrage C&EQ C&FX C&Inf C&G
CTA Global CTA&EQ CTA&FX CTA&Inf CTA.&G
Distressed Securities D&EQ D&FX D&Inf D&G
Emerging Markets Em&EQ Em&FX Em&Inf Em&G
Equity Market Neutral Eq&EQ Eq&FX Eq&Inf Eq&G
Event Driven Ev&EQ Ev&FX Ev&Inf Ev&G
Fixed Income Arbitrage Fix&EQ Fix&FX Fix&Inf Fix&G
Funds of Funds Fun&EQ Fun&FX Fun&Inf Fun&G
Global Macro Glo&EQ Glo&FX Glo&Inf Glo&G
Long Short Equity Lon&EQ Lon&FX Lon&Inf Lon&G
Merger Arbitrage Me&EQ Me&FX Me&Inf Me&G
Relative Value Rel&EQ Rel&FX Rel&Inf Rel&G
Short Selling Sh&EQ Sh&FX Sh&Inf Sh&G

l

This html table was generated using The Tables Generator with Compact mode ticked and Do not Generate CSS unticked.

To give an example of the information contained in a dashboard,consider the case of  Global Macro x Inflation and relevant points of interest below :

l

mkl

l

Points of interest :

[Barcharts & Table of estimates in top rows]

  1. The Inflation economic regime variable begins in the normal state,with a high probability of remaining in this state (Persistence : 90.1%) and a low probability of transitioning to the event state (Transition : 9.9%).The estimated mean and sigma for this normal state are 0.2559 and 0.275 respectively.
  2. The Event state for all regime variable is characterised by higher estimated sigmas and means than corresponding values for the normal state.
  3. The persistence of normal states across all economic regime variables is higher than that that of event states. The corollary is found in transition estimates where we are more likely to transition from the event state to the normal state than from the normal state to the event state for all regime variables.
  4. The dodged barchart in the final column seeks to answer the question : What is the average return for fund x when regime y is in state a or state b? For our example, the mean return to the Global Macro strategy when the inflation regime is in the normal state exceeds the corresponding value in the event state.

 

[Selection & Performance plots in bottom rows]

  1. The list of funds and regime variables are given as strips of text in two separate ggplots with a green rectangle beneath the chosen fund and a red rectangle beneath the chosen regime. They are here mainly for eye candy, filling in space and horsing around with the ggplot package!
  2. The monthly,cumulative returns and drawdowns are also drawn.It seems that that for the Global Macro x Inflation case,knowledge of Markov states does not translate to higher cumulative returns.The drawdowns however seem more favourable.
  3. We also have a time series plot of the chosen economic regime variable along with an overlay of event versus non-event states.The thin red bars signify moments in time where the regime variable is in the event state.The blue bars show when that variable is in its normal state.There are some strange discrepancies between the pdf file and this zoomed image above.The pdf file is a better option here even though the colour is strangely off depending on the zoom.Also there is some sort of white taper in the pdf version of this plot which is probably due to the jagged lines I mentioned in the previous post.
  4. The final barchart in the bottom right corner shows the scaled difference in means across states for the chosen regime variable. If I understood this correctly,this should answer the question : By how many standard deviations is a particular fund’s performance higher/lower during the event/normal regime? In our case,the Global Macro strategy performs worse in the event regime than the normal regime by -0.10 standard deviations (?) I suppose this corroborates the previous finding that the mean performance of the chosen fund,when seen in the context of the inflation regime variable,is superior in the normal state versus the event state.

Whether these results are consistent or my interpretations correct I do not know.Any mistakes are of course mine.Although the code for the function is a bit of a mess and for the most part just arranges the plots in the desired layout,I include it here for the sake of completeness :
l

#########################################################################################
# Dashboard
#########################################################################################

DashboardPlot <- function(Inputs,Fund,Regime){

#Set up data
	regime.map <- data.frame(regime=c('Equity','Currency','Inflation','Growth'),idx=c(1:4),stringsAsFactors=F)
	fund.names <- names(Inputs$FundRet.list)
  reg.names <- regime.map[,1]

#regime strip
  lbl.font <- c(rep('bold',4))
	reg.df<-data.frame(lab.x=rep(20,4),lab.y=seq(2,26,length=4),lab.txt=reg.names,lab.font=lbl.font,stringsAsFactors=F)
	empty.df <- data.frame(x=-2:26,y=-2:26)
	ymin <- filter(reg.df,lab.txt==Regime)$lab.y-2
	ymax<-ymin+diff(reg.df$lab.y)[1]-1.5
	rect.df <- data.frame(xmin=-4,xmax=28,ymin=ymin,ymax=ymax)

	gg.reg.list <-  ggplot(empty.df)+geom_blank()+theme_economist(base_size=5)+
                      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
   	 									panel.border = element_blank(), panel.background = element_blank(), axis.title.x = element_blank(),
    									axis.title.y = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(),
    									axis.ticks = element_blank(),legend.position='none')+
                   		geom_rect(data=rect.df,aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),fill='red',alpha=0.4)+
		                  geom_text(data=reg.df,aes(x=lab.x,y=(lab.y),label=lab.txt,fontface=lab.font,hjust=1,vjust=0),size=rel(3))

#fund strip
  lbl.font <- c(rep('bold',13))
	fund.df<-data.frame(lab.x=rep(20,13),lab.y=seq(0,26,length=13),lab.txt=fund.names,lbl.font=lbl.font,stringsAsFactors=F)
	empty.df <- data.frame(x=-2:26,y=-2:26)
	ymin <- filter(fund.df,lab.txt==Fund)$lab.y-0.5
	ymax<-ymin+diff(fund.df$lab.y)[1]-0.5
	rect.df <- data.frame(xmin=-4,xmax=28,ymin=ymin,ymax=ymax)
	gg.fund.list <-  ggplot(empty.df)+geom_blank()+theme_economist(base_size=5)+
                      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
   	 									panel.border = element_blank(), panel.background = element_blank(), axis.title.x = element_blank(),
    									axis.title.y = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(),
    									axis.ticks = element_blank(),legend.position='none')+
                   		geom_rect(data=rect.df,aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),fill='green',alpha=0.4)+
		                  geom_text(data=fund.df,aes(x=lab.x,y=(lab.y),label=lab.txt,fontface=lbl.font,hjust=1,vjust=0),size=rel(3))

#Data table
	reg.str <- paste(filter(regime.map,regime==Regime)[2],']]',sep='')
	tbl1 <- Inputs$Turbulence1.tbl
	tbl2 <- Inputs$Turbulence2.tbl
	initial.state <- tbl1[unlist(filter(regime.map,regime==Regime)[2]),1]

	mean.s1 <- round(tbl1[unlist(filter(regime.map,regime==Regime)[2]),4],3)
        mean.s2 <- round(tbl2[unlist(filter(regime.map,regime==Regime)[2]),4],3)
	mean.df <- data.frame(State=c('Normal','Event'),Mean=c(mean.s1,mean.s2),stringsAsFactors=F)

	sd.s1 <- round(tbl1[unlist(filter(regime.map,regime==Regime)[2]),5],3)
        sd.s2 <- round(tbl2[unlist(filter(regime.map,regime==Regime)[2]),5],3)
	sd.df <- data.frame(State=c('Normal','Event'),StDev=c(sd.s1,sd.s2),stringsAsFactors=F)

	#Check State and store fitted information
	if(initial.state=='State 1'){
		temp <-Inputs$Turbulence1.tbl
		state.type <-'Normal'
	}else{
		temp<-Inputs$Turbulence2.tbl
    state.type <- 'Event'
	}

	pers <- temp[unlist(filter(regime.map,regime==Regime)[2]),2]
	trans <- temp[unlist(filter(regime.map,regime==Regime)[2]),3]
	mean.f <- round(temp[unlist(filter(regime.map,regime==Regime)[2]),4],3)
	stddev <- round(temp[unlist(filter(regime.map,regime==Regime)[2]),5],3)

#Create Plots

	gg.ret.plot <- eval(parse(text=paste('Inputs$FundRet.list$',Fund,sep='')))
	gg.turb.plot <- eval(parse(text=paste('Inputs$Turbulence.plot[[',reg.str,sep='')))

	gg.turb.map1 <- eval(parse(text=paste('Inputs$Turbulence.map2[[',reg.str,'[[1]]',sep='')))
	gg.turb.map2 <- eval(parse(text=paste('Inputs$Turbulence.map2[[',reg.str,'[[2]]',sep='')))

	gg.avg.plot <- eval(parse(text=paste('Inputs$plot.list[[',reg.str,sep='')))
	gg.cumu.plot1 <- eval(parse(text=paste('Inputs$CompareCumu$',Fund,'[[',reg.str,'$plot[[1]]',sep='')))
	gg.cumu.plot2 <- eval(parse(text=paste('Inputs$CompareCumu$',Fund,'[[',reg.str,'$plot[[2]]',sep=''))) 

	gg.facet.plot <- eval(parse(text=paste('Inputs$FacetPlot$',Fund,sep='')))
	gg.mkv.mean <- Inputs$MarkovPlots[[1]]
	gg.mkv.sd <- Inputs$MarkovPlots[[3]]
	gg.mkv.p <- Inputs$MarkovPlots[[5]]
	gg.mkv.t <- Inputs$MarkovPlots[[6]]

#Dashboard table
	lab1 <- paste("~Fund   :  ",Fund,sep=' ')
	lab2 <- paste('~Regime   :  ',Regime,sep=' ')
        lab3 <- paste('       |__Initial State :  ',state.type,sep=' ')
        lab4 <- paste('       |__Persistence :  ',pers,sep=' ')
        lab5 <- paste('       |__Transition :  ',trans,sep=' ')
        lab6 <- paste('       |__Mean  :  ',mean.f,sep=' ')
        lab7 <- paste('       |__StDev  :  ',stddev,sep=' ')
        lbl.cols <- c('green','red','white','white','white','white','white')
        lbl.font <- c('bold','bold','bold','bold','bold','bold','bold')
        lbl.df <-data.frame(lab.x=rep(-2,7),lab.y=seq(-1,8,length=7),lab.txt=c(lab1,lab2,lab3,lab4,lab5,lab6,lab7),lbl.font=lbl.font,lbl.cols=lbl.cols,stringsAsFactors=F)

	empty.df <- data.frame(x=-2:12,y=-2:12)
	gg.empty.plot <-  ggplot(empty.df,aes(x=x,y=y))+geom_blank()+geom_hline(y=11,colour='white',size=1)+theme_tufte(base_size=5)+
                      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
   	 									panel.border = element_blank(), panel.background = element_blank(), axis.title.x = element_blank(),
    									axis.title.y = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(),
    									axis.ticks = element_blank(),plot.title = element_text(size = rel(4),colour='white'),plot.background = element_rect(colour = "skyblue4", fill = "skyblue4"))+
		                  labs(title='\n.:: Dashboard ::.')+
		                  geom_text(data=lbl.df,aes(x=lab.x,y=rev(lab.y),label=lab.txt,hjust=0,vjust=1,fontface=lbl.font),size=rel(3),colour=lbl.cols)

	gg.empty2.plot <-  ggplot(empty.df,aes(x=x,y=y))+geom_blank()+theme_tufte(base_size=5)+
                      theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
   	 									panel.border = element_blank(), panel.background = element_blank(), axis.title.x = element_blank(),
    									axis.title.y = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(),
    									axis.ticks = element_blank(),plot.title = element_text(size = rel(4)),plot.background = element_rect(colour = "skyblue4", fill = "skyblue4"))

#Data table
  temptbl <- eval(parse(text=paste('Inputs$FacetObj$',Fund,'$df',sep='')))
	gg.tbl.plot <- QuickTbl(temptbl,title='Averaging Returns')

#Markov estimate tables
	gg.mkv.mean.tbl <- Inputs$MarkovPlots[[2]]
   	gg.mkv.sd.tbl <- Inputs$MarkovPlots[[4]]
	gg.mkv.p.tbl <- Inputs$MarkovPlots[[7]]
        gg.mkv.t.tbl <- Inputs$MarkovPlots[[8]]

#Arrange multiple plots and save as pdf
pdf(file = paste(Fund,'&',Regime,'.pdf',sep=''), width = 30, height = 17)
  layOut(
  	     list(gg.empty.plot,1:2,1),
  	     list(gg.empty2.plot,3:6,1),
  	     list(gg.reg.list,3,2),
  	     list(gg.fund.list,4:6,2),
   	  	 list(gg.mkv.mean,1,2),
  	     list(gg.mkv.sd,1,3),
  	     list(gg.mkv.p,1,4),
  	     list(gg.mkv.t,1,5),
  	  	 list(gg.facet.plot,1,6),
  	     list(gg.mkv.mean.tbl,2,2),
  	     list(gg.mkv.sd.tbl,2,3),
         list(gg.mkv.p.tbl,2,4),
  	     list(gg.mkv.t.tbl,2,5),
  	     list(gg.tbl.plot,2,6),
  	     list(gg.ret.plot,3:4,3:4),
  	     list(gg.cumu.plot1,5,3:4),
   	     list(gg.cumu.plot2,6,3:4),
  	     list(gg.avg.plot,5:6,5:6),
  	  	 list(gg.turb.plot,3:4,5:6)
   	)
dev.off()
}
#########################################################################################

l
Wish I could make this collapsable but wordpress seems to need a plugin for that.

Advertisements
5 comments
  1. vonjd said:

    Again, really great work, thank you – I will try to run your code and let you know in case I encounter any issues.

    One small thing: The link for the pdf for Fun&G doesn’t work.

  2. Thank you for the pointer..i do not know how you saw that but it should be updated now. As I have said in the post and elsewhere, stuff on this blog was never written with replication in mind and i am sure there are many mini functions / code snippets i have not bothered to include ..oops!

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 )

Twitter picture

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

Facebook photo

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

Google+ photo

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

Connecting to %s

%d bloggers like this: