Question

请考虑以下事项：

df <- data.frame(X = c(5000, 6000, 5500, 5000, 5300))

count_above <- function(vector)
{
  counts <- vector()
  counts[1] <- 0
  for (i in 2:length(vector))
  {
    temp <- vector[1:i]
    counts <- c(counts, sum(temp < vector[i]))
  }
  return(counts)
}

这给了我正确的输出：

count_above(df$X)
[1] 0 1 1 0 2

例如，这里的（列）向量是

在最顶层的5000，上方没有值。所以这给出了值0。

在6000处，有一个值高于它且小于6000：5000。所以这给出了值1。

在5500，其上方有两个值，其中一个值小于5500，因此这会给出值1，依此类推。

有没有办法在不使用循环的情况下将其写出来？

Answer 1

另一种方法，与aichao的解决方案非常相似（但有点短）

X <- c(5000, 6000, 5500, 5000, 5300)
indices <- 1:length(X)
count_above <- colSums(outer(X, X, "<") & outer(indices, indices, "<"))
## [1] 0 1 1 0 2

编辑（性能）：也许我的想法被选为接受的答案，因为它是简短且自我解释的代码 - 但要注意在大型载体上使用它！这是这里建议的所有解决方案中最慢的方法！与dracodoc所做的类似，我也做了一个微基准测试。但我使用随机生成的3000个值的矢量来获得更重要的运行时间：

count_above_loop <- function(v)
{
  counts <- integer(length = length(v))
  counts[1] <- 0
  for (i in 2:length(v))
  {
    counts[i] <- sum(v[1:(i-1)] < v[i])
  }
  return(counts)
}

count_above_outer <- function(X) {
  indices <- 1:length(X)
  colSums(outer(X, X, "<") & outer(indices, indices, "<"))
}

count_above_apply <- function(X) {
  sapply(seq_len(length(X)), function(i) sum(X[i:1] < X[i]))
}

X <- runif(3000)

microbenchmark::microbenchmark(count_above_loop(X), 
                               count_above_apply(X),
                               count_above_outer(X), times = 10)

Unit: milliseconds
                 expr       min        lq      mean    median        uq       max neval cld
  count_above_loop(X)  56.27923  58.17195  62.07571  60.08123  63.92010  77.31658    10  a 
 count_above_apply(X)  54.41776  55.07511  57.12006  57.22372  58.61982  59.95037    10  a 
 count_above_outer(X) 121.12352 125.56072 132.45728 130.08141 137.08873 154.28419    10   b

我们看到对大型向量的apply方法没有数据帧的开销比for-loop略快。

我的外部产品方法花费的时间是原来的两倍。

所以我建议使用for-loop - 它也可读且速度更快。如果你想要有可证明的正确代码，我的方法可能会被考虑（因为这个单行代码非常接近问题的规范）

Answer 2

考虑使用sapply()运行条件计数。虽然这仍然是一个循环，但它是一个矢量化方法：

count_above <- sapply(seq_len(nrow(df)), 
                      function(i) sum(df[i:1, c("X")] < df$X[i]))
count_above
# [1] 0 1 1 0 2

Answer 3

编辑：我应该使用更大的数据集作为基准，微小的数据集使基准测试结果有点误导。请参阅PatrickRoocks的更新。

我刚评论说for循环并不一定比应用family更糟糕，所以我看到了这个。

我做了一个微基准测试，比较了优化的for循环和sapply方法。 for循环快6倍。 sapply方法不是一个合适的函数，将它修改为一个带向量的函数，而不是假设数据帧列可以稍微改进一点。

df <- data.frame(X = c(5000, 6000, 5500, 5000, 5300))

count_above <- function(v)
{
  counts <- integer(length = length(v))
  counts[1] <- 0
  for (i in 2:length(v))
  {
    counts[i] <- sum(v[1:(i-1)] < v[i])
  }
  return(counts)
}
count_above(df$X)

microbenchmark::microbenchmark(count_above(df$X), sapply(seq_len(nrow(df)), function(i) sum(df[i:1, c("X")] < df$X[i])), times = 10)

Unit: microseconds
                                                                  expr
                                                     count_above(df$X)
 sapply(seq_len(nrow(df)), function(i) sum(df[i:1, c("X")] < df$X[i]))
     min      lq     mean   median      uq     max neval cld
  38.623  41.068  65.0722  55.0010  65.512 142.757    10  a 
 262.045 269.379 368.6231 339.2905 415.067 640.934    10   b

更新

# modify Parfait's answer into a function, taking vector instead of data frame
count_above_2 <- function(v){
  counts <- sapply(seq_len(length(v)), 
    function(i) sum(v[i:1] < v[i]))
  return(counts)
}

X <- df$X

microbenchmark::microbenchmark(count_above(X), count_above_2(X), {indices <- 1:length(X); colSums(outer(X, X, "<") & outer(indices, indices, "<"))}, times = 100)

Unit: microseconds
                                                                                        expr
                                                                              count_above(X)
                                                                            count_above_2(X)
 {     indices <- 1:length(X)     colSums(outer(X, X, "<") & outer(indices, indices, "<")) }
    min      lq     mean  median      uq     max neval cld
 21.023 23.4680 39.02878 26.1565 35.4450 144.224   100  a 
 41.067 49.3785 67.06162 53.2900 70.1565 166.712   100   b
 37.646 40.0900 66.45059 53.0450 72.8455 258.623   100   b

For循环仍然获胜。转移矢量而不是df$X为所有人节省时间，所以我给3个解决方案相同的矢量来进行比较。 Parfa的答案与PatrickRoocks的答案相当。

除了表现之外，还有一个微妙的正确点。

OP的函数和Parfait的和（v [i：1]＆lt; v [i]）仅给出正确答案，因为v [i]＆lt; v [i]是假的。根据定义，它应该使用v [1：（i-1）]＆lt; v [i]中。

我的功能可以用更简洁的版本编写：

count_above <- function(v)
{
  counts <- integer(length = length(v))
  for (i in 1:length(v))
  {
    counts[i] <- sum(v[1:(i-1)] < v[i])
  }
  return(counts)
}

看起来更好，并给出正确的结果。这也取决于v [1]＆lt; v [1]是假的。它不一定是错的，因为它只是第一行，但我仍然更喜欢更长但更明显的版本。

Answer 4

另一种方法（由于colSums仍然是循环）：

xg <- expand.grid(df$X,df$X)
o <- matrix(xg$Var1 < xg$Var2, nrow=length(x))
o[lower.tri(o)] <- FALSE
count_above <- colSums(o)
##[1] 0 1 1 0 2

这很可能不如Parfait的答案那么有效，但它是另一种选择。

在不使用循环

4 个答案: