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