r语言 - 将拟合的威布尔分布 (fitdistr) 添加到geom_bar (ggplot2) 分类图中



我根据 ggplot2 中的人口普查数据创建了年龄与人口规模(按性别)的条形图。 类似地,我使用了fitdistrplus包中的"fitdist"函数来推导出归一化(通过所有年龄箱中的最大观测人口)人口数据的Weibull参数。

我想做的是将绘制的数据与分布叠加为线图。 我试过了

+ geom_line (denscomp(malefit.w))

加上其他众多(不成功)的策略。

任何可以提供的帮助将不胜感激! 请在下面找到附加的语法:

数据结构

    Order     Age    Male  Female   Total  male.norm
1      1   0 - 5 2870000 2820000 5690000 1.00000000
2      2   5 - 9 2430000 2390000 4820000 0.84668990
3      3 10 - 14 2340000 2250000 4590000 0.81533101
4      4 15 - 19 2500000 2500000 5000000 0.87108014
5      5 20 - 24 2690000 2680000 5370000 0.93728223
6      6 25 - 29 2540000 2520000 5060000 0.88501742
7      7 30 - 34 2040000 1990000 4030000 0.71080139
8      8 35 - 39 1710000 1760000 3470000 0.59581882
9      9 40 - 44 1400000 1550000 2950000 0.48780488
10    10 45 - 49 1200000 1420000 2620000 0.41811847
11    11 50 - 54 1010000 1210000 2220000 0.35191638
12    12 55 - 59  812000  985000 1800000 0.28292683
13    13 60 - 64  612000  773000 1390000 0.21324042
14    14 65 - 69  402000  556000  958000 0.14006969
15    15 70 - 74  293000  455000  748000 0.10209059
16    16 75 - 79  165000  316000  481000 0.05749129
17    17 80 - 84  101000  222000  323000 0.03519164
18    18 85 plus   75500  180000  256000 0.02630662
   female.norm 
1   1.00000000  
2   0.84751773   
3   0.79787234    
4   0.88652482    
5   0.95035461    
6   0.89361702    
7   0.70567376    
8   0.62411348   
9   0.54964539    
10  0.50354610    
11  0.42907801    
12  0.34929078    
13  0.27411348   
14  0.19716312    
15  0.16134752   
16  0.11205674    
17  0.07872340   
18  0.06382979 

这是我上面提出的原始问题的答案。 结合问题中发布的数据,它是一个从头到尾的解决方案(即要绘制的数据.raw)。

南非年龄人口数据(按性别)拟合到威布尔分布(Theresa Cain和Ben Small)

加载库

library(MASS)
library(ggplot2)  

导入数据集

age_gender2 <- read.csv("age_gender2.csv", sep=",", header = T)

按性别定义总人口规模 - 即所有年龄箱中整个男性/女性人口的总和,并分别放置在对象"total.male"和"total.female"中

total.male <- sum(age_gender2$Male)
total.female <- sum(age_gender2$Female)

对象 'age.groups' 是一个单行、单列向量,描述 'age_gender2' df 的年龄箱数

age.groups <- length(age_gender2$Age) 

对象 'age.all' 是一个 1 行 18 列的空矩阵,它将描述从 age_gender2 df 的"年龄"列中的年龄箱(类别)中提取的最小年龄范围

age.all <- matrix(0,1,age.groups)

下一行为每个年龄组中第一列的矩阵的每个元素 (1 X 18) 分配最小年龄。 因此,"for"循环将矩阵的每一列分配为一个年龄(帮助:在R中编写for循环)。

'for' 循环 # RULE(在括号 () 中给出)的结构:对于每个元素 (i)

从 2 循环到 'age.groups' 对象(即 18) # COMMAND(在大括号 {} 中给出):取 'age.male' 矩阵中的每个元素 (i) 并从第一行开始(即 [1,通过每个元素(即 [1,i]),执行/分配 ('<-') 以下操作: ((5 X(第 i 个元素 - 1)) - 2.5)。 此操作为箱提供"中年"年龄

这将为"age.all"矩阵中的第一个元素(行,列)分配值2.5

age.all[1,1] <- 2.5 
for(i in 2:age.groups){ 
age.all[1,i] <- ((5*(i)) - 2.5)  
}

下一个命令 'rep' 在特定 bin 内创建一个 (1 X 25190500) 所有年龄的向量

male.data <- rep(age.all,age_gender2$Male) 
female.data <- rep(age.all,age_gender2$Female)

根据男性和女性的年龄拟合威布尔分布

male.weib <- fitdistr(male.data, "weibull")
female.weib <- fitdistr(female.data, "weibull")

male.shape <- male.weib$estimate[1] 
male.scale <- male.weib$estimate[2] 
female.shape <- female.weib$estimate[1] 
female.scale <- female.weib$estimate[2] 

将"Age_Median"列添加到"age_gender2"df,并显示年龄中位数。 需要转置为"age.all"是一个 1 行 X 18 列向量。

age_gender2["Age_Median"] <- t(age.all)

拟合威牛分布

函数 'pweibull' 是一个 PDF,用于查找所有年龄段的累积概率,因此我们需要从当前箱中减去以前的年龄箱以找到该箱的概率,从而(通过乘以男性总人口)该箱的预期人口。

male.p.weibull <- matrix(0,1,age.groups)
female.p.weibull <- matrix(0,1,age.groups)
for (i in 1:age.groups){
male.p.weibull[1,i] <- pweibull(age.all[1,i]+2.5, male.shape, male.scale) -  pweibull(age.all[1,i]-2.5, male.shape, male.scale)
 }
for (i in 1:age.groups){
female.p.weibull[1,i] <- pweibull(age.all[1,i]+2.5, female.shape, female.scale) - pweibull(age.all[1,i]-2.5, female.shape, female.scale)
 }

添加列以列出每个年龄箱的计算人口 - "转置"为 1 x 18 -> 18 行 x 1 列向量

age_gender2["male.prob"] <- t(male.p.weibull * total.male)
age_gender2["female.prob"] <- t(female.p.weibull * total.female)

创建描述年龄-性别人口分布的条形图

男性(真实数据)和显示威布尔计算概率的叠加曲线(ggplot2)

agp.male <- ggplot(age_gender2, aes(x=reorder(Age, Order), y=Male, fill=Male)) +   geom_bar(stat="identity") + theme (axis.text.x=element_text(angle=45, hjust=1)) + xlab("Age Group (5 yr bin)") + ylab("Male Population (M)") + geom_smooth(aes(age_gender2$Age,age_gender2$male.prob, group=1))

女性(真实数据)和显示威布尔计算概率的叠加曲线(ggplot2)

agp.female <- ggplot(age_gender2, aes(x=reorder(Age, Order), y=Female, fill=Female)) + geom_bar(stat="identity") + theme (axis.text.x=element_text(angle=45, hjust=1)) + xlab("Age Group (5 yr bin)") + ylab("Female Population (M)") + geom_smooth(aes(age_gender2$Age,age_gender2$female.prob, group=1))

最新更新