Data Processing
- for language enrollment rates prediction model
Doris Chen
2024-04-05
Load packages
library(openxlsx)
library(plyr)
library(tidyverse)
library(lubridate)
library(fs)
library(zoo)Language Enrollments
To match the data availability from US Census, we will extract language enrollments data from the Modern Language Association database as follows:
- Chinese/Japanese/Filipino: 1958-2021;
- Korean: 1970-2021;
- Hindi/Vietnamese: 1980-2021
# Load the data
MLA <- read.xlsx("https://www.mla.org/content/download/191323/file/Historical-language-enrollments-1958-2021.xlsx")
# Check column names
colnames(MLA)# Create a data frame for total enrollments for each census
totl_lan <- MLA %>%
filter(TERM == "Fall") %>%
dplyr::rename(Year = SRVY_YEAR) %>%
dplyr::group_by(Year) %>%
dplyr::summarise(Totl_Lan = sum(ALL.LEVEL.TOTAL, na.rm = TRUE)) %>%
dplyr::select(Year, Totl_Lan)
totl_lan <- totl_lan[!(totl_lan$Year == 2020), ]# Select needed languages and features
enrollments <- MLA %>%
filter(grepl("CHINESE|MANDARIN|JAPANESE|KOREAN|FILIPINO|HINDI|VIETNAMESE", LANGUAGE)) %>%
filter(TERM == "Fall") %>%
dplyr::rename(Year = SRVY_YEAR, Language = LANGUAGE) %>%
select(Year, Language, ALL.LEVEL.TOTAL)
summary(enrollments)## Year Language ALL.LEVEL.TOTAL
## Min. :1958 Length:19312 Min. : 0.00
## 1st Qu.:1995 Class :character 1st Qu.: 14.00
## Median :2006 Mode :character Median : 32.00
## Mean :2003 Mean : 67.66
## 3rd Qu.:2016 3rd Qu.: 77.00
## Max. :2021 Max. :6620.00
## NA's :53# Change data types
enrollments <- enrollments %>%
mutate(Language = as.factor(Language))
# Check all language course names
unique(enrollments$Language)## [1] CHINESE JAPANESE
## [3] MANDARIN KOREAN
## [5] JAPANESE, CLASSICAL FILIPINO/PILIPINO/TAGALOG
## [7] HINDI VIETNAMESE
## [9] CHINESE, CLASSICAL HINDI-URDU
## [11] KOREAN, CLASSICAL CHINESE, PRE-MODERN
## 12 Levels: CHINESE CHINESE, CLASSICAL ... VIETNAMESE# Combine related language courses
enrollments$Language <- recode(enrollments$Language, "CHINESE" = "Chinese", "CHINESE, CLASSICAL" = "Chinese",
"CHINESE, PRE-MODERN" = "Chinese", "MANDARIN" = "Chinese", "JAPANESE" = "Japanese",
"JAPANESE, CLASSICAL" = "Japanese", "KOREAN" = "Korean",
"KOREAN, CLASSICAL" = "Korean", "HINDI-URDU" = "Hindi",
"HINDI" = "Hindi", "VIETNAMESE" = "Vietnamese",
"FILIPINO/PILIPINO/TAGALOG" = "Filipino")
# Calculate enrollments for each year-term-language
enrollments <- enrollments %>%
dplyr::group_by(Year, Language) %>%
dplyr::summarise(Lang_Enrol = sum(ALL.LEVEL.TOTAL, na.rm = TRUE))
# Remove the enrollments of 2020 which was generated by a sample survey due to COVID-19
enrollments <- enrollments %>%
filter(Year != "2020")
# Remove 1958-1969 Korean enrollments and 1958-1979 Hindi/Vietnamese enrollments
enrollments <- enrollments %>%
filter(!(Year < 1970 & Language == "Korean")) %>%
filter(!(Year < 1980 & Language %in% c("Hindi", "Vietnamese")))
summary(enrollments)## Year Language Lang_Enrol
## Min. :1958 Chinese :22 Min. : 1.0
## 1st Qu.:1974 Filipino :21 1st Qu.: 648.8
## Median :1990 Hindi :12 Median : 2162.0
## Mean :1990 Japanese :22 Mean :11653.2
## 3rd Qu.:2006 Korean :15 3rd Qu.:11403.5
## Max. :2021 Vietnamese:12 Max. :72379.0There is only 21 Filipino data while it supposed to be 22. From MLA database, the enrollments of Filipino in 1961 is 0. We’ll add the data into the data frame.
enrollments[nrow(enrollments)+1, ] = list(1961, "Filipino", 0)# Join the enrollments and the totl_lan table to calculate the percentage of each language course enrollments over the total language course enrollments that year
enrollments <- left_join(enrollments, totl_lan, by = "Year")
enrollments <- enrollments %>%
mutate(Lang_Enrol_Pct = round(Lang_Enrol / Totl_Lan, 4)) %>%
select(-Totl_Lan)We will interpolate the language enrollments data for the years between two nearest census (MLA conducted 26 census from 1958 to 2021) using spline.
# Extend the data frame with the years needing interpolate
all_years <- seq(1958, 2021, by = 1)
ipt <- data.frame(Year = c(rep(all_years[!(all_years %in% enrollments[enrollments$Language == "Chinese",]$Year)], 3),
all_years[!(all_years %in% enrollments[enrollments$Language == "Korean",]$Year) & all_years > 1969],
rep(all_years[!(all_years %in% enrollments[enrollments$Language == "Vietnamese",]$Year) & all_years > 1979], 2)),
Language = c(rep("Chinese", 42), rep("Japanese", 42), rep("Filipino", 42),
rep("Korean", 37), rep("Vietnamese", 30), rep("Hindi", 30)),
Lang_Enrol = rep(NA, 223), Lang_Enrol_Pct = rep(NA, 223))
enrollments <- rbind(enrollments, ipt)
enrollments <- enrollments %>%
arrange(Language, Year)# Interpolating the missing data
for (lan in unique(enrollments$Language)){
enrollments[enrollments$Language == lan, "Lang_Enrol"] = round(na.spline(enrollments[enrollments$Language == lan, "Lang_Enrol"]))
enrollments[enrollments$Language == lan, "Lang_Enrol_Pct"] = round(na.spline(enrollments[enrollments$Language == lan, "Lang_Enrol_Pct"]), 4)
}
enrollments$Language <- as.factor(enrollments$Language)
summary(enrollments)## Year Language Lang_Enrol Lang_Enrol_Pct
## Min. :1958 Chinese :64 Min. : 0.0 Min. :0.00000
## 1st Qu.:1981 Filipino :64 1st Qu.: 727.8 1st Qu.:0.00070
## Median :1994 Hindi :42 Median : 2389.5 Median :0.00170
## Mean :1993 Japanese :64 Mean :13147.6 Mean :0.01004
## 3rd Qu.:2008 Korean :52 3rd Qu.:14369.5 3rd Qu.:0.01323
## Max. :2021 Vietnamese:42 Max. :72379.0 Max. :0.05550ggplot(data = enrollments, aes(x = as.factor(Year), y = Lang_Enrol, group = Language, col = Language))+
geom_line()+
geom_point()+
theme_classic()+
theme(axis.text.x = element_text(angle = 90))+
labs(title = "Language course enrollment trend", x = "Year", y = "Enrollment")
International trade
# Load trade data 1985-2023 from US census
US_trade <- read.xlsx("https://www.census.gov/foreign-trade/balance/country.xlsx")
summary(US_trade)us_total <- read.xlsx("https://www.census.gov/foreign-trade/statistics/historical/gands.xlsx", startRow = 4, cols = c(1, 6, 9))
colnames(us_total) <- c("Year", "Exp", "Imp")
us_total <- us_total %>%
mutate(US_Total = Exp + Imp) %>%
mutate(Year = year(as.Date(Year, "%Y"))) %>%
select(Year, US_Total)
us_total <- us_total[c(26:62), ]
summary(us_total)## Year US_Total
## Min. :1985 Min. : 554003
## 1st Qu.:1994 1st Qu.:1171549
## Median :2003 Median :2016661
## Mean :2003 Mean :2372515
## 3rd Qu.:2012 3rd Qu.:3738771
## Max. :2021 Max. :4615280# Select needed countries, features and years
trade <- as.data.frame(US_trade[US_trade$CTYNAME %in% c("China", "Korea, South", "Japan",
"India", "Vietnam", "Philippines"), ])
trade <- trade %>%
select(year, CTYNAME, IYR, EYR) %>%
filter(year <= 2021) %>%
mutate(Total_Trade = IYR + EYR) %>%
dplyr::rename(Language = CTYNAME, Year = year) %>%
mutate(Year = year(as.Date(Year, "%Y")), Language = as.factor(Language)) %>%
select(Year, Language, Total_Trade)
# Change country names to languages
trade$Language <- recode(trade$Language, "China" = "Chinese", "Korea, South" = "Korean",
"Japan" = "Japanese", "Vietnam" = "Vietnamese",
"India" = "Hindi", "Philippines" = "Filipino")
summary(trade)## Year Language Total_Trade
## Min. :1985 Chinese :37 Min. : 4.6
## 1st Qu.:1995 Hindi :37 1st Qu.: 15944.5
## Median :2004 Japanese :37 Median : 48219.3
## Mean :2003 Korean :37 Mean :101202.3
## 3rd Qu.:2012 Filipino :37 3rd Qu.:136013.4
## Max. :2021 Vietnamese:30 Max. :658795.4From the summary, we found that Vietnam only got 30 data point, let’s check which years are missing.
trade[trade$Language == "Vietnamese",]$Year ## [1] 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006
## [16] 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021The Vietnam - US trade data starts from 1992, from US Census, all figures are in millions of U.S. dollars, meaning before that the volume was less than 1 million, which we will treat it as 0.
# Join the us_total table with the trade table, to calculate the trade_ratio
trade <- left_join(trade, us_total, by = "Year")trade <- trade %>%
mutate(Trade_Pct = round(Total_Trade / US_Total, 4)) %>%
select(Year, Language, Total_Trade, Trade_Pct)Load trade data 1958–1984, which are derived from Statistical Abstract of the United States.
# Combine trade data from 1958-2021
trade <- rbind(read_csv("Data/Trade 1958-1984.csv"), trade)
trade$Language <- as.factor(trade$Language)
summary(trade)## Year Language Total_Trade Trade_Pct
## Min. :1958 Chinese :64 Min. : 0 Min. :0.00000
## 1st Qu.:1981 Filipino :64 1st Qu.: 3305 1st Qu.:0.00640
## Median :1994 Hindi :42 Median : 17709 Median :0.01575
## Mean :1993 Japanese :64 Mean : 68730 Mean :0.03786
## 3rd Qu.:2008 Korean :52 3rd Qu.: 78101 3rd Qu.:0.05158
## Max. :2021 Vietnamese:42 Max. :658795 Max. :0.18380ggplot(data = trade, aes(x = as.factor(as.character(Year)), y = Trade_Pct, group = Language, col = Language))+
geom_point()+
geom_line()+
scale_y_continuous(labels = scales::percent)+
theme_classic()+
theme(axis.text.x = element_text(angle = 90))+
labs(title = "US-foreign trade trend", x = "Year", y = "Percentage")
Total US university enrollments
# Load the data
university <- read.xlsx("https://nces.ed.gov/programs/digest/d23/tables/xls/tabn303.10.xlsx", startRow = 5)
university <- university[c(11:dim(university)[1]), c(1,2)]
university <- as.data.frame(university[university[,1] %in% all_years,])
colnames(university) <- c("Year", "Total_Stud")There are no enrollment data for 1958, 1960 and 1962 in the NCES dataset. We found the figures from a US census report and impute the missing value.
# Impute missing values
university[nrow(university)+1, ] <- c(1958, 3242000)
university[nrow(university)+1, ] <- c(1960, 3570000)
university[nrow(university)+1, ] <- c(1962, 4208000)
# Change the data type
university <- mutate(university, Year = year(as.Date(Year, "%Y")))
summary(university)## Year Total_Stud
## Min. :1958 Min. : 3242000
## 1st Qu.:1974 1st Qu.:10068328
## Median :1990 Median :13678598
## Mean :1990 Mean :13292322
## 3rd Qu.:2005 3rd Qu.:17554164
## Max. :2021 Max. :21019438American Community Survey and US Census data
We downloaded the American Community Survey(ACS) S0201 table from US census. The available years are 2010-2019 and 2021.
# Load seven CSV files into a list
file_paths <- fs::dir_ls("Data/S0201")
ACS_file <- list()
for (i in seq_along(file_paths)){
ACS_file[[i]] <- read_csv(
file = file_paths[[i]], show_col_types = FALSE
)
}# Clean the data
acs_df <- list()
Year <- c(seq(2010, 2019, by = 1), 2021)
for (i in 1:length(ACS_file)){
fil <- as.data.frame(ACS_file[i])
fil$`Label..Grouping.` <- str_trim(fil$`Label..Grouping.`)
fil <- fil[c(2, 97, 106, 165, 167, 168, 235, 272), ]
colnames(fil) <- c("feature", "United_States", "Chinese", "Japanese",
"Filipino", "Korean", "Hindi", "Vietnamese")
us_fil <- fil[, c(1,2)]
us_fil$United_States <- as.numeric(gsub("\\%", "",
gsub("\\,", "", us_fil$United_States)))
fil <- fil[, c(1, 3:8)]
rownames(fil) <- c(fil$feature)
fil <- fil[, c(2:7)]
fil <- t(fil)
fil <- as.data.frame(fil)
fil <- cbind(data.frame(Language = rownames(fil), Year = rep(Year[i], 6)), fil)
rownames(fil) <- NULL
cols_num <- 3:10
fil[, cols_num] <- lapply(fil[, cols_num], function(fil){as.numeric(gsub("\\,|%", "", fil))})
fil <- fil %>%
mutate(`Bachelor's degree or higher` = `Bachelor's degree or higher`*0.01,
`Language other than English` = `Language other than English`*0.01,
`Speak English less than \"very well\"`=`Speak English less than \"very well\"`*0.01,
`All families` = `All families`*0.01) %>%
mutate(HEdu_Pop = round(`Population 25 years and over` * `Bachelor's degree or higher`),
Lang_Pop = round(`Population 5 years and over` * `Language other than English`),
Eng_LesVw_Pop = round(`Speak English less than \"very well\"` * Lang_Pop)) %>%
dplyr::rename(HEdu_Pct = `Bachelor's degree or higher`, Pop = `Total population`,
Med_Inc = `Median household income (dollars)`, Pvt_Pct = `All families`) %>%
mutate(Pop_UsPct = round(Pop / us_fil[1,2], 4),
Lang_Pop_UsPct = round(Lang_Pop / us_fil[1,2], 4),
Eng_LesVw_Pop_UsPct = round(Eng_LesVw_Pop / us_fil[1,2], 4),
HEdu_UsPct = round(HEdu_Pop / round(us_fil[2,2] * us_fil[3,2] * 0.01), 4),
HEdu_Ratio = round(HEdu_Pct / (us_fil[3,2] * 0.01), 2),
Inc_Ratio = round(Med_Inc / us_fil[7,2], 2),
Pvt_Ratio = round(Pvt_Pct / (us_fil[8,2] * 0.01), 2),
) %>%
mutate(Language = as.factor(Language)) %>%
select(Year, Language, Pop, Pop_UsPct, Lang_Pop, Lang_Pop_UsPct, Eng_LesVw_Pop,
Eng_LesVw_Pop_UsPct, HEdu_Pop, HEdu_UsPct, HEdu_Pct, HEdu_Ratio,
Med_Inc, Inc_Ratio, Pvt_Pct, Pvt_Ratio)
acs_df[[i]] <- fil
}
# Merge all data frames into one ACS2010-2021
ACS10_21 <- acs_df[[1]]
for (i in 2:11){
ACS10_21 <- rbind(ACS10_21, acs_df[[i]])
}
summary(ACS10_21)## Year Language Pop Pop_UsPct
## Min. :2010 Chinese :11 Min. : 742549 Min. :0.002200
## 1st Qu.:2012 Filipino :11 1st Qu.:1457178 1st Qu.:0.004525
## Median :2015 Hindi :11 Median :2204688 Median :0.006900
## Mean :2015 Japanese :11 Mean :2401309 Mean :0.007479
## 3rd Qu.:2018 Korean :11 3rd Qu.:3482517 3rd Qu.:0.011125
## Max. :2021 Vietnamese:11 Max. :4404678 Max. :0.013400
## Lang_Pop Lang_Pop_UsPct Eng_LesVw_Pop Eng_LesVw_Pop_UsPct
## Min. : 316515 Min. :0.001000 Min. : 72060 Min. :0.000200
## 1st Qu.:1056061 1st Qu.:0.003300 1st Qu.: 378358 1st Qu.:0.001200
## Median :1562282 Median :0.004900 Median : 461754 Median :0.001500
## Mean :1705465 Mean :0.005311 Mean : 581869 Mean :0.001814
## 3rd Qu.:2619424 3rd Qu.:0.008175 3rd Qu.: 720935 3rd Qu.:0.002275
## Max. :3348155 Max. :0.010200 Max. :1492502 Max. :0.004600
## HEdu_Pop HEdu_UsPct HEdu_Pct HEdu_Ratio
## Min. : 268719 Min. :0.004300 Min. :0.2520 Min. :0.880
## 1st Qu.: 352524 1st Qu.:0.005225 1st Qu.:0.4808 1st Qu.:1.562
## Median : 777614 Median :0.011850 Median :0.5260 Median :1.705
## Mean : 947692 Mean :0.014108 Mean :0.5204 Mean :1.685
## 3rd Qu.:1407387 3rd Qu.:0.022925 3rd Qu.:0.5697 3rd Qu.:1.817
## Max. :2336589 Max. :0.030100 Max. :0.7680 Max. :2.510
## Med_Inc Inc_Ratio Pvt_Pct Pvt_Ratio
## Min. : 50316 Min. :1.010 Min. :0.03500 Min. :0.3100
## 1st Qu.: 64758 1st Qu.:1.120 1st Qu.:0.04500 1st Qu.:0.4425
## Median : 76424 Median :1.300 Median :0.06450 Median :0.6750
## Mean : 78519 Mean :1.372 Mean :0.07518 Mean :0.7203
## 3rd Qu.: 88506 3rd Qu.:1.538 3rd Qu.:0.10475 3rd Qu.:0.9775
## Max. :141906 Max. :2.040 Max. :0.14000 Max. :1.1900We derive US census 1950 – 2000 data from the US decennial census report. These data share the same features as the ACS data above.
# Load US census 1950-2000 data
US_census <- read_csv("Data/Census 1950-2000.csv")## Rows: 28 Columns: 16
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Language
## dbl (15): Year, Pop, Pop_UsPct, Lang_Pop, Lang_Pop_UsPct, Eng_LesVw_Pop, Eng...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.summary(US_census)## Year Language Pop Pop_UsPct
## Min. :1950 Length:28 Min. : 61636 Min. :0.000400
## 1st Qu.:1970 Class :character 1st Qu.: 318551 1st Qu.:0.001525
## Median :1980 Mode :character Median : 665439 Median :0.002850
## Mean :1980 Mean : 751007 Mean :0.003046
## 3rd Qu.:1990 3rd Qu.: 904890 3rd Qu.:0.003650
## Max. :2000 Max. :2432585 Max. :0.008600
##
## Lang_Pop Lang_Pop_UsPct Eng_LesVw_Pop Eng_LesVw_Pop_UsPct
## Min. : 53528 Min. :0.000300 Min. : 59740 Min. :0.000300
## 1st Qu.: 278014 1st Qu.:0.001125 1st Qu.: 138952 1st Qu.:0.000625
## Median : 423328 Median :0.001750 Median : 244145 Median :0.001050
## Mean : 579355 Mean :0.002277 Mean : 338464 Mean :0.001306
## 3rd Qu.: 789063 3rd Qu.:0.003025 3rd Qu.: 393395 3rd Qu.:0.001475
## Max. :2022145 Max. :0.007200 Max. :1166455 Max. :0.004100
## NA's :6 NA's :6 NA's :10 NA's :10
## HEdu_Pop HEdu_UsPct HEdu_Pct HEdu_Ratio
## Min. : 1370 Min. :0.000300 Min. :0.0350 Min. :0.560
## 1st Qu.: 27848 1st Qu.:0.002575 1st Qu.:0.1703 1st Qu.:1.427
## Median :124312 Median :0.004850 Median :0.3410 Median :1.800
## Mean :182506 Mean :0.005811 Mean :0.3008 Mean :1.824
## 3rd Qu.:266324 3rd Qu.:0.007875 3rd Qu.:0.4100 3rd Qu.:2.260
## Max. :798828 Max. :0.018000 Max. :0.6390 Max. :3.300
##
## Med_Inc Inc_Ratio Pvt_Pct Pvt_Ratio
## Min. : 1689 Min. :0.760 Min. :0.0630 Min. :0.5000
## 1st Qu.: 9282 1st Qu.:0.990 1st Qu.:0.0970 1st Qu.:0.7825
## Median :21262 Median :1.120 Median :0.1340 Median :0.8750
## Mean :25636 Mean :1.149 Mean :0.1495 Mean :1.0454
## 3rd Qu.:42164 3rd Qu.:1.323 3rd Qu.:0.1510 3rd Qu.:1.1250
## Max. :63669 Max. :1.510 Max. :0.3550 Max. :3.0600
## US_census$Language <- as.factor(US_census$Language)
# Combine ACS10_21 and US_census data into one data frame
US_census <- rbind(US_census, ACS10_21)However, there are still missing data for the years between the decennial census. As these are demographic data which usually change slowly and gradually, we will use cubic spline interpolation to estimate the missing data between two nearest decennial census.
# Extend the US_census data frame for interpolating data of the years between two decennial census
ipt <- data.frame(Year = c(rep(all_years[!(all_years %in% US_census$Year)],3),
all_years[all_years > 1969 & !(all_years %in% US_census$Year)],
rep(all_years[all_years > 1979 & !(all_years %in% US_census$Year)], 2)),
Language = c(rep("Chinese", 48), rep("Japanese", 48), rep("Filipino", 48),
rep("Korean", 37), rep("Hindi", 28), rep("Vietnamese", 28)))
for (i in 3:ncol(US_census)){
ipt[, i] = rep(NA, nrow(ipt))
}
colnames(ipt) <- colnames(US_census)
US_census <- rbind(US_census, ipt)
US_census <- US_census %>%
arrange(Language, Year)# Interpolate missing data between two nearest decennial census using cubic spline interpolation
# The data related to Lang_Pop are only available since 1970; data related to Eng_LesVw are only available since 1980.
for (lan in unique(US_census$Language)){
US_census[US_census$Language == lan & US_census$Year > 1969, "Lang_Pop"] =
na.spline(US_census[US_census$Language == lan & US_census$Year > 1969, "Lang_Pop"])
US_census[US_census$Language == lan & US_census$Year > 1969, "Lang_Pop_UsPct"] =
na.spline(US_census[US_census$Language == lan & US_census$Year > 1969, "Lang_Pop_UsPct"])
US_census[US_census$Language == lan & US_census$Year > 1979, "Eng_LesVw_Pop"] =
na.spline(US_census[US_census$Language == lan & US_census$Year > 1979, "Eng_LesVw_Pop"])
US_census[US_census$Language == lan & US_census$Year > 1979, "Eng_LesVw_Pop_UsPct"] =
na.spline(US_census[US_census$Language == lan & US_census$Year > 1979, "Eng_LesVw_Pop_UsPct"])
}# Interpolate the rest missing data
col_nam <- colnames(US_census)[c(3:4, 9:16)]
lang <- unique(US_census$Language)
for (nam in col_nam){
for (lan in lang){
US_census[US_census$Language == lan, nam] = na.spline(US_census[US_census$Language == lan, nam])
}
}# Remove the unnecessary years
US_census <- US_census[US_census$Year %in% all_years, ]
# Round the figures to desired number of digits
for (nam in colnames(US_census)[3:16]){
if (grepl("UsPct", nam)){
US_census[, nam] = round(US_census[, nam], 4)
}
else if (grepl("_Pct", nam)){
US_census[, nam] = round(US_census[, nam], 3)
}
else if (grepl("Ratio", nam)){
US_census[, nam] = round(US_census[, nam], 2)
} else {
US_census[, nam] = round(US_census[, nam])
}
}
summary(US_census)## Year Language Pop Pop_UsPct
## Min. :1958 Chinese :64 Min. : 74264 Min. :0.000400
## 1st Qu.:1981 Filipino :64 1st Qu.: 606186 1st Qu.:0.002500
## Median :1994 Hindi :42 Median : 895283 Median :0.003550
## Mean :1993 Japanese :64 Mean :1316853 Mean :0.004671
## 3rd Qu.:2008 Korean :52 3rd Qu.:1723252 3rd Qu.:0.006025
## Max. :2021 Vietnamese:42 Max. :4404678 Max. :0.013400
##
## Lang_Pop Lang_Pop_UsPct Eng_LesVw_Pop Eng_LesVw_Pop_UsPct
## Min. : 31614 Min. :0.00020 Min. : 44146 Min. :0.00020
## 1st Qu.: 343175 1st Qu.:0.00150 1st Qu.: 204825 1st Qu.:0.00080
## Median : 736797 Median :0.00290 Median : 377164 Median :0.00130
## Mean : 973738 Mean :0.00337 Mean : 448984 Mean :0.00156
## 3rd Qu.:1382340 3rd Qu.:0.00450 3rd Qu.: 543873 3rd Qu.:0.00202
## Max. :3348155 Max. :0.01020 Max. :1492502 Max. :0.00460
## NA's :36 NA's :36 NA's :76 NA's :76
## HEdu_Pop HEdu_UsPct HEdu_Pct HEdu_Ratio
## Min. : 4343 Min. :0.000600 Min. :0.0550 Min. :0.760
## 1st Qu.: 90257 1st Qu.:0.004600 1st Qu.:0.2567 1st Qu.:1.620
## Median : 258221 Median :0.006300 Median :0.3925 Median :1.800
## Mean : 423966 Mean :0.008906 Mean :0.3904 Mean :1.840
## 3rd Qu.: 552831 3rd Qu.:0.012025 3rd Qu.:0.5050 3rd Qu.:2.212
## Max. :2336589 Max. :0.030100 Max. :0.7680 Max. :3.300
##
## Med_Inc Inc_Ratio Pvt_Pct Pvt_Ratio
## Min. : 2817 Min. :0.760 Min. :0.0260 Min. :0.2500
## 1st Qu.: 19928 1st Qu.:1.067 1st Qu.:0.0660 1st Qu.:0.5700
## Median : 42842 Median :1.235 Median :0.0980 Median :0.8500
## Mean : 44165 Mean :1.243 Mean :0.1084 Mean :0.9129
## 3rd Qu.: 63466 3rd Qu.:1.383 3rd Qu.:0.1340 3rd Qu.:1.1200
## Max. :141906 Max. :2.040 Max. :0.3550 Max. :3.0600
## International Students
# Load the data
foreign_stud <- read.xlsx("https://opendoorsdata.org/?download=https://opendoorsdata.org/wp-content/uploads/2023/11/Census_All-Places-of-Origin_OD23.xlsx", startRow = 3)# Extract total international student data for each year
world_total <- as.data.frame(foreign_stud[264, c(4:35)])
# Change the wide table to a long table
world_total <- pivot_longer(world_total, everything(), names_to = "Year", values_to = "world_total")
# Edit the year value and only keep the start year (fall)
world_total$Year <- substr(world_total$Year, 1, 4)
# Change the data type
world_total <- world_total %>%
mutate(Year = year(as.Date(Year, "%Y")), world_total = as.numeric(world_total))
summary(world_total)## Year world_total
## Min. :1954 Min. : 34232
## 1st Qu.:1993 1st Qu.: 436189
## Median :2006 Median : 584660
## Mean :2000 Mean : 620158
## 3rd Qu.:2013 3rd Qu.: 893063
## Max. :2021 Max. :1095299# Extract data related to the countries of interest
# Select needed rows and columns
intl_stud <- as.data.frame(foreign_stud[foreign_stud$Place.of.Origin %in% c("China", "South Korea", "Japan",
"India", "Vietnam", "Philippines"), ])
intl_stud <- intl_stud[, -c(1, 3, 36:39)]
# change the wide table to a long table
intl_stud <- pivot_longer(intl_stud, !Place.of.Origin, names_to = "Year", values_to = "Intl_Stud")
# Edit the year value and only keep the start year (fall)
intl_stud$Year <- substr(intl_stud$Year, 1, 4)
summary(intl_stud)## Place.of.Origin Year Intl_Stud
## Length:192 Length:192 Length:192
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :characterintl_stud$Intl_Stud <- gsub("\\-", "0", intl_stud$Intl_Stud)
intl_stud <- intl_stud %>%
dplyr::rename(Language = Place.of.Origin) %>%
mutate(Language = as.factor(Language), Year = year(as.Date(Year, "%Y")),
Intl_Stud = as.numeric(Intl_Stud)) %>%
select(Year, Language, Intl_Stud)
intl_stud$Language <- recode(intl_stud$Language, "China" = "Chinese", "South Korea" = "Korean",
"Japan" = "Japanese", "Vietnam" = "Vietnamese",
"India" = "Hindi", "Philippines" = "Filipino")# Join the world_total data with the intl_stud data to calculate the percentage of each country's international student over the total international student in US
intl_stud <- left_join(intl_stud, world_total, by = "Year")
intl_stud <- intl_stud %>%
mutate(Intl_Stud_Pct = round(Intl_Stud / world_total, 3)) %>%
select(Year, Language, Intl_Stud, Intl_Stud_Pct)
summary(intl_stud)## Year Language Intl_Stud Intl_Stud_Pct
## Min. :1954 Chinese :32 Min. : 0 Min. :0.00000
## 1st Qu.:1993 Hindi :32 1st Qu.: 3516 1st Qu.:0.01275
## Median :2006 Japanese :32 Median : 20340 Median :0.04300
## Mean :2000 Filipino :32 Mean : 51472 Mean :0.07036
## 3rd Qu.:2013 Korean :32 3rd Qu.: 62538 3rd Qu.:0.10425
## Max. :2021 Vietnamese:32 Max. :372532 Max. :0.34700The historical data from Open Doors only provides figures every five years for the years before 2000. We found data for some years between 1960 and 1990 from the Open Doors annual reports available online and NCES Digest of Education Statistics.
# load international students data 1960-1990
stu60_98 <- read_csv("Data/Intl Students 1960-1998.csv")## Rows: 67 Columns: 4
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Language
## dbl (3): Year, Intl_Stud, Intl_Stud_Pct
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.intl_stud <- rbind(intl_stud, stu60_98)
intl_stud <- as.data.frame(intl_stud)
intl_stud <- arrange(intl_stud, Language, Year)
summary(intl_stud)## Year Language Intl_Stud Intl_Stud_Pct
## Min. :1954 Chinese :44 Min. : 0 Min. :0.0000
## 1st Qu.:1989 Hindi :42 1st Qu.: 3500 1st Qu.:0.0110
## Median :2000 Japanese :44 Median : 20713 Median :0.0460
## Mean :1997 Filipino :44 Mean : 44208 Mean :0.0659
## 3rd Qu.:2011 Korean :43 3rd Qu.: 49428 3rd Qu.:0.0960
## Max. :2021 Vietnamese:42 Max. :372532 Max. :0.3470
## NA's :4 NA's :4However, we cannot find data for all the years required for this project. Therefore, we will impute missing data using spline, similar to our approach with the census data.
# Extend the data frame for missing years of international students data
ipt <- data.frame(
Year = c(rep(all_years[!(all_years %in% intl_stud$Year)], 3),
all_years[all_years > 1969 & !(all_years %in% intl_stud$Year)],
rep(all_years[all_years > 1979 & !(all_years %in% intl_stud$Year)],2)),
Language = c(rep("Chinese", length(all_years[!(all_years %in% intl_stud$Year)])),
rep("Japanese", length(all_years[!(all_years %in% intl_stud$Year)])),
rep("Filipino", length(all_years[!(all_years %in% intl_stud$Year)])),
rep("Korean", length(all_years[all_years > 1969 & !(all_years %in% intl_stud$Year)])),
rep("Hindi", length(all_years[all_years>1979 & !(all_years %in% intl_stud$Year)])),
rep("Vietnamese", length(all_years[all_years>1979 & !(all_years %in% intl_stud$Year)]))))
ipt[, ncol(ipt)+1] <- rep(NA, nrow(ipt))
ipt[, ncol(ipt)+1] <- rep(NA, nrow(ipt))
colnames(ipt)[3:4] <- c("Intl_Stud", "Intl_Stud_Pct")
intl_stud <- rbind(intl_stud, ipt)
intl_stud <- arrange(intl_stud, Language, Year)We will interpolate missing data as following: 1. The number of Chinese student increased dramatically after the year 1979, so we will use linear interpolation via na.approx for Chinese students before year 1980 to avoid negative values generating by na.spine. 2. The rest of the missing data are interpolate by na.spline.
intl_stud[intl_stud$Year < 1980 & intl_stud$Language == "Chinese", "Intl_Stud"] <-
round(na.approx(intl_stud[intl_stud$Year < 1980 & intl_stud$Language == "Chinese", "Intl_Stud"]))
intl_stud[intl_stud$Year < 1980 & intl_stud$Language == "Chinese", "Intl_Stud_Pct"] <-
round(na.approx(intl_stud[intl_stud$Year < 1980 & intl_stud$Language == "Chinese", "Intl_Stud_Pct"]), 3)
lang <- unique(intl_stud$Language)
for (lan in lang){
intl_stud[intl_stud$Language == lan, "Intl_Stud"] = round(na.spline(intl_stud[intl_stud$Language == lan, "Intl_Stud"]))
intl_stud[intl_stud$Language == lan, "Intl_Stud_Pct"] = round(na.spline(intl_stud[intl_stud$Language == lan, "Intl_Stud_Pct"]), 3)
}
# Select years and remove unwanted data
intl_stud <- intl_stud[intl_stud$Year %in% all_years, ]
intl_stud <- intl_stud[!(intl_stud$Language == "Korean" & intl_stud$Year < 1970), ]
intl_stud <- intl_stud[!(intl_stud$Language %in% c("Hindi", "Vietnamese") & intl_stud$Year < 1980), ]
summary(intl_stud)## Year Language Intl_Stud Intl_Stud_Pct
## Min. :1958 Chinese :64 Min. : 0 Min. :0.00000
## 1st Qu.:1981 Hindi :42 1st Qu.: 3224 1st Qu.:0.01100
## Median :1994 Japanese :64 Median : 13474 Median :0.03550
## Mean :1993 Filipino :64 Mean : 35901 Mean :0.05625
## 3rd Qu.:2008 Korean :52 3rd Qu.: 42587 3rd Qu.:0.08125
## Max. :2021 Vietnamese:42 Max. :372532 Max. :0.34700Party government
We derive the data of party government from History, Art & Archives
party_gov <- read_csv("Data/Party government.csv")## Rows: 64 Columns: 3
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Presidency, Party_Gov
## dbl (1): Year
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.party_gov <- party_gov %>%
mutate(Presidency = as.factor(Presidency), Party_Gov = as.factor(Party_Gov))
summary(party_gov)## Year Presidency Party_Gov
## Min. :1958 Democrat :29 Divided:41
## 1st Qu.:1974 Republican:35 Unified:23
## Median :1990
## Mean :1990
## 3rd Qu.:2005
## Max. :2021Combine all data frames
all_data <- join_all(list(enrollments, US_census, intl_stud, trade), by = c("Year", "Language"), type = "left")
all_data <- join_all(list(all_data, university, party_gov), by = "Year", type = "left")
# Add a column "lan_UsPct" for the percentage of a language course enrollment over total US college enrollment
all_data <- all_data %>%
mutate(Lan_UsPct = round(Lang_Enrol/Total_Stud, 5))
summary(all_data)## Year Language Lang_Enrol Lang_Enrol_Pct
## Min. :1958 Chinese :64 Min. : 0.0 Min. :0.00000
## 1st Qu.:1981 Filipino :64 1st Qu.: 727.8 1st Qu.:0.00070
## Median :1994 Hindi :42 Median : 2389.5 Median :0.00170
## Mean :1993 Japanese :64 Mean :13147.6 Mean :0.01004
## 3rd Qu.:2008 Korean :52 3rd Qu.:14369.5 3rd Qu.:0.01323
## Max. :2021 Vietnamese:42 Max. :72379.0 Max. :0.05550
##
## Pop Pop_UsPct Lang_Pop Lang_Pop_UsPct
## Min. : 74264 Min. :0.000400 Min. : 31614 Min. :0.00020
## 1st Qu.: 606186 1st Qu.:0.002500 1st Qu.: 343175 1st Qu.:0.00150
## Median : 895283 Median :0.003550 Median : 736797 Median :0.00290
## Mean :1316853 Mean :0.004671 Mean : 973738 Mean :0.00337
## 3rd Qu.:1723252 3rd Qu.:0.006025 3rd Qu.:1382340 3rd Qu.:0.00450
## Max. :4404678 Max. :0.013400 Max. :3348155 Max. :0.01020
## NA's :36 NA's :36
## Eng_LesVw_Pop Eng_LesVw_Pop_UsPct HEdu_Pop HEdu_UsPct
## Min. : 44146 Min. :0.00020 Min. : 4343 Min. :0.000600
## 1st Qu.: 204825 1st Qu.:0.00080 1st Qu.: 90257 1st Qu.:0.004600
## Median : 377164 Median :0.00130 Median : 258221 Median :0.006300
## Mean : 448984 Mean :0.00156 Mean : 423966 Mean :0.008906
## 3rd Qu.: 543873 3rd Qu.:0.00202 3rd Qu.: 552831 3rd Qu.:0.012025
## Max. :1492502 Max. :0.00460 Max. :2336589 Max. :0.030100
## NA's :76 NA's :76
## HEdu_Pct HEdu_Ratio Med_Inc Inc_Ratio
## Min. :0.0550 Min. :0.760 Min. : 2817 Min. :0.760
## 1st Qu.:0.2567 1st Qu.:1.620 1st Qu.: 19928 1st Qu.:1.067
## Median :0.3925 Median :1.800 Median : 42842 Median :1.235
## Mean :0.3904 Mean :1.840 Mean : 44165 Mean :1.243
## 3rd Qu.:0.5050 3rd Qu.:2.212 3rd Qu.: 63466 3rd Qu.:1.383
## Max. :0.7680 Max. :3.300 Max. :141906 Max. :2.040
##
## Pvt_Pct Pvt_Ratio Intl_Stud Intl_Stud_Pct
## Min. :0.0260 Min. :0.2500 Min. : 0 Min. :0.00000
## 1st Qu.:0.0660 1st Qu.:0.5700 1st Qu.: 3224 1st Qu.:0.01100
## Median :0.0980 Median :0.8500 Median : 13474 Median :0.03550
## Mean :0.1084 Mean :0.9129 Mean : 35901 Mean :0.05625
## 3rd Qu.:0.1340 3rd Qu.:1.1200 3rd Qu.: 42587 3rd Qu.:0.08125
## Max. :0.3550 Max. :3.0600 Max. :372532 Max. :0.34700
##
## Total_Trade Trade_Pct Total_Stud Presidency
## Min. : 0 Min. :0.00000 Min. : 3242000 Democrat :144
## 1st Qu.: 3305 1st Qu.:0.00640 1st Qu.:12205679 Republican:184
## Median : 17709 Median :0.01575 Median :14358953
## Mean : 68730 Mean :0.03786 Mean :14352656
## 3rd Qu.: 78101 3rd Qu.:0.05158 3rd Qu.:18658756
## Max. :658795 Max. :0.18380 Max. :21019438
##
## Party_Gov Lan_UsPct
## Divided:220 Min. :0.0000000
## Unified:108 1st Qu.:0.0000575
## Median :0.0001400
## Mean :0.0008159
## 3rd Qu.:0.0010300
## Max. :0.0037600
## # Save the data frame as csv file
write_csv(all_data, "Data/all_data.csv")
write_csv(totl_lan, "Data/All_Lang_Enrol.csv")
write_csv(university, "Data/UsCollege_Enrol.csv")
write_csv(enrollments, "Data/Asian_Lang_Enrol.csv")
write_csv(trade, "Data/trade.csv")
write_csv(US_census, "Data/US_census.csv")