R comparaison de valeurs par groupe

Bonsoir.
Dans une dataframe groupée je cherche si des valeurs d'une colonne sont présentes dans une autre colonne pour chaque groupe indépendamment bien sûr.
Voici in exemple factice et simplifié de mes données :

Code:

---

1 2 3 4 5 6 7 8 9 10 11

df <- data.frame() for (i in 1:4) { for (j in 1:4) { x <- sample(1:12,4) y <- sample(1:12,4) gr <- i x <- cbind(gr,x,y) } df <- rbind(df,x) } df <- df %>% group_by(gr)

---

Voici le résultat attendu :

  gr x1 x2 x3 x4
  1  1  1  0  0
  2  0  0  1  0
  3  1  1  0  0
  4  0  0  0  1

Je pourrais le faire avec une boucle :

Code:

---

1 2 3 4 5 6 7 8

pre <- unique(df$gr) result <- data.frame() for (i in pre) { tmp <- df %>% filter(gr == i) result <- rbind(result,as.integer(tmp$x %in% tmp$y )) } result <- cbind(pre,result) names(result) <- c("gr","x1","x2","x3","x4")

---

mais je suis sur que c'est faisable avec quelque chose de la famille des apply. Mon problème c'est que j'ai beau triturer tout cela dans tous les sens, je ne m'en sort pas. Un peu d'aide serait la bienvenue.
Merci

bonjour ,
une solution avec le tidyverse et purrr, mais honnêtement ça n'apporte pas grand chose, je pense qe l'on peux faire mieux

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

library(tidyverse) library(purrr) ... comparer <- function(groupe){ tmp <- df %>% filter(gr == groupe) enframe (as.integer(tmp$x %in% tmp$y )) %>% spread(name,value) } #res <- map(unique(df$gr),comparer) %>% reduce(bind_rows) ## map fonction équivalente à apply # mieux res <- map_df(unique(df$gr),comparer) ...

---

cdlt

Merci pour la proposition. En effet ça ne semble pas être très efficace mais c'est tout de même bien plus élégant que mes boucles.
Il me semble que group_map serait pertinent mais je coince sur l'utilisation et je ne trouve pas d’exemple qui me soit compréhensible...

Citation:

---

Envoyé par yalehaire

Merci pour la proposition. En effet ça ne semble pas être très efficace mais c'est tout de même bien plus élégant que mes boucles.
Il me semble que group_map serait pertinent mais je coince sur l'utilisation et je ne trouve pas d’exemple qui me soit compréhensible...

---

Eureka! J'ai trouvé.

Code:

---

1 2 3 4

fcomparer <- function(df,...){ as.data.frame(t(as.integer(df$x %in% df$y ))) } res <- df %>% group_map(fcomparer)

---

5.4 secondes pour traiter 11441 groupes.
Difficile de faire plus simple il me semble.
Merci de votre attention.

encore plus simple

Code:

---

1 2	res <- map_df(split(df,df$gr),~enframe(as.integer(.x$x %in% .x$y )) %>% spread(name,value))

---

Plus simple mais beaucoup moins rapide :

Code:

---

1 2 3

system.time : utilisateur système écoulé 31.74 0.01 33.06

---

contre :

Code:

---

1 2 3

system.time : utilisateur système écoulé 7.52 0.00 7.83

---

pour le même jeu de données.

merci,très intéressant, je ne connaissais pas group_map, de plus ma version de dplyr n'avais pas cette fonction, j'ai mis à jour
bonne journée

re bonjour,
je pense que le bon temps de réponse provient du fait que tu as utiliser la fonction t() et donc tu travailles sur des matrices
j'ai retesté une solution avec map_df en m'inspirant de ton code , plus rapide qu'avec group_map(? si tu peux confirmer ou non), par contre le code est un peu plus tordu! (à cause de la mise en forme du dataframe final)
je te mets aussi mes stats calculées à partir de microbenchmark

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

res4 <- tibble(gr=unique(df$gr)) %>% bind_cols( map_df(split(df,df$gr), ~as.integer(.x$x %in% .x$y )) %>%t() %>% as.tibble())   fcomparer <- function(df,...){ as.data.frame(t(as.integer(df$x %in% df$y ))) } res5 <- df %>% group_map(fcomparer)   library(microbenchmark) microbenchmark(res4 =tibble(gr=unique(df$gr)) %>% bind_cols( map_df(split(df,df$gr), ~as.integer(.x$x %in% .x$y )) %>%t() %>% as.tibble()) , res5 = df %>% group_map(fcomparer))   #Unit: milliseconds #expr min lq mean median uq max neval #res4 3.185675 3.473044 4.115843 3.721240 4.087462 13.16657 100 #res5 4.546566 4.878921 5.766514 5.121645 5.591182 37.55826 100

---

Sur un gros jeu de données le résultat n'est pas convainquant. Je n'ai aucune idée d'où cela peut venir.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17

length(unique(df$gr)) 54598   system.time({ res5 <- df %>% group_by(gr) %>% group_map(fcomparer) }) utilisateur système écoulé 24.57 0.11 25.64   system.time({ res4 <- tibble(gr=unique(df$gr)) %>% bind_cols( map_df(split(df,df$gr), ~as.integer(.x$x %in% .x$y )) %>%t() %>% as.tibble()) }) Warning message: `as.tibble()` is deprecated, use `as_tibble()` (but mind the new semantics) utilisateur système écoulé 150.72 0.33 156.80

---