Compute Elasticities of School Resources to Changes in Populations • PrjCompPPTS

library(tibble)
library(dplyr)
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyr)
library(stringr)
library(readr)
library(kableExtra)
#> 
#> Attaching package: 'kableExtra'
#> The following object is masked from 'package:dplyr':
#> 
#>     group_rows

library(PrjCompPPTS)
# If resave outputs to data, only do this during development
bl_resave_to_data <- FALSE

In this file, we compute all potential elasticities of school resource changes given changes in school age populations.

Elasticity of schools with respect to (school-age) population is the percentage change in the number of schools divided by percentage change in the school-age population.

Elasticity of teachers with respect to (school-age) population is the percentage change in the number of teachers divided by percentage change in the school-age population.

Load data inputs and review

We load in the global population data.

# File use
bl_interp <- FALSE
ppts_wrk <- ppts_easia_weuro_world_pchg %>% 
  filter(!str_detect(year_bins_type, "1940t2020i01"))

str(ppts_wrk)
#> tibble [25,765 × 9] (S3: tbl_df/tbl/data.frame)
#>  $ location_code : Factor w/ 286 levels "ABW","AFE","AFG",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ location_level: Factor w/ 4 levels "country","multicountry",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ variable      : Factor w/ 5 levels "gdp","school",..: 1 1 1 1 1 1 1 1 3 3 ...
#>  $ year_bins_type: Factor w/ 5 levels "1920t2020i05",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ year_bins     : chr [1:25765] "1981-1985" "1986-1990" "1991-1995" "1996-2000" ...
#>  $ pchg          : num [1:25765] NA NA 0.0532 0.064 -0.0504 ...
#>  $ pchg_interp1  : num [1:25765] 1.2489 0.903 0.0532 0.064 -0.0504 ...
#>  $ value         : num [1:25765] NA 27884 29367 31246 29670 ...
#>  $ value_interp1 : num [1:25765] 14653 27884 29367 31246 29670 ...

We review all unique values in variables. We get all unique “variable” values, drop enroll_ratio

ar_st_vars <- unique(ppts_wrk %>% pull(variable))
ar_year_bins_type <- unique(ppts_wrk %>% pull(year_bins_type))
print(ar_st_vars)
#> [1] gdp      student  teacher  youthpop school  
#> Levels: gdp school student teacher youthpop
print(ar_year_bins_type)
#> [1] 1920t2020i05 1920t2020i10 1920t2020i20 1925t2015i15
#> Levels: 1920t2020i05 1920t2020i10 1920t2020i20 1925t2015i15 1940t2020i01

Numerator and denominator percentage changes and Elasticity

We generate separate columns for each of the “variables”, containing the percentage change value for each variable. These columns will be numerators, and the original column will be the denominator.

Then, we reshape the file just created, so that all “numerators” will be in the same column.

We compute elasticities after

it_avg_type <- 1
for (it_avg_type in c(1, 2)) {
  
  if (it_avg_type == 1) {
    svr_var_val_exclude <- c("value_interp1", "pchg_interp1")
    svr_var_val <- "value"
    svr_chg_var <- "pchg"
    svr_chg_var_num <- "pchg_numerator"
    svr_elas_var <- "elasticity"
  } else if (it_avg_type == 2) {
    svr_var_val_exclude <- c("value", "pchg")
    svr_var_val <- "value_interp1"
    svr_chg_var <- "pchg_interp1"
    svr_chg_var_num <- "pchg_interp1_numerator"
    svr_elas_var <- "elasticity_interp1"
  }  
  
  ppts_wrk_jnt <- ppts_wrk %>% 
    select(-one_of(svr_var_val_exclude))
  ar_st_cur_col_var <- ar_st_vars
  for (st_cur_col_var in ar_st_cur_col_var) {
    #   st_cur_col_var <- "school"
    st_new_col_var <- paste0("pchgnum_", st_cur_col_var)
    # 20. Generate "variable"-specific dataframes
    ppts_one_var <- ppts_wrk %>%
      select(-one_of(svr_var_val_exclude)) %>%
      filter(variable == st_cur_col_var) %>%
      select(-!!sym(svr_var_val), - variable) %>%
      rename(!!sym(st_new_col_var) := !!sym(svr_chg_var))
    
    # 30. Merge "variable"-specific dataframe to main
    ppts_wrk_jnt <- ppts_wrk_jnt %>%
      left_join(ppts_one_var,
                by = (c(
                  "location_code" = "location_code",
                  "location_level" = "location_level",
                  "year_bins_type" = "year_bins_type",
                  "year_bins" = "year_bins"
                )))
  }
  
  # Show variable names
  print(colnames(ppts_wrk_jnt))
  print(dim(ppts_wrk_jnt))
  
  # 60. Reshape from wide to long, rename variable numerator, variable denominator
  ppts_wrk_jnt_long <- ppts_wrk_jnt %>% 
    pivot_longer(cols = starts_with('pchgnum'),
                 names_to = c('variable_numerator'),
                 names_pattern = paste0("pchgnum_(.*)"),
                 values_to = svr_chg_var_num)
  
  # 70. Compute elasticity
  # Now, we simply divide the numerator from the variable "pchg_yrspan_interp1_numerator" by the values in "pchg_yrspan_interp1", which is the denominator. 
  # Compute elasticities
  ppts_wrk_jnt_long <- ppts_wrk_jnt_long %>%
    mutate(!!sym(svr_elas_var) :=   
             !!sym(svr_chg_var_num)/!!sym(svr_chg_var))
  # Keep the elasticity column 
  # ppts_wrk_jnt_long <- ppts_wrk_jnt_long %>% 
  #   select(-contains("value"))
  
  # 61. save files 
  if (it_avg_type == 1) {
    ppts_wrk_jnt_long_val <- ppts_wrk_jnt_long
  } else if (it_avg_type == 2) {
    ppts_wrk_jnt_long_interp1 <- ppts_wrk_jnt_long
  }  
}
#>  [1] "location_code"    "location_level"   "variable"         "year_bins_type"  
#>  [5] "year_bins"        "pchg"             "value"            "pchgnum_gdp"     
#>  [9] "pchgnum_student"  "pchgnum_teacher"  "pchgnum_youthpop" "pchgnum_school"  
#> [1] 25765    12
#>  [1] "location_code"    "location_level"   "variable"         "year_bins_type"  
#>  [5] "year_bins"        "pchg_interp1"     "value_interp1"    "pchgnum_gdp"     
#>  [9] "pchgnum_student"  "pchgnum_teacher"  "pchgnum_youthpop" "pchgnum_school"  
#> [1] 25765    12

Examine elasticities

We now examine elasticity results. We show the percentage changes in schools and teachers, divided by the percentage change in students, these are the elasticity measures.

Elasticities in Afghanistan

We do not have data on schools. We show elasticity of teachers with respect to students, per decade.

# Display
st_year_bin_type <- "1920t2020i10"
st_cur_col_var <- c("teacher")
# print(ppts_wrk_jnt_long[1:50,])
st_caption <- paste0(
  "Afghanistan:",
  "Elastiicty with percentage change in students in the denominator ", 
  "and percentage change in ", st_cur_col_var, " in the numerator, ", 
  "using as bin-type=", st_year_bin_type)
kable(ppts_wrk_jnt_long_interp1 %>% 
        filter(location_code == 'AFG' & 
                 variable == 'student' & 
                 year_bins_type == st_year_bin_type &
                 variable_numerator == st_cur_col_var) %>%
        select(-location_level, -year_bins_type, 
               -value_interp1),
      caption = st_caption)

Afghanistan:Elastiicty with percentage change in students in the denominator and percentage change in teacher in the numerator, using as bin-type=1920t2020i10
location_code	variable	year_bins	pchg_interp1	variable_numerator	pchg_interp1_numerator	elasticity_interp1
AFG	student	1961-1970	NA	teacher	NA	NA
AFG	student	1971-1980	0.7747542	teacher	0.4731653	0.6107295
AFG	student	1981-1990	-0.3512672	teacher	-0.2181983	0.6211749
AFG	student	1991-2000	0.2037660	teacher	1.1426953	5.6078794
AFG	student	2001-2010	6.0451132	teacher	2.6721340	0.4420321
AFG	student	2011-2020	0.3295164	teacher	0.1558013	0.4728180

Elasticities in Germany

# Display
st_year_bin_type <- "1920t2020i10"
st_cur_col_var <- "school"
# print(ppts_wrk_jnt_long[1:50,])
st_caption <- paste0(
  "Germany:",
  "Elastiicty with percentage change in students in the denominator ", 
  "and percentage change in ", st_cur_col_var, " in the numerator, ", 
  "using as bin-type=", st_year_bin_type)
kable(ppts_wrk_jnt_long_interp1 %>% 
        filter(location_code == 'DEU' & 
                 variable == 'student' & 
                 year_bins_type == st_year_bin_type &
                 variable_numerator == st_cur_col_var) %>%
        select(-location_level, -year_bins_type, 
               -value_interp1),
      caption = st_caption)

Germany:Elastiicty with percentage change in students in the denominator and percentage change in school in the numerator, using as bin-type=1920t2020i10
location_code	variable	year_bins	pchg_interp1	variable_numerator	pchg_interp1_numerator	elasticity_interp1
DEU	student	1991-2000	NA	school	-0.0403391	NA
DEU	student	2001-2010	-0.1536558	school	-0.0570188	0.3710814
DEU	student	2011-2020	0.0016087	school	-0.0517495	-32.1690215

Elasticities in Switzerland

In Switerland, elasticity of teachers to students, schools to students, every 10 years

# Display
st_year_bin_type <- "1920t2020i10"
st_cur_col_var <- "teacher"
# print(ppts_wrk_jnt_long[1:50,])
st_caption <- paste0(
  "Switerland:",
  "Elastiicty with percentage change in students in the denominator ", 
  "and percentage change in ", st_cur_col_var, " in the numerator, ", 
  "using as bin-type=", st_year_bin_type)
kable(ppts_wrk_jnt_long_interp1 %>% 
        filter(location_code == 'CHE' & 
                 variable == 'student' & 
                 year_bins_type == st_year_bin_type &
                 variable_numerator == st_cur_col_var) %>%
        select(-location_level, -year_bins_type, 
               -value_interp1),
      caption = st_caption)

Switerland:Elastiicty with percentage change in students in the denominator and percentage change in teacher in the numerator, using as bin-type=1920t2020i10
location_code	variable	year_bins	pchg_interp1	variable_numerator	pchg_interp1_numerator	elasticity_interp1
CHE	student	1921-1930	-0.1088153	teacher	-0.0167073	0.1535385
CHE	student	1931-1940	-0.0422086	teacher	0.0197445	-0.4677836
CHE	student	1941-1950	0.0277636	teacher	0.0594144	2.1400096
CHE	student	1951-1960	0.2337117	teacher	0.2169864	0.9284365
CHE	student	1961-1970	-0.0725023	teacher	0.2003332	-2.7631297
CHE	student	1971-1980	-0.1714082	teacher	0.2046066	-1.1936806
CHE	student	1981-1990	-0.0664079	teacher	0.2046066	-3.0810588
CHE	student	1991-2000	0.1522173	teacher	0.2046066	1.3441745
CHE	student	2001-2010	-0.0795079	teacher	0.2046066	-2.5734116
CHE	student	2011-2020	0.2159203	teacher	0.2420525	1.1210273

Elasticities in Austria

In Austria, elasticity of schools to students, every 20 years

# Display
st_year_bin_type <- "1920t2020i20"
st_cur_col_var <- "school"
# print(ppts_wrk_jnt_long[1:50,])
st_caption <- paste0(
  "Austria:",
  "Elastiicty with percentage change in students in the denominator ", 
  "and percentage change in ", st_cur_col_var, " in the numerator, ", 
  "using as bin-type=", st_year_bin_type)
kable(ppts_wrk_jnt_long_interp1 %>% 
        filter(location_code == 'AUT' & 
                 variable == 'student' & 
                 year_bins_type == st_year_bin_type &
                 variable_numerator == st_cur_col_var) %>%
        select(-location_level, -year_bins_type, 
               -value_interp1),
      caption = st_caption)

Austria:Elastiicty with percentage change in students in the denominator and percentage change in school in the numerator, using as bin-type=1920t2020i20
location_code	variable	year_bins	pchg_interp1	variable_numerator	pchg_interp1_numerator	elasticity_interp1
AUT	student	1921-1940	NA	school	NA	NA
AUT	student	1941-1960	-0.2191390	school	-0.0193360	0.0882361
AUT	student	1961-1980	-0.2222666	school	-0.2146597	0.9657758
AUT	student	1981-2000	-0.0194571	school	-0.0260870	1.3407426
AUT	student	2001-2020	-0.1170392	school	-0.1029762	0.8798434

Elasticities in Busan, Korea

In Busan, Korea, elasticity of teachers to students, schools to students, every 10 years

# Display
st_year_bin_type <- "1920t2020i10"
st_cur_col_var <- "teacher"
# print(ppts_wrk_jnt_long[1:50,])
kable(ppts_wrk_jnt_long_interp1 %>% 
        filter(location_code == 'KOR_Busan' & 
                 variable == 'student' & 
                 year_bins_type == st_year_bin_type &
                 variable_numerator == st_cur_col_var) %>%
        select(-location_level, -year_bins_type, 
               -value_interp1),
      caption = "Busan Korea Elastiicty of teachers with respect to students")

Busan Korea Elastiicty of teachers with respect to students
location_code	variable	year_bins	pchg_interp1	variable_numerator	pchg_interp1_numerator	elasticity_interp1
KOR_Busan	student	1961-1970	NA	teacher	NA	NA
KOR_Busan	student	1971-1980	0.5542519	teacher	0.8009709	1.4451387
KOR_Busan	student	1981-1990	0.0244194	teacher	0.4051213	16.5901539
KOR_Busan	student	1991-2000	-0.3547216	teacher	-0.0620564	0.1749439
KOR_Busan	student	2001-2010	-0.3306965	teacher	0.1207690	-0.3651958
KOR_Busan	student	2011-2020	-0.2222425	teacher	-0.0740876	0.3333638

Save elasticity file

# Review file variable names
print(colnames(ppts_wrk_jnt_long))
#>  [1] "location_code"          "location_level"         "variable"              
#>  [4] "year_bins_type"         "year_bins"              "pchg_interp1"          
#>  [7] "value_interp1"          "variable_numerator"     "pchg_interp1_numerator"
#> [10] "elasticity_interp1"
print(str(ppts_wrk_jnt_long))
#> tibble [128,825 × 10] (S3: tbl_df/tbl/data.frame)
#>  $ location_code         : Factor w/ 286 levels "ABW","AFE","AFG",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ location_level        : Factor w/ 4 levels "country","multicountry",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ variable              : Factor w/ 5 levels "gdp","school",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ year_bins_type        : Factor w/ 5 levels "1920t2020i05",..: 1 1 1 1 1 1 1 1 1 1 ...
#>  $ year_bins             : chr [1:128825] "1981-1985" "1981-1985" "1981-1985" "1981-1985" ...
#>  $ pchg_interp1          : num [1:128825] 1.25 1.25 1.25 1.25 1.25 ...
#>  $ value_interp1         : num [1:128825] 14653 14653 14653 14653 14653 ...
#>  $ variable_numerator    : chr [1:128825] "gdp" "student" "teacher" "youthpop" ...
#>  $ pchg_interp1_numerator: num [1:128825] 1.2489 NA NA -0.0298 NA ...
#>  $ elasticity_interp1    : num [1:128825] 1 NA NA -0.0239 NA ...
#> NULL
# Save file
if (bl_resave_to_data) {
  ppts_easia_weuro_world_elas_interp1 <- ppts_wrk_jnt_long_interp1
  write_csv(ppts_easia_weuro_world_elas_interp1, "../data/ppts_easia_weuro_world_elas_interp1.csv")
  usethis::use_data(ppts_easia_weuro_world_elas_interp1, overwrite = TRUE)
  
  ppts_easia_weuro_world_elas_raw <- ppts_wrk_jnt_long_val
  write_csv(ppts_easia_weuro_world_elas_raw, "../data/ppts_easia_weuro_world_elas_raw.csv")
  usethis::use_data(ppts_easia_weuro_world_elas_raw, overwrite = TRUE)
}