web-dev-qa-db-fra.com

Concaténation rapide des colonnes data.table en une colonne de chaîne

Étant donné une liste arbitraire de noms de colonnes dans un data.table, je souhaite concaténer le contenu de ces colonnes dans une seule chaîne stockée dans une nouvelle colonne. Les colonnes que je dois concaténer ne sont pas toujours les mêmes. Je dois donc générer l'expression pour le faire à la volée.

Je soupçonne subtilement que j'utilise l'appel eval(parse(...)) pour le remplacer par quelque chose d'un peu plus élégant, mais la méthode ci-dessous est la plus rapide que j'ai pu l'obtenir jusqu'à présent.

Avec 10 millions de lignes, cela prend environ 21,7 secondes sur cet exemple de données (la base R paste0 prend légèrement plus de temps - 23,6 secondes)}. Mes données actuelles concaténent 18 à 20 colonnes et jusqu’à 100 millions de lignes. Le ralentissement devient donc un peu moins pratique.

Avez-vous des idées pour accélérer les choses?


Méthodes actuelles

library(data.table)
library(stringi)

RowCount <- 1e7
DT <- data.table(x = "foo",
                 y = "bar",
                 a = sample.int(9, RowCount, TRUE),
                 b = sample.int(9, RowCount, TRUE),
                 c = sample.int(9, RowCount, TRUE),
                 d = sample.int(9, RowCount, TRUE),
                 e = sample.int(9, RowCount, TRUE),
                 f = sample.int(9, RowCount, TRUE))

## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- c("x","a","b","c","d","e","f","y")
PasteStatement <- stri_c('stri_c(',stri_c(ConcatCols,collapse = ","),')')
print(PasteStatement)

donne

[1] "stri_c(x,a,b,c,d,e,f,y)"

qui est ensuite utilisé pour concaténer les colonnes avec l'expression suivante:

DT[,State := eval(parse(text = PasteStatement))]

Exemple de sortie:

     x   y a b c d e f        State
1: foo bar 4 8 3 6 9 2 foo483692bar
2: foo bar 8 4 8 7 8 4 foo848784bar
3: foo bar 2 6 2 4 3 5 foo262435bar
4: foo bar 2 4 2 4 9 9 foo242499bar
5: foo bar 5 9 8 7 2 7 foo598727bar

Profilage des résultats

 Flame Graph  Data


Mise à jour 1: fread, fwrite et sed

Suivant la suggestion de @Gregor, j'ai essayé d'utiliser sed pour effectuer la concaténation sur le disque. Grâce aux fonctions rapides fread et fwrite de data.table, j'ai pu écrire les colonnes sur le disque, éliminer les délimiteurs de virgule à l'aide de sed, puis les relire dans la sortie post-traitée dans environ 18.3 secondes - pas assez rapide pour effectuer le changement, mais une tangente intéressante quand même!

ConcatCols <- c("x","a","b","c","d","e","f","y")
fwrite(DT[,..ConcatCols],"/home/xxx/DT.csv")
system("sed 's/,//g' /home/xxx/DT.csv > /home/xxx/DT_Post.csv ")
Post <- fread("/home/xxx/DT_Post.csv")
DT[,State := Post[[1]]]

Ventilation des 18,3 secondes globales (impossible d'utiliser profvis car sed est invisible pour le profileur R)

  • data.table::fwrite() - 0,5 seconde
  • sed- 14,8 secondes
  • data.table::fread() - 3,0 secondes
  • := - 0.0 secondes

Si rien d'autre, cela témoigne du travail considérable des auteurs de data.table sur l'optimisation des performances pour les E/S de disque. (J'utilise la version de développement 1.10.5 qui ajoute le multi-threading à fread, fwrite est multithread depuis un certain temps).

Une mise en garde: s'il existe une solution de contournement pour écrire le fichier en utilisant fwrite et un séparateur vide comme suggéré par @Gregor dans un autre commentaire ci-dessous, cette méthode peut être réduite de manière plausible à ~ 3,5 secondes! 

Mise à jour sur cette tangente: data.table avec fourche et commentaire sur la ligne nécessitant un séparateur supérieur à la longueur 0, mystérieusement quelques espaces à la place? Après avoir causé une poignée de segfaults essayant de déconner avec le C interne mettez celui-ci sur la glace pour le moment. La solution idéale ne nécessiterait pas d'écrire sur le disque et garderait tout en mémoire.} _ 


Mise à jour 2: sprintf pour les cas spécifiques entiers

Une deuxième mise à jour ici: alors que j’incluais des chaînes dans mon exemple d’utilisation original, mon cas d’utilisation actuel concatène exclusivement des valeurs entières (qui peuvent toujours être considérées comme non nulles en fonction des étapes de nettoyage en amont).

Comme le cas d'utilisation est très spécifique et diffère de la question initiale, je ne comparerai pas directement les timings à ceux précédemment publiés. Cependant, on peut admettre que _ bien que stringi gère de nombreux formats de codage de caractères, des types de vecteurs mixtes sans qu'il soit nécessaire de les spécifier, et qu'il gère de nombreuses erreurs, cela ajoute un peu de temps (qui vaut probablement la peine dans la plupart des cas)}. 

En utilisant la fonction sprintf de la base R et en lui faisant savoir à l'avance que toutes les entrées seront des entiers, nous pouvons réduire d'environ 30% le temps d'exécution de 5 millions de lignes avec 18 colonnes d'entier à calculer. (20,3 secondes au lieu de 28,9)

library(data.table)
library(stringi)
RowCount <- 5e6
DT <- data.table(x = "foo",
                 y = "bar",
                 a = sample.int(9, RowCount, TRUE),
                 b = sample.int(9, RowCount, TRUE),
                 c = sample.int(9, RowCount, TRUE),
                 d = sample.int(9, RowCount, TRUE),
                 e = sample.int(9, RowCount, TRUE),
                 f = sample.int(9, RowCount, TRUE))

## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- list("a","b","c","d","e","f")
## Do it 3x as many times
ConcatCols <- c(ConcatCols,ConcatCols,ConcatCols)

## Using stringi::stri_c ---------------------------------------------------
stri_joinStatement <- stri_c('stri_join(',stri_c(ConcatCols,collapse = ","),', sep="", collapse=NULL, ignore_null=TRUE)')
DT[, State := eval(parse(text = stri_joinStatement))]

## Using sprintf -----------------------------------------------------------
sprintfStatement <- stri_c("sprintf('",stri_flatten(rep("%i",length(ConcatCols))),"', ",stri_c(ConcatCols,collapse = ","),")")
DT[,State_sprintf_i := eval(parse(text = sprintfStatement))]

Les déclarations générées sont les suivantes:

> cat(stri_joinStatement)
stri_join(a,b,c,d,e,f,a,b,c,d,e,f,a,b,c,d,e,f, sep="", collapse=NULL, ignore_null=TRUE)
> cat(sprintfStatement)
sprintf('%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i%i', a,b,c,d,e,f,a,b,c,d,e,f,a,b,c,d,e,f)

 sprintf


Mise à jour 3: R ne doit pas nécessairement être lent.

Sur la base de la réponse de @Martin Modrák, j'ai mis au point un package poney à un tour basé sur quelques internes de data.table spécialisés dans le cas spécialisé du "nombre entier à un chiffre": fastConcat. (Ne le cherchez pas sur CRAN de si tôt, mais vous pouvez l'utiliser à vos risques et périls en installant à partir de github repo, msummersgill/fastConcat .)}

Cela pourrait probablement être amélioré beaucoup plus loin par quelqu'un qui comprend mieux c, mais pour le moment, il exécute le même cas que dans la Mise à jour 2 en 2,5 secondes - environ 8x plus rapidement que sprintf() et 11.5x plus rapide que la méthode stringi::stri_c() que j'utilisais à l'origine.

Pour moi, cela met en évidence l'énorme opportunité d'améliorer les performances sur certaines des opérations les plus simples de Rcomme la concaténation rudimentaire de vecteurs chaînes avec un meilleur réglage de c. Je suppose que des gens comme @Matt Dowle ont vu cela pendant des années - si seulement il avait le temps de réécrire tout R, pas seulement le nom data.frame.

 fastConcat


18
Matt Summersgill

C à la rescousse!

En volant du code dans data.table, nous pouvons écrire une fonction C qui fonctionne beaucoup plus rapidement (et qui pourrait être parallélisée pour être encore plus rapide).

Tout d’abord, assurez-vous que vous avez une chaîne d’outils C++ fonctionnelle avec:

library(inline)

fx <- inline::cfunction( signature(x = "integer", y = "numeric" ) , '
    return ScalarReal( INTEGER(x)[0] * REAL(y)[0] ) ;
' )
fx( 2L, 5 ) #Should return 10

Cela devrait alors fonctionner (en supposant que les données ne contiennent que des nombres entiers, mais le code peut être étendu à d'autres types):

library(inline)
library(data.table)
library(stringi)

header <- "

//Taken from https://github.com/Rdatatable/data.table/blob/master/src/fwrite.c
static inline void reverse(char *upp, char *low)
{
  upp--;
  while (upp>low) {
  char tmp = *upp;
  *upp = *low;
  *low = tmp;
  upp--;
  low++;
  }
}

void writeInt32(int *col, size_t row, char **pch)
{
  char *ch = *pch;
  int x = col[row];
  if (x == INT_MIN) {
  *ch++ = 'N';
  *ch++ = 'A';
  } else {
  if (x<0) { *ch++ = '-'; x=-x; }
  // Avoid log() for speed. Write backwards then reverse when we know how long.
  char *low = ch;
  do { *ch++ = '0'+x%10; x/=10; } while (x>0);
  reverse(ch, low);
  }
  *pch = ch;
}

//end of copied code 

"



 worker_fun <- inline::cfunction( signature(x = "list", preallocated_target = "character", columns = "integer", start_row = "integer", end_row = "integer"), includes = header , "
  const size_t _start_row = INTEGER(start_row)[0] - 1;
  const size_t _end_row = INTEGER(end_row)[0];

  const int max_out_len = 256 * 256; //max length of the final string
  char buffer[max_out_len];
  const size_t num_elements = _end_row - _start_row;
  const size_t num_columns = LENGTH(columns);
  const int * _columns = INTEGER(columns);

  for(size_t i = _start_row; i < _end_row; ++i) {
    char *buf_pos = buffer;
    for(size_t c = 0; c < num_columns; ++c) {
      if(c > 0) {
        buf_pos[0] = ',';
        ++buf_pos;
      }
      writeInt32(INTEGER(VECTOR_ELT(x, _columns[c] - 1)), i, &buf_pos);
    }
    SET_STRING_ELT(preallocated_target,i, mkCharLen(buffer, buf_pos - buffer));
  }
return preallocated_target;
" )

#Test with the same data

RowCount <- 5e6
DT <- data.table(x = "foo",
                 y = "bar",
                 a = sample.int(9, RowCount, TRUE),
                 b = sample.int(9, RowCount, TRUE),
                 c = sample.int(9, RowCount, TRUE),
                 d = sample.int(9, RowCount, TRUE),
                 e = sample.int(9, RowCount, TRUE),
                 f = sample.int(9, RowCount, TRUE))

## Generate an expression to paste an arbitrary list of columns together
ConcatCols <- list("a","b","c","d","e","f")
## Do it 3x as many times
ConcatCols <- c(ConcatCols,ConcatCols,ConcatCols)


ptm <- proc.time()
preallocated_target <- character(RowCount)
column_indices <- sapply(ConcatCols, FUN = function(x) { which(colnames(DT) == x )})
x <- worker_fun(DT, preallocated_target, column_indices, as.integer(1), as.integer(RowCount))
DT[, State := preallocated_target]
proc.time() - ptm

Bien que votre exemple (entier uniquement) s'exécute dans environ 20 secondes sur mon PC, il s'exécute en environ 5 secondes et peut être facilement mis en parallèle.

Quelques points à noter:

  • Le code n'est pas prêt pour la production - de nombreuses vérifications de sécurité doivent être effectuées sur les entrées de fonction (en particulier pour vérifier si toutes les colonnes ont la même longueur, en vérifiant les types de colonne, la taille de preallocated_target, etc.).
  • La fonction place sa sortie dans un vecteur de caractère préalloué, ce qui est non standard et moche (R n’a généralement pas de sémantique passe par référence) mais permet la parallélisation (voir ci-dessous).
  • Les deux derniers paramètres sont les lignes de début et de fin à traiter, encore une fois, il s’agit de la paralellisation
  • La fonction accepte les index de colonne et non les noms de colonne. Toutes les colonnes doivent être de type entier. 
  • À l'exception de l'entrée data.table et preallocated_target, les entrées doivent être des entiers.
  • Le temps de compilation de la fonction n’est pas inclus (vous devez le compiler au préalable - peut-être même créer un paquet)

Parallélisation

EDIT: L'approche ci-dessous échouerait en réalité à cause du fonctionnement de clusterExport et du stockage de chaînes R. La parallélisation doit donc probablement aussi être effectuée en C, de la même manière que dans data.table.

Etant donné que vous ne pouvez pas transmettre de fonctions compilées en ligne à travers des processus R, la parallélisation nécessite davantage de travail. Pour pouvoir utiliser la fonction ci-dessus en parallèle, vous devez soit la compiler séparément avec le compilateur R, soit utiliser dyn.load OR pour l’envelopper dans un paquet OR, utiliser un backend de forking pour le parallèle (je ne sais pas. en avoir un, le bricolage ne fonctionne que sous UNIX). 

Courir en parallèle ressemblerait alors à quelque chose comme (non testé):

no_cores <- detectCores()

# Initiate cluster
cl <- makeCluster(no_cores)

#Preallocated target and prepare params
num_elements <- length(DT[[1]])
preallocated_target <- character(num_elements)
block_size <- 4096 #No of rows processed at once. Adjust for best performance
column_indices <- sapply(ConcatCols, FUN = function(x) { which(colnames(DT) == x )})

num_blocks <- ceiling(num_elements / block_size)

clusterExport(cl, 
   c("DT","preallocated_target","column_indices","num_elements", "block_size"))
clusterEvalQ(cl, <CODE TO LOAD THE NATIVE FUNCTION HERE>)

parLapply(cl, 1:num_blocks ,
          function(block_id)
          {
            throw_away <- 
              worker_fun(DT, preallocated_target, columns, 
              (block_id - 1) * block_size + 1, min(num_elements, block_id * block_size - 1))
            return(NULL)
          })



stopCluster(cl)
12
Martin Modrák

Je ne sais pas dans quelle mesure les échantillons de données sont représentatifs de vos données réelles, mais dans le cas de vos données échantillonnées, vous pouvez améliorer considérablement les performances en concaténant chaque combinaison unique de ConcatCols une fois au lieu de plusieurs fois.

Cela signifie que pour les données de l'échantillon, vous obtiendrez environ 500 000 concaténations contre 10 millions si vous effectuez également les doublons.

Voir l'exemple de code et de synchronisation suivant:

system.time({
  setkeyv(DT, ConcatCols)
  DTunique <- unique(DT[, ConcatCols, with=FALSE], by = key(DT))
  DTunique[, State :=  do.call(paste, c(DTunique, sep = ""))]
  DT[DTunique, State := i.State, on = ConcatCols]
})
#       user      system     elapsed 
#      7.448       0.462       4.618 

Environ la moitié du temps est consacrée à la partie setkey. Si vos données sont déjà saisies, le temps est réduit à un peu plus de 2 secondes.

setkeyv(DT, ConcatCols)
system.time({
  DTunique <- unique(DT[, ConcatCols, with=FALSE], by = key(DT))
  DTunique[, State :=  do.call(paste, c(DTunique, sep = ""))]
  DT[DTunique, State := i.State, on = ConcatCols]
})
#       user      system     elapsed 
#      2.526       0.280       2.181 
8
docendo discimus

Ceci utilise unite du paquet tidyr. Peut-être pas le plus rapide, mais il est probablement plus rapide que le code R codé à la main.

library(tidyr)
system.time(
  DNew <- DT %>% unite(State, ConcatCols, sep = "", remove = FALSE)
)
# user  system elapsed 
# 14.974   0.183  15.343 

DNew[1:10]
# State   x   y a b c d e f
# 1: foo211621bar foo bar 2 1 1 6 2 1
# 2: foo532735bar foo bar 5 3 2 7 3 5
# 3: foo965776bar foo bar 9 6 5 7 7 6
# 4: foo221284bar foo bar 2 2 1 2 8 4
# 5: foo485976bar foo bar 4 8 5 9 7 6
# 6: foo566778bar foo bar 5 6 6 7 7 8
# 7: foo892636bar foo bar 8 9 2 6 3 6
# 8: foo836672bar foo bar 8 3 6 6 7 2
# 9: foo963926bar foo bar 9 6 3 9 2 6
# 10: foo385216bar foo bar 3 8 5 2 1 6
0
Andrew Lavers