Chetty’s Mobility Matrices

Create list of matrices

First, I load the data and create a list of matrices:

t <- data.table(read_dta(paste0(path, "data/tmatrices_cz.dta")))
t <- t[complete.cases(t)] # remove missing data
nrow(t)

[1] 729

# 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
}

I defined functions to get upper and lower mobility differences.

# functions to get lower and upper mobility
ld <- function(mat) {
      am <- sum(diag(mat)) / 5 
      s <- apply(upper.triangle(mat), 1, sum)
      t <- diag(mat)
      t[1:3] <- s[1:3]
      return(sum(t)/5 -  am)
}
ud <- function(mat) {
      am <- sum(diag(mat)) / 5 
      s <- apply(upper.triangle(mat), 1, sum)
      t <- diag(mat)
      t[3:5] <- s[3:5]
      return(sum(t)/5 -  am)
}

Now I can compute figures and plot them. Most of the difference is observed for lower changes (as expected).

lmd <- sapply(mm, ld)
umd <- sapply(mm, ud)
# get some plots
hist(lmd, main = "lower mobility")

hist(umd, main = "upper mobility")

Explore patterns

The correlation between scores is pretty high 0.89. This is not good if we want to distinguish the effect of lower and upper mobility.

plot(lmd, umd, xlab = "lower mobility", ylab = "upper mobility")

I can use just the extreme quantiles (remove the third):

# functions to get lower and upper mobility
ld <- function(mat) {
      am <- sum(diag(mat)) / 5 
      s <- apply(upper.triangle(mat), 1, sum)
      t <- diag(mat)
      t[1:2] <- s[1:2] 
      return(sum(t)/5 -  am)
}
ud <- function(mat) {
      am <- sum(diag(mat)) / 5 
      s <- apply(upper.triangle(mat), 1, sum)
      t <- diag(mat)
      t[4:5] <- s[4:5] 
      return(sum(t)/5 -  am)
}

Get new plots:

lmdb <- sapply(mm, ld)
umdb <- sapply(mm, ud)
# get some plots
hist(lmdb, main = "lower mobility")

hist(umdb, main = "upper mobility")

Now the correlation is lower 0.69:

plot(lmdb, umdb, xlab = "lower mobility", ylab = "upper mobility")

Any ideas or suggestions? To use weights? What about the direction of mobility?