Эффективная реализация алгоритма GTIN-13

Question

Я ищу эффективный способ реализовать алгоритм контрольных цифр GTIN-13. Я рассмотрел некоторые соответствующие сообщения SO, такие как эта и эта, но кажется, что эффективность не была предметом внимания в обоих случаях.

Вкратце, алгоритм берет числовую строку (например, 123765) и умножает каждую другую цифру (справа налево) на 1 или 3, чтобы вычислить сумму (так 5 * 1 + 6 * 3 + 7 * 1 + 3 * 3 + 2 * 1 + 1 * 3 = 44), а затем вычитает эту сумму из ближайшего кратного 10, равного или превышающего эту сумму (в этом случае 50 - 44 = 6) для получения последней контрольной цифры (здесь 6). Ожидается, что ввод будет состоять из 12 цифр, но если короче, он может быть просто дополнен нулями слева (так 123765 действительно ожидается как 000000123765) но результат будет все тот же.

Наивная реализация этого будет выглядеть следующим образом:

gtin13 <- function(n) {
  s <- as.character(n)
  check.sum <- 0
  for (i in 1:nchar(s)) {
    digit <- substr(s, nchar(s) - i + 1, nchar(s) - i + 1)
    check.sum <- check.sum + as.numeric(digit) * ifelse(i %% 2, 1, 3)
  }
  10 - check.sum %% 10
}

Однако это неэффективно из-за цикла for, а также преобразования в строку и обратно в число. Например:

df <- data.frame(
  num <- sample(1:1000000, 100000, T)
)
system.time(cd <- vapply(df$num, gtin13, 0))

Возьмите около 6 секунд на среднем рабочем столе.

Что является более эффективным для расчета этой контрольной суммы?

Answer 1

Эта версия не нуждается в vapply, поэтому она быстрее, потому что мы не зацикливаемся на количестве возможных цифр в R. Например

gtim13_vec <- function(x) {
  d <- x %% 10
  for(i in 1:12) { # Input can be up to 12 digits
    d <- d +(x%/% 10^i %% 10) * c(1,3)[1+i%%2]
  }
  d
  10-(d%%10)
}

я использовал set.seed(7) для этого эксперимента. я вижу

system.time(r1 <- vapply(df$num, gtim13, 0))
#    user  system elapsed 
#    3.21    0.00    3.36 
system.time(r2 <- gtim13_vec(df$num))
#    user  system elapsed 
#    0.03    0.00    0.03 
all(r1==r2)
# [1] TRUE

Так что есть большое улучшение скорости.

Answer 2

Используя Rcpp:

#include <Rcpp.h>
using namespace Rcpp;

int gtim13_cpp(int x) {

  int r, sum = 0, coeff = 1;
  while (x != 0) {
    r = x % 10;
    sum += coeff * r;
    coeff = 4 - coeff;  // 3 <--> 1
    x /= 10;
  }

  return 10 - (sum % 10);
}

// [[Rcpp::export]]
IntegerVector gtim13_all_cpp(IntegerVector x) {

  int n = x.size();
  IntegerVector res(n);
  for (int i = 0; i < n; i++) {
    res[i] = gtim13_cpp(x[i]);
  }

  return res;
}


/*** R
gtim13_all_cpp(123765)

gtin13 <- function(n) {
  s <- as.character(n)
  check.sum <- 0
  for (i in 1:nchar(s)) {
    digit <- substr(s, nchar(s) - i + 1, nchar(s) - i + 1)
    check.sum <- check.sum + as.numeric(digit) * ifelse(i %% 2, 1, 3)
  }
  10 - check.sum %% 10
}
df <- data.frame(
  num <- sample(1:1000000, 100000, T)
)
system.time(cd <- vapply(df$num, gtin13, 0))
system.time(cd3 <- gtim13_all_cpp(df$num))
all.equal(cd3, cd)
*/

Результаты:

> system.time(cd <- vapply(df$num, gtin13, 0))
   user  system elapsed 
  4.105   0.001   4.105 

> system.time(cd3 <- gtim13_all_cpp(df$num))
   user  system elapsed 
  0.004   0.000   0.003 

> all.equal(cd3, cd)
[1] TRUE

Answer 3

Мы можем сделать намного лучше. Если мы работаем с целыми числами вместо символов, мы видим большой выигрыш в эффективности:

gtim13Challenger <- function(n) {
    n <- as.integer(n)
    len <- as.integer(ceiling(log10(n)))
    digs <- n %/% as.integer(10^(0L:(len - 1L))) %% 10L
    if (len > 1L)
        digs[seq.int(2L,len,2L)] <- digs[seq.int(2L,len,2L)] * 3L
    10L - sum(digs) %% 10L
}

system.time(cd <- vapply(df$num, gtim13, 0))
user  system elapsed 
6.15    0.00    6.16 

system.time(cd2 <- vapply(df$num, gtim13Challenger, 0L))
user  system elapsed 
0.76    0.00    0.76 

all.equal(cd, cd2)
[1] TRUE