Pierwsze podejście
Możesz spróbować tego podejścia w Mathematica.
Wygenerujmy dane dwuwymiarowe:
data = Table[RandomVariate[BinormalDistribution[{50, 50}, {5, 10}, .8]], {1000}];
Następnie musimy załadować ten pakiet:
Needs["MultivariateStatistics`"]
I teraz:
ellPar=EllipsoidQuantile[data, {0.9}]
daje wynik, który definiuje 90% elipsę ufności. Wartości otrzymane z tego wyniku są w następującym formacie:
{Ellipsoid[{x1, x2}, {r1, r2}, {{d1, d2}, {d3, d4}}]}
x1 i x2 określają punkt, w którym elipsa w środku, r1 i r2 określają promienie półosi, a d1, d2, d3 i d4 określają kierunek wyrównania.
Możesz również wykreślić to:
Show[{ListPlot[data, PlotRange -> {{0, 100}, {0, 100}}, AspectRatio -> 1], Graphics[EllipsoidQuantile[data, 0.9]]}]
Ogólna parametryczna forma elipsy to:
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]}
Możesz wykreślić to w ten sposób:
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}}]
Możesz wykonać sprawdzenie w oparciu o informacje czysto geometryczne: jeśli odległość euklidesowa między środkiem elipsy (ellPar [[1,1]]) a punktem danych jest większa niż odległość między środkiem elipsy a granicą elipsa (oczywiście w tym samym kierunku, w którym znajduje się twój punkt), wtedy ten punkt danych znajduje się poza elipsą.
Drugie podejście
To podejście opiera się na płynnej dystrybucji jądra.
Oto niektóre dane dystrybuowane w podobny sposób jak Twoje dane:
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];
Uzyskujemy płynny rozkład jądra na tych wartościach danych:
skd = SmoothKernelDistribution[data];
Otrzymujemy wynik liczbowy dla każdego punktu danych:
eval = Table[{data[[i]], PDF[skd, data[[i]]]}, {i, Length[data]}];
Naprawiamy próg i wybieramy wszystkie dane, które są wyższe niż ten próg:
threshold = 1.2;
dataIn = Select[eval, #1[[2]] > threshold &][[All, 1]];
Tutaj otrzymujemy dane spoza regionu:
dataOut = Complement[data, dataIn];
A teraz możemy wykreślić wszystkie dane:
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]]
Punkty w kolorze zielonym są powyżej progu, a punkty w kolorze czerwonym są poniżej progu.