İki değişkenli normal dağıtılmış verilerden elips bölgesi nasıl alınır?

Şuna benzeyen verilerim var:

Üzerine normal dağılım (çekirdek yoğunluğu tahmini daha iyi çalışır, ancak böyle büyük bir hassasiyete ihtiyacım yok) uygulamaya çalıştım ve oldukça iyi çalışıyor. Yoğunluk grafiği bir elips yapar.

Bir noktanın elips bölgesinde olup olmadığına karar vermek için bu elips işlevini almam gerekiyor. Bu nasıl yapılır?

R veya Mathematica kodu memnuniyetle karşılanmaktadır.

Corsario bir yorumda iyi bir çözüm sunar: bir düzey kümesine dahil edilme durumunu test etmek için çekirdek yoğunluğu işlevini kullanın.

Sorunun başka bir yorumu , verilere iki değişkenli normal bir yaklaşımla oluşturulan elipslere dahil edilme testini yapmak için bir prosedür talep etmesidir . Başlamak için, sorudaki şekle benzeyen bazı veriler üretelim:

library(mvtnorm) # References rmvnorm()
set.seed(17)
p <- rmvnorm(1000, c(250000, 20000), matrix(c(100000^2, 22000^2, 22000^2, 6000^2),2,2))

Elipsler verilerin birinci ve ikinci momentleri tarafından belirlenir:

center <- apply(p, 2, mean)
sigma <- cov(p)

Formül , varyans-kovaryans matrisinin ters çevrilmesini gerektirir:

sigma.inv = solve(sigma, matrix(c(1,0,0,1),2,2))

Elips "yükseklik" işlevi, iki değişkenli normal yoğunluğun logaritmasının negatifidir :

ellipse <- function(s,t) {u<-c(s,t)-center; u %*% sigma.inv %*% u / 2}

( değerine eşit bir katkı sabitini yok .)$\log(2\pi\sqrt{\det(\Sigma)})$

Bunu test etmek için , bazı konturlarını çizelim. Bu, x ve y yönlerinde bir nokta ızgarasının oluşturulmasını gerektirir:

n <- 50
x <- (0:(n-1)) * (500000/(n-1))
y <- (0:(n-1)) * (50000/(n-1))

Bu ızgaradaki yükseklik işlevini hesaplayın ve çizin:

z <- mapply(ellipse, as.vector(rep(x,n)), as.vector(outer(rep(0,n), y, `+`)))
plot(p, pch=20, xlim=c(0,500000), ylim=c(0,50000), xlab="Packets", ylab="Flows")
contour(x,y,matrix(z,n,n), levels=(0:10), col = terrain.colors(11), add=TRUE)

Açıkçası işe yarıyor. Bu nedenle, test noktası olup olmadığını belirlemek için seviyesi de eliptik konturu içinde yalan olan$(s,t)$$c$

ellipse(s,t) <= c

Mathematica işi aynı şekilde yapar: verilerin varyans-kovaryans matrisini hesaplayın, ters çevirin, ellipseişlevi oluşturun ve hazırsınız.

Çizim, R ellipse()için mixtoolspaketin fonksiyonu ile basittir :

library(mixtools)
library(mvtnorm) 
set.seed(17)
p <- rmvnorm(1000, c(250000, 20000), matrix(c(100000^2, 22000^2, 22000^2, 6000^2),2,2))
plot(p, pch=20, xlim=c(0,500000), ylim=c(0,50000), xlab="Packets", ylab="Flows")
ellipse(mu=colMeans(p), sigma=cov(p), alpha = .05, npoints = 250, col="red") 

İlk yaklaşım

Bu yaklaşımı Mathematica'da deneyebilirsiniz.

Bazı iki değişkenli veriler oluşturalım:

data = Table[RandomVariate[BinormalDistribution[{50, 50}, {5, 10}, .8]], {1000}];

O zaman bu paketi yüklememiz gerekiyor:

Needs["MultivariateStatistics`"]

Ve şimdi:

ellPar=EllipsoidQuantile[data, {0.9}]

% 90 güven elipsini tanımlayan bir çıktı verir. Bu çıktıdan elde ettiğiniz değerler aşağıdaki formattadır:

{Ellipsoid[{x1, x2}, {r1, r2}, {{d1, d2}, {d3, d4}}]}

x1 ve x2 ortadaki elipsin, r1 ve r2'nin yarı eksen yarıçaplarını ve d1, d2, d3 ve d4'ün hizalama yönünü belirttiği noktayı belirtir.

Bunu da çizebilirsiniz:

Show[{ListPlot[data, PlotRange -> {{0, 100}, {0, 100}}, AspectRatio -> 1],  Graphics[EllipsoidQuantile[data, 0.9]]}]

Elipsin genel parametrik formu:

ell[t_, xc_, yc_, a_, b_, angle_] := {xc + a Cos[t] Cos[angle] - b Sin[t] Sin[angle],
    yc + a Cos[t] Sin[angle] + b Sin[t] Cos[angle]}

Ve bu şekilde çizebilirsiniz:

ParametricPlot[
    ell[t, ellPar[[1, 1, 1]], ellPar[[1, 1, 2]], ellPar[[1, 2, 1]], ellPar[[1, 2, 2]],
    ArcTan[ellPar[[1, 3, 1, 2]]/ellPar[[1, 3, 1, 1]]]], {t, 0, 2 \[Pi]},
    PlotRange -> {{0, 100}, {0, 100}}]

Saf geometrik bilgilere dayanarak bir kontrol yapabilirsiniz: elipsin merkezi (ellPar [[1,1]]) ile veri noktanız arasındaki Öklid mesafesi elips merkezi ile kenarlığı arasındaki mesafeden büyükse elips (açıkçası, noktanızın bulunduğu yönde), bu veri noktası elipsin dışındadır.

İkinci yaklaşım

Bu yaklaşım, düzgün çekirdek dağılımına dayanmaktadır.

Bunlar, verilerinize benzer şekilde dağıtılan bazı verilerdir:

data1 = RandomVariate[BinormalDistribution[{.3, .7}, {.2, .3}, .8], 500];
data2 = RandomVariate[BinormalDistribution[{.6, .3}, {.4, .15}, .8], 500];
data = Partition[Flatten[Join[{data1, data2}]], 2];

Bu veri değerleri üzerinde düzgün bir çekirdek dağılımı elde ediyoruz:

skd = SmoothKernelDistribution[data];

Her veri noktası için sayısal bir sonuç elde ederiz:

eval = Table[{data[[i]], PDF[skd, data[[i]]]}, {i, Length[data]}];

Bir eşiği düzeltiriz ve bu eşikten daha yüksek olan tüm verileri seçeriz:

threshold = 1.2;
dataIn = Select[eval, #1[[2]] > threshold &][[All, 1]];

Burada bölgenin dışında kalan verileri alıyoruz:

dataOut = Complement[data, dataIn];

Ve şimdi tüm verileri çizebiliriz:

Show[ContourPlot[Evaluate@PDF[skd, {x, y}], {x, 0, 1}, {y, 0, 1}, PlotRange -> {{0, 1}, {0, 1}}, PlotPoints -> 50],
ListPlot[dataIn, PlotStyle -> Darker[Green]],
ListPlot[dataOut, PlotStyle -> Red]]

Yeşil renkli noktalar eşiğin üstündeki noktalardır ve kırmızı renkli noktalar eşiğin altındaki noktalardır.

ellipseFonksiyon ellipse, bu elips üretecektir R paketin (aslında bir çokgen elips yaklaşan). Bu elipsi kullanabilirsiniz.

Aslında daha kolay olabilecek nokta, noktadaki yoğunluğun yüksekliğini hesaplamak ve elipsin kontur değerinden daha yüksek (elipsin içinde) veya daha düşük (elipsin dışında) olup olmadığına bakmaktır. İç ellipsefonksiyonlar elipsi oluşturmak için bir değeri kullanır, kullanılacak yüksekliği bulmak için oradan başlayabilirsiniz.$\chi^2$

Cevabı şu adreste buldum: /programming/2397097/how-can-a-data-ellipse-be-superimposed-on-a-ggplot2-scatterplot

#bootstrap
set.seed(101)
n <- 1000
x <- rnorm(n, mean=2)
y <- 1.5 + 0.4*x + rnorm(n)
df <- data.frame(x=x, y=y, group="A")
x <- rnorm(n, mean=2)
y <- 1.5*x + 0.4 + rnorm(n)
df <- rbind(df, data.frame(x=x, y=y, group="B"))

#calculating ellipses
library(ellipse)
df_ell <- data.frame()
for(g in levels(df$group)){
df_ell <- rbind(df_ell, cbind(as.data.frame(with(df[df$group==g,], ellipse(cor(x, y), 
                                         scale=c(sd(x),sd(y)), 
                                         centre=c(mean(x),mean(y))))),group=g))
}
#drawing
library(ggplot2)
p <- ggplot(data=df, aes(x=x, y=y,colour=group)) + geom_point(size=1.5, alpha=.6) +
  geom_path(data=df_ell, aes(x=x, y=y,colour=group), size=1, linetype=2)