用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()

我希望我的内涵正确,否则我可以使用更多的原理图来解释你想要的东西.