繪制函數和派生函數

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的魅力ggplot2 。

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

到現在為止還挺好。 但我想繪制的是擬合函數fit的一階導數， data$Y' 。 我感興趣的是擬合函數的梯度。

我的問題 ：我怎樣才能得到fit的導數函數？ 我假設我可以“預測”之后繪制的絕對值。 正確？

Answer 1

首先，我將創建一些“類似”的測試數據

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 2

您可以通過首先根據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 3

據稱，quantchem軟件包可以使用派生函數來實現。

描述

計算給定x的多項式的導數。

用法

導數（obj，x）

參數

obj ：類'lm'的對象，以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）

資源

注意：所有這些都說，它對我和我的數據不起作用。