Question

我的问题最后是粗体。

我知道如何使beta分布符合某些数据。例如：

library(Lahman)
library(dplyr)

# clean up the data and calculate batting averages by playerID
batting_by_decade <- Batting %>%
  filter(AB > 0) %>%
  group_by(playerID, Decade = round(yearID - 5, -1)) %>%
  summarize(H = sum(H), AB = sum(AB)) %>%
  ungroup() %>%
  filter(AB > 500) %>%
  mutate(average = H / AB)

# fit the beta distribution
library(MASS)
m <- MASS::fitdistr(batting_by_decade$average, dbeta,
                    start = list(shape1 = 1, shape2 = 10))

alpha0 <- m$estimate[1]
beta0 <- m$estimate[2]

# plot the histogram of data and the beta distribution
ggplot(career_filtered) +
  geom_histogram(aes(average, y = ..density..), binwidth = .005) +
  stat_function(fun = function(x) dbeta(x, alpha0, beta0), color = "red",
                size = 1) +
  xlab("Batting average")

哪个收益率：

现在我想为数据的每个alpha0列计算不同的beta参数beta0和batting_by_decade$Decade，这样我最终会得到15个参数集，以及15个我可以调整的beta版分布这个十年平均成绩的ggplot：

batting_by_decade %>% 
  ggplot() +
  geom_histogram(aes(x=average)) +
  facet_wrap(~ Decade)

我可以通过过滤每十年来对此进行硬编码，并将这十年的数据传递到fidistr函数中，重复这几十年，但有一种计算方法所有beta测试参数每十年快速且可重复，可能还有一个应用函数？

Answer 1

您可以将summarise与两个自定义函数结合使用：

getAlphaEstimate = function(x) {MASS::fitdistr(x, dbeta,start = list(shape1 = 1, shape2 = 10))$estimate[1]}

getBetaEstimate = function(x) {MASS::fitdistr(x, dbeta,start = list(shape1 = 1, shape2 = 10))$estimate[2]}

batting_by_decade %>%
  group_by(Decade) %>%
  summarise(alpha = getAlphaEstimate(average),
         beta = getBetaEstimate(average)) -> decadeParameters

但是，根据Hadley的帖子，您将无法使用stat_summary进行投影：https://stackoverflow.com/a/1379074/3124909

Answer 2

这是一个如何从生成虚拟数据到绘图的示例。

temp.df <- data_frame(yr = 10*187:190,
                      al = rnorm(length(yr), mean = 4, sd = 2),
                      be = rnorm(length(yr), mean = 10, sd = 2)) %>% 
  group_by(yr, al, be) %>% 
  do(data_frame(dats = rbeta(100, .$al, .$be)))

首先，我根据每个组合编制了一些比例参数四年，然后使用do创建一个包含每个分布的100个样本的数据框。除了知道“真实”参数外，这个数据框看起来应该与原始数据非常相似：具有相关年份的样本矢量。

temp.ests <- temp.df %>% 
  group_by(yr, al, be) %>% 
  summarise(ests = list(MASS::fitdistr(dats, dbeta, start = list(shape1 = 1, shape2 = 1))$estimate)) %>% 
  unnest %>% 
  mutate(param = rep(letters[1:2], length(ests)/2)) %>% 
  spread(key = param, value = ests)

这是你的大部分问题，解决了你的解决方法。如果您逐行浏览此代码段，您会看到数据框的类型为list，每行包含<dbl [2]>。当您unnest()时，它会将这两个数字拆分为不同的行，然后我们通过添加一个“a，b，a，b，...”列和spread将它们分开来识别它们每年获得两列，每行一行。在这里，您还可以看到fitdistr与我们采样的真实人口的匹配程度，a vs al和b vs be。

temp.curves <- temp.ests %>% 
  group_by(yr, al, be, a, b) %>% 
  do(data_frame(prop = 1:99/100,
                trueden = dbeta(prop, .$al, .$be),
                estden = dbeta(prop, .$a, .$b)))

现在我们将该过程内部转出以生成绘制曲线的数据。对于每一行，我们使用do制作一个值为prop的数据帧，并计算真实总体参数和估算样本参数的每个值的β密度。

ggplot() +
  geom_histogram(data = temp.df, aes(dats, y = ..density..), colour = "black", fill = "white") +
  geom_line(data = temp.curves, aes(prop, trueden, color = "population"), size = 1) +
  geom_line(data = temp.curves, aes(prop, estden, color = "sample"), size = 1) +
  geom_text(data = temp.ests, 
            aes(1, 2, label = paste("hat(alpha)==", round(a, 2))), 
            parse = T, hjust = 1) +
  geom_text(data = temp.ests, 
            aes(1, 1, label = paste("hat(beta)==", round(b, 2))), 
            parse = T, hjust = 1) +
  facet_wrap(~yr)

最后我们把它放在一起，绘制我们的样本数据的直方图。然后从我们的曲线数据中获得真密度的一条线。然后是我们的曲线数据中的一条线，用于估算的密度。然后我们的参数估计数据中的一些标签显示样本参数，并按年份显示方面。

Answer 3

这是一个适用的解决方案，但我更喜欢@ CMichael的dplyr解决方案。

calc_beta <- function(decade){
  dummy <- batting_by_decade %>% 
    dplyr::filter(Decade == decade) %>% 
    dplyr::select(average)

  m <- fitdistr(dummy$average, dbeta, start = list(shape1 = 1, shape2 = 10))

  alpha0 <- m$estimate[1]
  beta0 <- m$estimate[2]

  return(c(alpha0,beta0))
}

decade <- seq(1870, 2010, by =10)
params <- sapply(decade, calc_beta)
colnames(params) <- decade

回复：@ CMichael关于避免双重fitdistr的评论，我们可以将函数重写为getAlphaBeta。

getAlphaBeta = function(x) {MASS::fitdistr(x, dbeta,start = list(shape1 = 1, shape2 = 10))$estimate}

batting_by_decade %>%
  group_by(Decade) %>%
  summarise(params = list(getAlphaBeta(average))) -> decadeParameters

decadeParameters$params[1] # it works!

现在我们只需要以一种很好的方式取消第二列的列表......

通过因子将MASS :: fitdistr应用于多个数据

3 个答案: