通过远离for循环来提高性能

era*_*rtg 16 r data.table

论证的要点如下:

我编写的函数考虑了一个参数,一个字母数字字符串,并且应该输出一个字符串,其中该字母数字字符串的每个元素的值被切换以进行某些"映射".MRE如下:

#This is the original and switches value map
map = data.table(mapped = c(0:35), original = c(0:9,LETTERS))
#the function that I'm using:
as_numbers <- function(string) {
  #split string unlisted
  vector_unlisted <- unlist(strsplit(string,""))
  #match the string in vector
  for (i in 1:length(vector_unlisted)) {

    vector_unlisted[i] <- subset(map, map$original==vector_unlisted[i])[[1]][1]

  }
  vector_unlisted <- paste0(vector_unlisted, collapse = "")

  return(vector_unlisted)
}
Run Code Online (Sandbox Code Playgroud)

我正试图摆脱for loop那些提高性能的东西,因为函数可以正常工作,但是对于我在这种形式下提供的元素数量而言,这是非常缓慢的:

unlist(lapply(dat$alphanum, function(x) as_numbers(x)))
Run Code Online (Sandbox Code Playgroud)

输入字符串的一个例子是:549300JV8KEETQJYUG13.这应该会产生一个字符串5493001931820141429261934301613

在这种情况下只提供一个字符串:

> as_numbers("549300JV8KEETQJYUG13")
[1] "5493001931820141429261934301613"
Run Code Online (Sandbox Code Playgroud)

zx8*_*754 18

我们可以使用基本转换:

#input and expected output
x <- "549300JV8KEETQJYUG13"
# "5493001931820141429261934301613"

#output
res <- paste0(strtoi(unlist(strsplit(x, "")), base = 36), collapse = "")

#test output
as_numbers(x) == res
# [1] TRUE
Run Code Online (Sandbox Code Playgroud)

性能

由于这篇文章是关于性能的,因此这里有3个解决方案的基准*:

#input set up
map = data.table(mapped = c(0:35), original = c(0:9,LETTERS))
x <- rep(c("549300JV8KEETQJYUG13", "5493V8KE300J"), 1000)

#define functions
base_f <- function(string) {
  sapply(string, function(x) {
    paste0(strtoi(unlist(strsplit(x, "")), base = 36), collapse = "")
    })
  }

match_f <- function(string) {
  mapped <- map$mapped
  original <- map$original
  sapply(strsplit(string, ""), function(y) {
    paste0(mapped[match(y, original)], collapse= "")})
  }

reduce_f <- function(string) {
  Reduce(function(string,r) 
    gsub(map$original[r],
         map$mapped[r], string, fixed = TRUE),
    seq_len(nrow(map)), string)
  }

#test if all return same output
all(base_f(x) == match_f(x))
# [1] TRUE
all(base_f(x) == reduce_f(x))
# [1] TRUE

library(rbenchmark)
benchmark(replications = 1000,
          base_f(x),
          match_f(x),
          reduce_f(x))
#          test replications elapsed relative user.self sys.self user.child sys.child
# 1   base_f(x)         1000   22.15    4.683     22.12        0         NA        NA
# 2  match_f(x)         1000   19.18    4.055     19.11        0         NA        NA
# 3 reduce_f(x)         1000    4.73    1.000      4.72        0         NA        NA
Run Code Online (Sandbox Code Playgroud)

*注意:microbenchmark()不断抛出警告,因此使用rbenchmark()代替.随意测试其他库并更新这篇文章.


mto*_*oto 6

使用Reducegsub,您可以定义以下功能

replacer <- function(x) Reduce(function(x,r) gsub(map$original[r],
             map$mapped[r], x, fixed=T), seq_len(nrow(map)),x)


# Let's test it
replacer("549300JV8KEETQJYUG13")
#[1] "5493001931820141429261934301613"
Run Code Online (Sandbox Code Playgroud)