বিভাজনযুক্ত সাধারণ বিতরণ করা ডেটা থেকে উপবৃত্ত অঞ্চলটি কীভাবে পাবেন?

Question

আমার কাছে এমন ডেটা রয়েছে যা দেখে মনে হচ্ছে:

আমি স্বাভাবিক বিতরণ প্রয়োগ করার চেষ্টা করেছি (কার্নেলের ঘনত্বের প্রাক্কলনটি আরও ভাল কাজ করে তবে আমার এ জাতীয় দুর্দান্ত নির্ভুলতার প্রয়োজন নেই) এবং এটি বেশ ভালভাবে কাজ করে। ঘনত্বের প্লট একটি উপবৃত্ত তৈরি করে।

উপবৃত্তের অঞ্চলের মধ্যে কোনও বিন্দু রয়েছে কি না তা সিদ্ধান্ত নিতে আমাকে সেই উপবৃত্ত ফাংশনটি পাওয়া দরকার। কিভাবে যে কি?

আর বা ম্যাথমেটিকা ​​কোড স্বাগত জানানো হয়।

Answer 1

কর্সারিও একটি মন্তব্যে একটি ভাল সমাধান সরবরাহ করে: স্তর স্তরের অন্তর্ভুক্তির জন্য পরীক্ষা করতে কর্নেল ঘনত্ব ফাংশনটি ব্যবহার করুন।

প্রশ্নের অন্য ব্যাখ্যাটি হ'ল এটি উপাত্তের দ্বিবির্ভর স্বাভাবিক আনুমানিকতার দ্বারা সৃষ্ট উপবৃত্তগুলির মধ্যে অন্তর্ভুক্তির জন্য পরীক্ষার জন্য একটি পদ্ধতির অনুরোধ করে। শুরু করতে, আসুন এমন কিছু ডেটা তৈরি করি যা প্রশ্নের উদাহরণের মতো দেখায়:

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}

(আমি equal) এর সমত কোনও অ্যাডিটিভ ধ্রুবক উপেক্ষা করেছি )$\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

ম্যাথামেটিকা একইভাবে কাজটি করেন: ডেটাটির ভেরিয়েন্স-কোভেরিয়েন্স ম্যাট্রিক্সটি গণনা করুন, এটি উল্টান করুন, ellipseফাংশনটি তৈরি করুন এবং আপনি সমস্ত প্রস্তুত।

Comments

আপনাকে সবাইকে ধন্যবাদ, বিশেষত @ হুবুহু এটি আমার প্রয়োজন ঠিক তাই।

— মাতেজাহ

BTW। কার্নেল ঘনত্বের অনুমানের পৃষ্ঠার জন্য কি কোনও সহজ সমাধান রয়েছে? কারণ আমি যদি আরও কঠোর হতে চাই তবে আমার ডেটা দেখতে দেখতে: github.com/matejuh/doschecker_wiki_images/raw/master/… রেসপেক্ট । github.com/matejuh/doschecker_wiki_images/raw/master/…

— মাতেজুহ

আমি আর একটি সহজ সমাধান ব্যবহার করার কথা বিবেচনা খুঁজে পাচ্ছি না ম্যাথামেটিকাল 8 এর "SmoothKernelDistribution" ফাংশন।

— whuber

আধ্যাত্মিক স্তরের স্তরের কর্ডস্প্যান্ডগুলি কী? আমি তাই মনে করি না। আমি কীভাবে এটি করতে পারি?

— মাতেজাহ

এটির জন্য একটি নতুন প্রশ্ন দরকার, কারণ আপনি কীসের আত্মবিশ্বাস চান তা নির্দিষ্ট করতে হবে এবং - আপনার প্লটগুলি থেকে বিচার করা - এই জাতীয় উপবৃত্তিগুলি প্রথমে ডেটার পর্যাপ্ত বিবরণ কিনা তা নিয়ে উদ্বেগ রয়েছে।

— হোবার

Answer 2

আর এর জন্য প্যাকেজটির 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}}]}

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

আপনি খাঁটি জ্যামিতিক তথ্যের উপর ভিত্তি করে একটি চেক সম্পাদন করতে পারেন: যদি উপবৃত্তের কেন্দ্র (এলিপার [[১,১]]) এর মধ্যে ইউক্লিডিয়ান দূরত্ব থাকে এবং উপবৃত্তের কেন্দ্র এবং সীমান্তের মধ্যবর্তী দূরত্বের চেয়ে আপনার ডেটা পয়েন্ট বড় হয় উপবৃত্ত (স্পষ্টতই, আপনার পয়েন্টটি যেদিকে একই অবস্থিত), তারপরে সেই ডেটা পয়েন্টটি উপবৃত্তের বাইরে।

দ্বিতীয় পন্থা

এই পদ্ধতির মসৃণ কার্নেল বিতরণের উপর ভিত্তি করে।

এগুলি আপনার ডেটার অনুরূপ উপায়ে বিতরণ করা কিছু ডেটা:

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

ধন্যবাদ, আপনার দ্বিতীয় পদ্ধতি আমাকে কর্নেল বিতরণে অনেক সহায়তা করে। আমি প্রোগ্রামার, পরিসংখ্যানগত নই এবং আমি ম্যাথমেটিকা ​​এবং আর-তে নতুন নবী তাই আমি আপনার সহায়তার অনেক প্রশংসা করি। আপনার দ্বিতীয় পদ্ধতির মধ্যে এটি আমার কাছে পরিষ্কার যে কিভাবে এটি একটি বিন্দু যেখানে পরীক্ষা করা যায়। কিন্তু কিভাবে প্রথম পদ্ধতির মধ্যে এটি করতে? আমি মনে করি আমাকে আমার বক্তব্যটি উপবৃত্তাকার সংজ্ঞা দিয়ে তুলনা করতে হবে। কিভাবে প্রদান করতে পারেন দয়া করে? এখন আমাকে আশা করতে হবে যে আর-তেও একই সংজ্ঞা রয়েছে, কারণ আমাকে রিনরুবিতে এটি ব্যবহার করা দরকার ...

— matejuh

@ মেটেজুহ আমি প্রথম পদ্ধতির সম্পর্কে আরও কয়েকটি লাইন যুক্ত করেছি যা আপনাকে কোনও সমাধানের দিকে নিয়ে যেতে পারে।

— ভিএলসি

Answer 4

আর এর জন্য প্যাকেজে থাকা ellipseক্রিয়াকলাপটি ellipseএই উপবৃত্তগুলি উত্পন্ন করবে (প্রকৃতপক্ষে উপবৃত্তের সমান একটি বহুভুজ)। আপনি সেই উপবৃত্তটি ব্যবহার করতে পারেন।

আসলে কী সহজ হতে পারে তা হ'ল আপনার বিন্দুতে ঘনত্বের উচ্চতা গণনা করা এবং উপবৃত্তের কনট্যুর মানের চেয়ে এটি (উপবৃত্তের অভ্যন্তরে) বা কম (উপবৃত্তের বাইরে) কিনা তা দেখুন if ellipseফাংশন অভ্যন্তরীণ একটি ব্যবহার মান উপবৃত্তাকার তৈরি করতে আপনি সেখানে ব্যবহার উচ্চতা খোঁজার জন্য শুরু করতে পারে।$\chi^2$

Answer 5

আমি উত্তরটি এখানে পেয়েছি: /programming/2397097/how-can-a-data-ellipse-be-superimpused-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)