Acg N. .
Temat: Jak wygenerowanie rozkłady o zadanej kurtozie?
Czołem :)Dla celów szkoleniowych potrzebuję wygenerować nakładające się na siebie rozkłady: mezo-, lepto- i platykurtyczny. Jednocześnie chcę uniknąć syfu, który bywa nierzadko popełniany, a więc nanoszenia na jeden wykres krzywych gęstości rozkładów o różnej wariancji i "odpowiedniego" opisu osi.
Tym bardziej, że właśnie częścią szkolenia będzie wyjaśnienie czym się różni kurtoza od wariancji (a to cięęęężko wchodzi do głów), więc właśnie z wariancją kombinować nie mogę.
A zatem trzy pierwsze (odpowiednie) momenty kolejnych rozkładów muszą być stałe, aby mieć stałą średnią, wariancję i skośność.
Najprostsze, co mi przyszło do głowy, to składanie rozkładów (fajnie brzmi :D):
1. mezo - rnorm(N, m, s)
2. lepto - c( rnorm(N/2, m, s_małe), rnorm(N/2, m, s_duże )
3. platy - c( rnorm(N/3, m_ujemne, s), rnorm(N/3, 0, s), rnorm(N/3, m_dodatnie, s) )
Gdzie odch. std. jest odpowiednio dobrane.
Trochę problemów jest z platykurtycznym, bo efekt uzyskany tą drogą nie jest zbyt widoczny (K=-0.5), a łatwo stracić kontrolę nad wariancją. Łączenie rozkładów o mniejszej wariancji tworzy oczywiście "piki", a zwiększanie parametru wygładzania dla density() to oczywiście tak samo, jak by zwiększyć wariancję :/ tak czy siak - ciężko "wypłaszczyć ogony" i "rozdąć środek"... Rozumiem więc, że nie tędy droga.
Coś tam uzyskałem, ale trzeba było dobierać eksperymentalnie współczynniki i efekt nie jest zbyt dobry.
Spróbuję się jeszcze bawić krzywymi Johnsona, gdzie można zadać 4 pierwsze momenty, ale muszę o tym doczytać. Tymczasem - może ktoś ma jakiś pomysł?
--------------------
Może komuś się przyda:
library('e1071')
N <- 1000000
cols <- c(mezo="black", lepto="orangered", platy="blue")
mezo <- rnorm(N, 0, 1.52)
plot(density(mezo,from=-5,to=5), col=cols["mezo"], main="Rozkłady mezo-, platy- i leptokurtyczne",
xlab="Wartości cechy", ylab="Gęstość", lwd=2, ylim=range(0,0.4), panel.first=grid(col='gray'), lty="solid")
lepto <- c(rnorm(N/2,mean=0,sd=2.0), rnorm(N/2,mean=0,sd=0.8))
lines(density(lepto), col=cols["lepto"], lwd=2, lty="dotted")
platy <- c(rnorm(N/3,mean=-1.4), rnorm(N/3, mean=0), rnorm(N/3,mean=1.4))
lines(density(platy), col=cols["platy"], lwd=2, lty="longdash")
text(adj=c(0,0), -5, 0.35, substitute(bar(x)[mezo]~"="~srednia, list(srednia=sprintf("%.2f", mean(mezo)))), cex=0.8, col=cols["mezo"])
text(adj=c(0,0), -5, 0.31, substitute(bar(x)[lepto]~"="~srednia, list(srednia=sprintf("%.2f", mean(lepto)))), cex=0.8, col=cols["lepto"])
text(adj=c(0,0), -5, 0.27, substitute(bar(x)[platy]~"="~srednia, list(srednia=sprintf("%.2f", mean(platy)))), cex=0.8, col=cols["platy"])
text(adj=c(0,0), -2.8, 0.35, substitute(bar(sigma)[mezo]~"="~sd, list(sd=sprintf("%.2f", sd(mezo)))), cex=0.8, col=cols["mezo"])
text(adj=c(0,0), -2.8, 0.31, substitute(bar(sigma)[lepto]~"="~sd, list(sd=sprintf("%.2f", sd(lepto)))), cex=0.8, col=cols["lepto"])
text(adj=c(0,0), -2.8, 0.27, substitute(bar(sigma)[platy]~"="~sd, list(sd=sprintf("%.2f", sd(platy)))), cex=0.8, col=cols["platy"])
text(adj=c(.5,0.5), -0.1, 0.05, sprintf("N=%i", N))
text(adj=c(0,0), 1.2, 0.35, substitute(sk[mezo]~"="~sks, list(sks=sprintf("%.2f", skewness(mezo)))), cex=0.8, col=cols["mezo"])
text(adj=c(0,0), 1.2, 0.31, substitute(sk[lepto]~"="~sks, list(sks=sprintf("%.2f", skewness(lepto)))), cex=0.8, col=cols["lepto"])
text(adj=c(0,0), 1.2, 0.27, substitute(sk[platy]~"="~sks, list(sks=sprintf("%.2f", skewness(platy)))), cex=0.8, col=cols["platy"])
text(adj=c(0,0), 3.5, 0.35, substitute(bold(K[mezo]~"="~kurtoza), list(kurtoza=sprintf("%.2f", kurtosis(mezo)))), cex=0.8, col=cols["mezo"])
text(adj=c(0,0), 3.5, 0.31, substitute(bold(K[lepto]~"="~kurtoza), list(kurtoza=sprintf("%.2f", kurtosis(lepto)))), cex=0.8, col=cols["lepto"])
text(adj=c(0,0), 3.5, 0.27, substitute(bold(K[platy]~"="~kurtoza), list(kurtoza=sprintf("%.2f", kurtosis(platy)))), cex=0.8, col=cols["platy"])
PS: bardzo "po polsku" napisałem temat... Michale, jeśli można, to prosiłbym o korektę :)Adrian Olszewski edytował(a) ten post dnia 25.05.12 o godzinie 19:57