Come disegnare un grafico adattato e un grafico effettivo della distribuzione gamma in un diagramma?


10

Carica il pacchetto necessario.

library(ggplot2)
library(MASS)

Genera 10.000 numeri adattati alla distribuzione gamma.

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

Disegna la funzione di densità di probabilità, supponendo che non sappiamo a quale distribuzione x si adatta.

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

Dal grafico, possiamo imparare che la distribuzione di x è abbastanza simile alla distribuzione gamma, quindi usiamo fitdistr()in pacchetto MASSper ottenere i parametri di forma e velocità di distribuzione gamma.

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

Traccia il punto effettivo (punto nero) e il grafico adattato (linea rossa) nella stessa trama, ed ecco la domanda, per favore guarda prima la trama.

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

grafico montato

Ho due domande:

  1. I veri parametri sono shape=2, rate=0.2ei parametri che uso la funzione fitdistr()per ottenere sono shape=2.01, rate=0.20. Questi due sono quasi uguali, ma perché il grafico adattato non si adatta bene al punto reale, ci deve essere qualcosa di sbagliato nel grafico adattato, o il modo in cui disegno il grafico adattato e i punti effettivi è totalmente sbagliato, cosa devo fare ?

  2. Dopo aver ottenuto il parametro del modello, stabilisco, in che modo valuto il modello, qualcosa come RSS (somma quadrata residua) per il modello lineare, o il valore p di shapiro.test(), ks.test()e altri test?

Sono povero di conoscenza statistica, potresti gentilmente aiutarmi?

ps: ho cercato molte volte su Google, StackOverflow e CV, ma non ho trovato nulla correlato a questo problema


1
Per prima cosa ho posto questa domanda in StackOverflow, ma sembrava che questa domanda appartenesse al CV, l'amico ha detto che avevo frainteso la funzione di massa di probabilità e la funzione di densità di probabilità, non potevo afferrarla completamente, quindi perdonami per aver risposto di nuovo a questa domanda in CV
Ling Zhang,

1
Il calcolo delle densità non è corretto. Un modo semplice per calcolare è h <- hist(x, 1000, plot = FALSE); t1 <- data.frame(x = h$mids, y = h$density).

@Pascal hai ragione, ho risolto il Q1, grazie!
Ling Zhang,

Vedi la risposta sotto, la densityfunzione è utile.

Ho capito, grazie ancora per aver modificato e risolto la mia domanda
Ling Zhang,

Risposte:


11

Domanda 1

Il modo in cui calcoli la densità a mano sembra sbagliato. Non è necessario arrotondare i numeri casuali dalla distribuzione gamma. Come notato da @Pascal, puoi usare un istogramma per tracciare la densità dei punti. Nell'esempio seguente, utilizzo la funzione densityper stimare la densità e tracciarla come punti. Vi presento l'adattamento sia con i punti che con l'istogramma:

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

Densità gamma

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

Vestibilità a densità gamma

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

Istogramma con vestibilità

Ecco la soluzione fornita da @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()

Punti di densità dell'istogramma

Domanda 2

Per valutare la bontà di adattamento consiglio il pacchetto fitdistrplus. Ecco come può essere utilizzato per adattarsi a due distribuzioni e confrontare i loro adattamenti graficamente e numericamente. Il comando gofstatstampa diverse misure, come AIC, BIC e alcune statistiche gof come KS-Test ecc. Vengono principalmente utilizzate per confrontare attacchi di diverse distribuzioni (in questo caso gamma contro Weibull). Maggiori informazioni sono disponibili nella mia risposta qui :

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 avvisa giustamente che il QQ-Plot (pannello in alto a destra) è il miglior singolo grafico per giudicare e confrontare gli accoppiamenti. Le densità adattate sono difficili da confrontare. Includo anche l'altra grafica per completezza.

Confronta misure

# 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

1
Non posso revisionare, ma hai un problema con il backtick per fitdistrpluse gofstatnella tua

2
Raccomandazione su una riga: il diagramma quantile-quantile è il miglior grafico singolo per questo scopo. Confrontare le densità osservate e adattate è difficile da fare bene. Ad esempio, è difficile individuare deviazioni sistematiche a valori elevati che scientificamente e praticamente sono spesso molto importanti.
Nick Cox,

1
Sono contento che siamo d'accordo. L'OP inizia con 10.000 punti. Molti problemi iniziano con molti meno e quindi avere una buona idea della densità può essere problematico.
Nick Cox,

1
@LingZhang Per confrontare gli accoppiamenti, è possibile esaminare il valore dell'AIC. È preferibile l'adattamento con il più basso AIC. Inoltre, non sono d'accordo sul fatto che la distribuzione di Weibull e Gamma sia la stessa nel diagramma QQ. I punti della vestibilità Weibull sono più vicini alla linea rispetto alla vestibilità Gamma, specialmente alle code. Di conseguenza, l'AIC per l'adattamento Weibull è più piccolo rispetto all'adattamento Gamma.
COOLSerdash

1
Più dritto è meglio. Inoltre, consulta stats.stackexchange.com/questions/111010/… I principi sono gli stessi. La deviazione sistematica dalla linearità è un problema.
Nick Cox,
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.