Charitable Trust Data Cleaning and Analysis 2023
Meng Ye
03/01/2023
# environment setup to run ordered logit properly
options(contrasts = rep("contr.treatment", 2))library(tidyverse)
library(lubridate) # For working with dates
library(scales)
library(ggridges) # For ridge plots
library(gghalves)
library(mapchina)
library(modelsummary)
library(marginaleffects)
library(ggrepel)
library(nnet)trust_raw <- read_csv("data/trust_2023_coded.csv")trust_data <- trust_raw %>%
mutate(term_limit_raw = parse_number(term)) %>%
mutate(term_limit = case_when(
str_detect(term, "月") ~ term_limit_raw / 12,
TRUE ~ term_limit_raw)) %>%
mutate(asset_num = parse_number(asset)*10000, # convert to 1 RMB unit
asset_size_log = log(asset_num),
asset_size_1000 = asset_num/1000) %>%
mutate(file_year = year(mdy(file_time)),
Year = as.factor(file_year)) %>%
mutate(term_category = case_when(
term_limit <= 5 ~ "1-5 years",
term_limit >= 6 ~ "6+ years",
TRUE ~ "no limit")) %>%
mutate(term_category = ordered(term_category,
levels = c("1-5 years", "6+ years", "no limit")),
collaboration_type = case_when(
structure == 0 ~ "loose/no",
structure == 1 ~ "same role",
structure == 2 ~ "different roles"),
collaboration_type = fct_rev(collaboration_type),
collaborate = ifelse(structure == 0, FALSE, TRUE),
charity_league = ifelse(str_detect(settlor, "慈善会|慈善协会|慈善总会|慈善联合会") |
str_detect(trustee, "慈善会|慈善协会|慈善总会|慈善联合会"), TRUE, FALSE),
league = fct_rev(factor(charity_league)),
co_trustee = ifelse(structure == 1, TRUE, FALSE),
co_trustee = ifelse(structure == 0, NA, co_trustee))#self reference:distribution of trusts with terms of <= 10 years
trust_data %>%
filter(!is.na(term_limit) & term_limit <= 10) %>%
ggplot() +
geom_histogram(aes(x = term_limit))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
trust_data %>%
count(collaboration_type)## # A tibble: 4 × 2
## collaboration_type n
## <fct> <int>
## 1 same role 96
## 2 loose/no 568
## 3 different roles 515
## 4 <NA> 1descriptive analysis
table1 <- datasummary((asset_size_1000 * (Mean + SD) + Year + league + term_category) ~
(collaboration_type + 1) ,
data = trust_data, fmt = 0)## Warning in !is.null(rmarkdown::metadata$output) && rmarkdown::metadata$output
## %in% : 'length(x) = 2 > 1' in coercion to 'logical(1)'table1| same role | loose/no | different roles | All | ||
|---|---|---|---|---|---|
| asset_size_1000 | Mean | 9539 | 3269 | 4648 | 4378 |
| SD | 54767 | 25825 | 28918 | 30493 | |
| Year | 2016 | 1 | 13 | 8 | 22 |
| 2017 | 6 | 25 | 12 | 43 | |
| 2018 | 9 | 49 | 29 | 87 | |
| 2019 | 14 | 79 | 33 | 126 | |
| 2020 | 11 | 164 | 93 | 268 | |
| 2021 | 18 | 126 | 101 | 245 | |
| 2022 | 37 | 112 | 239 | 389 | |
| league | TRUE | 54 | 6 | 287 | 347 |
| FALSE | 40 | 473 | 228 | 741 | |
| term_category | 1-5 years | 38 | 215 | 167 | 421 |
| 6+ years | 13 | 70 | 80 | 163 | |
| no limit | 45 | 283 | 268 | 596 |
logit regression
#benchmark model
model_logit1 <- glm(collaborate ~ asset_size_log + file_year + term_category + charity_league,
data = trust_data, family = "binomial")
summary(model_logit1)##
## Call:
## glm(formula = collaborate ~ asset_size_log + file_year + term_category +
## charity_league, family = "binomial", data = trust_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.9437 -0.8224 0.1597 0.2817 2.0297
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -371.94447 108.45168 -3.430 0.000605 ***
## asset_size_log 0.16850 0.03997 4.215 2.49e-05 ***
## file_year 0.18270 0.05363 3.407 0.000658 ***
## term_category6+ years 1.08246 0.22411 4.830 1.36e-06 ***
## term_categoryno limit -0.21869 0.17608 -1.242 0.214236
## charity_leagueTRUE 4.73626 0.42389 11.173 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1492.72 on 1087 degrees of freedom
## Residual deviance: 970.98 on 1082 degrees of freedom
## (92 observations deleted due to missingness)
## AIC: 982.98
##
## Number of Fisher Scoring iterations: 6# marginal effects
ame_logit1 <-avg_slopes(model_logit1)
summary(ame_logit1)##
## Term Contrast Estimate Std. Error z Pr(>|z|)
## asset_size_log dY/dX 0.0253 0.01240 2.04 0.0412
## charity_league TRUE - FALSE 0.6226 0.13735 4.53 <0.001
## file_year dY/dX 0.0274 0.00542 5.06 <0.001
## term_category 6+ years - 1-5 years 0.1762 0.13573 1.30 0.1942
## term_category no limit - 1-5 years -0.0323 0.02755 -1.17 0.2415
## 2.5 % 97.5 %
## 0.00101 0.0496
## 0.35341 0.8918
## 0.01682 0.0381
## -0.08980 0.4423
## -0.08627 0.0217
##
## Columns: term, contrast, estimate, std.error, statistic, p.value, conf.low, conf.high#add province fixed effect
model_logit2 <- glm(collaborate ~ asset_size_log + file_year + term_category + charity_league + province,
data = trust_data, family = "binomial")
summary(model_logit2)##
## Call:
## glm(formula = collaborate ~ asset_size_log + file_year + term_category +
## charity_league + province, family = "binomial", data = trust_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0030 -0.7113 0.1487 0.2645 2.4255
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -464.72943 118.57554 -3.919 8.88e-05 ***
## asset_size_log 0.17179 0.04496 3.821 0.000133 ***
## file_year 0.22771 0.05864 3.883 0.000103 ***
## term_category6+ years 1.23237 0.27505 4.480 7.45e-06 ***
## term_categoryno limit 0.08822 0.21790 0.405 0.685565
## charity_leagueTRUE 4.55634 0.44113 10.329 < 2e-16 ***
## provinceBeijing 1.77734 0.84122 2.113 0.034617 *
## provinceChongqing 0.78126 1.09395 0.714 0.475127
## provinceFujian -15.09876 1373.62413 -0.011 0.991230
## provinceGansu 1.04803 0.86862 1.207 0.227603
## provinceGuangdong 1.56956 0.87424 1.795 0.072598 .
## provinceHainan -15.74327 3956.18041 -0.004 0.996825
## provinceHebei 2.60638 1.51357 1.722 0.085068 .
## provinceHeilongjiang -16.39681 2281.75282 -0.007 0.994266
## provinceHenan 1.42694 0.95124 1.500 0.133593
## provinceHubei 1.46566 1.61267 0.909 0.363436
## provinceHunan 0.41442 1.38532 0.299 0.764823
## provinceInnerMogolia -14.68020 2796.53176 -0.005 0.995812
## provinceJiangsu 18.68683 776.83894 0.024 0.980809
## provinceJilin -15.07440 1592.59094 -0.009 0.992448
## provinceLiaoning -14.96041 2268.30013 -0.007 0.994738
## provinceNanjing 1.95252 0.89357 2.185 0.028883 *
## provinceQinghai 1.43176 0.89886 1.593 0.111191
## provinceShaanxi 1.12868 0.87649 1.288 0.197840
## provinceShandong 3.26043 1.11429 2.926 0.003433 **
## provinceShanghai 2.21388 0.91745 2.413 0.015818 *
## provinceSichuan 1.96041 1.04404 1.878 0.060419 .
## provinceTianjin 4.17696 0.95805 4.360 1.30e-05 ***
## provinceXinjiang -15.07959 2283.12193 -0.007 0.994730
## provinceYunnan 2.47884 1.47953 1.675 0.093851 .
## provinceZhejiang 1.76986 0.85879 2.061 0.039315 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1492.72 on 1087 degrees of freedom
## Residual deviance: 860.61 on 1057 degrees of freedom
## (92 observations deleted due to missingness)
## AIC: 922.61
##
## Number of Fisher Scoring iterations: 16# marginal effects
ame_logit2 <-avg_slopes(model_logit2)
summary(ame_logit2)##
## Term Contrast Estimate Std. Error z Pr(>|z|)
## asset_size_log dY/dX 0.0223 0.00638 3.504 < 0.001
## charity_league TRUE - FALSE 0.5732 0.07134 8.035 < 0.001
## file_year dY/dX 0.0296 0.00208 14.257 < 0.001
## province Beijing - Anhui 0.2151 0.08005 2.688 0.00720
## province Chongqing - Anhui 0.0794 0.11441 0.694 0.48765
## province Fujian - Anhui -0.3647 0.07941 -4.592 < 0.001
## province Gansu - Anhui 0.1119 0.08315 1.346 0.17835
## province Guangdong - Anhui 0.1838 0.08628 2.131 0.03311
## province Hainan - Anhui -0.3647 0.07943 -4.591 < 0.001
## province Hebei - Anhui 0.3459 0.21972 1.574 0.11540
## province Heilongjiang - Anhui -0.3647 0.07940 -4.593 < 0.001
## province Henan - Anhui 0.1631 0.10154 1.607 0.10811
## province Hubei - Anhui 0.1687 0.21359 0.790 0.42966
## province Hunan - Anhui 0.0395 0.13527 0.292 0.77043
## province InnerMogolia - Anhui -0.3647 0.07953 -4.585 < 0.001
## province Jiangsu - Anhui 0.6353 0.07940 8.001 < 0.001
## province Jilin - Anhui -0.3647 0.07942 -4.592 < 0.001
## province Liaoning - Anhui -0.3647 0.07945 -4.590 < 0.001
## province Nanjing - Anhui 0.2424 0.09064 2.674 0.00750
## province Qinghai - Anhui 0.1638 0.08972 1.826 0.06784
## province Shaanxi - Anhui 0.1223 0.08426 1.452 0.14658
## province Shandong - Anhui 0.4408 0.14474 3.046 0.00232
## province Shanghai - Anhui 0.2838 0.10166 2.792 0.00524
## province Sichuan - Anhui 0.2436 0.12627 1.929 0.05371
## province Tianjin - Anhui 0.5381 0.11714 4.594 < 0.001
## province Xinjiang - Anhui -0.3647 0.07944 -4.591 < 0.001
## province Yunnan - Anhui 0.3259 0.21333 1.528 0.12657
## province Zhejiang - Anhui 0.2140 0.08252 2.593 0.00951
## term_category 6+ years - 1-5 years 0.1719 0.06668 2.578 0.00992
## term_category no limit - 1-5 years 0.0113 0.02817 0.401 0.68831
## 2.5 % 97.5 %
## 0.00985 0.0348
## 0.43339 0.7130
## 0.02555 0.0337
## 0.05825 0.3720
## -0.14484 0.3037
## -0.52035 -0.2091
## -0.05106 0.2749
## 0.01474 0.3529
## -0.52038 -0.2090
## -0.08472 0.7766
## -0.52032 -0.2091
## -0.03586 0.3621
## -0.24994 0.5873
## -0.22565 0.3046
## -0.52058 -0.2088
## 0.47968 0.7909
## -0.52036 -0.2090
## -0.52042 -0.2090
## 0.06472 0.4200
## -0.01201 0.3397
## -0.04283 0.2875
## 0.15712 0.7245
## 0.08455 0.4831
## -0.00389 0.4911
## 0.30852 0.7677
## -0.52040 -0.2090
## -0.09220 0.7440
## 0.05226 0.3757
## 0.04124 0.3026
## -0.04392 0.0665
##
## Columns: term, contrast, estimate, std.error, statistic, p.value, conf.low, conf.high# use year fixed effect instead of linear trend
model_logit2Y <- glm(collaborate ~ asset_size_log +Year + term_category + charity_league + province,
data = trust_data, family = "binomial")
summary(model_logit2Y)##
## Call:
## glm(formula = collaborate ~ asset_size_log + Year + term_category +
## charity_league + province, family = "binomial", data = trust_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.0919 -0.7071 0.1299 0.2944 2.0536
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -4.61450 1.22144 -3.778 0.000158 ***
## asset_size_log 0.16526 0.04539 3.641 0.000272 ***
## Year2017 0.01891 0.69298 0.027 0.978225
## Year2018 -0.06847 0.61208 -0.112 0.910934
## Year2019 -0.19547 0.59795 -0.327 0.743742
## Year2020 -0.08794 0.58077 -0.151 0.879651
## Year2021 0.26045 0.58318 0.447 0.655156
## Year2022 1.00013 0.57379 1.743 0.081328 .
## term_category6+ years 1.09201 0.27897 3.914 9.06e-05 ***
## term_categoryno limit 0.03734 0.22238 0.168 0.866662
## charity_leagueTRUE 4.51572 0.44266 10.201 < 2e-16 ***
## provinceBeijing 1.40955 0.83876 1.681 0.092857 .
## provinceChongqing 0.68999 1.09238 0.632 0.527624
## provinceFujian -15.18347 1388.44866 -0.011 0.991275
## provinceGansu 0.99523 0.85915 1.158 0.246705
## provinceGuangdong 1.33725 0.86672 1.543 0.122860
## provinceHainan -16.34561 3956.18043 -0.004 0.996703
## provinceHebei 2.29923 1.55629 1.477 0.139574
## provinceHeilongjiang -16.25833 2278.53078 -0.007 0.994307
## provinceHenan 1.18224 0.94567 1.250 0.211238
## provinceHubei 1.55110 1.61332 0.961 0.336336
## provinceHunan 0.26113 1.39290 0.187 0.851292
## provinceInnerMogolia -15.11000 2796.62335 -0.005 0.995689
## provinceJiangsu 18.52995 782.40203 0.024 0.981105
## provinceJilin -15.48232 1557.69938 -0.010 0.992070
## provinceLiaoning -15.02753 2279.69477 -0.007 0.994740
## provinceNanjing 1.68919 0.88653 1.905 0.056727 .
## provinceQinghai 1.21292 0.89083 1.362 0.173333
## provinceShaanxi 0.85277 0.87010 0.980 0.327049
## provinceShandong 3.16567 1.11855 2.830 0.004652 **
## provinceShanghai 1.98842 0.90928 2.187 0.028757 *
## provinceSichuan 1.80442 1.03901 1.737 0.082445 .
## provinceTianjin 4.02437 0.94759 4.247 2.17e-05 ***
## provinceXinjiang -15.10362 2278.07814 -0.007 0.994710
## provinceYunnan 2.34230 1.47194 1.591 0.111541
## provinceZhejiang 1.54960 0.85022 1.823 0.068366 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1492.72 on 1087 degrees of freedom
## Residual deviance: 850.41 on 1052 degrees of freedom
## (92 observations deleted due to missingness)
## AIC: 922.41
##
## Number of Fisher Scoring iterations: 16# marginal effects
ame_logit2Y <-avg_slopes(model_logit2Y)
summary(ame_logit2Y)##
## Term Contrast Estimate Std. Error z Pr(>|z|)
## Year 2017 - 2016 0.00242 0.0886 0.0273 0.9782
## Year 2018 - 2016 -0.00866 0.0778 -0.1113 0.9114
## Year 2019 - 2016 -0.02433 0.0757 -0.3215 0.7479
## Year 2020 - 2016 -0.01110 0.0739 -0.1501 0.8807
## Year 2021 - 2016 0.03422 0.0749 0.4571 0.6476
## 2.5 % 97.5 %
## -0.1711 0.1760
## -0.1612 0.1438
## -0.1727 0.1240
## -0.1560 0.1338
## -0.1125 0.1810
## --- 25 rows omitted. See ?print.marginaleffects ---
## province Xinjiang - Anhui -0.38621 0.0779 -4.9552 <0.001
## province Yunnan - Anhui 0.31254 0.2052 1.5234 0.1277
## province Zhejiang - Anhui 0.19012 0.0854 2.2272 0.0259
## term_category 6+ years - 1-5 years 0.15039 0.0384 3.9191 <0.001
## term_category no limit - 1-5 years 0.00474 0.0282 0.1680 0.8666
## 2.5 % 97.5 %
## -0.5390 -0.2335
## -0.0896 0.7146
## 0.0228 0.3574
## 0.0752 0.2256
## -0.0506 0.0601
## Columns: term, contrast, estimate, std.error, statistic, p.value, conf.low, conf.highco-trustee as DV
Result not really useful
#benchmark model
trustee_logit1 <- glm(co_trustee ~ asset_size_log + file_year + term_category + charity_league,
data = trust_data, family = "binomial")
summary(trustee_logit1)#add province fixed effect
trustee_logit2 <- glm(co_trustee ~ asset_size_log + file_year + term_category + charity_league + province,
data = trust_data, family = "binomial")
summary(trustee_logit2)# use year fixed effect instead of linear trend
trustee_logit2Y <- glm(co_trustee ~ asset_size_log +Year + term_category + charity_league + province,
data = trust_data, family = "binomial")
summary(trustee_logit2Y)Figure and table
trust_data %>%
group_by(collaboration_type, Year) %>%
summarise(count = n()) %>%
ggplot(aes(x=Year, color = collaboration_type, group = collaboration_type, y = count))+
geom_line(size = 1)+
geom_text_repel(aes(label = count, x = Year), color = "grey20", size = 3)+
scale_color_viridis_d(option = "plasma", begin = 0.1, end = 0.8) +
guides(color=guide_legend(title="Charities' Roles"),
label = "none") +
labs(x = NULL, y = NULL) +
theme_minimal(base_size = 10) +
theme(legend.position="bottom")
models_table <- modelsummary(list("Model 1" = model_logit1, "Model 2" = model_logit2,
"Model 3" = model_logit2Y),
coef_omit = "^Year|^province",
statistic = "({p.value}) {stars}")
models_table| Model 1 | Model 2 | Model 3 | |
|---|---|---|---|
| (Intercept) | −371.944*** | −464.729*** | −4.615*** |
| (0.001) *** | (0.000) *** | (0.000) *** | |
| asset_size_log | 0.168*** | 0.172*** | 0.165*** |
| (0.000) *** | (0.000) *** | (0.000) *** | |
| file_year | 0.183*** | 0.228*** | |
| (0.001) *** | (0.000) *** | ||
| term_category6+ years | 1.082*** | 1.232*** | 1.092*** |
| (0.000) *** | (0.000) *** | (0.000) *** | |
| term_categoryno limit | −0.219 | 0.088 | 0.037 |
| (0.214) | (0.686) | (0.867) | |
| charity_leagueTRUE | 4.736*** | 4.556*** | 4.516*** |
| (0.000) *** | (0.000) *** | (0.000) *** | |
| Num.Obs. | 1088 | 1088 | 1088 |
| AIC | 983.0 | 922.6 | 922.4 |
| BIC | 1012.9 | 1077.4 | 1102.1 |
| Log.Lik. | −485.491 | −430.303 | −425.205 |
| F | 33.987 | 6.996 | 6.108 |
| RMSE | 0.39 | 0.36 | 0.36 |
ame_table <- modelsummary(list("Model 1" = ame_logit1, "Model 2" = ame_logit2,
"Model 3" = ame_logit2Y),
coef_omit = "^Year|^province",
shape = term + contrast ~ model,
statistic = "({p.value}) {stars}")
ame_table| Model 1 | Model 2 | Model 3 | ||
|---|---|---|---|---|
| asset_size_log | dY/dX | 0.025* | 0.022*** | 0.021*** |
| (0.041) * | (0.000) *** | (0.000) *** | ||
| charity_league | TRUE - FALSE | 0.623*** | 0.573*** | 0.563*** |
| (0.000) *** | (0.000) *** | (0.000) *** | ||
| file_year | dY/dX | 0.027*** | 0.030*** | |
| (0.000) *** | (0.000) *** | |||
| term_category | 6+ years - 1-5 years | 0.176 | 0.172** | 0.150*** |
| (0.194) | (0.010) ** | (0.000) *** | ||
| no limit - 1-5 years | −0.032 | 0.011 | 0.005 | |
| (0.241) | (0.688) | (0.867) | ||
| Num.Obs. | 1088 | 1088 | 1088 | |
| AIC | 983.0 | 922.6 | 922.4 | |
| BIC | 1012.9 | 1077.4 | 1102.1 | |
| Log.Lik. | −485.491 | −430.303 | −425.205 | |
| F | 33.987 | 6.996 | 6.108 | |
| RMSE | 0.39 | 0.36 | 0.36 |