绘制函数和派生函数

Question

我想绘制一个数据框（X，Y）data以及拟合函数和拟合函数的导数。

fit <- lm(data$Y ~ poly(data$X,32,raw=TRUE))
data$fitted_values <- predict(fit, data.frame(x=data$X))

据我所知，这给了我一个第32度的多项式函数fit，我用它来计算函数值并将它们存储在data$fitted中。绘制这些系列就像ggplot2的魅力一样。

ggplot(data, aes(x=X)) + 
    geom_line(aes(y = Y), colour="red") + 
    geom_line(aes(y = predict), colour="blue")

到目前为止一切顺利。但我想绘制的也是拟合函数data$Y'的一阶导数fit。我感兴趣的是拟合函数的梯度。

我的问题：如何获得fit的衍生函数？ 我想我可以然后预测＆＃34;之后绘制的绝对值。正确的吗？

Answer 1

您可以通过首先根据X对数据进行排序，然后找出每对连续值之间的差异来近似导数。

data <- d[order(d$X), ]
data$derivative = c(diff(d$fitted_values) / diff(d$X), NA)

（注意我最后添加NA的方法，因为差异会使它略微缩短）。之后你可以绘制这个：

ggplot(data, aes(X, derivative)) + geom_line()

Answer 2

首先，我将创建一些“类似”的测试数据

set.seed(15)
rr<-density(faithful$eruptions)
dd<-data.frame(x=rr$x)
dd$y=rr$y+ runif(8,0,.05)

fit <- lm(y ~ poly(x,32,raw=TRUE), dd)
dd$fitted <- fitted(fit)

ggplot(dd, aes(x=x)) + 
    geom_line(aes(y = y), colour="red") + 
    geom_line(aes(y = fitted), colour="blue")

然后，因为你有一个特殊形式的多项式，我们可以通过将每个系数乘以幂并将所有项向下移动来轻松计算导数。这是一个计算新系数的辅助函数

deriv_coef<-function(x) {
    x <- coef(x)
    stopifnot(names(x)[1]=="(Intercept)")
    y <- x[-1]
    stopifnot(all(grepl("^poly", names(y))))
    px <- as.numeric(gsub("poly\\(.*\\)","",names(y)))
    rr <- setNames(c(y * px, 0), names(x))
    rr[is.na(rr)] <- 0
    rr
}

我们可以像......一样使用

dd$slope <- model.matrix(fit) %*% matrix(deriv_coef(fit), ncol=1)

现在我可以绘制

ggplot(dd, aes(x=x)) + 
    geom_line(aes(y = y), colour="red") + 
    geom_line(aes(y = fitted), colour="blue") + 
    geom_line(aes(y = slope), colour="green")

我们可以看到拐点对应于导数为零的地方。

Answer 3

据称，quantchem软件包可以使用派生函数来完成它。

  

<强>描述

     

计算给定x的多项式的导数。

     

<强>用法

     

衍生物（obj，x）

     

<强>参数

     

obj ：类＆＃39; lm＆＃39;的对象，拟合y~x + I（x ^ 2）+ I（x ^ 3）+ ...   方式。

     

x ：x值的向量

     

<强>实施例

     

x = 1:10 y =抖动（x + x ^ 2）

     

fit = lm（y~x + I（x ^ 2））

     

衍生物（配合，1：10）

Source

注意：所有这些都说，它对我和我的数据都没有用。