Bir grafikte takılı grafik ve gerçek gama dağılımı grafiği nasıl çizilir?

Gerekli paketi yükleyin.

library(ggplot2)
library(MASS)

Gama dağılımına uygun 10.000 sayı oluşturun.

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

Olasılık yoğunluğu fonksiyonunu çizin, x'in hangi dağılımı taktığını bilmiyoruz.

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()

Grafikten, x'in dağılımının gama dağılımına oldukça benzediğini öğrenebiliriz, bu nedenle fitdistr()pakette MASSgama dağılımının şekil ve oran parametrelerini almak için kullanırız .

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

Aynı noktaya gerçek noktayı (siyah nokta) ve takılı grafiği (kırmızı çizgi) çizin ve işte soru, lütfen önce grafiğe bakın.

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()

İki sorum var:

1. Gerçek parametrelerdir shape=2, rate=0.2ve ben işlevini kullanın parametreler fitdistr()almak için vardır shape=2.01, rate=0.20. Bu ikisi neredeyse aynı, ancak yerleştirilmiş grafik neden gerçek noktaya uymuyor, yerleştirilmiş grafikte yanlış bir şey olmalı veya yerleştirilmiş grafiği ve gerçek noktaları çizme şeklim tamamen yanlış, ne yapmalıyım ?

2. Ben lineer modelin veya p-değeri için bir model, RSS (rezidüel kare toplamı) gibi bir şey değerlendirmek hangi yolla ben kurmak modelinin parametresini aldıktan sonra shapiro.test(), ks.test()ve diğer teste?

İstatistiksel bilgi konusunda fakirim, lütfen bana yardım eder misin?

ps: Google'da, stackoverflow ve CV'de birçok kez arama yaptım, ancak bu sorunla ilgili hiçbir şey bulamadım

Soru 1

Yoğunluğu elle hesaplama şekliniz yanlış görünüyor. Gama dağılımından rastgele sayıların yuvarlanmasına gerek yoktur. @Pascal'ın belirttiği gibi, noktaların yoğunluğunu çizmek için bir histogram kullanabilirsiniz. Aşağıdaki örnekte density, yoğunluğu tahmin etmek ve nokta olarak çizmek için işlevi kullanıyorum . Uygunluğu hem noktalarla hem de histogramla sunuyorum:

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 tarafından sağlanan çözüm şöyledir:

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()

soru 2

Uyumun iyiliğini değerlendirmek için paketi tavsiye ederim fitdistrplus. İki dağıtımı sığdırmak ve uyumlarını grafik ve sayısal olarak karşılaştırmak için kullanılabilir. Komut gofstat, AIC, BIC ve KS-Test vb. Gibi bazı gof istatistikleri gibi çeşitli önlemler yazdırır. Bunlar esas olarak farklı dağıtımların uyumlarını karşılaştırmak için kullanılır (bu durumda gama ve Weibull'a karşı). Cevabımda daha fazla bilgi bulabilirsiniz :

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'un (sağ üst panel) uyumları değerlendirmek ve karşılaştırmak için en iyi tek grafik olduğunu doğru bir şekilde tavsiye eder. Uygun yoğunlukların karşılaştırılması zordur. Tamlık uğruna diğer grafikleri de dahil ediyorum.

# 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