如何繪制平滑函數的一階導數？

Question

我有以下腳本可以模擬我擁有的數據結構的類型以及我想對它進行的分析，

library(ggplot2)
library(reshape2)

n <- 10
df <- data.frame(t=seq(n)*0.1, a  =sort(rnorm(n)), b  =sort(rnorm(n)),
                               a.1=sort(rnorm(n)), b.1=sort(rnorm(n)), 
                               a.2=sort(rnorm(n)), b.2=sort(rnorm(n)))
head(df)

mdf <- melt(df, id=c('t'))
## head(mdf)

levels(mdf$variable) <- rep(c('a','b'),3)

g <- ggplot(mdf,aes(t,value,group=variable,colour=variable))
g +
stat_smooth(method='lm', formula = y ~ ns(x,3)) +
geom_point() +
facet_wrap(~variable) +
opts()

除此以外，我還要繪制平滑函數的一階導數相對於t以及因數c('a','b') 。 任何建議如何做到這一點將不勝感激。

Answer 1

您必須自己構造導數，並且有兩種可能的方法。 讓我通過僅使用一組進行說明：

require(splines) #thx @Chase for the notice
lmdf <- mdf[mdf$variable=="b",]
model <- lm(value~ns(t,3),data=lmdf)

然后，您可以根據預測值簡單地將導數定義為diff(Y)/diff(X) ，就像對離散函數進行微分一樣。 如果您獲得足夠的X點，這是一個很好的近似值。

X <- data.frame(t=seq(0.1,1.0,length=100) ) # make an ordered sequence
Y <- predict(model,newdata=X) # calculate predictions for that sequence
plot(X$t,Y,type="l",main="Original fit") #check

dY <- diff(Y)/diff(X$t)  # the derivative of your function
dX <- rowMeans(embed(X$t,2)) # centers the X values for plotting
plot(dX,dY,type="l",main="Derivative") #check

如您所見，通過這種方式可以獲得繪制導數的點。 您將從這里弄清楚如何將其應用於兩個級別並將這些點組合到所需的繪圖中。 在此示例代碼的圖下方：

Answer 2

這是用ggplot進行繪制的一種方法。 可能有一種更有效的方法，但這使用了@Joris進行的手動計算。 我們將簡單地使用所有X和Y值構造一個長的data.frame，同時還提供一個變量以“構圖”繪圖：

require(ggplot2)

originalData <- data.frame(X = X$t, Y, type = "Original")
derivativeData <- data.frame(X = dX, Y = dY, type = "Derivative")

plotData <- rbind(originalData, derivativeData)

ggplot(plotData, aes(X,Y)) + 
  geom_line() + 
  facet_wrap(~type, scales = "free_y")

Answer 3

倘若數據是使用平滑化smooth.spline ，預測的數據的衍生物可以使用參數來指定deriv在predict 。 來自@Joris的解決方案

lmdf <- mdf[mdf$variable == "b",]
model <- smooth.spline(x = lmdf$t, y = lmdf$value)
Y <- predict(model, x = seq(0.1,1.0,length=100), deriv = 1) # first derivative
plot(Y$x[, 1], Y$y[, 1], type = 'l')

輸出中的任何差異很可能歸因於平滑差異。