计算曲线下的面积

时间:2011-02-10 07:35:54

标签: r numerical-integration

我想计算曲线下面积来进行积分而不定义integrate()中的函数。

我的数据如下:

Date          Strike     Volatility
2003-01-01    20         0.2
2003-01-01    30         0.3
2003-01-01    40         0.4
etc.

我绘制plot(strike, volatility)来看看波动性微笑。有没有办法整合这个绘制的“曲线”?

7 个答案:

答案 0 :(得分:39)

通过查看大量梯形数字,每次在x_ix_{i+1}y{i+1}y_i之间进行约束,AUC非常容易接近。使用zoo包的rollmean,您可以:

library(zoo)

x <- 1:10
y <- 3*x+25
id <- order(x)

AUC <- sum(diff(x[id])*rollmean(y[id],2))

确保您订购了x值,否则您的结果将无济于事。如果沿y轴某处有负值,则必须弄清楚你想要如何确定曲线下面积,并进行相应调整(例如使用abs()

关于你的后续行动:如果你没有正式的职能,你会如何策划它?因此,如果您只有值,那么您唯一可以近似的就是一个明确的积分。即使你在R中有函数,也只能使用integrate()计算定积分。只有在您也可以定义形式函数时,才可以绘制正式函数。

答案 1 :(得分:31)

只需将以下内容添加到您的程序中即可获得曲线下的区域:

require(pracma)
AUC = trapz(strike,volatility)

来自?trapz

  

这种方法完全匹配积分的近似值   使用带有基点x的梯形法则的函数。

答案 2 :(得分:21)

还有三个选项,包括一个使用样条方法和一个使用Simpson规则......

# get data
n <- 100
mean <- 50
sd <- 50

x <- seq(20, 80, length=n)
y <- dnorm(x, mean, sd) *100

# using sintegral in Bolstad2
require(Bolstad2)
sintegral(x,y)$int

# using auc in MESS
require(MESS)
auc(x,y, type = 'spline')

# using integrate.xy in sfsmisc
require(sfsmisc)
integrate.xy(x,y)

梯形方法不如样条方法准确,因此MESS::auc(使用样条方法)或Bolstad2::sintegral(使用Simpson规则)应该是首选方法。这些的DIY版本(以及使用正交规则的其他方法)在这里:http://www.r-bloggers.com/one-dimensional-integrals/

答案 3 :(得分:11)

好的,所以我在聚会上来得有点迟了但是回过头来解决这个问题的简单R解决方案。这里简单而干净:

sum(diff(x) * (head(y,-1)+tail(y,-1)))/2

OP的解决方案如下:

sum(diff(strike) * (head(volatility,-1)+tail(volatility,-1)))/2

通过取“&#34; left&#34;的平均值,使用梯形方法有效地计算面积。和&#34;对&#34; y值。

注意:正如@Joris已经指出的那样,如果这更有意义,你可以使用abs(y)

答案 4 :(得分:3)

在药代动力学(PK)领域,计算不同类型的AUC是一项常见的基本任务。药代动物的许多不同的AUC计算,例如

  • AUC0-t =从零到时间t的AUC
  • AUC0-last =从零到最后一个时间点的AUC(可能与上面相同)
  • AUC0-inf =从零到无穷大的AUC
  • AUCint =一段时间内的AUC
  • AUCall =数据存在的整个时间段内的AUC

进行这些计算的最佳软件包之一是来自辉瑞公司的相对较新的软件包PKNCA。看看吧。

答案 5 :(得分:0)

Joris Meys's answer was great but I struggled to remove NAs from my samples. Here is the little function I wrote to deal with them :

library(zoo) #for the rollmean function

######
#' Calculate the Area Under Curve of y~x
#'
#'@param y Your y values (measures ?)
#'@param x Your x values (time ?)
#'@param start : The first x value 
#'@param stop : The last x value
#'@param na.stop : returns NA if one value is NA
#'@param ex.na.stop : returns NA if the first or the last value is NA
#'
#'@examples 
#'myX = 1:5
#'myY = c(17, 25, NA, 35, 56)
#'auc(myY, myX)
#'auc(myY, myX, na.stop=TRUE)
#'myY = c(17, 25, 28, 35, NA)
#'auc(myY, myX, ex.na.stop=FALSE)
auc = function(y, x, start=first(x), stop=last(x), na.stop=FALSE, ex.na.stop=TRUE){
  if(all(is.na(y))) return(NA)
  bounds = which(x==start):which(x==stop)
  x=x[bounds]
  y=y[bounds]
  r = which(is.na(y))
  if(length(r)>0){
    if(na.stop==TRUE) return(NA)
    if(ex.na.stop==TRUE & (is.na(first(y)) | is.na(last(y)))) return(NA)
    if(is.na(last(y))) warning("Last value is NA, so this AUC is bad and you should feel bad", call. = FALSE) 
    if(is.na(first(y))) warning("First value is NA, so this AUC is bad and you should feel bad", call. = FALSE) 
    x = x[-r]
    y = y[-r]
  }
  sum(diff(x[order(x)])*rollmean(y[order(x)],2))
}

I then use it with an apply onto my dataframe : myDF$auc = apply(myDF, MARGIN=1, FUN=auc, x=c(0,5,10,15,20))

Hope it can help noobs like me :-)

EDIT : added bounds

答案 6 :(得分:-3)

您可以使用ROCR包,其中以下行将为您提供AUC:

pred <- prediction(classifier.labels, actual.labs)
attributes(performance(pred, 'auc'))$y.values[[1]]