世界人口动态作业
刘畅
2025-03-29
WD<-getwd() WD if(!is.null(WD)) setwd(“C:\Users\l\Desktop\国际关系研究方法\homework1”) getwd()
读取数据
K<-read.csv("Kenya.csv")
S<-read.csv("Sweden.csv")
W<-read.csv("World.csv")library(ggplot2)## Warning: 程序包'ggplot2'是用R版本4.4.3 来建造的library(scales)## Warning: 程序包'scales'是用R版本4.4.3 来建造的library(dplyr)## Warning: 程序包'dplyr'是用R版本4.4.3 来建造的##
## 载入程序包：'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union##出生率
CBR<-function(x) {
result<-sum(x$births)/(sum(x$py.men)+sum(x$py.women))
return(result)
}
k1<-K[K$period=="1950-1955",]
k2<-K[K$period=="2005-2010",]
s1<-S[S$period=="1950-1955",]
s2<-S[S$period=="2005-2010",]
w1<-W[W$period=="1950-1955",]
w2<-W[W$period=="2005-2010",]
CBR_kenya<-c(CBR(k1),CBR(k2))
CBR_sweden<-c(CBR(s1),CBR(s2))
CBR_world<-c(CBR(w1),CBR(w2))
print(CBR_kenya)## [1] 0.05209490 0.03851507print(CBR_sweden)## [1] 0.01539614 0.01192554print(CBR_world)## [1] 0.03732863 0.02021593#可视化
results<-data.frame(
Country = rep(c("Kenya", "Sweden", "World"), each = 2),
Period = rep(c("1950-1955", "2005-2010"), 3),
CBR = c(CBR(k1), CBR(k2), CBR(s1), CBR(s2), CBR(w1), CBR(w2))
)
print(results)## Country Period CBR
## 1 Kenya 1950-1955 0.05209490
## 2 Kenya 2005-2010 0.03851507
## 3 Sweden 1950-1955 0.01539614
## 4 Sweden 2005-2010 0.01192554
## 5 World 1950-1955 0.03732863
## 6 World 2005-2010 0.02021593ggplot(results, aes(x = Country, y = CBR, fill = Period)) +
geom_bar(stat = "identity", position = position_dodge()) +
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
# 将y轴显示为百分比
labs(title = "出生率(CBR)比较",
x = "国家/地区",
y = "出生率",
fill = "时期") +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5)) # 标题居中
###生育率
#各阶段生育率ASFR
ASFR<-function(data){
f<-unique(data$age)
asfr_results <- numeric(length(f))
names(asfr_results) <- f
for(i in 1:length(f)){
age_data<-data[data$age==f[i],]
births<-sum(age_data$births)
women_p<-sum(age_data$py.women)
asfr_results[i]<-ifelse(women_p > 0, births/women_p, NA)
}
return(asfr_results)
}
print(ASFR(k1))## 0-4 9-May 14-Oct 15-19 20-24 25-29 30-34
## 0.00000000 0.00000000 0.00000000 0.16884585 0.35596942 0.34657814 0.28946367
## 35-39 40-44 45-49 50-54 55-59 60-69 70-79
## 0.20644016 0.11193267 0.03905205 0.00000000 0.00000000 0.00000000 0.00000000
## 80+
## 0.00000000print(ASFR(k2))## 0-4 9-May 14-Oct 15-19 20-24 25-29 30-34
## 0.00000000 0.00000000 0.00000000 0.10057087 0.23583536 0.23294721 0.18087964
## 35-39 40-44 45-49 50-54 55-59 60-69 70-79
## 0.13126805 0.05626214 0.03815044 0.00000000 0.00000000 0.00000000 0.00000000
## 80+
## 0.00000000print(ASFR(s1))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 0.000000000 0.000000000 0.000000000 0.038908952 0.127710883 0.125243665
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.087364159 0.048603771 0.016210186 0.001341829 0.000000000 0.000000000
## 60-69 70-79 80+
## 0.000000000 0.000000000 0.000000000print(ASFR(s2))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 0.0000000000 0.0000000000 0.0000000000 0.0059709097 0.0507320271 0.1162085625
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.1322744621 0.0625923991 0.0121600765 0.0006143942 0.0000000000 0.0000000000
## 60-69 70-79 80+
## 0.0000000000 0.0000000000 0.0000000000print(ASFR(w1))## 0-4 5-9 10-14 15-19 20-24 25-29 30-34
## 0.00000000 0.00000000 0.00000000 0.09029521 0.23763370 0.25245229 0.20416410
## 35-39 40-44 45-49 50-54 55-59 60-69 70-79
## 0.13810534 0.06360832 0.01519064 0.00000000 0.00000000 0.00000000 0.00000000
## 80+
## 0.00000000print(ASFR(w2))## 0-4 5-9 10-14 15-19 20-24 25-29
## 0.000000000 0.000000000 0.000000000 0.048489719 0.151971307 0.146980966
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.093813813 0.046689639 0.016268995 0.004510245 0.000000000 0.000000000
## 60-69 70-79 80+
## 0.000000000 0.000000000 0.000000000#总生育率TFR
TFR<-function(z){
result2<-sum(z$births)/sum(z$py.women)
return(result2)
}
tk1<-k1[k1$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
tk2<-k2[k2$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
ts1<-s1[s1$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
ts2<-s2[s2$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
tw1<-w1[w1$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
tw2<-w2[w2$age %in% c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49"),]
TFR_kenya<-c(TFR(tk1),TFR(tk2))
TFR_sweden<-c(TFR(ts1),TFR(ts2))
TFR_world<-c(TFR(tw1),TFR(tw2))
print(TFR_kenya)## [1] 0.2345367 0.1583425print(TFR_sweden)## [1] 0.0628168 0.0530123print(TFR_world)## [1] 0.1517275 0.0777116#可视化
results<-data.frame(
Country = rep(c("Kenya", "Sweden", "World"), each = 2),
Period = rep(c("1950-1955", "2005-2010"), 3),
TFR = c(TFR(tk1), TFR(tk2), TFR(ts1), TFR(ts2), TFR(tw1), TFR(tw2))
)
print(results)## Country Period TFR
## 1 Kenya 1950-1955 0.2345367
## 2 Kenya 2005-2010 0.1583425
## 3 Sweden 1950-1955 0.0628168
## 4 Sweden 2005-2010 0.0530123
## 5 World 1950-1955 0.1517275
## 6 World 2005-2010 0.0777116ggplot(results, aes(x = Country, y = TFR, fill = Period)) +
geom_bar(stat = "identity", position = position_dodge()) +
scale_y_continuous(labels = scales::percent_format(accuracy = 0.1)) +
# 将y轴显示为百分比
labs(title = "总生育率(TFR)比较",
x = "国家/地区",
y = "生育率",
fill = "时期") +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(hjust = 0.5)) # 标题居中
###死亡率
CDR<-function(y){
result2<-sum(y$deaths)/(sum(y$py.men)+sum(y$py.women))
return(result2)
}
CDR_kenya<-c(CDR(k1),CDR(k2))
CDR_sweden<-c(CDR(s1),CDR(s2))
CDR_world<-c(CDR(w1),CDR(w2))
print(CDR_kenya)## [1] 0.02396254 0.01038914print(CDR_sweden)## [1] 0.009844842 0.009968455print(CDR_world)## [1] 0.019318929 0.008166083##可视化
cdr_data <- data.frame(
Country = rep(c("Kenya", "Sweden", "World"), each = 2),
Period = rep(c("1950-1955", "2005-2010"), 3),
CDR = c(CDR_kenya, CDR_sweden, CDR_world)
)
# 柱状图
ggplot(cdr_data, aes(x = Country, y = CDR, fill = Period)) +
geom_bar(stat = "identity", position = position_dodge(width = 0.7), width = 0.6) +
geom_text(aes(label = round(CDR, 4)),
position = position_dodge(width = 0.7),
vjust = -0.5, size = 3.5) +
scale_fill_manual(values = c("#1f77b4", "#ff7f0e")) +
labs(title = "死亡率(CDR)国际比较",
subtitle = "1950-1955 vs 2005-2010",
x = "国家/地区",
y = "死亡率",
fill = "时期") +
theme_minimal() +
theme(legend.position = "top",
plot.title = element_text(size = 14, face = "bold"),
axis.text = element_text(size = 10))
###各年龄段的死亡率ASDR
ASDR<-function(data){
a<-unique(data$age)
asdr_results <- numeric(length(a))
names(asdr_results) <- a
for(i in 1:length(a)){
age_data<-data[data$age==a[i],]
deaths<-sum(age_data$deaths)
population<-sum(age_data$py.men) + sum(age_data$py.women)
asdr_results[i]<-ifelse(population > 0, deaths/population, NA)
}
return(asdr_results)
}
print(ASDR(k1))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 0.066826532 0.009321789 0.005972093 0.005869582 0.007651103 0.008838750
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.009677594 0.010986891 0.012633744 0.014760408 0.018260395 0.024433007
## 60-69 70-79 80+
## 0.041996801 0.093683927 0.200016381print(ASDR(k2))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 0.020920755 0.002911301 0.002918895 0.002942986 0.003885368 0.006558131
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.010603913 0.013881062 0.013474598 0.011288057 0.011152339 0.013898334
## 60-69 70-79 80+
## 0.025395531 0.061261551 0.158620510print(ASDR(s1))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 0.0047456697 0.0004320537 0.0004896406 0.0007431865 0.0010177339 0.0011140910
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.0013343851 0.0017429491 0.0025095541 0.0039668755 0.0063486410 0.0101672774
## 60-69 70-79 80+
## 0.0214156644 0.0599823093 0.1678170255print(ASDR(s2))## 0-4 9-May 14-Oct 15-19 20-24 25-29
## 6.790712e-04 8.138094e-05 1.135496e-04 2.687775e-04 4.697344e-04 4.941440e-04
## 30-34 35-39 40-44 45-49 50-54 55-59
## 5.057066e-04 6.689578e-04 1.039256e-03 1.769621e-03 2.988715e-03 4.709913e-03
## 60-69 70-79 80+
## 9.828772e-03 2.803963e-02 1.098892e-01print(ASDR(w1))## 0-4 5-9 10-14 15-19 20-24 25-29
## 0.054589755 0.005600412 0.004261869 0.004752908 0.005891020 0.006325420
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.007132501 0.008534487 0.010572557 0.013459846 0.017335769 0.024265320
## 60-69 70-79 80+
## 0.042262017 0.086910343 0.184364978print(ASDR(w2))## 0-4 5-9 10-14 15-19 20-24 25-29
## 0.012802492 0.001256903 0.001079067 0.001302818 0.001832602 0.002278500
## 30-34 35-39 40-44 45-49 50-54 55-59
## 0.002623982 0.003031563 0.003753402 0.005085583 0.007126588 0.010477192
## 60-69 70-79 80+
## 0.020235894 0.047457519 0.120679385