# packages for the plots of the matrices
library(gplots)
library(graphics)
# the following function improves the plots of the matrices
sig=function(x,alpha=0.4)
{
return(1/(1+exp(-x/alpha)))
}
# 1) we generate the parameters by groups in order
K=4 # number or groups
pk=rep(0,K)
for(k in 1:K)
{
pk[k]=round(6+4*runif(1))
}
p=sum(pk)
Sigma_ord=matrix(0,nrow=p, ncol=p)
ind_min=0
L=5
for(k in 1:K)
{
p_k=pk[k]
ind=ind_min+(1:p_k)
ind_min=ind_min+p_k
A=2*matrix(runif(p_k*L),nrow=L,ncol=p_k)-1
Sigma_ord[ind,ind]=t(A)%*%A + 0.2*diag(rep(1,p_k))
}
image((0:p)+0.5,(0:p)+0.5,z=sig(Sigma_ord),col=cm.colors(100), zlim=c(0,1),
ylim=c(p+0.5,0.5), main=expression(Sigma["order"]),
cex.main=3,ylab = "", xlab = "",axes=FALSE)
box()
Beta_ord=3*runif(p)+1
eta_ord=shapleyLinearGaussian(Beta=Beta_ord, Sigma=Sigma_ord)
barplot(eta_ord,main=expression(eta["order"]),cex.axis = 2,cex.main=3)
# 2) We sample the input variables to get an input vector more general
samp=sample(1:p)
Sigma=Sigma_ord[samp,samp]
image((0:p)+0.5,(0:p)+0.5,z=sig(Sigma),col=cm.colors(100), zlim=c(0,1),
ylim=c(p+0.5,0.5), main=expression(Sigma),
cex.main=3,ylab = "",xlab = "",axes=FALSE)
box()
Beta=Beta_ord[samp]
eta=shapleyLinearGaussian(Beta=Beta, Sigma=Sigma)
barplot(eta,main=expression(eta),cex.axis = 2,cex.main=3)
# 3) We generate the observations with these parameters
n=5*p #sample size
C=chol(Sigma)
X0=matrix(rnorm(p*n),ncol=p)
X=X0%*%C
S=var(X) #empirical covariance matrix
image((0:p)+0.5,(0:p)+0.5,z=sig(S),col=cm.colors(100), zlim=c(0,1),
ylim=c(p+0.5,0.5), main=expression(S),
cex.main=3,ylab = "", xlab = "",axes=FALSE)
box()
beta0=rnorm(1)
Y=X%*%as.matrix(Beta)+beta0+0.2*rnorm(p)
# 4) We estimate the block-diagonal covariance matrix
# and the Shapley effects using the observations
# We assume that we know that the groups are smaller than 15
Estim=shapleyBlockEstimationX(X,Y,delta=3/4, M=15, tol=10^(-6))
eta_hat=Estim$Shapley
S_B=Estim$S_B
image((0:p)+0.5,(0:p)+0.5,z=sig(S_B),col=cm.colors(100), zlim=c(0,1),
ylim=c(p+0.5,0.5), main=expression(S[hat(B)]),
cex.main=3,ylab = "",xlab = "",axes=FALSE)
box()
barplot(eta_hat,main=expression(hat(eta)),cex.axis = 2,cex.main=3)
sum(abs(eta_hat-eta))
Run the code above in your browser using DataLab