Как нарисовать подобранный график и реальный график распределения гаммы на одном графике?

10

Загрузите пакет, необходимый.

library(ggplot2)
library(MASS)

Генерация 10000 номеров, приспособленных к гамма-распределению.

x <- round(rgamma(100000,shape = 2,rate = 0.2),1)
x <- x[which(x>0)]

Нарисуйте функцию плотности вероятности, предположим, что мы не знаем, к какому распределению x подходит.

t1 <- as.data.frame(table(x))
names(t1) <- c("x","y")
t1 <- transform(t1,x=as.numeric(as.character(x)))
t1$y <- t1$y/sum(t1[,2])
ggplot() + 
  geom_point(data = t1,aes(x = x,y = y)) + 
  theme_classic()

PDF

Из графика мы можем узнать, что распределение x очень похоже на гамма-распределение, поэтому мы используем fitdistr()пакет MASSдля получения параметров формы и скорости гамма-распределения.

fitdistr(x,"gamma") 
##       output 
##       shape           rate    
##   2.0108224880   0.2011198260 
##  (0.0083543575) (0.0009483429)

Нарисуйте фактическую точку (черная точка) и подогнанный график (красная линия) на одном графике, и вот вопрос, пожалуйста, посмотрите график сначала.

ggplot() + 
  geom_point(data = t1,aes(x = x,y = y)) +     
  geom_line(aes(x=t1[,1],y=dgamma(t1[,1],2,0.2)),color="red") + 
  theme_classic()

подогнанный график

У меня есть два вопроса:

  1. Реальные параметры shape=2, rate=0.2и параметры , которые я использую функцию , fitdistr()чтобы получить это shape=2.01, rate=0.20. Эти два почти одинаковы, но почему выровненный график плохо соответствует фактической точке, должно быть что-то не так в выровненном графике, или то, как я рисую подобранный график и фактические точки, совершенно неверно, что мне делать ?

  2. После того, как я получу параметр модели, которую я устанавливаю, каким образом я оцениваю модель, что-то вроде RSS (остаточная квадратная сумма) для линейной модели, или p-значение shapiro.test(), ks.test()и другой тест?

Я беден статистическими знаниями, не могли бы вы мне помочь?

PS: у меня был поиск в Google, stackoverflow и CV много раз, но не нашел ничего, связанного с этой проблемой

Лин Чжан
источник
1
Сначала я задал этот вопрос в stackoverflow, но, похоже, этот вопрос относится к CV, друг сказал, что я неправильно понял функцию вероятности и плотности вероятности, я не смог понять ее полностью, поэтому простите за ответ на этот вопрос еще раз в CV
Лин Чжан
1
Ваш расчет плотности неверен. Простой способ рассчитать это h <- hist(x, 1000, plot = FALSE); t1 <- data.frame(x = h$mids, y = h$density).
@ Паскаль, ты прав, я решил вопрос 1, спасибо!
Лин Чжан
Смотрите ответ ниже, densityфункция полезна.
Я понял, еще раз спасибо за редактирование и решение моего вопроса
Лин Чжан

Ответы:

11

Вопрос 1

То, как вы рассчитываете плотность вручную, кажется неправильным. Нет необходимости округлять случайные числа из гамма-распределения. Как отметил @Pascal, вы можете использовать гистограмму для построения плотности точек. В приведенном ниже примере я использую функцию, densityчтобы оценить плотность и построить ее в виде точек. Я представляю соответствие как с точками, так и с гистограммой:

library(ggplot2)
library(MASS)

# Generate gamma rvs

x <- rgamma(100000, shape = 2, rate = 0.2)

den <- density(x)

dat <- data.frame(x = den$x, y = den$y)

# Plot density as points

ggplot(data = dat, aes(x = x, y = y)) + 
  geom_point(size = 3) +
  theme_classic()

Гамма плотность

# Fit parameters (to avoid errors, set lower bounds to zero)

fit.params <- fitdistr(x, "gamma", lower = c(0, 0))

# Plot using density points

ggplot(data = dat, aes(x = x,y = y)) + 
  geom_point(size = 3) +     
  geom_line(aes(x=dat$x, y=dgamma(dat$x,fit.params$estimate["shape"], fit.params$estimate["rate"])), color="red", size = 1) + 
  theme_classic()

Гамма плотность подходит

# Plot using histograms

ggplot(data = dat) +
  geom_histogram(data = as.data.frame(x), aes(x=x, y=..density..)) +
  geom_line(aes(x=dat$x, y=dgamma(dat$x,fit.params$estimate["shape"], fit.params$estimate["rate"])), color="red", size = 1) + 
  theme_classic()

Гистограмма с подгонкой

Вот решение, которое предоставил @Pascal:

h <- hist(x, 1000, plot = FALSE)
t1 <- data.frame(x = h$mids, y = h$density)

ggplot(data = t1, aes(x = x, y = y)) + 
  geom_point(size = 3) +     
  geom_line(aes(x=t1$x, y=dgamma(t1$x,fit.params$estimate["shape"], fit.params$estimate["rate"])), color="red", size = 1) + 
  theme_classic()

Точки плотности гистограммы

вопрос 2

Для оценки качества посадки рекомендую пакет fitdistrplus. Вот как это можно использовать для подгонки двух распределений и сравнения их подгонки графически и численно. Команда gofstatвыводит на экран несколько показателей, таких как AIC, BIC и некоторые статистические данные gof, такие как KS-Test и т. Д. Они в основном используются для сравнения подгонок различных распределений (в данном случае гамма против Вейбулла). Более подробную информацию можно найти в моем ответе здесь :

library(fitdistrplus)

x <- c(37.50,46.79,48.30,46.04,43.40,39.25,38.49,49.51,40.38,36.98,40.00,
       38.49,37.74,47.92,44.53,44.91,44.91,40.00,41.51,47.92,36.98,43.40,
       42.26,41.89,38.87,43.02,39.25,40.38,42.64,36.98,44.15,44.91,43.40,
       49.81,38.87,40.00,52.45,53.13,47.92,52.45,44.91,29.54,27.13,35.60,
       45.34,43.37,54.15,42.77,42.88,44.26,27.14,39.31,24.80,16.62,30.30,
       36.39,28.60,28.53,35.84,31.10,34.55,52.65,48.81,43.42,52.49,38.00,
       38.65,34.54,37.70,38.11,43.05,29.95,32.48,24.63,35.33,41.34)

fit.weibull <- fitdist(x, "weibull")
fit.gamma <- fitdist(x, "gamma", lower = c(0, 0))

# Compare fits 

graphically

par(mfrow = c(2, 2))
plot.legend <- c("Weibull", "Gamma")
denscomp(list(fit.weibull, fit.gamma), fitcol = c("red", "blue"), legendtext = plot.legend)
qqcomp(list(fit.weibull, fit.gamma), fitcol = c("red", "blue"), legendtext = plot.legend)
cdfcomp(list(fit.weibull, fit.gamma), fitcol = c("red", "blue"), legendtext = plot.legend)
ppcomp(list(fit.weibull, fit.gamma), fitcol = c("red", "blue"), legendtext = plot.legend)

@NickCox справедливо советует, что QQ-Plot (верхняя правая панель) является лучшим одиночным графиком для оценки и сравнения подгонок. Установленные плотности трудно сравнивать. Я включаю и другую графику для полноты картины.

Сравнить подходит

# Compare goodness of fit

gofstat(list(fit.weibull, fit.gamma))

Goodness-of-fit statistics
                             1-mle-weibull 2-mle-gamma
Kolmogorov-Smirnov statistic    0.06863193   0.1204876
Cramer-von Mises statistic      0.05673634   0.2060789
Anderson-Darling statistic      0.38619340   1.2031051

Goodness-of-fit criteria
                               1-mle-weibull 2-mle-gamma
Aikake's Information Criterion      519.8537    531.5180
Bayesian Information Criterion      524.5151    536.1795
COOLSerdash
источник
1
Я не могу отредактировать, но у вас есть проблема с обратной fitdistrplusgofstat
2
Рекомендация в одну строку: график квантиль-квантиль - лучший отдельный график для этой цели. Сравнение наблюдаемых и установленных плотностей трудно сделать хорошо. Например, трудно определить систематические отклонения при высоких значениях, которые с научной и практической точки зрения часто очень важны.
Ник Кокс
1
Рад, что мы согласны. ОП начинается с 10000 очков. Многие проблемы начинаются с гораздо меньшего количества, и тогда получение хорошего представления о плотности может быть проблематичным.
Ник Кокс
1
@LingZhang Для сравнения подходит, вы можете посмотреть на значение AIC. Подгонка с самым низким AIC является предпочтительной. Кроме того, я не согласен с тем, что распределение Вейбулла и Гаммы в QQ-графике совершенно одинаковое. Точки подгонки Вейбулла ближе к линии, чем подгонка Гаммы, особенно на хвостах. Соответственно, AIC для посадки Вейбулла меньше по сравнению с подгонкой гаммы.
COOLSerdash
1
Прямо лучше. Также см. Stats.stackexchange.com/questions/111010/… Принципы те же. Систематическое отклонение от линейности является проблемой.
Ник Кокс