sapply 的替代品答案

【问题标题】：Alternative for sapplysapply 的替代品
【发布时间】：2018-09-07 05:38:13
【问题描述】：

我在 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”这样的字符串并将其转换为数字并从中返回最大值。现在，我有一列充满了这样的字符串，并且这段代码运行良好，直到数据量很小。但是当数据大小为 2500 万行（我目前正在处理）时，此代码变得非常慢。这段代码有什么替代方法可以让我从存储在新列中的字符串中获取最大值吗？

【问题讨论】：

为什么是strsplit？你能提供一个数据的小例子吗？
您是否尝试过找出哪个组件花费的时间最多——它不一定是 sapply。（可以是strsplit 或ifelse 或as.character 或às.numeric
可以尝试这样的事情：apply(sapply(0:9, function(Y) grepl(Y,x)),2,which.max)（其中x是一个向量，类似于x<-c("123", "12345", "56690239")
unlist(lapply(..)) 将（通常）比 sapply 快

标签： r dplyr data.table sapply

【解决方案1】：

基于我上面的评论的答案（但我已经修改了代码以使其实际工作）：

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

这比使用 strsplit 的原始代码快大约 3 倍……但我确信还有改进的余地。嗯...实际上，我会再次尝试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

【讨论】：

如果我想计算字符串中的“>0”个条目怎么办？
您的意思是222 和111 导致3 但099 导致2？一个简单的方法是nchar(gsub("0","",x))——但这假定字符串只包含数字
我想，nchar(gsub("[^1-9]","",x)) 将是一种更通用的方法（例如，如果它们出现在字符串中，则不会计算空格和字母）

【解决方案2】：

转换为整数然后使用 %% 和 %/% 计算数字对于 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~

【讨论】：