Optimisation de l'algorithme Verhoeff en R

Question

J'ai écrit la fonction suivante pour calculer un chiffre de contrôle dans l'affaire R.

verhoeffCheck <- function(x) 
{ 
## calculates check digit based on Verhoeff algorithm 
## note that due to the way strsplit works, to call for vector x, use sapply(x,verhoeffCheck) 

## check for string since leading zeros with numbers will be lost 
if (class(x)!="character"){stop("Must enter a string")} 

#split and convert to numbers 
digs <- strsplit(x,"")[[1]] 
digs <- as.numeric(digs) 

digs <- rev(digs) ## right to left algorithm 

## tables required for D_5 group 

d5_mult <- matrix(c(
       0:9, 
       c(1:4,0,6:9,5), 
       c(2:4,0:1,7:9,5:6), 
       c(3:4,0:2,8:9,5:7), 
       c(4,0:3,9,5:8), 
       c(5,9:6,0,4:1), 
       c(6:5,9:7,1:0,4:2), 
       c(7:5,9:8,2:0,4:3), 
       c(8:5,9,3:0,4), 
       9:0 
       ),10,10,byrow=T) 

d5_perm <- matrix(c(
       0:9, 
       c(1,5,7,6,2,8,3,0,9,4), 
       c(5,8,0,3,7,9,6,1,4,2), 
       c(8,9,1,6,0,4,3,5,2,7), 
       c(9,4,5,3,1,2,6,8,7,0), 
       c(4,2,8,6,5,7,3,9,0,1), 
       c(2,7,9,3,8,0,6,4,1,5), 
       c(7,0,4,6,9,1,3,2,5,8) 
       ),8,10,byrow=T) 

d5_inv <- c(0,4:1,5:9) 

## apply algoritm - note 1-based indexing in R 
d <- 0 

for (i in 1:length(digs)){ 
    d <- d5_mult[d+1,(d5_perm[(i%%8)+1,digs[i]+1])+1] 
    } 

d5_inv[d+1] 
} 

Afin d'exécuter sur un vecteur de chaînes, sapply doit être utilisé. C'est en partie à cause de l'utilisation de strsplit, qui renvoie une liste de vecteurs. Cela a un impact sur la performance, même pour des entrées de taille modérée.

Comment cette fonction peut-elle être vectorisée?

Je suis également conscient que certaines performances sont perdues lors de la création des tables à chaque itération. Le stockage dans un nouvel environnement serait-il une meilleure solution?

Answer 1

Si vos chaînes d'entrée peuvent contenir différents nombres de caractères, alors je ne vois aucun moyen d'appeler lapply (ou un équivalent plyr). L'astuce consiste à les déplacer dans la fonction, donc verhoeffCheck peut accepter les entrées vectorielles. De cette façon, vous n'avez besoin de créer les matrices qu'une seule fois.

verhoeffCheckNew <- function(x) 
{ 
## calculates check digit based on Verhoeff algorithm 

## check for string since leading zeros with numbers will be lost 
    if (!is.character(x)) stop("Must enter a string") 

    #split and convert to numbers 
    digs <- strsplit(x, "") 
    digs <- lapply(digs, function(x) rev(as.numeric(x))) 

    ## tables required for D_5 group 
    d5_mult <- matrix(c(
        0:9, 
        c(1:4,0,6:9,5), 
        c(2:4,0:1,7:9,5:6), 
        c(3:4,0:2,8:9,5:7), 
        c(4,0:3,9,5:8), 
        c(5,9:6,0,4:1), 
        c(6:5,9:7,1:0,4:2), 
        c(7:5,9:8,2:0,4:3), 
        c(8:5,9,3:0,4), 
        9:0 
        ),10,10,byrow=T) 

    d5_perm <- matrix(c(
        0:9, 
        c(1,5,7,6,2,8,3,0,9,4), 
        c(5,8,0,3,7,9,6,1,4,2), 
        c(8,9,1,6,0,4,3,5,2,7), 
        c(9,4,5,3,1,2,6,8,7,0), 
        c(4,2,8,6,5,7,3,9,0,1), 
        c(2,7,9,3,8,0,6,4,1,5), 
        c(7,0,4,6,9,1,3,2,5,8) 
        ),8,10,byrow=T) 

    d5_inv <- c(0,4:1,5:9) 

    ## apply algorithm - note 1-based indexing in R  
    sapply(digs, function(x) 
    { 
    d <- 0 
    for (i in 1:length(x)){ 
     d <- d5_mult[d + 1, (d5_perm[(i %% 8) + 1, x[i] + 1]) + 1] 
     } 
    d5_inv[d+1] 
    }) 
} 

Depuis d dépend de ce qu'il était auparavant, l'est pas facile de vectoriser la boucle for.

Ma version tourne environ la moitié du temps pour les chaînes 1e5.

rand_string <- function(n = 12) 
{ 
    paste(sample(as.character(0:9), sample(n), replace = TRUE), collapse = "") 
} 
big_test <- replicate(1e5, rand_string()) 

tic() 
res1 <- unname(sapply(big_test, verhoeffCheck)) 
toc() 

tic() 
res2 <- verhoeffCheckNew(big_test) 
toc() 

identical(res1, res2) #hopefully TRUE! 

Voir this question pour tic et toc.

D'autres idées:

Vous voudrez peut-être entrée supplémentaire pour vérifier "" et d'autres chaînes qui reviennent NA lorsqu'ils sont convertis en numérique.

Étant donné que vous utilisez exclusivement des nombres entiers, vous pouvez obtenir un léger avantage de performance en les utilisant plutôt qu'en doublant. (Utilisez as.integer plutôt que as.numeric et ajoutez L aux valeurs de vos matrices.)

Answer 2

Richie C a répondu joliment à la question de vectorisation; comme pour seulement creatig les tables une fois sans encombrer l'espace de nom global, une solution rapide qui ne nécessite pas un paquet est

verhoeffCheck <- local(function(x) 
{ 
## calculates check digit based on Verhoeff algorithm 
## note that due to the way strsplit works, to call for vector x, use sapply(x,verhoeffCheck) 
## check for string since leading zeros with numbers will be lost 
if (class(x)!="character"){stop("Must enter a string")} 
#split and convert to numbers 
digs <- strsplit(x,"")[[1]] 
digs <- as.numeric(digs) 
digs <- rev(digs) ## right to left algorithm 
## apply algoritm - note 1-based indexing in R 
d <- 0 
for (i in 1:length(digs)){ 
    d <- d5_mult[d+1,(d5_perm[(i%%8)+1,digs[i]+1])+1] 
    } 
d5_inv[d+1] 
}) 

assign("d5_mult", matrix(c(
    0:9, c(1:4,0,6:9,5), c(2:4,0:1,7:9,5:6), c(3:4,0:2,8:9,5:7), 
    c(4,0:3,9,5:8), c(5,9:6,0,4:1), c(6:5,9:7,1:0,4:2), c(7:5,9:8,2:0,4:3), 
    c(8:5,9,3:0,4), 9:0), 10, 10, byrow = TRUE), 
    envir = environment(verhoeffCheck)) 

assign("d5_perm", matrix(c(
    0:9, c(1,5,7,6,2,8,3,0,9,4), c(5,8,0,3,7,9,6,1,4,2), 
    c(8,9,1,6,0,4,3,5,2,7), c(9,4,5,3,1,2,6,8,7,0), c(4,2,8,6,5,7,3,9,0,1), 
    c(2,7,9,3,8,0,6,4,1,5), c(7,0,4,6,9,1,3,2,5,8)), 8, 10, byrow = TRUE), 
    envir = environment(verhoeffCheck)) 

assign("d5_inv", c(0,4:1,5:9), envir = environment(verhoeffCheck)) 
## Now just use the function 

qui maintient les données dans l'environnement de la fonction. Vous pouvez le chronométrer pour voir à quel point c'est plus rapide.

Espérons que cela aide.

Allan

Answer 3

Nous commençons par définir les matrices de recherche. Je les ai disposés d'une manière qui devrait les rendre plus faciles à vérifier par rapport à une référence, par exemple. http://en.wikipedia.org/wiki/Verhoeff_algorithm.

d5_mult <- matrix(as.integer(c(
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 
    1, 2, 3, 4, 0, 6, 7, 8, 9, 5, 
    2, 3, 4, 0, 1, 7, 8, 9, 5, 6, 
    3, 4, 0, 1, 2, 8, 9, 5, 6, 7, 
    4, 0, 1, 2, 3, 9, 5, 6, 7, 8, 
    5, 9, 8, 7, 6, 0, 4, 3, 2, 1, 
    6, 5, 9, 8, 7, 1, 0, 4, 3, 2, 
    7, 6, 5, 9, 8, 2, 1, 0, 4, 3, 
    8, 7, 6, 5, 9, 3, 2, 1, 0, 4, 
    9, 8, 7, 6, 5, 4, 3, 2, 1, 0 
)), ncol = 10, byrow = TRUE) 

d5_perm <- matrix(as.integer(c(
    0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 
    1, 5, 7, 6, 2, 8, 3, 0, 9, 4, 
    5, 8, 0, 3, 7, 9, 6, 1, 4, 2, 
    8, 9, 1, 6, 0, 4, 3, 5, 2, 7, 
    9, 4, 5, 3, 1, 2, 6, 8, 7, 0, 
    4, 2, 8, 6, 5, 7, 3, 9, 0, 1, 
    2, 7, 9, 3, 8, 0, 6, 4, 1, 5, 
    7, 0, 4, 6, 9, 1, 3, 2, 5, 8 
)), ncol = 10, byrow = TRUE) 

d5_inv <- as.integer(c(0, 4, 3, 2, 1, 5, 6, 7, 8, 9)) 

Ensuite, nous allons définir la fonction de vérification et l'essayer avec une entrée de test. J'ai suivi la dérivation dans wikipedia d'aussi près que possible.

p <- function(i, n_i) { 
    d5_perm[(i %% 8) + 1, n_i + 1] + 1 
} 
d <- function(c, p) { 
    d5_mult[c + 1, p] 
} 

verhoeff <- function(x) { 
    #split and convert to numbers 
    digs <- strsplit(as.character(x), "")[[1]] 
    digs <- as.numeric(digs) 
    digs <- rev(digs) ## right to left algorithm 

    ## apply algoritm - note 1-based indexing in R 
    c <- 0 
    for (i in 1:length(digs)) { 
    c <- d(c, p(i, digs[i])) 
    } 

    d5_inv[c + 1] 
} 
verhoeff(142857) 

## [1] 0 

Cette fonction est fondamentalement itérative, chaque itération dépend de la valeur de la précédente. Cela signifie qu'il est peu probable que nous puissions vectoriser dans R, donc si nous voulons vectoriser, nous aurons besoin d'utiliser Rcpp. Cependant, avant de nous tourner vers cela, il est intéressant d'explorer si nous pouvons faire la division initiale plus rapidement. D'abord, nous faisons un peu microbenchmark pour voir si elle est intéressant tracasser:

library(microbenchmark) 
digits <- function(x) { 
    digs <- strsplit(as.character(x), "")[[1]] 
    digs <- as.numeric(digs) 
    rev(digs) 
} 

microbenchmark(
    digits(142857), 
    verhoeff(142857) 
) 

## Unit: microseconds 
##    expr min lq median uq max neval 
## digits(142857) 11.30 12.01 12.43 12.85 28.79 100 
## verhoeff(142857) 32.24 33.81 34.66 35.47 95.85 100 

On dirait qu'il! Sur mon ordinateur, verhoeff_prepare() représente environ 50% du temps d'exécution. Un peu de recherche sur stackoverflow révèle une autre approche pour transformer un number into digits:

digits2 <- function(x) { 
    n <- floor(log10(x)) 
    x %/% 10^(0:n) %% 10 
} 
digits2(12345) 

## [1] 5 4 3 2 1 

microbenchmark(
    digits(142857), 
    digits2(142857) 
) 

## Unit: microseconds 
##    expr min  lq median  uq max neval 
## digits(142857) 11.495 12.102 12.468 12.834 79.60 100 
## digits2(142857) 2.322 2.784 3.358 3.561 13.69 100 

digits2() est beaucoup plus rapide que digits() mais il a un impact limité sur l'exécution ensemble.

verhoeff2 <- function(x) { 
    digs <- digits2(x) 

    c <- 0 
    for (i in 1:length(digs)) { 
    c <- d(c, p(i, digs[i])) 
    } 

    d5_inv[c + 1] 
} 
verhoeff2(142857) 

## [1] 0 

microbenchmark(
    verhoeff(142857), 
    verhoeff2(142857) 
) 

## Unit: microseconds 
##    expr min lq median uq max neval 
## verhoeff(142857) 33.06 34.49 35.19 35.92 73.38 100 
## verhoeff2(142857) 20.98 22.58 24.05 25.28 48.69 100 

Pour le rendre encore plus rapide, nous pourrions essayer C++.

#include <Rcpp.h> 
using namespace Rcpp; 

// [[Rcpp::export]] 
int verhoeff3_c(IntegerVector digits, IntegerMatrix mult, IntegerMatrix perm, 
       IntegerVector inv) { 
    int n = digits.size(); 
    int c = 0; 

    for(int i = 0; i < n; ++i) { 
    int p = perm(i % 8, digits[i]); 
    c = mult(c, p); 
    } 

    return inv[c]; 
} 

verhoeff3 <- function(x) { 
    verhoeff3_c(digits(x), d5_mult, d5_perm, d5_inv) 
} 
verhoeff3(142857) 

## [1] 3 

microbenchmark(
    verhoeff2(142857), 
    verhoeff3(142857) 
) 

## Unit: microseconds 
##    expr min lq median uq max neval 
## verhoeff2(142857) 21.00 22.85 25.53 27.11 63.71 100 
## verhoeff3(142857) 16.75 17.99 18.87 19.64 79.54 100 

Cela ne donne pas beaucoup d'amélioration. Peut-être que nous pouvons faire mieux si nous passons le nombre de C++ et de traiter les chiffres dans une boucle:

#include <Rcpp.h> 
using namespace Rcpp; 

// [[Rcpp::export]] 
int verhoeff4_c(int number, IntegerMatrix mult, IntegerMatrix perm, 
       IntegerVector inv) { 
    int c = 0; 
    int i = 0; 

    for (int i = 0; number > 0; ++i, number /= 10) { 
    int p = perm(i % 8, number % 10); 
    c = mult(c, p); 
    } 

    return inv[c]; 
} 

verhoeff4 <- function(x) { 
    verhoeff4_c(x, d5_mult, d5_perm, d5_inv) 
} 
verhoeff4(142857) 

## [1] 3 

microbenchmark(
    verhoeff2(142857), 
    verhoeff3(142857), 
    verhoeff4(142857) 
) 

## Unit: microseconds 
##    expr min  lq median  uq max neval 
## verhoeff2(142857) 21.808 24.910 26.838 27.797 64.22 100 
## verhoeff3(142857) 17.699 18.742 19.599 20.764 81.67 100 
## verhoeff4(142857) 3.143 3.797 4.095 4.396 13.21 100 

Et nous obtenons un coup d'oeil: verhoeff4() est environ 5 fois plus rapide que verhoeff2().