R 使用apply函数族编写对数似然函数。性能损失？

我正在研究R中的apply（）函数族，并试图使用apply（）编写一个对数似然函数

下面是假设高斯干扰的线性回归模型的对数似然：

# Likelihood function for the standard linear regression model

logL <- function(theta, data){
    # Return minus the log likelihood function for the standard linear regression model
    # y: endogenous variable
    # x: matrix of regressors
    y <- data[, 1]
    x <- data[, -1]
    N <- nrow(data)
    # This is the contribution to the log-likelihood of individual i. Initialized at 0.
    contrib <- 0
    beta <- head(theta, -1) # Every element but the last one
    sigma <- tail(theta, 1) # Only the last element
    for (i in 1:N){
        contrib <- contrib + (y[i] - beta%*%x[i,])**2
    }
    sigma <- abs(sigma)
    L <- -(1/(2*sigma^2)*contrib) - 1/2 * N * log(2*pi) - N * log(sigma)
    return(-L)
}

现在我尝试用apply函数替换for循环。为此，我将contrib定义为一个函数：

contrib <- function(beta, one_obs){
    y <- one_obs[1]
    x <- one_obs[-1]
    return((y - beta%*%x)**2)
}

logL2 <- function(theta, data){
# Return minus the log likelihood function for the standard linear   regression model
# y: endogenous variable
# x: matrix of regressors
N <- nrow(data)
beta <- head(theta, -1) # Every element but the last one
sigma <- tail(theta, 1) # Only the last element
sigma <- abs(sigma)
L <- -(1/(2*sigma^2)*sum(apply(data, FUN=contrib, beta = beta, 1))) 
- 1/2 * N * log(2*pi) - N * log(sigma)
return(-L)
}

---

那么，如何使用apply函数族使代码更具可读性，至少与for循环一样快呢？

您可以通过考虑for循环中涉及的数学知识来简化代码

您的for循环是

contrib <- contrib + (y[i] - beta%*%x[i,])**2

这完全消除了for循环

logL2 <- function(theta, data){
    y <- data[, 1]
    x <- data[, -1]
    N <- nrow(data)
    beta <- head(theta, -1) # Every element but the last one
    sigma <- tail(theta, 1) # Only the last element
    contrib <- sum((y - beta %*% t(x))^2)
    sigma <- abs(sigma)
    L <- -(1/(2*sigma^2)*contrib) - 1/2 * N * log(2*pi) - N * log(sigma)
    return(-L)
}

library(rbenchmark)
benchmark(
    orig={orig.answer <- optim(c(1,1,1, 1), fn = logL, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
    new={new.answer <- optim(c(1,1,1, 1), fn = logL2, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
replications=10
)

还有，让我们检查一下，我们没有犯错误

all.equal(orig.answer, new.answer)
# [1] TRUE

---

作为一个样式点，为什么不将

y

作为

logL2

的第三个参数（而不是

cbind

在开始时将其添加到

数据中，然后一直选择适当的行/列）？这样可以避免执行
y您可以通过考虑for循环中涉及的数学来简化代码

您的for循环是

contrib <- contrib + (y[i] - beta%*%x[i,])**2

这完全消除了for循环

logL2 <- function(theta, data){
    y <- data[, 1]
    x <- data[, -1]
    N <- nrow(data)
    beta <- head(theta, -1) # Every element but the last one
    sigma <- tail(theta, 1) # Only the last element
    contrib <- sum((y - beta %*% t(x))^2)
    sigma <- abs(sigma)
    L <- -(1/(2*sigma^2)*contrib) - 1/2 * N * log(2*pi) - N * log(sigma)
    return(-L)
}

library(rbenchmark)
benchmark(
    orig={orig.answer <- optim(c(1,1,1, 1), fn = logL, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
    new={new.answer <- optim(c(1,1,1, 1), fn = logL2, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
replications=10
)

还有，让我们检查一下，我们没有犯错误

all.equal(orig.answer, new.answer)
# [1] TRUE

作为一个样式点，为什么不将
y
作为
logL2
的第三个参数（而不是
cbind
在开始时将其添加到
数据中，然后一直选择适当的行/列）？这让你不用再做
y欢迎回来，MC。回答得很好。R中的矩阵乘法非常快，这是由c/fortran实现的，我们甚至可以使用openBLAS、Intel MKL、cuBLAS构建R来利用多核功能：）回答得非常好@mathematic.coffee，up。您好，感谢您提供非常详细的答案！的确，在这种特殊情况下，我可以去掉循环，但我的目标是比较for循环并应用（因此使用for循环而不是使用矩阵乘法）。这样看来，如果您只能使用循环，那么就没有真正的方法使其更快（除了并行化，也许，但这并不总是微不足道的）。还感谢所有其他提示，以使代码运行更快！欢迎回来，麦克。回答得很好。R中的矩阵乘法非常快，这是由c/fortran实现的，我们甚至可以使用openBLAS、Intel MKL、cuBLAS构建R来利用多核功能：）回答得非常好@mathematic.coffee，up。您好，感谢您提供非常详细的答案！的确，在这种特殊情况下，我可以去掉循环，但我的目标是比较for循环并应用（因此使用for循环而不是使用矩阵乘法）。这样看来，如果您只能使用循环，那么就没有真正的方法使其更快（除了并行化，也许，但这并不总是微不足道的）。还感谢所有其他提示，以使代码运行更快！
logL2 <- function(theta, data){
    y <- data[, 1]
    x <- data[, -1]
    N <- nrow(data)
    beta <- head(theta, -1) # Every element but the last one
    sigma <- tail(theta, 1) # Only the last element
    contrib <- sum((y - beta %*% t(x))^2)
    sigma <- abs(sigma)
    L <- -(1/(2*sigma^2)*contrib) - 1/2 * N * log(2*pi) - N * log(sigma)
    return(-L)
}

library(rbenchmark)
benchmark(
    orig={orig.answer <- optim(c(1,1,1, 1), fn = logL, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
    new={new.answer <- optim(c(1,1,1, 1), fn = logL2, data = my_data,
method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01))},
replications=10
)

  test replications elapsed relative user.self sys.self user.child sys.child
2  new           10   0.306     1.00     0.332    0.048          0         0
1 orig           10   4.584    14.98     4.588    0.000          0         0

all.equal(orig.answer, new.answer)
# [1] TRUE

logL3 <- function(theta, x, y){
  N <- length(y)
  beta <- head(theta, -1) # Every element but the last one
  sigma <- tail(theta, 1) # Only the last element
  contrib <- sum((y - beta %*% x)^2)
  sigma <- abs(sigma)
  L <- -(1/(2*sigma^2)*contrib) - 1/2 * N * log(2*pi) - N * log(sigma)
  return(-L)
}

benchmark(
  new=optim(c(1,1,1, 1), fn = logL2, data = my_data,
            method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01)),
  new.new=optim(c(1,1,1, 1), fn = logL3, x=t(x), y=y,
            method = "L-BFGS-B",upper = c(Inf, Inf, Inf), lower=c(-Inf, -Inf, 0.01)),
  replications=100
)
     test replications elapsed relative user.self sys.self user.child sys.child
1     new          100   3.149    2.006     3.317    0.700          0         0
2 new.new          100   1.570    1.000     1.488    0.344          0         0

vapply(1:nrow(data), function(i) contrib(beta, data[i, ]), FUN.VALUE=1)