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

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)

输出：

要进行进一步的分析，您可以使用名为{em> x 的app$x和app$y 和列表app的 y 组件。