在R中的for循环中附加函数

时间:2015-12-06 07:43:29

标签: r loops functional-programming

我有integrant函数,它是几个累积概率函数和密度函数的乘积。

对于仅两个事件,integrant函数只是累积概率和密度函数的乘积:

function(value) pnorm(value,mean = mean2 ,sd = sigma, lower.tail = TRUE)*
dnorm(value,mean = mean1, sd = sigma)

对于每个新事件,我需要与另一个累积概率函数相乘。因此,对于三种替代方案,该功能变为:

function(value) pnorm(value,mean = mean2 ,sd = sigma, lower.tail = TRUE)*
 pnorm(value,mean = mean1,sd = sigma, lower.tail = TRUE)*
 dnorm(value,mean = mean0, sd = sigma)

四:

 function(value) pnorm(value,mean = mean3 ,sd = sigma, lower.tail = TRUE)*
 pnorm(value,mean = mean2,sd = sigma, lower.tail = TRUE)*
 pnorm(value,mean = mean1,sd = sigma, lower.tail = TRUE)*
 dnorm(value,mean = mean0, sd = sigma)

依此类推......

我正在尝试构建一个循环,可以为任意数量的事件动态创建此函数。我尝试了不同的方法来概括功能,但到目前为止我还没有任何工作。关于我应该如何进行的任何想法?

2 个答案:

答案 0 :(得分:1)

根据我提议的方法,您向函数传递一个向量(meanvec),其第一个元素是mean部分中使用的dnorm,其他元素用于pnorm。我假设sigma总是一样的。使用此方法,您可以在meanvec参数中传递任意数量的元素。

myfun<-function(value,meanvec,sigma) {
    valuelong<-rep(value,each=length(meanvec)-1)
    ppart<-apply(matrix(pnorm(valuelong,meanvec[-1],sigma),nrow=length(meanvec)-1),2,prod)
    if (length(meanvec)>1) ppart*dnorm(value,meanvec[1],sigma) else dnorm(value,meanvec[1],sigma)
}

示例:

mean0<-1
mean1<-2
mean2<-3
mean3<-4
value<-runif(100)
sigma<-2
#here define your not generalized function with 3 pnorm
oldfun<-function(value) pnorm(value,mean = mean3 ,sd = sigma, lower.tail = TRUE)*
pnorm(value,mean = mean2,sd = sigma, lower.tail = TRUE)*
pnorm(value,mean = mean1,sd = sigma, lower.tail = TRUE)*
dnorm(value,mean = mean0, sd = sigma)
all.equal(oldfun(value),myfun(value,c(mean0,mean1,mean2,mean3),sigma))
#[1] TRUE

答案 1 :(得分:1)

以下是另一种方法,我认为很容易理解。

关键是Reduce功能。即Reduce('+',1:3)1+2+3相同,Reduce('*',1:3)1*2*3相同。

do_it <- function(value, means, sigma) {

  # get the pnorm values (and then ignore the first result)
  pn_result <- pnorm(value, means, sigma, lower.tail = TRUE)[-1]

  # now get the dnorm (i.e. the first mean)
  dn_result  <- dnorm(value[1], means[1], sd = sigma[1])

  # Use reduce function to multiply all values together
  Reduce("*", c(pn_result, dn_result))

}

现在使用这样的功能:

> do_it(value = 7,   means = 2:4, sigma = 2)
[1] 0.007992577
> do_it(value = 7,   means = 2:4, sigma = 1:3)
[1] 1.222387e-06
> do_it(value = 7:9, means = 2:4, sigma = 1:3)
[1] 1.406878e-06

根据尼古拉的评论,是的,这个比较慢。

microbenchmark(
  do_it(7, 2:1000, 2),
  myfun(7, 2:1000, 2),
  time = 10000,
  unit = 'eps'
)

大约慢4-5倍,即~5ms vs~1ms以1000手段运行。

Unit: evaluations per second
                expr         min           lq        mean       median           uq          max neval
 do_it(7, 2:1000, 2)    1006.555     2234.863     2299.33     2373.921     2409.485 2.554957e+03   100
 myfun(7, 2:1000, 2)    5627.335     9837.340    10040.78    10169.636    10497.424 1.155161e+04   100
                time 9523809.524 30776515.152 48510649.75 38461538.462 57189542.484 1.666667e+08   100

编辑:已更新为矢量化代码,添加了基准