找到比当前元素大且下标更大的第一个元素。

Question

我有两个向量，A和B。对于A中的每个元素，我想找到B中第一个大于该元素且索引更高的元素的索引。A和B的长度相同。

所以对于向量：

A <- c(10, 5, 3, 4, 7)

B <- c(4, 8, 11, 1, 5)

我希望您能够提供一个结果向量：

R <- c(3, 3, 5, 5, NA)

当然我可以用两个循环来完成，但这很慢，而且我不知道在这种情况下如何使用apply()函数，因为索引很重要。我的数据集有长度为20000的向量，所以在这种情况下速度非常重要。

一些额外的问题：

1.如果我有一个数字序列（比如seq = 2:10），我想找到第一个大于A的每个a和seq的每个s之和的B中的数字。

2.与问题1类似，但我想知道第一个更大和第一个更小的值，并创建一个矩阵，存储哪一个是第一个。例如，对于A的a和seq的10，我想找到第一个大于a+10或小于a-10的B的值，并存储它的索引和值。

- mikabast

---

如果效率是一个问题，您可能不想在这种情况下使用嵌套的 apply 循环，因为一旦找到您的值，就没有必要继续搜索。 - Ricardo Saporta

Answer 1

sapply(sapply(seq_along(a),function(x) which(b[-seq(x)]>a[x])+x),"[",1)
[1]  3  3  5  5 NA

- James

---

我必须找出一些调整方法，因为它占用了太多的内存。我猜没有真正的替代'which()'，对吧？谢谢你的回答！ - mikabast

我一直觉得mapply应该有一个选项，你可以提供A和B，但不是逐个操作A与B的元素进行比较，而是先将A1与B1..B2..Bn进行比较，然后是A2与B2..B3..Bn等等。是否有这样的快捷函数？ - Stephen Henderson

这段代码可以解决你的内存问题：vapply(seq_along(A),function(x) match(TRUE, tail(B,-x) > A[x]), integer(1)) + seq_along(A)，因为match返回单个索引，而which则返回所有索引。然而，在我的机器上它稍微慢了一点，我本来以为会更快。 - flodel

@hadley，“1L”在这里也可以使用，但“1L”不等同于“integer(1)”，进而，“2L”也不同于“integer(2)”。因此，当涉及告诉vapply它应返回n个整数时，我认为integer(n)更合适。 - flodel

@flodel 哦，我看得太快了 - 你完全正确，这也是我喜欢与 vapply 一起使用的。 - hadley

Answer 2

这是一个很好的例子，说明使用sapply比使用循环更低效。尽管使用sapply能让代码看起来更整洁，但你需要用更多的时间来换取这种整洁性。

相反，你可以将while循环包装在for循环中，并封装成一个漂亮简洁的函数。

以下是比较嵌套应用程序循环和嵌套for-while循环的基准测试（还有一个混合应用程序while循环，以确保衡量）。

更新：添加了评论中提到的vapply..match..。比sapply更快，但仍比while循环慢得多。

基准测试：

           test elapsed relative
1     for.while   0.069    1.000
2  sapply.while   0.080    1.159
3  vapply.match   0.101    1.464
4 nested.sapply   0.104    1.507

注意，您可以节省三分之一的时间; 当您开始将序列添加到A中时，节省的时间可能会更多。

---

对于您问题的第二部分：

如果您已经将所有内容都包装在一个不错的函数中，那么将序列添加到A中就很容易了。

# Sample data
A <- c(10, 5, 3, 4, 7, 100, 2)
B <- c(4, 8, 11, 1, 5, 18, 20)

# Sample sequence
S <- seq(1, 12, 3)

# marix with all index values (with names cleaned up)   
indexesOfB <- t(sapply(S, function(s) findIndx(A+s, B)))
dimnames(indexesOfB) <- list(S, A) 

最后，如果您想要找到比A更小的B值，只需在函数中交换操作即可。
（您可以在函数中包含if语句并仅使用一个函数。我认为使用两个单独的函数更加有效率）

findIndx.gt(A, B)   #  [1]  3  3  5  5  6 NA  8 NA NA
findIndx.lt(A, B)   #  [1]  2  4  4 NA  8  7 NA NA NA

然后你可以将它包装成一个漂亮的包裹。

rangeFindIndx(A, B, S)
 #     A   S  indxB.gt indxB.lt
 #    10   1        3        2
 #     5   1        3        4
 #     3   1        5        4
 #     4   1        5       NA
 #     7   1        6       NA
 #   100   1       NA       NA
 #     2   1       NA       NA
 #    10   4        6        4
 #     5   4        3        4
 #   ...

函数

(请注意它们依赖于reshape2)

rangeFindIndx <- function(A, B, S) {
  # For each s in S, and for each a in A,
  # find the first value of B, which is higher than a+s, or lower than a-s

  require(reshape2)

  # Create gt & lt matricies;  add dimnames for melting function
  indexesOfB.gt <- sapply(S, function(s) findIndx.gt(A+s, B))
  indexesOfB.lt <- sapply(S, function(s) findIndx.lt(A-s, B))
  dimnames(indexesOfB.gt) <- dimnames(indexesOfB.gt) <- list(A, S)

  # melt the matricies and combine into one
  gtltMatrix <- cbind(melt(indexesOfB.gt), melt(indexesOfB.lt)$value)

  # clean up their names
  names(gtltMatrix) <- c("A", "S", "indxB.gt", "indxB.lt")

  return(gtltMatrix)
}

findIndx.gt <- function(A, B) {
  lng <- length(A)
  ret <- integer(0)
  b <- NULL
  for (j in seq(lng-1)) {
    i <- j + 1
    while (i <= lng && ((b <- B[[i]]) < A[[j]]) ) {
      i <- i + 1
    }
    ret <- c(ret, ifelse(i<lng, i, NA))
  }
  c(ret, NA)  
}

findIndx.lt <- function(A, B) {
  lng <- length(A)
  ret <- integer(0)
  b <- NULL
  for (j in seq(lng-1)) {
    i <- j + 1
    while (i <= lng && ((b <- B[[i]]) > A[[j]]) ) {   # this line contains the only difference from findIndx.gt
      i <- i + 1
    }
    ret <- c(ret, ifelse(i<lng, i, NA))
  }
  c(ret, NA)  
}

- Ricardo Saporta