如何在R中插值和提取黄土平滑以上的点?

How to interpolate and extract points above loess smooth in R?

(这​​个post是问题的后半部分来自:)

我已经将黄土平滑绘制成散点图(即在两个定量变量之间)。我只想提取散点图中位于平滑线上方的数据点。

例如,如果这是我的散点图:

qplot(mpg, cyl, data=mtcars)

我可以将平滑器绘制为:

qplot(hp,wt,data=mtcars) + stat_smooth(method="loess")

现在,我只想提取平滑器上方的数据点。我玩过 (Method to extract stat_smooth line fit):

中提供的代码
model <- loess(wt ~ hp, data=mtcars)
xrange <- range(mtcars$hp)
xseq <- seq(from=xrange[1], to=xrange[2], length=80)
pred <- predict(model, newdata = data.frame(hp = xseq), se=TRUE)
y = pred$fit
ci <- pred$se.fit * qt(0.95 / 2 + .5, pred$df)
ymin = y - ci
ymax = y + ci
loess.DF <- data.frame(x = xseq, y, ymin, ymax, se = pred$se.fit)

这会产生一个包含 80 行和 5 列的数据框 loess.DF。

我现在知道我必须应用一个函数来遍历原始 mtcars 数据帧的每一行,并为每个 x 值 (hp) 插入其最接近的预测黄土 y 值 (wt)。我完成此插值的唯一想法是使用类似于 (http://www.ajdesigner.com/phpinterpolation/linear_interpolation_equation.php) 的线性插值。之后,我将简单地将 mtcars 中的 y 值与插值预测的黄土 y 值进行比较。如果 mtcars 中的 y 值大于预测的 loess y 值,那么我保留那个原始数据点;否则,我将其删除。

我开始对此进行编码,但意识到我无法以有效的方式进行编码。一个问题是我的(真实)数据集(不是 mtcars)非常大(~40,000 行):首先,要进行线性插值,我需要找到黄土拟合中最接近的两个 x 值我的数据集中的原始 x 值(如果没有完全匹配),我不知道如何在不搜索增加黄土 x 值的情况下有效地做到这一点。

解决这个问题的有效方法是什么,例如,首先在 mtcars 数据集上进行测试?谢谢。

作为 loess 返回的 residuals 列表组件,您会自动拥有它:

> str(model)
List of 17
 $ n        : int 32
 $ fitted   : num [1:32] 2.83 2.83 2.57 2.83 3.74 ...
 $ residuals: Named num [1:32] -0.2133 0.0417 -0.2477 0.3817 -0.2997 ...
  ..- attr(*, "names")= chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive" ...
 $ enp      : num 4.94
 $ s        : num 0.655
 $ one.delta: num 26.1
 $ two.delta: num 25.8
 $ trace.hat: num 5.43
 $ divisor  : num 1
...

如果您这样做:model$residuals,正值在线上方,负值在线下方:

> which(sign(model$residuals) == 1)
      Mazda RX4 Wag      Hornet 4 Drive             Valiant           Merc 240D            Merc 230            Merc 280 
                  2                   4                   6                   8                   9                  10 
          Merc 280C          Merc 450SE  Cadillac Fleetwood Lincoln Continental   Chrysler Imperial            Fiat 128 
                 11                  12                  15                  16                  17                  18 
   Dodge Challenger         AMC Javelin    Pontiac Firebird       Maserati Bora 
                 22                  23                  25                  31

以上结果是原始数据中所有在LOESS曲线上方的点。