top of page
  • Twitter
  • LinkedIn
  • Facebook

When Factors Collide: Mapping Causal Spillovers across Global Asset Networks

  • gkonstantinov1111
  • vor 2 Tagen
  • 3 Min. Lesezeit

Gueorgui S. Konstantinov and Frank J. Fabozzi (2026)

The Journal of Portfolio Management 52 ( 3): 48 - 63.

Building on the theoretical work of Marcos López de Prado, Alexander Lipton, and Vincent Zoonekynd, who demonstrated that causal factor analysis is necessary for investment efficiency, this article develops a quantitative framework that makes causal factor investing operational. The proposed CAFNITE (Causal Asset and Factor Network Interference under Treatment Effects) model extends causal inference from model specification to network behavior, quantifying how shocks to one factor propagate across others through causal linkages. Using a dataset of 20 global factors and 20 assets from 2001 to 2024, CAFNITE estimates direct, indirect, and combined causal effects across equity, bond, currency, and commodity markets. The results reveal asymmetric, state-dependent transmission patterns: during calm regimes, spillovers are diffuse whereas under stress, a small set of factors, particularly the market, momentum, and the US dollar, dominate propagation. By linking causal modeling to factor interaction and diversification diagnostics, CAFNITE provides investors with a practical toolkit for monitoring causal dependencies, stress-testing portfolios, and designing dynamically resilient factor allocations. CAFNITE integrates causal factor inference and interference.


#CAFNITE Framework Code in R


#Define a W-1 Network of Asset and Factor Returns

returns<-TSMultAssetsFactors.exp[,-1]

mtx_undir_wd<-matrix(nrow=ncol(TSMultAssetsFactors.exp[,-1]),ncol=ncol(TSMultAssetsFactors.exp[,-1]))

for(i in 1:ncol(returns)) {

for(j in 1:ncol(returns)) {

mtx_undir_wd[i,j]=wasserstein1d(returns[,i], returns[,j], p=2)

}

}

netz_undir_wd=as.matrix(abs(mtx_undir_wd))

netz_undir_wd=ifelse(netz_undir_wd[,]<mean(netz_undir_wd),1,0)

diag(netz_undir_wd)<-0

colnames(netz_undir_wd)<-colnames(TSMultAssetsFactors.exp[,-1])

print(netz_undir_wd)

netz_undir_wd<-graph_from_adjacency_matrix(netz_undir_wd, weighted=FALSE)


hist(degree_distribution(netz_undir_wd), main="")

E(netz_undir_wd)$arrow.size<-1


barplot(sort(degree(netz_undir_wd), decreasing=TRUE), lwd=0.5, cex.names=0.7,cex.axis=0.7,las=2)


barplot(sort(eigen_centrality(netz_undir_wd)$vector, decreasing=TRUE), lwd=0.5, cex.names=0.7,cex.axis=0.7,las=2)

ecs<-as.matrix(eigen_centrality(netz_undir_wd)$vector)



netz_undir_wd<-set_vertex_attr(netz_undir_wd, "category", value=c("F", "F", "F", "F", "F", "F", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A", "A","A", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F","F","F","A","A","A","F","F","F"))


V(netz_undir_wd)$color <- V(netz_undir_wd)$category

V(netz_undir_wd)$color <- gsub("F","orange",V(netz_undir_wd)$color)

V(netz_undir_wd)$color <- gsub("A","lightblue",V(netz_undir_wd)$color)


V(netz_undir_wd)$shape <- V(netz_undir_wd)$category

V(netz_undir_wd)$shape <- gsub("F","circle",V(netz_undir_wd)$shape)

V(netz_undir_wd)$shape <- gsub("A","square",V(netz_undir_wd)$shape)

E(netz_undir_wd)$arrow.size<-0


af_net<-netz_undir_wd



#Use Economic Reasoning to Identify Representatives############################################################################

#Serial Treatment Effects, Dilation is the total market return


A<-as_adjacency_matrix(netz_undir_wd) #extract the adjacency matrix of the underlying network

nodes<-vcount(netz_undir_wd)


iterations=10000


z<-numeric(nodes)

z[c(8,12, 14)]<-1 #select the Asset and Factors with economic reasoning

#based on Asness et al. (2013) we select Value and Momentum (everywhere) - HML and MOM

#based on Konstantinov and Fabozzi (2021) we select the US dollar - DXY

#Based on Leibowitz (2011) we select Market - Mkt.Rf

print(z)

par(mfrow=c(1,2))

m<-sum(z)


V(netz_undir_wd)[z==1]$names #show the names of the selected nodes

rank(-degree(netz_undir_wd))[z==1] #Evaluate the Rank of the Representatives using node degree

V(netz_undir_wd)[z==1]$color<-"purple" #set a color for the treatment assignment nodes

E(netz_undir_wd)$arrow.size<-0

#plot the netwotk with the Treatment assignment nodes

plot((netz_undir_wd), vertex.size=sqrt(degree(netz_undir_wd))*3, vertex.label.cex=0.4, layout=layout_with_kk, main="Treatment Assignment") #plot the original network

legend("bottom", bty="n",legend = c("Assets", "Factors", "Treatment Assignments"),

fill= c("lightblue", "orange", "purple"))


av.c11<-numeric()

av.c01<-numeric()

av.c10<-numeric()

av.c00<-numeric()


I11<-matrix(,nrow=nodes,ncol=iterations)

I10<-matrix(,nrow=nodes,ncol=iterations)

I01<-matrix(,nrow=nodes,ncol=iterations)

I00<-matrix(,nrow=nodes,ncol=iterations)


d.00<-mean(as.matrix(TSMultAssetsFactors.exp[,-1]))


o.c11<-2*d.00

o.c10<-1.5*d.00

o.c01<-1.25*d.00

o.c00<-1*d.00



I.impact.nodes<-as.numeric(z%*%A>0)

E(netz_undir_wd)$arrow.size<-0

V(netz_undir_wd)[z*I.impact.nodes==1]$color<-"red"

V(netz_undir_wd)[(1-z)*I.impact.nodes==1]$color<-"pink"

V(netz_undir_wd)[z*(1-I.impact.nodes)==1]$color<-"yellow"

V(netz_undir_wd)[(1-z)*(1-I.impact.nodes)==1]$color<-"white"

#plot the network with the exposure conditions

plot(netz_undir_wd, vertex.size=sqrt(degree(netz_undir_wd))*3, vertex.label.cex=0.4, layout=layout_with_kk, main="Exposure Conditions")

legend("bottom", bty="n",legend = c("indirect+direct", "indirect", "direct","no exposure"),

fill= c("red", "pink", "yellow", "white"))




#Monte Carlo Sampling

for (i in 1:iterations){

z<-rep(0,nodes)

reps.ind<-sample((1:nodes),m,replace=FALSE)

z[reps.ind]<-1

reps.nb<-as.numeric(z%*%A>0)

I11[,i]<-z*reps.nb #direct & undirect

I10[,i]<-z*(1-reps.nb) #direct

I01[,i]<-(1-z)*reps.nb #indirect

I00[,i]<-(1-z)*(1-reps.nb) #no exposure

c11<-z*reps.nb #direct & undirect

c10<-z*(1-reps.nb) #indirect

c01<-(1-z)*reps.nb #direct

c00<-(1-z)*(1-reps.nb) #no exposure

av.c11<-c(av.c11,o.c11*mean(c11/diag(I11.11))) #the average indirect and direct effect

av.c10<-c(av.c10,o.c10*mean(c10/diag(I10.10))) #average direct effect

av.c01<-c(av.c01,o.c01*mean(c01/diag(I01.01))) #average indirect effect

av.c00<-c(av.c00,o.c00*mean(c00/diag(I00.00))) #no effect

}


I11.11<-I11%*%t(I11)/iterations

I10.10<-I10%*%t(I10)/iterations

I01.01<-I01%*%t(I01)/iterations

I00.00<-I00%*%t(I00)/iterations


par(mfrow=c(2,2))

image(I11.11, xaxt="n",yaxt="n", main="Direct+Indirect Exposure",col=gray(100:1/100))

mtext(side=1, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=3,cex=0.5)

mtext(side=2, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=1,cex=0.5)

image(I10.10, xaxt="n",yaxt="n", main="Direct Exposure",col=gray(100:1/100))

mtext(side=1, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=3,cex=0.5)

mtext(side=2, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=1,cex=0.5)

image(I01.01, xaxt="n",yaxt="n", main="Indirect Exposure",col=gray(100:1/100))

mtext(side=1, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/40)), las=3,cex=0.5)

mtext(side=2, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=1,cex=0.5)

image(I00.00, xaxt="n",yaxt="n",main="No Exposure",col=gray(100:1/100))

mtext(side=1, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=3,cex=0.5)

mtext(side=2, text=colnames(TSMultAssetsFactors.exp[,-1]), at=seq(0.0,1.0,(1/39)), las=1,cex=0.5)

ACE<-list(av.c11-av.c00,av.c10-av.c00,av.c01-av.c00)


print(sapply(ACE,mean)-c(o.c11-o.c00,o.c10-o.c00,o.c01-o.c00))

print(sapply(ACE,sd))

print(sapply(ACE,sd)/c(o.c11,o.c10,o.c01))

 
 
 

Kommentare


bottom of page