Альтернатива для сапли - PullRequest
Новая
       24

Альтернатива для сапли

0 голосов
/ 07 сентября 2018

Я использую следующий код в R: 

df$max_col<- sapply(df$col, function(x) ifelse(x == "", 0, strsplit(as.character(x), "", perl = TRUE)[[1]] %>% as.numeric %>% max(na.rm = T)))

Этот код в основном разбивает строку наподобие «123456», превращает ее в числовую и возвращает из нее максимальное значение.Теперь у меня есть столбец, полный строк, подобных этим, и этот код работает нормально, пока размер данных не будет низким.Но когда размер данных составляет 25 миллионов строк (с которыми я сейчас имею дело), ​​этот код становится очень медленным.Есть ли альтернатива для этого кода, с помощью которой я могу получить максимальное значение из строки, хранящейся в новом столбце?

Ответы [ 2 ]

0 голосов
/ 08 сентября 2018

Преобразование в целое число с последующим вычислением цифр с использованием %% и %/% представляется наиболее быстрым для вектора длиной 25 000 000: 

a <- as.character(sample(1:1e6, size = 25e6, replace = TRUE))

use_grepl <- function(x) {
  o <- integer(length(x))
  o[grep('1', x, fixed = TRUE)] <- 1L
  o[grep('2', x, fixed = TRUE)] <- 2L
  o[grep('3', x, fixed = TRUE)] <- 3L
  o[grep('4', x, fixed = TRUE)] <- 4L
  o[grep('5', x, fixed = TRUE)] <- 5L
  o[grep('6', x, fixed = TRUE)] <- 6L
  o[grep('7', x, fixed = TRUE)] <- 7L
  o[grep('8', x, fixed = TRUE)] <- 8L
  o[grep('9', x, fixed = TRUE)] <- 9L
  o
}

use_strsplit <- function(x) {
  tbl19 <- as.character(1:9)
  vapply(strsplit(x, split = "", fixed = TRUE),
         function(v) {
           max(fmatch(v, table = tbl19, nomatch = 0L))
         },
         0L)
}

use_mod <- function(xx) {

  nth_digit_of <- function (x, n) {
    {x %% 10^n} %/% 10^{n - 1L}
  }
  v <- as.integer(xx)
  most_digits <- as.integer(ceiling(log10(max(v))) + 1)
  o <- nth_digit_of(v, 1L)
  for (vj in 2:most_digits) {
    o <- pmax.int(o, nth_digit_of(v, vj)) 
  }
  as.integer(o)
}


doit4 <- function(V) as.numeric(sapply(strsplit(V, ""), max))

bench::mark(use_mod(a), use_grepl(a), doit4(a))
# A tibble: 3 x 14
  expression   min  mean median   max `itr/sec` mem_alloc  n_gc n_itr total_time result memory time 
  <chr>      <bch> <bch> <bch:> <bch>     <dbl> <bch:byt> <dbl> <int>   <bch:tm> <list> <list> <lis>
1 use_mod(a) 14.4s 14.4s  14.4s 14.4s    0.0693    2.61GB     3     1      14.4s <int ~ <Rpro~ <bch~
2 use_grepl~ 38.2s 38.2s  38.2s 38.2s    0.0262    1.32GB     0     1      38.2s <int ~ <Rpro~ <bch~
3 doit4(a)   56.5s 56.5s  56.5s 56.5s    0.0177    1.18GB     7     1      56.5s <dbl ~ <Rpro~ <bch~
0 голосов
/ 07 сентября 2018

Ответ, основанный на моем комментарии выше (но я изменил код, чтобы он действительно работал): 

x <- c("123", "224", "221", "1912323", "445")
apply(sapply(1:9, function(p) grepl(p, x)), 1, function(k) max(which(k)))
# the above will work if 0 is never the largest  number in any cell

Более обобщенная версия: 

doit <- function(x) apply(sapply(0:9, function(p) grepl(p, x)), 1, function(k) max(which(k)))-1
x <- c("123", "224", "221", "1912323", "445", "000")
doit(x)
# [1] 3 4 2 9 5 0

Это примерно в 3 раза быстрее, чем оригинальный код с использованием strsplit ... но я уверен, что есть возможности для улучшения. Хм ... на самом деле, я попробую снова с strsplit: 

doit3 <- function(.) sapply(strsplit(.,""), max)
doit3(x)
# [1] "3" "4" "2" "9" "5" "0"

Это примерно в 5 раз быстрее, чем мой предыдущий подход. Таким образом, проблема была не в sapply или strsplit, а в других компонентах. Если вам нужно преобразовать его в числовой, добавьте as.numeric к внешнему слою, это не займет много дополнительного времени: 

doit4 <- function(.) as.numeric(sapply(strsplit(.,""), max))
> doit4(x)
# [1] 3 4 2 9 5 0
...