Question

exactci包中有一个函数，我想将参数作为矩阵传递并返回矩阵。事实上，所有参数都只能是长度为1的向量。我挖掘了源代码并找到了这个函数，我实际使用的函数（这里修改和减少了参数）：

exact.binom.minlike <- function(d1, d2, e1, e2){
    x           <- round(d1)
    n           <- x + round(d2)
    p           <- e1 / (e1 + e2)

    support     <- 0:n
    f           <- dbinom(support, n, p)
    d           <- f[support == x]

    sum(f[f <= d * relErr])
}

（这使用minlike方法返回pisson值，用于泊松率相等的双边检验）

我看到我无法传递矩阵并返回矩阵的原因是因为内部创建了向量support。我将dbinom()部分删到了以下内容：

f           <- exp( lfactorial(n) - 
                    (lfactorial(support) + lfactorial(n - support)) + 
                    support * log(p) + 
                    (n - support) * log(1 - p)
                   )

这会返回相同的向量，f，精细和花花公子，甚至更快一点，但它似乎无法解决我的问题 - 至少我没有看到使用{{ 1}}作为向量。支持的长度将根据support的不同而有所不同，因此我不得不一次进行一次比较。我能做的最好的事情就是将整个事物放在d1+d2里面，这样可以将矩阵作为参数，但返回一个向量而不是矩阵：

Vectorize()

以下是一个例子：

exact.binom.minlike.stripped <- Vectorize(compiler:::cmpfun(function(d1, d2, e1, e2, relErr = 1 + 10 ^ ( -7)){
    x           <- round(d1)
    n           <- x + round(d2)
    p           <- e1 / (e1 + e2)

    support     <- 0:n

    # where dbinom() is the prob mass function:
    # n choose k * p ^ k * (1 - p) ^ (n - k) # log it to strip down, then exp it
    f           <- exp( lfactorial(n) - 
                        (lfactorial(support) + lfactorial(n - support)) + 
                        support * log(p) + 
                        (n - support) * log(1 - p)
                       )
   #f           <- dbinom(support,n,p)
   d            <- f[support == x]

   sum(f[f <= d * relErr])
}))

此输出是长度为36而不是6x6矩阵的向量。所有四个输入都是6x6矩阵：

set.seed(1)
d1 <- matrix(rpois(36,lambda = 100), 6)
d2 <- matrix(rpois(36,lambda = 150), 6)
e1 <- matrix(rpois(36,lambda = 10000), 6)
e2 <- matrix(rpois(36,lambda = 25000), 6)

我收集我可以为此添加(p.vals <- exact.binom.minlike.stripped(d1, d2, e1, e2)) [1] 1.935277e-04 9.680425e-08 1.508232e-08 1.227176e-04 1.656111e-02 [6] 2.310620e-04 2.871150e-05 4.024025e-06 4.804943e-05 1.619866e-02 [11] 3.610596e-02 1.101247e-04 5.153746e-04 1.350891e-04 8.663191e-06 [16] 1.384378e-05 2.681715e-06 4.556092e-08 2.270317e-04 2.040001e-04 [21] 3.330344e-01 4.775055e-05 2.588667e-07 5.647732e-04 1.615861e-03 [26] 2.438345e-03 2.524692e-04 3.398664e-05 2.001322e-05 4.361194e-03 [31] 3.909116e-05 1.697943e-03 8.543677e-07 2.992653e-05 2.617216e-04 [36] 3.106748e-03并将其重新组合成矩阵：

dim()

但这似乎是第二好的。我可以让dim(p.vals) <- dim(d1)给出一个与传递给它的参数相同维度的矩阵吗？更好的是，有没有办法正确地向量化我在这里做的事情并完全避免隐藏for循环（Vectorize()使用Vectorize()）？

[[编辑]]感谢Pete的伟大建议。以下是使用更接近维度的数据进行比较：

mapply()

在这些期间，我看了我的系统监视器的内存使用情况，只有set.seed(1) N <-110 d1 <- matrix(rpois(N^2,lambda = 1000), N) d2 <- matrix(rpois(N^2,lambda = 1500), N) e1 <- matrix(rpois(N^2,lambda = 10000), N) e2 <- matrix(rpois(N^2,lambda = 25000), N) system.time(exact.binom.minlike.stripped.2(d1, d2, e1, e2)) user system elapsed 16.353 1.112 17.635 system.time(exact.binom.minlike.stripped.3(d1, d2, e1, e2)) user system elapsed 14.685 0.016 14.715 system.time({ (p.vals <- exact.binom.minlike.stripped(d1, d2, e1, e2)) (dim(p.vals) <- dim(d1)) }) user system elapsed 12.541 0.040 12.604是内存耗尽。我看到如果我在我的真实数据上使用它，exact.binom.minlike.stripped.2()可以增加10-20倍，那我的计算机就会窒息。（3）没有这个问题，但由于某种原因，它不如max(n)快。编译（3）并没有使它在我的系统上运行得更快。

[[编辑2]]：对于相同的数据，Pete的新exact.binom.minlike.stripped()完成了这项工作：

exact.binom.minlike.stripped3()

因此，后期的stretegy，预先计算user system elapsed 6.468 0.032 6.513的对数阶乘，是一个主要的节省时间。非常感谢Pete！

Answer 1

我可以想到两个理由，想要像这个矢量化这样的函数：方便性或性能。

以下应该是为了方便起见，但我怀疑如果max(n)非常大，那么所有的内存分配都会抵消dbinom调用的矢量化所带来的任何收益。

exact.binom.minlike.stripped.2 <- function(d1, d2, e1, e2, relErr = 1 + 1e-7) {

    x <- round(d1)
    n <- x + round(d2)
    p <- e1 / (e1 + e2)

    # `binom` is already vectorised.
    d <- dbinom(x, n, p)

    # rearrange inputs to `dbinom` so that it works with `outer`.
    dbinom.rearrange <- function(n, x, p) dbinom(x, n, p) 
    support <- 0:max(n)
    f <- outer(n, support, dbinom.rearrange, p=p)

    # repeat `d` enough times to conform with `f`.
    d <- array(d, dim(f))
    f[f > d * relErr] <- 0

    # extract the required sums.
    apply(f, c(1,2), sum) 
}

或者，可能更明智的做法：尽可能使用自然矢量化，并将Vectorize限制为“不自然”部分。这仍然需要在最后修复尺寸。

vector.f <- Vectorize(function(d, n, p, ftable) {

    x <- 0:n
    f <- exp( ftable[n+1] - (ftable[x+1] + ftable[n-x+1]) + x*log(p) + (n-x)*log(1-p) )
    sum(f[f <= d])

}, c('d', 'n', 'p'))

exact.binom.minlike.stripped.3 <- function(d1, d2, e1, e2, relErr = 1 + 1e-7) {

    x <- round(d1)
    n <- x + round(d2)
    p <- e1 / (e1 + e2)

    # `binom` is already vectorised.
    d <- dbinom(x, n, p)

    # precompute factorials
    ftable <- lfactorial(0:max(n))

    f <- vector.f(d * relErr, n, p, ftable)
    dim(f) <- dim(d1)

    return(f)
}

在我的笔记本电脑上，这些都是以相同的速度出现的，但是根据问题和硬件的实际大小，其中一种可能会更快。

使Vectorize（）传递dims或正确地向量化此函数

1 个答案: