鉴于此数据集:
y<-c(-13,16,35,40,28,36,43,33,40,33,22,-5,-27,-31,-29,-25,-26,-31,-26,-24,-25,-29,-23,4)
t<-1:24
我的目标是计算两个区域。第一个区域将仅整合零线上方的曲线的第一部分的数据。第二个区域将整合零线下方曲线的第二部分的数据。
首先,我想对这些数据进行正弦波拟合。使用这个出色的答案:
https://stats.stackexchange.com/questions/60994/fit-a-sinusoidal-term-to-data
我能够拟合正弦波(我将使用周期性的二次谐波,看起来更合适)
ssp <- spectrum(y)
per <- 1/ssp$freq[ssp$spec==max(ssp$spec)]
reslm <- lm(y ~ sin(2*pi/per*t)+cos(2*pi/per*t))
summary(reslm)
rg <- diff(range(y))
plot(y~t,ylim=c(min(y)-0.1*rg,max(y)+0.1*rg))
lines(fitted(reslm)~t,col=4,lty=2) # dashed blue line is sin fit
# including 2nd harmonic really improves the fit
reslm2 <- lm(y ~ sin(2*pi/per*t)+cos(2*pi/per*t)+sin(4*pi/per*t)+cos(4*pi/per*t))
summary(reslm2)
lines(fitted(reslm2)~t,col=3) # solid green line is periodic with second harmonic
abline(h=0,lty=2)
接下来,我想计算曲线下仅为正的面积,以及曲线下仅为负的面积。我很幸运使用Bolstad2和Mess软件包中的AUC功能查看类似的答案。但是我的数据点并没有整齐地落在零线上,我不知道如何将正弦函数分解到仅在零线之上且仅在零线之下的区域。
答案 0 :(得分:1)
这可能不是您正在寻找的解决方案,但您可以试试这个:
# Create a new t vector but with more subdivisions
t2 = seq(1,24,length.out = 10000)
# Evaluate your model on this t2
y2 = predict(reslm2, newdata = data.frame(t = t2))
lines(t2[y2>=0],y2[y2>=0],col="red")
# Estimate the area where the curve is greater than 0
sum(diff(t2)[1]*y2[y2>0])
# Estimate the area where the curve is less than 0
sum(diff(t2)[1]*y2[y2<0])
答案 1 :(得分:1)
首先要做的事情。要获得精确计算,您需要使用二次谐波傅立叶的精确函数。其次,谐波功能的美妙之处在于它们是重复的。因此,如果你想找到你的函数达到0的位置,你只需要扩展你的间隔,这样你就可以确保找到超过2个根。
首先,我们从回归模型中获得确切的函数
fourierfnct <- function(t){
fnct <- reslm2$coeff[1]+
reslm2$coeff[2]*sin(2*pi/per*t)+
reslm2$coeff[3]*cos(2*pi/per*t)+
reslm2$coeff[4]*sin(4*pi/per*t)+
reslm2$coeff[5]*cos(4*pi/per*t)
return(fnct)
}
其次,你可以编写一个可以找到根的函数(函数为0)。 R提供了一个uniroot函数,您可以使用它在循环中查找多个根。
manyroots <- function(f,inter,period){
roots <- array(NA, inter)
for(i in 1:(length(inter)-1)){
roots[i] <- tryCatch({
return_value <- uniroot(f,c(inter[i],inter[i+1]))$root
}, error = function(err) {
return_value <- -1
})
}
retroots <- roots[-which(roots==-1)]
return(retroots)
}
然后您只需计算根,并使用它们将功能整合到这些边界。
roots <- manyroots(fourierfnct,seq(0,25),per)
integrate(fourierfnct, roots[1],roots[2])
#300.6378 with absolute error < 3.3e-12
integrate(fourierfnct, roots[2],roots[3])
#-284.6378 with absolute error < 3.2e-12