Question

我正在使用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)
}

下面我们模拟一些数据并最小化负对数似然（这相当于最大化对数似然）。

# Simulate some data
N <- 1000
x <- cbind(1, rnorm(N,0,sd=1), rnorm(N, 0, sd=2)) 

true_theta <- c(2, 3, 2, 4)

y <- true_theta[1:3]%*%t(x) + rnorm(N, mean = 0, sd = true_theta[4])

my_data <- cbind(t(y),x)

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))

到目前为止，我们得到的结果与用于模拟数据的结果相同。通过使用rbenchmark软件包，我得到了优化步骤的10次复制，在我的计算机上大约需要4秒钟。

benchmark(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)),
replications=10)

现在我尝试用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循环慢，对吧？那么我的代码发生了什么？某些类型转换正在进行中吗？我检查了，logL返回一个矩阵，logL2返回一个数字。我尝试使用vapply（），因为它允许指定返回的对象的类型，但是vapply（）似乎通过将每个列堆叠在一起而将我的数据矩阵转换为向量。这导致contrib函数不再起作用：

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(vapply(data, FUN=contrib, beta = beta, FUN.VALUE = matrix(1)))) - 1/2 * N * log(2*pi) - N * log(sigma)
return(-L)
}

这就是我得到的：

class(logL2(theta = c(1,2,2,2), my_data))

Error in beta %*% x : non-conformable arguments

那么我怎样才能使用apply系列函数来使我的代码更具可读性，并且至少与for循环一样快？

Answer 1

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

你的for循环是

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

现在这与计算所有(y[i] - beta %*% x[i, ])^2并将它们全部加起来相同。考虑beta %*% x[i, ]您正在使用1x3矩阵（beta）与3x1（x[i, ]）进行矩阵乘法，得到1x1结果。所以你正在做的是独立地将beta乘以{em>每行 x。但是，使用矩阵乘法，无论如何都可以同时执行它们，并获得Nx1矩阵！

即。 beta（1x3）%*% x（3xN）将为您提供1xN矩阵，然后从y中减去此值，x也是长度为N的向量，每个差值为平方独立地总结它们。这相当于你的for循环。

唯一的问题是，t()是Nx3而不是3xN，所以我们先contrib <- sum((y - beta %*% t(x))^2)：

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
)

这完全取消了你的for循环。

  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

并且让我们检查一下我们没有犯错

作为一种风格点，为什么不让logL2成为cbind的第三个参数（而不是data在开始时y <- data[, 1]，然后必须一直选择合适的行/列）？这样您就无法始终执行x <- data[, -1]和logL <- function (theta, x, y) { ... }。即执行optim()之类的操作，然后在x来电中，您可以提供y和my_data参数，而不是t(x)。你甚至可以在一开始就做logL2进一步改进（例如在你的召唤中），所以每次调用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时都不必完成它？

logL2

它的速度提高了一倍。一般来说，如果你可以做一次而不是每次调用t(x)（例如data[, 1]，*apply等），它会为你节省一些时间。

关于您的原始问题（特别是与vapply函数有关：

data将列表作为输入，而您的contrib是一个矩阵，因此data在{{1}的一个元素上运行一次。即contrib将x视为单个数字。因此，不可协调的矩阵，因为矩阵乘法将beta（1x3）与x（1x1）相乘，并且要使矩阵乘法起作用，您需要beta的列数等于x的行数。要使用vapply，您需要类似
的内容
```
vapply(1:nrow(data), function(i) contrib(beta, data[i, ]), FUN.VALUE=1)
```
（！我没有通过基准测试或其他任何东西测试这些语句。这正是我在我的经验中发现的）：在所有*apply函数中，我发现apply()很慢（经常比for-loop慢）。这对于整齐的代码很方便（＆＃34;为每一行执行此操作＆＃34;或者＆＃34;为每个列执行此操作＆＃34; - 类型的任务：而不是大量的data[i, ]它＆＃39 ;只是apply(.., MARGIN=1)），但如果你需要速度，请执行for循环或使用其中一个表兄弟，如vapply，lapply或sapply。
vapply，lapply很快。 sapply也是如此，但通常前两者中的一个更快（sapply更容易使用，因为FUN.VALUE位vapply正在为你制定。或者如果您知道FUN.VALUE赢得的总是相同，则相当于lapply，所以您也可以使用它。因为sapply所有这一切都为您做到了它可以更容易使用，但速度稍慢。）
最快的是如果你可以使用一些数学来避免循环！例如如果你可以像我在这里所做的那样用矩阵乘法重新定义你的循环。虽然这仅适用于极少数情况。

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

1 个答案: