J'ai une data.table avec plus de 200 variables qui sont toutes binaires. Je veux y créer une nouvelle colonne qui compte la différence entre chaque ligne et un vecteur de référence:
dt[,"distance":= sum(reference != c(V1,V2,V3,V4,V5))] dt[,"distance":= sum(reference != .SD)]
Je peux le faire avec une petite boucle for, comme
distance = NULL
for(i in 1:nrow(dt)){
distance[i] = sum(reference != dt[i,])
}
Mais c'est plutôt lent et ce n'est sûrement pas la meilleure façon de le faire. J'ai essayé:
#Example dt = data.table( "V1" = c(1,1,0,1,0,0,0,1,0,1,0,1,1,0,1,0), "V2" = c(0,1,0,1,0,1,0,0,0,0,1,1,0,0,1,0), "V3" = c(0,0,0,1,1,1,1,0,1,0,1,0,1,0,1,0), "V4" = c(1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0), "V5" = c(1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0) ) reference = c(1,1,0,1,0)
Mais ni l'un ni l'autre ne fonctionne, car ils renvoient la même valeur pour toutes les lignes. De plus, une solution où je n'ai pas à taper tous les noms de variables serait bien meilleure, car la vraie table data.table a plus de 200 colonnes
4 Réponses :
Vous pouvez utiliser sweep () avec rowSums , c'est-à-dire
HUGH <- function(dt) {
dt[, I := .I]
distance_by_I <- melt(dt, id.vars = "I")[, .(distance = sum(reference != value)), keyby = "I"]
return(dt[distance_by_I, on = "I"])
}
Sotos <- function(dt) {
return(rowSums(sweep(dt, 2, reference) != 0))
}
dt1 <- as.data.table(replicate(5, sample(c(0, 1), 100000, replace = TRUE)))
microbenchmark(HUGH(dt1), Sotos(dt1))
#Unit: milliseconds
# expr min lq mean median uq max neval cld
# HUGH(dt1) 112.71936 117.03380 124.05758 121.6537 128.09904 155.68470 100 b
# Sotos(dt1) 23.66799 31.11618 33.84753 32.8598 34.02818 68.75044 100 a
BENCHMARK
rowSums(sweep(dt, 2, reference) != 0) #[1] 2 2 2 2 4 4 3 2 4 3 2 1 3 4 1 3
Pour l'enregistrer en tant que nouvelle colonne: dt [ distance: = rowSums (sweep (.SD, 2, reference)! = 0)]
Cette solution est vraiment sympa et fonctionne parfaitement dans l'exemple du jouet. Mais pour une raison quelconque, j'obtiens une erreur lors de l'application aux données réelles: Erreur dans Ops.data.frame (x, aperm (array (STATS, dims [perm]), order (perm)),: list d'une longueur de 3860579 sans signification . Une idée pourquoi?
Aucune idée. Quelle est la structure de votre tableau de données? ( str (dt) )
rowSums (dt - as.data.table (as.list (reference)) [rep (1, nrow (dt))]! = 0) semble être un peu plus rapide, si la vitesse est un problème.
Tout numérique. J'ai également essayé de changer les deux en tout entier mais sans succès. Mais merci, c'était déjà utile, j'ai juste besoin d'élargir l'exemple pour correspondre à ce que j'ai.
@Henrik J'ai essayé de l'ajouter dans l'analyse comparative mais cela génère une erreur, Erreur dans Ops.data.frame (dt1, as.data.table (as.list (référence)) [rep (1,: '- 'défini uniquement pour les blocs de données de taille égale
@Sotos OK. Les parties data.frame de l'erreur semblent suspectes. Ça marche ici. f <- function (dt) rowSums (dt - as.data.table (as.list (reference)) [rep (1, nrow (dt))]! = 0) ; all.equal (Sotos (dt1), f (dt1)) , TRUE .
Fait intéressant, je n'ai pas eu une si grande différence dans mon benchmark entre vos solutions.
Faites fondre le tableau puis comparez chaque groupe.
dt[, I := .I] # Add a dummy id if one doesn't already exist distance_by_I <- melt(dt, id.vars = "I")[, .(distance = sum(reference != value)), keyby = "I"] dt[distance_by_I, on = "I"]
Voici une autre méthode:
library(data.table) dt1 <- as.data.table(replicate(5, sample(c(0, 1), 100000, replace = TRUE))) identical(Sotos(dt1), mm(dt1)) # [1] TRUE microbenchmark::microbenchmark(HUGH(dt1), Sotos(dt1), mm(dt1)) # Unit: milliseconds # expr min lq mean median uq max neval cld # HUGH(dt1) 85.542550 101.339416 129.71317 106.634169 112.66004 473.9380 100 b # Sotos(dt1) 35.699128 42.677696 125.95430 180.302919 189.34098 377.9523 100 b # mm(dt1) 4.604986 7.002416 17.57238 9.819895 12.27015 165.1440 100 a
benchmark
mm <- function(dt){
colSums(t(dt) != reference)
}
mm(dt)
# [1] 2 2 2 2 4 4 3 2 4 3 2 1 3 4 1 3
C'est vraiment intéressant. Je n'ai aucune idée de la raison pour laquelle l'analyse comparative est différente.
Another:
Unit: milliseconds
expr min lq mean median uq max neval
HUGH(dt1, ref) 365.0529 370.05233 378.8826 375.0517 385.79737 396.5430 3
Sotos(dt1, ref) 871.5693 926.50462 961.5527 981.4400 1006.54437 1031.6488 3
mm(dt1, ref) 104.5631 121.74086 131.7157 138.9186 145.29197 151.6653 3
ff(dt1, lref) 87.0800 87.48975 93.1361 87.8995 96.16415 104.4288 3
Comment ça marche. Nous prenons donc chaque colonne vectorielle dans .SD et la comparons au valeur unique correspondante dans ref . La fonction ! = est vectorisée, donc chaque élément de ref est recyclé pour correspondre à la longueur de chaque vecteur.
Cette carte call renvoie une liste de vecteurs TRUE / FALSE, un pour chaque colonne. Lorsque nous additionnons les valeurs TRUE / FALSE, elles sont traitées comme 1/0, il nous suffit donc d'ajouter ces colonnes. Ceci peut être réalisé en passant l'opérateur par paires + entre la première colonne et la seconde; puis de nouveau entre le résultat de ce calcul et la troisième colonne; etc. C'est ainsi que fonctionne Réduire . Il pourrait être plus lisible comme
HUGH <- function(dt, r) {
dt[, I := .I]
res <- melt(dt, id.vars = "I")[, .(distance = sum(r != value)), keyby = "I"]$distance
dt[, I := NULL]
res
}
Sotos <- function(dt, r) {
return(rowSums(sweep(dt, 2, r) != 0))
}
mm <- function(dt, r){
colSums(t(dt) != r)
}
ff <- function(DT, r){
DT[, Reduce(`+`, Map(`!=`, .SD, r))]
}
nr = 20000
nc = 500
dt1 <- as.data.table(replicate(nc, sample(0:1, nr, replace = TRUE)))
ref <- rep(as.integer(reference), length.out=nc)
lref = as.list(ref)
identical(HUGH(dt1, ref), ff(dt1, lref)) # integer output
identical(mm(dt1, ref), Sotos(dt1, ref)) # numeric output
all.equal(HUGH(dt1, ref), mm(dt1, ref)) # but they match
# all TRUE
microbenchmark::microbenchmark(times = 3,
HUGH(dt1, ref),
Sotos(dt1, ref),
mm(dt1, ref),
ff(dt1, lref)
)
qui peut être lu comme
Voir aussi ? Map et ?Reduce.
Timings. I ' m modifier les données de référence, car l'utilisation d'entiers semble beaucoup plus saine si l'OP a vraiment des données 0-1. De plus, ajouter plus de colonnes puisque l'OP dit qu'ils en ont beaucoup. Enfin, modifier la réponse de Hugh pour qu'elle soit comparable aux autres:
x = dt[, Map(`!=`, .SD, ref)] Reduce(`+`, x, init = 0L)
Résultat:
ref = as.list(reference) dt[, Reduce(`+`, Map(`!=`, .SD, ref))]
J'adore cette réponse mais je ne comprends pas grand-chose de ce qui se passe ... + `, Map (`! = la fonction est-elle passée à Réduire ? Pourriez-vous expliquer un peu comment cela fonctionne ou donner un lien que je peux lire?
@Fino :) Bien sûr, j'ai ajouté quelques explications sur Map et Reduce.