R-应用以使用函数替换for循环

我已经看过十几个学习apply、sapply、lappy的网站，但它们除了教你如何求一行或一列的和或平均值之外，没有什么进展。我必须使用很多for循环，通常是嵌套的。请告诉我如何在以下情况下替换为应用

for (i in 1:NTR) {
    X = as.vector(as.matrix(XTR[i,]))
    YZ = FN(W, V, U, X) # return Y and Z
    Y = YZ$Y
    Z = YZ$Z
    for (j in 1:NOUT) {
        F[i+NOUT*(j-1)] = Y[j]-YTR[i,j]
    } # j
} # i

及

---

非常感谢您的回复。

将循环转换为lappy的最简单方法是将for循环中的内容插入函数中。让我们从内部循环开始

foo_inner <- function(j) {
    F[i+NOUT*(j-1)] = Y[j]-YTR[i,j]
}

然后，您可以简单地将此函数应用于1:NOUT。在这种情况下，由于您的帖子中缺少信息，我似乎无法确定返回值是否只是一个数字，以便您可以直接创建一个向量而不是列表。在这种情况下，最好使用sapply而不是lapply“s”表示简化为向量，而“l”表示列表：

sapply(1:NOUT, foo_inner)

现在必须在外循环中指定此新向量。从您的代码中，似乎您希望将此向量指定给F[i+NOUT*1:NOUT-1]。我只是用迭代器1:NOUT替换了你的j值。因此，您的代码段可以这样修改：

for (i in 1:NTR) {
    X = as.vector(as.matrix(XTR[i,]))
    YZ = FN(W, V, U, X) # return Y and Z
    Y = YZ$Y
    Z = YZ$Z
    F[i+NOUT*(1:NOUT-1)] <- sapply(1:NOUT, foo_inner)
} # i

或者，修改foo_内部函数，使其以i为参数并返回正确的函数。然后将函数foo_inneri应用于内部sapply，而不是foo_inner：

在本例中，我使用了一个lappy，因为返回的每个元素都将是一个向量，所以我宁愿返回一个列表，然后将其折叠，因为我不确定sapply在本例中是否就是这么做的，而且我现在懒得去发现，如果有人能证实这一点，我会更正

现在你需要一个大的向量，我就把它折叠起来

do.call(c, lapply(1:NTR, foo_outer))

然后我可以直接将这个值赋给F：

F <- do.call(c, lapply(1:NTR, foo_outer))

对于任何j值，get_j_value在向量中返回LL的所有第j个元素。通过将此函数应用于所有可能的j值，它将返回一个包含第一个元素的列表：j=1的所有i值，然后对于第二个元素，j=2的所有i值

然后我可以把这个列表折叠成一个大的向量并分配它

F <- do.call(c, LL2)

---

编辑2：虽然可以使用apply函数重新创建for循环，但这可能是for循环实际上更好的情况之一：没有结果的累积，因此apply方法不应该更快，我相信for循环会更清晰。通常情况下，当您在多个不同对象上使用的索引上循环时，您无法直接在任何特定对象上使用apply，但需要将函数应用于索引向量。。。只要我的两分钱……

你的例子可能对你有意义，但如果没有上下文，它们对其他人可能没有意义。代码的输入和预期输出是什么？这比任何教程都好。我仍然需要理解函数定义中的函数是如何工作的，但我可以读懂。F和Y是向量，YTR是一个全数字矩阵，因此Y[j]-YTR[i，j]是一个数字。它只需要放在向量F的正确位置。FN是矩阵W，V，U和向量X的函数。XTR是一个数据帧，因为我从read.csv文件中读取它。我不明白最后一部分——LL和LL2。我们根本没有创建任何列表。只有YZ是一个列表，因为我想从FN返回两个矩阵。再次感谢您的解释。使用foo_inner我很高兴您发现它很有用。@user6439024，您可以通过单击Choubi答案旁边灰色阴影的记号来接受他的答案，也可以通过单击记号上方的向上箭头来给他答案a+1

foo_outer <- function(i) {
    X = as.vector(as.matrix(XTR[i,]))
    YZ = FN(W, V, U, X) # return Y and Z
    Y = YZ$Y
    Z = YZ$Z
    foo_inner <- function(j) {
        return(Y[j]-YTR[i,j])
    }
    F[i+NOUT*(1:NOUT-1)] <- sapply(1:NOUT, foo_inner)
}

foo_inner <- function(i) {
    function(j) {
        return(Y[j]-YTR[i,j])
    }
}
foo_outer <- function(i) {
    X = as.vector(as.matrix(XTR[i,]))
    YZ = FN(W, V, U, X) # return Y and Z
    Y = YZ$Y
    Z = YZ$Z
    F[i+NOUT*(1:NOUT-1)] <- sapply(1:NOUT, foo_inner(i))
}

foo_inner <- function(i) {
    function(j) {
        return(Y[j]-YTR[i,j])
    }
}
foo_outer <- function(i) {
    X = as.vector(as.matrix(XTR[i,]))
    YZ = FN(W, V, U, X) # return Y and Z
    Y = YZ$Y
    Z = YZ$Z
    return(sapply(1:NOUT, foo_inner(i)))
}

lapply(1:NTR, foo_outer)

do.call(c, lapply(1:NTR, foo_outer))

F <- do.call(c, lapply(1:NTR, foo_outer))

LL <- lapply(1:NTR, foo_outer)
get_j_values <- function(j) {
    sapply(LL, function(x) x[[j]])
}

LL2 <- lapply(1:NOUT, get_j_values)

F <- do.call(c, LL2)