একটি কিউকিউ-প্লটের কেন্দ্রের নিকটে বহিরাগত পয়েন্টগুলি সরিয়ে ফেলা হচ্ছে

Question

আমি প্রায় 1.2 মিলিয়ন পয়েন্টের দুটি ডাটা সেট, আর (কিউকিপ্লট ব্যবহার করে এবং ডেটা জিজিপ্লাট 2 এ খাওয়ানো) সহ একটি কিউ-প্লট প্লট করার চেষ্টা করছি। গণনাটি যথেষ্ট সহজ, তবে ফলক গ্রাফটি লোড করা বেদনাদায়কভাবে ধীরে ধীরে, কারণ অনেকগুলি পয়েন্ট রয়েছে। আমি পয়েন্ট সংখ্যা 10000 কমানোর জন্য লিনিয়ার আনুমানিকতা চেষ্টা করেছি (এটি কিউকিপ্লট ফাংশন যাইহোক যাইহোক, যদি আপনার কোনও ডেটা সেট অন্যের চেয়ে বড় হয়) তবে আপনি লেজগুলিতে প্রচুর বিবরণ হারাবেন।

কেন্দ্রের দিকে ডেটা পয়েন্টগুলির বেশিরভাগই মূলত অকেজো - এগুলি এত বেশি ওভারল্যাপ করে যে পিক্সেল প্রতি প্রায় 100 রয়েছে। লেজগুলির দিকে আরও স্পার্স ডেটা না হারিয়ে, এমন কি খুব সহজেই ডেটা অপসারণের কোনও সহজ উপায় আছে?

Comments

আমার উল্লেখ করা উচিত ছিল, আমি আসলে একটি ডেটা সেট (জলবায়ু পর্যবেক্ষণ) এর সাথে তুলনামূলক ডেটা সেটগুলির (মডেল রান) সংকলনের সাথে তুলনা করছি। সুতরাং আমি 87m মডেল পয়েন্টের সাথে আমি 1.2m obs পয়েন্টগুলির সাথে তুলনা করছি, সুতরাং approx()ফাংশনটি qqplot()ফাংশনে কার্যকর হয়।

— nnot101

Answer 1

কিউকিউ প্লটগুলি লেজ বাদে অবিশ্বাস্যভাবে স্বতঃসংশ্লিষ্ট। তাদের পর্যালোচনা করতে গিয়ে একজন প্লটের সামগ্রিক আকার এবং লেজের আচরণের দিকে মনোনিবেশ করে। অতএব , আপনি স্থূলভাবে দ্বারা জরিমানা কি করতে হবে ডিস্ট্রিবিউশন এর কেন্দ্রে subsampling এবং মুদ্রার উলটা পিঠ যথেষ্ট পরিমাণ সহ।

এখানে একটি সম্পূর্ণ ডেটাসেট জুড়ে কীভাবে নমুনা বজায় রাখা যায় সেইসাথে চরম মানগুলি কীভাবে নেওয়া যায় তা এখানে কোড সহকারে।

quant.subsample <- function(y, m=100, e=1) {
  # m: size of a systematic sample
  # e: number of extreme values at either end to use
  x <- sort(y)
  n <- length(x)
  quants <- (1 + sin(1:m / (m+1) * pi - pi/2))/2
  sort(c(x[1:e], quantile(x, probs=quants), x[(n+1-e):n]))
  # Returns m + 2*e sorted values from the EDF of y
}

উদাহরণস্বরূপ, এই সিমুলেটেড ডেটাসেটটি প্রায় 1.2 মিলিয়ন মানের দুটি ডেটাসেটের মধ্যে একটির মধ্যে খুব কম পরিমাণে "দূষণ" এর মধ্যে একটি কাঠামোগত পার্থক্য দেখায়। এছাড়াও, এই পরীক্ষাটি কঠোর করার জন্য মানগুলির একটি বিরতি সম্পূর্ণরূপে একটি ডেটাसेट থেকে বাদ দেওয়া হয়: কিউকিউ প্লটের সেই মানগুলির জন্য একটি বিরতি প্রদর্শন করা দরকার।

set.seed(17)
n.x <- 1.21 * 10^6
n.y <- 1.20 * 10^6
k <- floor(0.0001*n.x)
x <- c(rnorm(n.x-k), rnorm(k, mean=2, sd=2))
x <- x[x <= -3 | x >= -2.5]
y <- rbeta(n.y, 10,13)

আমরা প্রতিটি ডেটাসেটের 0.1% সাবস্ক্রিপশন করতে পারি এবং তাদের চরমের আরও 0.1% অন্তর্ভুক্ত করতে পারি, প্লটকে 2420 পয়েন্ট দিয়ে। মোট সময় অতিবাহিত সময় 0.5 সেকেন্ডের কম:

m <- .001 * max(n.x, n.y)
e <- floor(0.0005 * max(n.x, n.y))

system.time(
  plot(quant.subsample(x, m, e), 
       quant.subsample(y, m, e), 
       pch=".", cex=4,
       xlab="x", ylab="y", main="QQ Plot")
  )

কোনও তথ্যই হারিয়ে যায় না:

Comments

আপনার উত্তরগুলি মার্জ করা উচিত নয়?

— মাইকেল আর চেরনিক

@ মিশেল হ্যাঁ, সাধারণত আমি প্রথম উত্তরটি (বর্তমানটি) সম্পাদনা করতাম। তবে প্রতিটি উত্তর দীর্ঘ এবং তারা বিভিন্ন পারফরম্যান্সের বৈশিষ্ট্য সহ যথেষ্ট ভিন্ন পদ্ধতির ব্যবহার করে, তাই দ্বিতীয়টি পৃথক উত্তর হিসাবে পোস্ট করা ভাল বলে মনে হয়। আসলে, আমার দ্বিতীয়টি (অভিযোজক) ঘটনার পরে আমি প্রথমটি মুছে ফেলার জন্য প্রলুব্ধ হয়েছিলাম, তবে এর আপেক্ষিক গতি কিছু লোকের কাছে আবেদন করতে পারে, সুতরাং এটি সম্পূর্ণরূপে অপসারণ করা অন্যায় হবে।

— whuber

এটি মূলত আমি যা চেয়েছিলাম তা কিন্তু এর পিছনে যুক্তি কী sin? আমি কি ঠিক বলেছি যে সাধারণ সিডিএফ আরও ভাল ফাংশন হবে, যদি আপনি ধরে নেন যে এক্সটি সাধারণত বিতরণ করা হয়েছিল? গণনা করা সহজ বলে আপনি কি পাপকে বেছে নিয়েছিলেন?

— nnot101

এটি কি আপনার অন্যান্য উত্তরের মতো একই ডেটা বলে মনে হচ্ছে? যদি তা হয় তবে প্লটগুলি এত আলাদা কেন? এক্স> 6 এর জন্য সমস্ত ডেটা কী হয়েছে?

— nnot101

$(3-2x)x^2$

Answer 2

এই থ্রেডের অন্য কোথাও আমি পয়েন্টগুলি সাবমল করার একটি সহজ তবে কিছুটা অ্যাডহক সমাধান প্রস্তাব করেছি । এটি দ্রুত, তবে দুর্দান্ত প্লট তৈরি করতে কিছু পরীক্ষা-নিরীক্ষার প্রয়োজন। বর্ণিত হওয়া সমাধানটি হ'ল প্রস্থের ধীর ক্রম (1.2 মিলিয়ন পয়েন্টের জন্য 10 সেকেন্ড পর্যন্ত সময় নেওয়া) তবে অভিযোজিত এবং স্বয়ংক্রিয়। বড় ডেটাসেটের জন্য, প্রথম বার ভাল ফলাফল দেওয়া উচিত এবং যুক্তিযুক্তভাবে দ্রুত করা উচিত।

$D_n$

এর এক্সট্রামায় যোগ দেওয়ার লাইনের মধ্যে সর্বাধিক উল্লম্ব বিচ্যুতি সন্ধান করুন$(x,y)$$t$$y$

যত্ন নেওয়ার জন্য কিছু বিশদ রয়েছে, বিশেষত বিভিন্ন দৈর্ঘ্যের ডেটাসেটগুলি মোকাবেলা করার জন্য। আমি লম্বাটির সাথে সম্পর্কিত কোয়ান্টাইলগুলির দ্বারা সংক্ষিপ্ত একটিকে প্রতিস্থাপন করে এটি করি: কার্যত, সংক্ষিপ্তটির EDF এর একটি টুকরোচক রৈখিক আনুমানিকতা এর প্রকৃত ডেটা মানগুলির পরিবর্তে ব্যবহৃত হয়। ("সংক্ষিপ্ত" এবং "দীর্ঘ" সেট করে বিপরীত হতে পারে use.shortest=TRUE))

এখানে একটি Rবাস্তবায়ন।

qq <- function(x0, y0, t.y=0.0005, use.shortest=FALSE) {
  qq.int <- function(x,y, i.min,i.max) {
    # x, y are sorted and of equal length
    n <-length(y)
    if (n==1) return(c(x=x, y=y, i=i.max))
    if (n==2) return(cbind(x=x, y=y, i=c(i.min,i.max)))
    beta <- ifelse( x[1]==x[n], 0, (y[n] - y[1]) / (x[n] - x[1]))
    alpha <- y[1] - beta*x[1]
    fit <- alpha + x * beta
    i <- median(c(2, n-1, which.max(abs(y-fit))))
    if (abs(y[i]-fit[i]) > thresh) {
      assemble(qq.int(x[1:i], y[1:i], i.min, i.min+i-1), 
               qq.int(x[i:n], y[i:n], i.min+i-1, i.max))
    } else {
      cbind(x=c(x[1],x[n]), y=c(y[1], y[n]), i=c(i.min, i.max))
    }
  }
  assemble <- function(xy1, xy2) {
    rbind(xy1, xy2[-1,])
  }
  #
  # Pre-process the input so that sorting is done once
  # and the most detail is extracted from the data.
  #
  is.reversed <- length(y0) < length(x0)
  if (use.shortest) is.reversed <- !is.reversed
  if (is.reversed) {
    y <- sort(x0)
    n <- length(y)
    x <- quantile(y0, prob=(1:n-1)/(n-1))    
  } else {
    y <- sort(y0)
    n <- length(y)
    x <- quantile(x0, prob=(1:n-1)/(n-1))    
  }
  #
  # Convert the relative threshold t.y into an absolute.
  #
  thresh <- t.y * diff(range(y))
  #
  # Recursively obtain points on the QQ plot.
  #
  xy <- qq.int(x, y, 1, n)
  if (is.reversed) cbind(x=xy[,2], y=xy[,1], i=xy[,3]) else xy
}

উদাহরণ হিসাবে আমি আমার পূর্ববর্তী উত্তরের মতো সিমুলেটেড ডেটা ব্যবহার করি (একটি চরম উচ্চ আউটলেট ফেলে দেওয়া yএবং xএই সময়ে বেশ কিছুটা দূষণের সাথে ):

set.seed(17)
n.x <- 1.21 * 10^6
n.y <- 1.20 * 10^6
k <- floor(0.01*n.x)
x <- c(rnorm(n.x-k), rnorm(k, mean=2, sd=2))
x <- x[x <= -3 | x >= -2.5]
y <- c(rbeta(n.y, 10,13), 1)

প্রান্তিকের ছোট এবং ছোট মানগুলি ব্যবহার করে কয়েকটি সংস্করণ প্লট করা যাক। .0005 এর মান এবং একটি মনিটরে 1000 পিক্সেল লম্বা প্রদর্শিত, আমরা হব প্লটের যে কোনও জায়গায় অর্ধেক উল্লম্ব পিক্সেলের চেয়ে বেশি না হওয়ার ত্রুটির গ্যারান্টি । এটি ধূসর রঙে দেখানো হয়েছে (কেবল 522 পয়েন্ট, লাইন বিভাগ দ্বারা যুক্ত); মোটা অনুমানগুলি এর উপরে প্লট করা হয়: প্রথমে কালোতে, তারপরে লাল রঙের (লাল পয়েন্টগুলি কালো রঙের একটি উপসেট হবে এবং সেগুলি overplot করা হবে), তারপরে নীল (যা আবার একটি উপসেট এবং ওভারপ্ল্লট)। সময়সীমা 6.5 (নীল) থেকে 10 সেকেন্ড (ধূসর) পর্যন্ত। প্রদত্ত যে তারা এত ভাল স্কেল করেছে, কেউ কেবল মাত্র প্রান্তিকের জন্য সর্বজনীন ডিফল্ট হিসাবে প্রায় দেড় পিক্সেল ব্যবহার করতে পারে ( যেমন , 1000 পিক্সেলের উচ্চ মনিটরের জন্য 1/2000) এবং এটি দিয়ে সম্পন্ন করা হবে।

qq.1 <- qq(x,y)
plot(qq.1, type="l", lwd=1, col="Gray",
     xlab="x", ylab="y", main="Adaptive QQ Plot")
points(qq.1, pch=".", cex=6, col="Gray")
points(qq(x,y, .01), pch=23, col="Black")
points(qq(x,y, .03), pch=22, col="Red")
points(qq(x,y, .1), pch=19, col="Blue")

সম্পাদন করা

qqমূল দুটি অ্যারের দীর্ঘতম (বা সংক্ষিপ্ততম হিসাবে নির্দিষ্ট হিসাবে) সূচকের তৃতীয় কলামটি ফিরিয়ে আনার জন্য আমি মূল কোডটি সংশোধন করেছি xএবং yনির্বাচিত পয়েন্টগুলির সাথে মিল রেখে। এই সূচকগুলি ডেটার "আকর্ষণীয়" মানগুলিকে নির্দেশ করে এবং তাই আরও বিশ্লেষণের জন্য কার্যকর হতে পারে।

আমি বারবার মানগুলির সাথে সংঘটিত একটি বাগও সরিয়েছি x(যার কারণে)beta )

Comments

qqপ্রদত্ত ভেক্টরের পক্ষে আমি কীভাবে যুক্তি গণনা করব ? এছাড়াও, আপনি কি প্যাকেজ qqসহ আপনার ফাংশনটি ব্যবহার করতে পরামর্শ দিতে পারেন ggplot2? আমি ব্যবহার সম্পর্কে চিন্তা ছিল ggplot2's stat_functionএই জন্য।

— আলেকসান্দ্র ব্লেক

Answer 3

মাঝখানে কিছু ডেটা পয়েন্ট অপসারণ করা অভিজ্ঞতা অভিজ্ঞতা এবং তাই কিউকিপ্লট পরিবর্তন করবে lot এটি বলা হচ্ছে, আপনি নিম্নলিখিতটি এবং তাত্ত্বিক বিতরণের কোয়ান্টাইল বনাম অনুশীলনমূলক বিতরণের কোয়ান্টাইলগুলি সরাসরি প্লট করতে পারেন:

x <- rnorm(1200000)
mean.x <- mean(x)
sd.x <- sd(x)
quantiles.x <- quantile(x, probs = seq(0,1,b=0.000001))
quantiles.empirical <- qnorm(seq(0,1,by=0.000001),mean.x,sd.x)
plot(quantiles.x~quantiles.empirical) 

আপনি লেজগুলিতে কত গভীর যেতে চান তার উপর নির্ভর করে আপনাকে সিকটি সামঞ্জস্য করতে হবে। আপনি যদি চালাক পেতে চান তবে প্লটটি গতি বাড়ানোর জন্য আপনি মাঝের সেই ক্রমটি পাতলা করতে পারেন। উদাহরণস্বরূপ ব্যবহার

plogis(seq(-17,17,by=.1))

একটি সম্ভাবনা।

Comments

দুঃখিত, আমি কেবল প্লটগুলি থেকে ডেটা সেটগুলি থেকে পয়েন্টগুলি সরাতে চাইছি না।

— nnot101

এমনকি তাদের প্লট থেকে অপসারণ করা একটি খারাপ ধারণা। তবে আপনি কি নিজের ডেটা সেট থেকে স্বচ্ছ পরিবর্তন এবং / অথবা এলোমেলোভাবে নমুনার চেষ্টা করেছেন?

— পিটার ফ্লুম - মনিকা পুনরায়

@ পিটার, প্লটটিতে ওভারল্যাপিং পয়েন্টগুলি থেকে অপ্রয়োজনীয় কালি অপসারণের ক্ষেত্রে কী ঘটবে?

— whuber

Answer 4

আপনি একটি hexbinচক্রান্ত করতে পারে ।

x <- rnorm(1200000)
mean.x <- mean(x)
sd.x <- sd(x)
quantiles.x <- quantile(x, probs = seq(0,1,b=0.000001))
quantiles.empirical <- qnorm(seq(0,1,by=0.000001),mean.x,sd.x)

library(hexbin)
bin <- hexbin(quantiles.empirical[-c(1,length(quantiles.empirical))],quantiles.x[-c(1,length(quantiles.x))],xbins=100)
plot(bin)

Comments

আমি জানি না যে এটি কিউকিউ-প্লট করা ডেটার ক্ষেত্রে সত্যিই প্রযোজ্য কিনা (কেন এটি আমার নির্দিষ্ট মামলায় কাজ করবে না তা সম্পর্কে আমার প্রশ্নে আমার মন্তব্য দেখুন)। আকর্ষণীয় বিষয় যদিও। আমি দেখতে পাচ্ছি যে আমি এটি পৃথক মডেল বনাম obs এ কাজ করতে পারি কিনা।

— nnot101

Answer 5

আর একটি বিকল্প সমান্তরাল বক্সপ্লট; আপনি বলেছিলেন যে আপনার কাছে দুটি ডেটা সেট রয়েছে, তাই এরকম কিছু:

y <- rnorm(1200000)
x <- rnorm(1200000)
grpx <- cut(y,20)
boxplot(y~grpx)

এবং আপনি আপনার ডেটা দিয়ে আরও ভাল করতে বিভিন্ন বিকল্প সমন্বয় করতে পারেন।

Comments

অবিচ্ছিন্ন ডেটা আঁকানোর আমি কখনই বড় অনুরাগী হইনি, তবে এটি একটি আকর্ষণীয় ধারণা।

— nnot101