在R中二次擬合外推整個曲線

Question

我在4個溫度 s下沿x軸進行了y的四個測量：

require(ggplot2)
x <- seq(0, 10, by = 0.1)
y1 <- cos(x)
y2 <- cos(x) + 0.2
y3 <- cos(x) + 0.4
y4 <- cos(x) + 0.8

df.1 <- data.frame(x, y = y1, Name = "df.1", Temperature = 4)
df.2 <- data.frame(x, y = y2, Name = "df.2", Temperature = 3)
df.3 <- data.frame(x, y = y3, Name = "df.3", Temperature = 2)
df.4 <- data.frame(x, y = y4, Name = "df.4", Temperature = 1)

df.merged <- rbind(df.1, df.2, df.3, df.4)

ggplot(df.merged, aes(x, y, color = Name)) + geom_line()

所有曲線均具有相同的x值。 我想要的是使用二次擬合並得出第五條曲線，外推至溫度= 0。

我所做的是以下幾點：

require(splines)
quadratic.model <- with(df.merged,
                        lm(y ~ bs(Temperature, degree = 2)))

result <- predict.lm(quadratic.model, data.frame(x, Temperature = 0))
df.5 <- data.frame(x, y = result, Name = "df.5", Temperature = 0)
df.merged <- rbind(df.1, df.2, df.3, df.4, df.5)
ggplot(df.merged, aes(x, y, color = Name)) + geom_line()

當然，這是行不通的，因為我的二次模型沒有考慮到我想要適合每個x值的事實。 但是我不知道該怎么做。

Answer 1

根據您的評論，這可能是您想要的：

#library(tidyverse)
df.merged %>%
  nest(-x) %>%
  mutate(Temperature = 0,
         model = map(data, lm, formula = y ~ bs(Temperature, degree = 2)),
         pred  = map_dbl(model, predict, newdata = data_frame(Temperature = 0))) %>%
  ggplot(aes(x = x, y = pred, color = factor(Temperature))) + 
  geom_point() +
  geom_point(data = df.merged, aes(x = x, y = y))

（如果您需要取消dply代碼，只需告訴;-） 即可。

###
# WARNING: only works if data is ordered by x
###
# first split data into groupy by x
groupedData <- split(df.merged, x)
# for each group compute linear model
models <- lapply(groupedData, lm, formula = y ~ bs(Temperature, degree = 2))
# for each model make prediction for Temperature = 0
predictions <- sapply(models, predict, newdata = data.frame(Temperature = 0))
preddf <- data.frame(x = x, y = predictions, Name = "df.5", Temperature = 0)

ggplot(data = rbind(df.merged, preddf), aes(x = x, y = y, color =     factor(Temperature))) +
  geom_point()

我希望我能正確理解您的意圖，否則我可以使用更多示意圖來解釋您想要的內容。