Як отримати область еліпса з двовимірних нормально розподілених даних?


13

У мене є дані, які виглядають так:

Малюнок

Я спробував застосувати нормальний розподіл (оцінка щільності ядра працює краще, але мені не потрібна така велика точність), і це працює досить добре. Діаграма щільності складає еліпс.

Мені потрібно отримати цю функцію еліпса, щоб вирішити, чи лежить точка в межах еліпса чи ні. Як це зробити?

R або Mathematica вітаються.

Відповіді:


18

Корсаріо пропонує гарне рішення у коментарі: використовуйте функцію щільності ядра, щоб перевірити на включення в набір рівня.

Інша інтерпретація питання полягає в тому, що він вимагає процедури перевірки на включення в еліпси, створені шляхом двовимірного нормального наближення до даних. Для початку давайте згенеруємо деякі дані, схожі на ілюстрацію у питанні:

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

Еліпси визначаються першим і другим моментами даних:

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

Формула вимагає інверсії матриці дисперсії-коваріації:

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

Функція "висоти" еліпса - від'ємник логарифму двовимірної нормальної щільності :

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

(Я проігнорував адитивну константу, рівну .)журнал(2πdet(Σ))

Щоб перевірити це , давайте намалюємо деякі його контури. Для цього потрібно генерувати сітку точок у напрямку x та y:

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

Обчисліть функцію висоти на цій сітці та побудуйте її:

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)

Контурний сюжет

Очевидно, що це працює. Таким чином, тест , щоб визначити , знаходиться точка лежить всередині еліптичного контуру на рівні поза(с,т)c

ellipse(s,t) <= c

Mathematica виконує завдання так само: обчислює матрицю дисперсії-коваріації даних, інвертує її, будує ellipseфункцію, і ви все готові.


Дякую всім, особливо @whuber. Це саме те, що мені потрібно.
matejuh

Btw. чи є якесь просте рішення для контурів оцінки щільності ядра? Оскільки, якщо я хочу бути більш суворим, мої дані виглядають так: github.com/matejuh/doschecker_wiki_images/raw/master/… респ. github.com/matejuh/doschecker_wiki_images/raw/master/…
matejuh

Я не можу знайти просте рішення в Р. Розгляньте питання про використання функції SmoothKernelDistribution Mathematica 8.
whuber

2
Чи відповідають рівні рівню довіри? Я не думаю, що так. Як я можу це зробити, будь ласка?
matejuh

Це потребує нового запитання, оскільки вам потрібно вказати, до чого ви прагнете впевненості, і - судячи з ваших сюжетів, - виникає занепокоєння щодо того, чи є такі еліпси в першу чергу адекватними описами даних.
whuber

10

Сюжет простий з ellipse()функцією mixtoolsпакету для R:

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

введіть тут опис зображення


5

Перший підхід

Ви можете спробувати такий підхід у Mathematica.

Давайте генеруємо деякі двовимірні дані:

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

Тоді нам потрібно завантажити цей пакет:

Needs["MultivariateStatistics`"]

І зараз:

ellPar=EllipsoidQuantile[data, {0.9}]

дає вихід, який визначає 90% впевненого еліпса. Значення, отримані з цього виводу, мають такий формат:

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

x1 і x2 задають точку, в якій еліпс у центрі, r1 і r2 задають радіуси напіввісі, а d1, d2, d3 і d4 задають напрямок вирівнювання.

Ви також можете побудувати це:

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

Загальною параметричною формою еліпса є:

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]}

І ви можете побудувати це таким чином:

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}}]

Ви можете здійснити перевірку на основі чистої геометричної інформації: якщо евклідова відстань між центром еліпса (ellPar [[1,1]]) та вашою точкою даних більша за відстань між центром еліпса та межею еліпса (очевидно, в тому ж напрямку, в якому знаходиться ваша точка), то ця точка даних знаходиться поза еліпсом.

Другий підхід

Цей підхід заснований на плавному розподілі ядра.

Це деякі дані, що поширюються аналогічно вашим даним:

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];

Ми отримуємо плавне розподіл ядра за цими значеннями даних:

skd = SmoothKernelDistribution[data];

Ми отримуємо числовий результат для кожної точки даних:

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

Ми встановлюємо поріг і вибираємо всі дані, що перевищують цей поріг:

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

Тут ми отримуємо дані, які потрапляють за межі регіону:

dataOut = Complement[data, dataIn];

А тепер ми можемо побудувати всі дані:

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]]

Зелені кольорові точки - це ті, що перевищують поріг, а точки червоного кольору - ті, що знаходяться нижче порогу.

введіть тут опис зображення


Дякую, ваш другий підхід мені дуже допомагає з розподілом ядра. Я програміст, а не статистичний, і я новачок в Mathmatica і R, тому дуже ціную вашу допомогу. У вашому другому підході мені зрозуміло, як перевірити один момент, де він лежить. Але як це зробити при першому підході? Я припускаю, що я маю порівнювати свою точку з визначенням еліпсоїда. Чи можете, будь ласка, надати, як? Тепер я маю сподіватися, що в R є ті самі визначення, тому що мені потрібно використовувати його в RinRuby ...
matejuh

@matejuh Я тільки що додав ще кілька рядків про перший підхід, який може направити вас на рішення.
VLC

2

ellipseФункція в ellipseпакеті для R буде генерувати ці еліпси ( на насправді багатокутник наближаючи еліпс). Ви могли використовувати цей еліпс.

Що насправді може бути простішим - це обчислити висоту густини у вашій точці і побачити, чи вона вище (всередині еліпса) або нижча (поза еліпсом), ніж контурне значення в еліпсі. Внутрішні ellipseфункції функції використовують значення для створення еліпса, ви можете почати там, щоб знайти висоту, яку слід використовувати.χ2


1

Відповідь я знайшов за адресою: /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)

введіть тут опис зображення

Використовуючи наш веб-сайт, ви визнаєте, що прочитали та зрозуміли наші Політику щодо файлів cookie та Політику конфіденційності.
Licensed under cc by-sa 3.0 with attribution required.