Как я могу сделать свою функцию, которая проверяет, какие значения не упорядочены в порядке возрастания быстрее?

Question

Я написал функцию, которая проверяет, какие значения в векторе не упорядочены в порядке возрастания.Поэтому каждый элемент в векторе проверяется, если он выше, чем все элементы слева от него.

Затем я использовал эту функцию для сгруппированных данных, но это занимает очень много времени (около 6-7 минут).Мои исходные данные содержат около 3 миллионов строк и 13 480 групп.

Мой код:

  check_which_not_ordered <- function(x) {  

      res <- rep(NA, length(x))

      for(i in 1:length(x)) {
         for (j in 1:i) {
         res[i] <- all(x[i] >= x[1:j])
         }
      }

  return(res) 

  }

  setDT(dt)[, ordered := check_which_not_ordered(no_of_reviews), 
            by = .(country, id)] 

Небольшая выборка данных:

  dtt <- data.frame(country = c(rep("USA", 10), rep("Canada", 10)),
             id = c(rep(1, 5), rep(2, 5), rep(3, 5), rep(4, 5)),
             no_of_reviews = c(c(10, 12, 3, 4, 13), 
                             c(2, 3, 4, 5, 6),
                             c(7, 9, NA, 7, NA),
                             c(NA, 7, 2, 9, 10)))

Выход проверяет, какие элементы не отсортированы в порядке возрастания, как ЛОЖНО.Интересно, смогу ли я достичь того же результата быстрее?

Answer 1

Используйте функцию cummax() и посмотрите, равен ли каждый элемент кумулятивному максимуму в том же месте.Затем вставьте АН обратно.

library(microbenchmark)
dtt <- data.frame(country = c(rep("USA", 10), rep("Canada", 10)),
                  id = c(rep(1, 5), rep(2, 5), rep(3, 5), rep(4, 5)),
                  no_of_reviews = c(c(10, 12, 3, 4, 13), 
                                    c(2, 3, 4, 5, 6),
                                    c(7, 9, NA, 7, NA),
                                    c(NA, 7, 2, 9, 10)))


check_which_not_ordered <- function(x) {  

  res <- rep(NA, length(x))

  for(i in 1:length(x)) {
    for (j in 1:i) {
      res[i] <- all(x[i] >= x[1:j])
    }
  }

  return(res) 

}

check_which_not_ordered2 <- function(x) {
  na_inds <- which(is.na(x))
  x[na_inds] <- min(x) - 1
  res <- x == cummax(x)
  res[na_inds] <- NA
  return(res)
}


x = dtt$no_of_reviews

microbenchmark(check_which_not_ordered(x), check_which_not_ordered2(x))
#> Unit: nanoseconds
#>                         expr   min       lq      mean   median       uq
#>   check_which_not_ordered(x) 97185 128197.5 167051.89 133333.5 135901.5
#>  check_which_not_ordered2(x)   790   1185.0  24845.53   1580.0   1975.0
#>      max neval
#>  3863309   100
#>  2304395   100

^{Создано в 2019-09-19 с помощью пакета представительства (v0.3.0)}

Answer 2

Другой вариант:

DT[, nor := replace(no_of_reviews, is.na(no_of_reviews), -Inf)][,
    o4 := cummax(no_of_reviews) & no_of_reviews >= cummax(nor), .(country, id)][,
        nor := NULL]

выход:

    country id no_of_reviews ordered    o4
 1:     USA  1            10    TRUE  TRUE
 2:     USA  1            12    TRUE  TRUE
 3:     USA  1             3   FALSE FALSE
 4:     USA  1             4   FALSE FALSE
 5:     USA  1            13    TRUE  TRUE
 6:     USA  2             2    TRUE  TRUE
 7:     USA  2             3    TRUE  TRUE
 8:     USA  2             4    TRUE  TRUE
 9:     USA  2             5    TRUE  TRUE
10:     USA  2             6    TRUE  TRUE
11:  Canada  3             7    TRUE  TRUE
12:  Canada  3             9    TRUE  TRUE
13:  Canada  3            NA      NA    NA
14:  Canada  3             7   FALSE FALSE
15:  Canada  3            NA      NA    NA
16:  Canada  4            NA      NA    NA
17:  Canada  4             7      NA    NA
18:  Canada  4             2   FALSE FALSE
19:  Canada  4             9      NA    NA
20:  Canada  4            10      NA    NA

данные:

library(data.table)
DT <- data.table(country = c(rep("USA", 10), rep("Canada", 10)),
    id = c(rep(1, 5), rep(2, 5), rep(3, 5), rep(4, 5)),
    no_of_reviews = c(c(10, 12, 3, 4, 13), 
        c(2, 3, 4, 5, 6),
        c(7, 9, NA, 7, NA),
        c(NA, 7, 2, 9, 10)))

#OP's function
check_which_not_ordered <- function(x) {  
    res <- rep(NA, length(x))
    for(i in 1:length(x)) {
        res[i] <- all(x[i] >= x[1:i])
    }
    res
}
DT[, ordered := check_which_not_ordered(no_of_reviews), .(country, id)]