Chetty’s Mobility Matrices

I first get the data and create list of matrices.

t <- data.table(read_dta(paste0(path, "data/tmatrices_cz.dta")))
c <- data.table(read_dta(paste0(path, "data/cz_full_covariates.dta")))
c <- c[, .(cz, s_rank, e_rank_b)]
setnames(c, names(c), c("cz", "rmob", "amob"))
setkey(t, cz)
setkey(c, cz)
t <- c[t] # merge data
t <- t[complete.cases(t)] # remove missing data
nrow(t)

[1] 709

# loop to create matrices 
mm <- list()
for (i in 1:nrow(t)) {
      tm <- matrix(NA, 5, 5)
            for (h in 1:5) {
                  for (j in 1:5) {
                        tm[h, j] <- t[i, get(paste0("prob_p", h, "_k", j))]
                  }
            }
      mm[[i]] <- tm
}

Hopefulness function:

hopefulness <- function(mat) {
  t <- upper.triangle(mat)
  diag(t) <- 0
  return( sum(t[1:2,4:5])/sum(t) )
}

t[, hope := sapply(mm, hopefulness)]
hist(t$hope)

cor(t[, .(rmob, amob, hope)])

           rmob       amob       hope
rmob  1.0000000 -0.6844716 -0.7758684
amob -0.6844716  1.0000000  0.8947943
hope -0.7758684  0.8947943  1.0000000

Pretty high correlation (.78 and 0.89). If I consider only upper transitions (let’s say 3 to 5):

upperMob <- function(mat) {
  t <- upper.triangle(mat)
  diag(t) <- 0
  # return((t[1,5]*1/3 + t[1,4]*1/4 + t[2,5]*1/4 + t[2,4]* 1/6 )/ sum(t) ) # based on number of jumps
  return((sum(t[3,4:5]) + t[4,5])/ sum(t) )
}

t[, upper := sapply(mm, upperMob)]
hist(t$upper)

cor(t[, .(rmob, amob, upper)])

            rmob       amob     upper
rmob   1.0000000 -0.6844716 0.2784068
amob  -0.6844716  1.0000000 0.3560352
upper  0.2784068  0.3560352 1.0000000

cor(t[, .(hope, upper)])

          hope    upper
hope  1.000000 0.185908
upper 0.185908 1.000000

This means that Chetty’s mobility measures are mainly measuring lower level mobility. Any comments?