where \(\frac{\dot{x}}{x}\) is the column vector of the growth rates in relative quantities, \(\frac{\dot{p}}{p}\) is the row vector of the growth rates in relative prices, and \(\delta_p\) and \(\delta_x\) are diagonal matrices with N positive adjustment coefficients (so they can also be understood as vectors). In discrete-time, scalar form, i indicates a particular sector: \[ \frac{p^i_{t+1}}{p^i_t} - 1 = - \delta^i_p \sum_j (b_{ij} - R a_{ij}) x^j_t \quad i=1,...,N\] \[ \frac{x^i_{t+1}}{x^i_t} - 1 = + \delta^i_x \sum_j p^j_t (b_{ji} - R a_{ji}) \quad i=1,...,N \]
The empirical calibration involves the econometric estimation of vectors of country-, sector-specific adjustment coefficients \(\delta^i_p\) and \(\delta^i_x\) that relate growth rates in prices and quantities to supply-demand and revenue-cost imbalances, respectively (i.e. excess demand and excess profitability), in a linear form: \[ y_{a,it} = \delta^i_a x_{a,it} \qquad a = p,x; \quad i=1,...,N; \quad t=2000,...,2014 \] This problem can be addressed applying a hierarchical mixed-effects linear model with varying slopes with respect to the country sector.
# Ordinates: Rates of Growth in Prices and Quantities
Y.P<-Y.X<-array(NA,dim=c(length(cou0),length(sec0),length(yrs.klem),4),dimnames=list(cou0,sec0,yrs.klem,paste0('y',1:4)))
for(k in 1:length(cou0))
{
fool <- t(apply(p_go[k,,],1,function(x){x[-1]/x[-length(x)]-1}))
Y.P[k,sec0,-length(yrs.klem),1] <- fool[sec0,] - colMeans(fool[sec0,],na.rm=T)
Y.P[k,sec0,-length(yrs.klem),2] <- fool[sec0,] - fool['TOT',]
Y.P[k,sec0,-length(yrs.klem),3] <- fool[sec0,] - fool['TOT_IND',]
Y.P[k,sec0,-length(yrs.klem),4] <- fool[sec0,] - fool['MARKT',]
fool <- t(apply(go_q[k,,],1,function(x){x[-1]/x[-length(x)]-1}))
Y.X[k,sec0,-ncol(fool),1] <- fool[sec0,] - colMeans(fool[sec0,],na.rm=T)
Y.X[k,sec0,-length(yrs.klem),2] <- fool[sec0,] - fool['TOT',]
Y.X[k,sec0,-length(yrs.klem),3] <- fool[sec0,] - fool['TOT_IND',]
Y.X[k,sec0,-length(yrs.klem),4] <- fool[sec0,] - fool['MARKT',]
}
df <- melt(p_go[1,,], varnames = c('sec','year'))
ggplot(df) + geom_line(aes(x = year, y = value, colour = sec)) + ggtitle('Prices, Germany')
## Warning: Removed 74 row(s) containing missing values (geom_path).
df <- melt(Y.P[1,,,1], varnames = c('sec','year'))
ggplot(df) + geom_line(aes(x = year, y = value, colour = sec)) + ggtitle('Growth in Prices, Germany')
## Warning: Removed 75 row(s) containing missing values (geom_path).
df <- melt(go_q[1,,], varnames = c('sec','year'))
ggplot(df) + geom_line(aes(x = year, y = value, colour = sec)) + ggtitle('Quantities, Germany')
## Warning: Removed 73 row(s) containing missing values (geom_path).
df <- melt(Y.X[1,,,1], varnames = c('sec','year'))
ggplot(df) + geom_line(aes(x = year, y = value, colour = sec)) + ggtitle('Growth in Quantities, Germany')
## Warning: Removed 75 row(s) containing missing values (geom_path).
R. <- t(sapply(dimnames(go)[[1]], function(x)
{
colSums(go[x,sec0,],na.rm=T)/colSums((ii+lab)[x,sec0,],na.rm=T)
}))
r.p <- go/(ii+lab)
r.q <- go_q/ii_q
r..q <- t(sapply(1:dim(go_q)[1], function(x) {colMeans((go_q/ii_q)[x,sec0,],na.rm=T) }))
rownames(r..q) <- geo
R.q <- t(sapply(1:dim(go_q)[1], function(x)
{
colSums(go_q[x,sec0,],na.rm=T)/colSums(ii_q[x,sec0,],na.rm=T)
}))
# X.X5<-X.X4<-X.X3<-X.P5<-X.P4<-X.P3<-X.P1<-X.P2<-X.P<-X.X<-X.X2
X.X<-X.P<-array(NA,dim=c(length(cou0),length(sec0),length(yrs.klem),6),dimnames=list(cou0,sec0,yrs.klem,paste0('x',1:6)))
for(k in 1:length(cou0))
{
X.P[k,sec0,,1] <- - (1 - R.[k,]*ii_q[k,sec0,]/go_q[k,sec0,])
X.P[k,sec0,,2] <- - (1 - R_[k,]*ii_q[k,sec0,]/go_q[k,sec0,])
X.P[k,sec0,,3] <- - (1 - r..q[k,]*ii_q[k,sec0,]/go_q[k,sec0,])
X.P[k,sec0,,4] <- - (1 - r.q[k,'TOT',]*ii_q[k,sec0,]/go_q[k,sec0,])
X.P[k,sec0,,5] <- - (1 - r.q[k,'TOT_IND',]*ii_q[k,sec0,]/go_q[k,sec0,])
X.P[k,sec0,,6] <- - (1 - r.q[k,'MARKT',]*ii_q[k,sec0,]/go_q[k,sec0,])
X.X[k,sec0,,1] <- (go[k,sec0,] - (ii+lab)[k,sec0,] * R_[k,])/go_q[k,sec0,]
X.X[k,sec0,,2] <- (go[k,sec0,] - (ii+lab)[k,sec0,] * R.[k,])/go_q[k,sec0,]
X.X[k,sec0,,3] <- (go[k,sec0,] - (ii+lab)[k,sec0,] * r.p[k,'TOT',])/go_q[k,sec0,]
X.X[k,sec0,,4] <- (go[k,sec0,] - (ii+lab)[k,sec0,] * r.p[k,'TOT_IND',])/go_q[k,sec0,]
X.X[k,sec0,,5] <- (go[k,sec0,] - (ii+lab)[k,sec0,] * r.p[k,'MARKT',])/go_q[k,sec0,]
}
model.ED <- list()
for(i in 1:dim(X.P)[4])
{
for (j in 1:dim(Y.P)[4])
{
y0 <- melt(Y.P[,,,j],varnames=c('geo','sec','year'),value.name='y')
x0 <- melt(X.P[,,,i],varnames=c('geo','sec','year'),value.name='x')
df <- merge(x0,y0)
df <- mutate(df, id = paste(geo,sec,sep='.'))
model.ED[[dim(X.P)[4]*(j-1) + i]] <- lmer(y ~ x - 1 + (x - 1 | id), df)
}
}
sapply(model.ED,function(x) {summary(x)$logLik})
## [1] 6283.223 6283.163 6158.713 6210.112 6158.520 6149.332 6450.890 6450.835
## [9] 6324.310 6378.263 6323.935 6314.494 6390.247 6390.187 6267.620 6319.425
## [17] 6267.193 6257.627 6339.965 6339.965 6217.156 6269.111 6216.995 6208.309
# coef.ED <- coef(model.ED[[1]])$id
# COEF.p <- array(unlist(coef(model.ED)),dim=c(length(sec0),length(geo)),dimnames=list(sec0,geo))
#
# df <- melt(COEF.p,varnames=c('sec','geo'))
# ggplot(data=df, aes(x=value, group=geo, fill=geo)) +
# geom_density(adjust=1.5, alpha=0.7) + facet_wrap(~geo) + geom_vline(xintercept=0, linetype="dotted") +
# theme(
# legend.position="none",
# panel.spacing = unit(0.1, "lines"),
# axis.ticks.x=element_blank()
# )
#
# round(colSums(COEF.p > 0)/nrow(COEF.p), 2)
# round(rowSums(COEF.p > 0)/ncol(COEF.p), 2)
# table(coef(model.ED2)$id>0)
# coef.ED_ <- setNames(coef(model.ED)$id$x.p, rownames(coef(model.ED)$id))
# coef.ED_ %>% melt %>% ggplot(aes(x=value)) + geom_density(fill="#69b3a2", color="#e9ecef", alpha=0.8)
model.EP <- list()
for(i in 1:(dim(X.X)[4]-1))
{
for (j in 1:dim(Y.X)[4])
{
y0 <- melt(Y.X[,,,j],varnames=c('geo','sec','year'),value.name='y')
x0 <- melt(X.X[,,,i],varnames=c('geo','sec','year'),value.name='x')
df <- merge(x0,y0)
df <- mutate(df, id = paste(geo,sec,sep='.'))
model.EP[[5*(j-1) + i]] <- lmer(y ~ x - 1 + (x - 1 | id), df)
}
}
sapply(model.EP,function(x) {summary(x)$logLik})
## [1] 5536.216 5546.593 5549.463 5549.628 5548.092 5687.383 5698.104 5703.209
## [9] 5703.514 5701.613 5634.601 5645.334 5650.586 5650.849 5648.743 5452.248
## [17] 5461.739 5467.669 5467.908 5464.356
# coefs.x.each <- sapply(unique(data.1$id), function(k) {summary(lm(data.1[data.1$id==k,'y.p'] ~ data.1[data.1$id==k,'x.p'] + 0))$coefficients})
# df <- data.frame(id = unique(data.1$id), estimate=coefs.p.each[1,],sd=coefs.p.each[2,])
# ggplot(df, aes(x=id, y=estimate)) + geom_bar(stat="identity") + geom_errorbar(aes(ymin=estimate-sd, ymax=estimate+sd), width=.2,position=position_dodge(.9))
# coef.EP <- coef(model.EP)$id
# coef.EP2 <- coef(model.EP2)$id
# COEF.x <- array(unlist(coef(model.EP)),dim=c(length(sec0),length(geo)),dimnames=list(sec0,geo))
#
# df <- melt(COEF.x,varnames=c('sec','geo'))
# ggplot(data=df, aes(x=value, group=geo, fill=geo)) +
# geom_density(adjust=1.5, alpha=0.7) + facet_wrap(~geo) + geom_vline(xintercept=0, linetype="dotted") +
# theme(
# legend.position="none",
# panel.spacing = unit(0.1, "lines"),
# axis.ticks.x=element_blank()
# )
#
# round(colSums(COEF.x > 0)/nrow(COEF.x), 2)
# round(rowSums(COEF.x > 0)/ncol(COEF.x), 2)
# table(coef.EP>0)
# table(coef.EP2>0)
# coef.EP_ <- setNames(coef(model.EP)$id$x.x, rownames(coef(model.EP)$id))
#
# coef.EP_ %>% melt %>% ggplot(aes(x=value)) + geom_density(fill="#69b3a2", color="#e9ecef", alpha=0.8)
#foo <- data.frame(p = rowSums(COEF.p > 0)/ncol(COEF.p),
# x = rowSums(COEF.x > 0)/ncol(COEF.x))
#round(rowSums(foo), 2)
# foo %>% melt %>% ggplot(aes(x=value)) + geom_density(fill="#69b3a2", color="#e9ecef", alpha=0.8)