删除黄土曲线限制之外的值

时间：2014-11-07 12:26:42

标签： r statistics loess

我希望在应用模型之前删除异常值。我使用黄土曲线来划分趋势线并设置了异常值限制。我想删除超出定义限制的行。除了使用自定义函数执行此操作，每次一个点，并检查本地黄土坡等...是否有更简单的方法？

Loess trend line with limits (1.2) 

# Code generating image above
scatter.smooth( idam$T_d, idam$T_x10d)
loessline <- loess.smooth( idam$T_d, idam$T_x10d)
lines(loessline$x, loessline$y, lwd=3)
lines(loessline$x, loessline$y*1.2, lwd=3, col='red')
lines(loessline$x, loessline$y/1.2, lwd=3, col='red')

3 个答案:

答案 0 :(得分：8)

检测异常值可以在DBSCAN R包的帮助下完成，这是用于群集识别的众所周知的算法（有关详细信息，请参阅WIKIPEDIA）。

此功能有三个重要输入：

  • x：您的数据（仅限数值）
  • eps：目标最大距离
  • minPts：将它们视为群集的最小点数

评估eps可以在knndist（...）和knndistplot（...）函数的帮助下完成：

  • knndistplot将绘制给定k的数据集上的eps值（即minPts）==＆gt;您可以在视觉上选择有效的eps值（通常在膝盖曲线部分）
  • knndist将评估eps值并将其从矩阵中返回。 k输入将生成1：1：k的估值，您可以使用结果以编程方式确定准确的eps＆amp; k值

接下来，您只需使用dbscan（yourdata，eps，k）来获取具有以下组件的dbscan对象：

  • eps：用于计算的eps
  • minPts：识别群集的最小点数
  • cluster：标识属于簇（= 1）或不属于（= 0）的点的整数向量。最后一个对应于您要消除的异常值。

请注意dbscan的以下限制：

  • dbscan使用欧几里德距离，因此它被提交给＆＃34;尺寸诅咒＆＃34;。使用PCA
    • 可以避免这种情况
  • dbscan消除了可能生成未识别点的叠加点。这可以通过使用左外连接将结果与数据合并，或使用抖动（...）函数来解决，这会为数据添加噪声。根据您显示的数据，我认为您的数据可能就是这种情况
知道这个限制，dbscan包提供了两种替代方法：LOF和OPTICS（DBSCAN的扩展）

2016年6月25日编辑

关注@rawr回答，我提供了一个基于mtcars数据集的示例，以说明如何使用dbscan来识别异常值。请注意，我的示例将使用优秀的data.table包而不是经典的data.frame。

首先，我开始复制rawr的方法来说明数据的使用。表

require(data.table)
require(ggplot2)
require(dbscan)
data(mtcars)
dt_mtcars <- as.data.table(mtcars)

# based on rawr's approach
plot(wt~mpg, data=dt_mtcars)
lo <- loess.smooth(dt_mtcars[,mpg], dt_mtcars[,wt])
lines(lo$x,lo$y, lwd=3)
lines(lo$x,lo$y * 1.2, lwd=3 , col=2 )
lines(lo$x,lo$y / 1.2, lwd=3 , col=2 )

enter image description here

因此，我们可以评估我们得到的结果与底层支持无关。

其次，以下代码说明了DBSCAN方法，该方法从确定eps和k开始，这是确定群集所需的点数：

res_knn = kNNdist( dt_mtcars[, .(wt, mpg)] , k = 10)
dim_knn = dim(res_knn)
x_knn =  seq(1, dim_knn[1])
ggplot() + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 1])  , col = 1 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 2])  , col = 2 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 3])  , col = 3 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 4])  , col = 4 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 5])  , col = 5 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 6])  , col = 6 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 7])  , col = 7 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 8])  , col = 8 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 9])  , col = 9 ) ) + 
   geom_line( aes( x = x_knn , y = sort(res_knn[, 10]) , col = 10 ) )  +
   xlab('sorted results') + 
   ylab('kNN distance')

结果如下图所示：

enter image description here

它表明计算的kNN距离对因子k敏感，但是分离异常值的准确eps值位于曲线的拐点部分==＆gt;合适的eps位于2到4之间。 这是一种视觉评估，可以使用适当的搜索算法自动化（例如，see this link）。 关于k，必须进行权衡，知道较低的k，结果不那么严格。

在下一部分中，我们将使用eps = 3（基于视觉估计）和k = 4对dbscan进行参数化，以获得轻微严格的结果。我们将在rawr的代码的帮助下绘制这些结果：

eps = 3
k = 4
res_dbscan = dbscan( dt_mtcars[, .(wt, mpg)] , eps , k )
plot(wt~mpg, data=dt_mtcars, col = res_dbscan$cluster)
lo <- loess.smooth(dt_mtcars[res_dbscan$cluster>0,mpg], dt_mtcars[res_dbscan$cluster>0,wt])
lines(lo$x,lo$y, lwd=3)
lines(lo$x,lo$y * 1.2, lwd=3 , col=2 )
lines(lo$x,lo$y / 1.2, lwd=3 , col=2 )

enter image description here

我们得到了这个数字，我们可以评估我们从rawr的方法得到的结果不同，mpg = [10,13]中的点被认为是异常值。

与rawr的解决方案相比，这些结果可能被认为是奇怪的，它在具有双变量数据（Y~X）的假设下工作。但是mtcars是一个多维数据集，其中变量之间的关系可能是（或不是）线性...为了评估这一点，我们可以对此数据集进行散点图，例如对数值进行过滤

pairs(dt_mtcars[, .(mpg, disp, hp, drat, wt, qsec)])

enter image description here

如果我们只关注结果wt ~ mpg，我们可能会认为这是一种反线性关系。但是对于其他绘制的关系，情况可能并非如此，在N-Dim环境中找到异常值有点棘手。实际上，当在特定的2D比较中进行预测时，有一点可能被认为是异常值...但是如果我们添加新的比较维度则相反。实际上，我们可能具有可以识别的共线性，从而加强了集群关系。

我的朋友们，我同意很多if，为了说明这种情况，我们将对dbscan的数值进行mtcars分析。< / p>

所以我将复制前面介绍的过程，让我们从kNN距离分析开始：

res_knn = kNNdist( dt_mtcars[, .(mpg, disp, hp, drat, wt, qsec)] , k = 10)
dim_knn = dim(res_knn)
x_knn =  seq(1, dim_knn[1])
ggplot() + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 1])  , col = 1 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 2])  , col = 2 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 3])  , col = 3 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 4])  , col = 4 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 5])  , col = 5 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 6])  , col = 6 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 7])  , col = 7 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 8])  , col = 8 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 9])  , col = 9 ) ) + 
    geom_line( aes( x = x_knn , y = sort(res_knn[, 10]) , col = 10 ) )  +
    xlab('sorted results') + 
    ylab('kNN distance')

sorted kNN distances

与wt ~ mpg上产生的分析相比，我们可以看到kNNdist(...)产生了更重要的kNN距离（例如，直到200 k = 10）。但是我们仍然有膝盖部分可以帮助我们估算合适的eps值。

在下一部分中，我们将使用eps = 75和k = 5以及

# optimal eps value is between 40 (k=1) and 130 (k=10)
eps = 75
k = 5
res_dbscan = dbscan( dt_mtcars[, .(mpg, disp, hp, drat, wt, qsec)] , eps , k )
pairs(dt_mtcars[, .(mpg, disp, hp, drat, wt, qsec)] , col = res_dbscan$cluster+2L)

enter image description here

因此，该分析的散点图强调，由于变量之间的复杂关系，在N-Dim环境中识别异常值可能会非常棘手。但请注意，在大多数情况下，异常值位于2D投影的角落部分，这加强了wt ~ mpg

获得的结果

答案 1 :(得分：7)

您可以使用approxfun

以下是＆＃34;异常值＆＃34;

的示例 
plot(wt ~ mpg, data = mtcars)
lo <- loess.smooth(mtcars$mpg, mtcars$wt)
lines(lo$x, lo$y, lwd = 3)
lines(lo$x, lo$y * 1.2, lwd = 3, col = 2)
lines(lo$x, lo$y / 1.2, lwd = 3, col = 2)

enter image description here

approxfun使用观察到的x值返回一个函数，我们可以用它来插值一组新的y值。

然后，您可以设置一个调用点异常值的阈值;在这里，我在原始问题中使用1.2 * y来识别极端观察。

f1 <- approxfun(lo$x, lo$y * 1.2)
(wh1 <- which(mtcars$wt > f1(mtcars$mpg)))
# [1]  8 17 18

f2 <- approxfun(lo$x, lo$y / 1.2)
(wh2 <- which(mtcars$wt < f2(mtcars$mpg)))
# [1] 28

## identify points to exclude
mt <- mtcars[c(wh1, wh2), ]
points(mt$mpg, mt$wt, pch = 4, col = 2, cex = 2)

enter image description here 

## plot without points
plot(wt ~ mpg, data = mt2 <- mtcars[-c(wh1, wh2), ])
lo <- loess.smooth(mt2$mpg, mt2$wt)
lines(lo$x, lo$y, lwd = 3)
lines(lo$x, lo$y * 1.2, lwd = 3, col = 2)
lines(lo$x, lo$y / 1.2, lwd = 3, col = 2)

enter image description here

由于这里有几个步骤，您可以将其打包成一个函数，以使事情变得更容易：

par(mfrow = c(2,2))
with(mtcars, {
  plot_lo(mpg, wt)
  plot_lo(mpg, wt, limits = c(1 / 1.5, 1.5))
  dd <<- plot_lo(mpg, wt, limits = c(1 / 1.2, 1.2))
  plot_lo(mpg, wt, pch = 16, las = 1, tcl = .5, bty = 'l')
})

str(dd)
# List of 2
# $ x: num [1:28] 21 21 22.8 21.4 18.7 18.1 14.3 22.8 19.2 17.8 ...
# $ y: num [1:28] 2.62 2.88 2.32 3.21 3.44 ...

{{3}} 

plot_lo <- function(x, y, limits = c(-Inf, Inf), ...) {
  lo <- loess.smooth(x, y)
  fx <- approxfun(lo$x, lo$y * limits[1L])
  fy <- approxfun(lo$x, lo$y * limits[2L])

  idx <- which(y < fx(x) | y > fy(x))
  if (length(idx)) {
    x  <- x[-idx]
    y  <- y[-idx]
    lo <- loess.smooth(x, y)
  }

  op <- par(..., no.readonly = TRUE)
  on.exit(par(op))

  plot(x, y)
  lines(lo$x, lo$y, lwd = 3)
  lines(lo$x, lo$y * limits[1L], lwd = 3, col = 2L)
  lines(lo$x, lo$y * limits[2L], lwd = 3, col = 2L)

  invisible(list(x = x, y = y))
}

答案 2 :(得分：0)

我的建议是去看outliers package。该软件包允许在分析发生之前进行识别。这是一个非常简单的例子：

library(outliers)
series<-c(runif(100,1,2),1000)
round(scores(series,prob=1,type="chisq"),3)

使用此功能，可以执行多项测试，您可以设置一个您感到舒适的异常概率水平。

series<-series[which(series<0.95),]
相关问题
最新问题