基于顶点生成线性样条的更好方法

Question

我正在尝试根据x值和由一组顶点定义的一系列曲线计算y值。我对R很陌生，找不到直接的方法来做到这一点。我找到了几种方法，但我正在寻找一种更好的方法来生成一个公式然后我可以应用于一系列数据框，以用于进一步的转换。曲线和顶点是文献值，我需要原样使用它们（穿过每个顶点的线性线段），而不是根据点解释模型然后添加预测。

#    Sample curve vertexes
Depth <- c(0,0.45,1.05,1.65,2.25,2.35,2.65,10,30)
Preference_depth_01 <- c(0,0,0.3,0.8,1,1,0.7,0.7,0)

#    Example data
Depth <- c(0.00, 0.42, 0.6328287, 2.7463492, 3.6011860, 3.5307984, 2.8850018, 2.0481874, 0.9274444,0)
example <- data.frame(Depth,"Pref"=0)

我尝试了两种方法，但它们不太理想，我想知道是否有一个公认的解决方案。

我可以手动定义一个函数，然后将它应用到我的数据框中，但定义函数是笨重且容易出错的，我需要定义十几条不同的曲线，然后依次将它们应用于一系列数据表。

#    Defining recoding function
pref_01 <- function(x){
    val <- if (x <= .45){0
        }else if (x <= 1.05){(.5 * x - .225)
        }else if (x <= 1.65){(5 / 6 * x - .575)
        }else if (x <= 2.25){(x / 3 + .25)
        }else if (x <= 2.35){1
        }else if (x <= 2.65){(-x + 3.35)
        }else if (x <= 10){.7
        }else if (x <= 30){-.035 * x + 1.05}
      return(val)
 }

#    Applying function to example data
for(i in 1:length(example[, 1])){
    example[[i, 2]] <- pref_01(example[[i, 1]])
}

由于曲线是线性样条曲线，我尝试使用lspline包中的lspline。这种方法更好，但是当我添加预测时，我得到一些负值，当我期望0的时候：

# Using linear spline method
library(lspline)
library(modelr)
spline_curve <- lm(Preference_depth_01 ~ lspline(Depth, knots = Depth[2:8])
       ,data = curve)
example <- add_predictions(data = example, model = spline_curve, var = "Spline")
example
#           Depth       Pref        Spline
#   1  0.0000000 0.00000000  3.816839e-16
#   2  0.4200000 0.00000000 -5.794200e-17  
#   3  0.6328287 0.09141435  9.141435e-02
#   4  2.7463492 0.70000000  7.000000e-01
#   5  3.6011860 0.70000000  7.000000e-01
#   6  3.5307984 0.70000000  7.000000e-01
#   7  2.8850018 0.70000000  7.000000e-01
#   8  2.0481874 0.93272913  9.327291e-01
#   9  0.9274444 0.23872220  2.387222e-01
#   10 0.0000000 0.00000000  3.816839e-16

我的下一步涉及以几何平均值使用预测，负值会导致问题。我可以通过四舍五入来解决这个问题，但我想知道是否有更优雅或被接受的解决方案。

Answer 1

您可以使用approx函数对数据点之间的数据进行线性插值，请参见下面的1000个插值点：

Depth <- c(0, 0.45, 1.05, 1.65, 2.25, 2.35, 2.65, 10, 30)
Preference_depth_01 <- c(0, 0, 0.3, 0.8, 1, 1, 0.7, 0.7, 0)
plot(Depth, Preference_depth_01, pch = 19, cex = 1.5)
app <- approx(Depth, Preference_depth_01, n = 1000)
points(app, col = 2, pch = "o", cex = .5)

Output:

有关进一步分析，您可以使用app$x和app$y，它们分别命名为app列表的x和y组件。