Aumentare prestazioni allontanandosi da un ciclo

Question

Il nocciolo dell'argomento è il seguente:

Una funzione che ho scritto, prende in considerazione un argomento, una stringa alfanumerica, e deve emettere una stringa dove i valori di ogni elemento di questa stringa alfanumerica viene scambiato per un po 'di "mappatura". MRE come segue:

#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) 
} 

Sto cercando di allontanarsi dal for loop per qualcosa che aumenta le prestazioni, come funziona la funzione, ma è piuttosto lento per la quantità di elementi che ho fornito in questa forma:

unlist(lapply(dat$alphanum, function(x) as_numbers(x))) 

Un esempio delle stringhe di input potrebbe essere: 549300JV8KEETQJYUG13. Questo dovrebbe portare a una stringa come 5493001931820141429261934301613

Fornendo solo una stringa in questo caso:

> as_numbers("549300JV8KEETQJYUG13") 
[1] "5493001931820141429261934301613" 

Answer 1

Utilizzando Reduce e gsub, è possibile definire la seguente funzione

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" 

Answer 2

sembra un merge:

map[as.data.table(unlist(strsplit(string, ""))), 
    .(mapped), on = c(original = "V1")][ , paste0(mapped, collapse = "")] 

Si noti che entrambi "D1" e "1V" volontà essere mappato a "131" ...

Sul tuo esempio di uscita è: "5493001931820141429261934301613"

È possibile utilizzare sep = "." se si vuole realmente che questo sia una mappatura reversibile ...

Answer 3

userei match:

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

as_numbers(c("549300JV8KEETQJYUG13", "5493V8KE300J")) 
#[[1]] 
#[1] "5493001931820141429261934301613" 
# 
#[[2]] 
#[1] "5493318201430019" 

Aggiunto un lapply chiamata a gestire correttamente la lunghezza> 1 ingresso.

Se avete bisogno di ulteriori accelerare, è possibile memorizzare e map$mappedmap$original in vettori separati e usarli nel match chiamata invece di map$... quindi non c'è bisogno di sottoinsieme delle data.frame/data.table così tante volte (che è piuttosto costoso).

---

Dal momento che il Q era circa le prestazioni, ecco un punto di riferimento di due delle soluzioni:

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

ascii_func <- function(string) { 
    lapply(string, function(x) { 
    x_ascii <- strtoi(charToRaw(x), 16) 
    paste(ifelse(x_ascii >= 65 & x_ascii <= 90, 
        x_ascii - 55, x_ascii - 48), 
        collapse = "") 
    }) 
} 

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

library(microbenchmark) 
microbenchmark(ascii_func(x), match_func(x), times = 25L) 
#Unit: milliseconds 
#   expr min lq mean median  uq max neval 
# ascii_func(x) 83.47 92.55 96.91 96.82 103.06 112.07 25 
# match_func(x) 24.30 24.74 26.86 26.11 28.67 31.55 25 

identical(ascii_func(x), match_func(x)) 
#[1] TRUE 

Answer 4

Possiamo utilizzare la conversione di base:

#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 

---

prestazioni

Dal momento che questo post è per le prestazioni, ecco benchmarking * per 3 soluzioni:

#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 

_{* Nota: microbenchmark() mantiene gettando avvertimenti, da qui utilizzato rbenchmark () invece. Sentiti libero di testare con altre librerie e aggiornare questo post.}