Исключить выбросы из расчета коэффициента корреляции

используя method = "spearman" на cor будет робастно к загрязнению и легко для того чтобы снабдить в виду того что оно только включает заменять cor(x, y) С cor(x, y, method = "spearman").

повторяя анализ Прасада, но используя вместо этого корреляции Спирмена, мы обнаруживаем, что корреляция Спирмена действительно устойчива к загрязнению здесь, восстанавливая лежащую в основе нулевую корреляцию:

set.seed(1)

# x and y are uncorrelated
x <- rnorm(1000)
y <- rnorm(1000)
cor(x,y)
## [1] 0.006401211

# add contamination -- now cor says they are highly correlated
x <- c(x, 500)
y <- c(y, 500)
cor(x, y)
## [1] 0.995741

# but with method = "spearman" contamination is removed & they are shown to be uncorrelated
cor(x, y, method = "spearman")
## [1] -0.007270813

это, возможно, уже было очевидно для ОП, но просто чтобы убедиться... Вы должны быть осторожны, потому что пытается maxmimize корреляция, возможно, на самом деле, как правило,включить останцы. (@Gavin коснулся этого момента в своем ответе/комментариях.) Я бы первый удаление выбросов, затем вычисление корреляции. В более общем плане мы хотим вычислить корреляцию, которая устойчива к выбросам (и в R есть много таких методов).

чтобы наглядно проиллюстрировать это, давайте создадим два вектора x и y, которые являются некоррелированными:

set.seed(1)
x <- rnorm(1000)
y <- rnorm(1000)
> cor(x,y)
[1] 0.006401211

теперь давайте добавим точку выброса (500,500):

x <- c(x, 500)
y <- c(y, 500)

теперь соотношение любой подмножество, включающее точку выброса, будет близко к 100%, а корреляция любого достаточно большого подмножества, исключающего выброс, будет близка к нулю. В частности,

> cor(x,y)
[1] 0.995741

если вы хотите оценить "истинную" зависимость, которая не чувствительна к выбросам, вы можете попробовать robust пакет:

require(robust)
> covRob(cbind(x,y), corr = TRUE)
Call:
covRob(data = cbind(x, y), corr = TRUE)

Robust Estimate of Correlation: 
            x           y
x  1.00000000 -0.02594260
y -0.02594260  1.00000000

вы можете играть с параметрами covRob, чтобы решить, как обрезать данные. обновление: есть еще rlm (надежная линейная регрессия) в MASS пакета.

вот еще одна возможность с выбросами в плен. Используя подобную схему, как Прасад:

library(mvoutlier)    
set.seed(1)    
x <- rnorm(1000)    
y <- rnorm(1000)    
xy <- cbind(x, y)    
outliers <- aq.plot(xy, alpha=0.975) #The documentation/default says alpha=0.025.  I think the functions wants 0.975   
cor.plot(x, y)    
color.plot(xy)   
dd.plot(xy)   
uni.plot(xy)    

в других ответах 500 застрял в конце x и y как выброс. Это может вызвать или не вызвать проблемы с памятью на вашем компьютере, поэтому я опустил его до 4, чтобы избежать этого.

x1 <- c(x, 4)     
y1 <- c(y, 4)    
xy1 <- cbind(x1, y1)    
outliers1 <- aq.plot(xy1, alpha=0.975) #The documentation/default says alpha=0.025.  I think the functions wants 0.975
cor.plot(x1, y1)    
color.plot(xy1)    
dd.plot(xy1)    
uni.plot(xy1)    

вот изображения из данных x1, y1, xy1:

вы можете попробовать загрузить свои данные, чтобы найти самый высокий коэффициент корреляции, например:

x <- cars$dist
y <- cars$speed
percent <- 0.9         # given in the question above
n <- 1000              # number of resampling
boot.cor <- replicate(n, {tmp <- sample(round(length(x)*percent), replace=FALSE); cor(x[tmp], y[tmp])})

и после max(boot.cor). Не расстраивайтесь, если все коэффициенты корреляции будут одинаковыми:)