बाइवेरेट सामान्य वितरित डेटा से दीर्घवृत्त क्षेत्र कैसे प्राप्त करें?

Question

मेरे पास डेटा है जो दिखता है:

मैंने सामान्य वितरण को लागू करने की कोशिश की (कर्नेल घनत्व अनुमान बेहतर काम करता है, लेकिन मुझे इस पर इतनी बड़ी सटीकता की आवश्यकता नहीं है) और यह काफी अच्छी तरह से काम करता है। घनत्व प्लॉट एक दीर्घवृत्त बनाता है।

मुझे उस दीर्घवृत्त समारोह को प्राप्त करने की आवश्यकता है ताकि यह तय हो सके कि एक बिंदु दीर्घवृत्त क्षेत्र के भीतर है या नहीं। उसको कैसे करे?

आर या गणितज्ञ कोड का स्वागत किया जाता है।

Answer 1

Corsario एक टिप्पणी में एक अच्छा समाधान प्रदान करता है: एक स्तर सेट के भीतर शामिल करने के लिए परीक्षण करने के लिए कर्नेल घनत्व फ़ंक्शन का उपयोग करें।

प्रश्न की एक अन्य व्याख्या यह है कि यह डेटा के लिए एक द्विभाजित सामान्य सन्निकटन द्वारा बनाए गए दीर्घवृत्त के भीतर शामिल करने के लिए परीक्षण करने के लिए एक प्रक्रिया का अनुरोध करता है । आरंभ करने के लिए, आइए कुछ डेटा उत्पन्न करें जो प्रश्न में चित्रण की तरह दिखाई देते हैं:

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}

(मैंने बराबर एक additive निरंतर को अनदेखा किया है ।))$\log(2\pi\sqrt{\det(\Sigma)})$

इसे जांचने के लिए , आइए इसके कुछ कंट्रोवर्सीज को ड्रा करें। इसके लिए 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)

जाहिर है कि यह काम करता है। इसलिए, परीक्षण निर्धारित करने के लिए एक बिंदु है कि क्या के स्तर पर एक अण्डाकार समोच्च अंदर झूठ है$(s,t)$$c$

ellipse(s,t) <= c

Mathematica उसी तरह से काम करता है: डेटा के variance-covariance मैट्रिक्स की गणना करें, इसे उल्टा करें, ellipseफ़ंक्शन का निर्माण करें , और आप सभी सेट हैं।

Comments

आप सभी को, विशेष रूप से @whuber को धन्यवाद। यह ठीक वैसा ही है जैसा मुझे चाहिए।

— मातुजू

Btw। क्या कर्नेल घनत्व अनुमान आकृति के लिए कोई सरल उपाय है? क्योंकि यदि मैं अधिक सख्त होना चाहता हूं, तो मेरा डेटा ऐसा दिखता है: github.com/matejuh/doschecker_wiki_images/raw/master/… सम्मान। github.com/matejuh/doschecker_wiki_images/raw/master/…

— matejuh

मैं R में एक सरल समाधान नहीं ढूँढ सकता। गणितज्ञ 8 के "स्मूथकर्नेलडिस्ट्रेशन" फ़ंक्शन का उपयोग करने पर विचार करें ।

— whuber

क्या स्तर आत्मविश्वास के स्तर को दर्शाता है? मुझे ऐसा नहीं लगता। मैं ऐसा कैसे कर सकता हूं?

— मृत्युंजय

आपको एक नए प्रश्न की आवश्यकता है, क्योंकि आपको यह निर्दिष्ट करने की आवश्यकता है कि आप अपने भूखंडों से क्या और क्या-क्या न्याय चाहते हैं - इस बात की चिंता है कि क्या इस तरह के दीर्घवृत्त पहले स्थान पर डेटा के पर्याप्त विवरण हैं।

— whuber

Answer 2

R के लिए पैकेज के ellipse()कार्य के साथ प्लॉट सीधा है mixtools:

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

Answer 3

पहले दृष्टिकोण

आप इस दृष्टिकोण को मैथेमेटिका में आज़मा सकते हैं।

आइए कुछ बीवरिएट डेटा उत्पन्न करें:

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

एक्स 1 और एक्स 2 उस बिंदु को निर्दिष्ट करते हैं जिस पर केंद्रित, आर 1 और आर 2 में दीर्घवृत्त अर्ध-अक्ष राडाइ निर्दिष्ट करते हैं, और डी 1, डी 2, डी 3 और डी 4 संरेखण दिशा निर्दिष्ट करते हैं।

आप यह भी प्लॉट कर सकते हैं:

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

हरे रंग के बिंदु वे दहलीज के ऊपर होते हैं और लाल रंग के बिंदु दहलीज के नीचे होते हैं।

Comments

धन्यवाद, आपका दूसरा दृष्टिकोण कर्नेल वितरण के साथ मुझे बहुत मदद करता है। मैं प्रोग्रामर हूं, स्टेटिस्टिक नहीं हूं और मैथमैटिका और आर में नौसिखिया हूं इसलिए मैं आपकी मदद की बहुत सराहना करता हूं। आपके दूसरे दृष्टिकोण में यह मेरे लिए स्पष्ट है कि एक बिंदु का परीक्षण कैसे किया जाए जहां यह झूठ है। लेकिन पहले दृष्टिकोण में ऐसा कैसे करें? मुझे लगता है कि मुझे अपनी बात की ellipsoid परिभाषा से तुलना करनी होगी। क्या आप कृपया प्रदान कर सकते हैं कैसे? अब मुझे आशा है कि R में समान परिभाषाएँ हैं, क्योंकि मुझे इसे रिन्यूबी में उपयोग करने की आवश्यकता है ...

— matejuh

@मेटजू ने पहले दृष्टिकोण के बारे में कुछ और पंक्तियाँ जोड़ीं जो आपको समाधान के लिए निर्देशित कर सकती हैं।

— VLC

Answer 4

ellipseमें समारोह ellipseआर के लिए पैकेज इन दीर्घवृत्त उत्पन्न होगा (वास्तव में एक बहुभुज दीर्घवृत्त का अनुमान)। आप उस दीर्घवृत्त का उपयोग कर सकते हैं।

वास्तव में जो आसान हो सकता है वह यह है कि आपके बिंदु पर घनत्व की ऊंचाई की गणना करें और देखें कि क्या यह दीर्घवृत्त (दीर्घवृत्त के अंदर) या निम्न (दीर्घवृत्त के बाहर) दीर्घवृत्त के मान से अधिक है। ellipseसमारोह internals एक का उपयोग मूल्य अंडाकार बनाने के लिए, तुम वहाँ उपयोग करने के लिए ऊंचाई को खोजने के लिए शुरू कर सकता है।$\chi^2$

Answer 5

मुझे इसका उत्तर मिला: /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)