Comment créer une matrice fictive à partir de deux listes avec des valeurs communes?

Question

En R, j'ai plusieurs listes d'adresses IP très grandes (de l'ordre de 140e6). Il existe de nombreuses adresses IP de chevauchement entre les listes multiples. Je voudrais créer une trame de données ou une table de données qui contient l'adresse IP comme nom de base (sans doublons) et les noms de liste comme les colonnes et un 0 ou 1 qui indique si l'adresse IP existe dans cette liste. Par exemple, nous avons les deux listes suivantes, avec quelques% d'intersection entre les deux.

a <- c("192.168.0.1","192.168.0.2","192.168.0.3","192.168.0.4","192.168.0.5","192.168.0.6","192.168.0.7","192.168.0.8","192.168.0.9","192.168.0.10") 
b <- c("192.168.1.1","192.168.1.2","192.168.1.3","192.168.1.4","192.168.0.5","192.168.0.6","192.168.0.7","192.168.0.8","192.168.0.9","192.168.0.10") 

Ce que je voudrais est ceci:

   a b 
192.168.0.1 1 0 
192.168.0.2 1 0 
192.168.0.3 1 0 
192.168.0.4 1 0 
192.168.0.5 1 1 
192.168.0.6 1 1 
192.168.0.7 1 1 
192.168.0.8 1 1 
192.168.0.9 1 1 
192.168.0.10 1 1 
192.168.1.1 0 1 
192.168.1.2 0 1 
192.168.1.3 0 1 
192.168.1.4 0 1 

J'ai essayé d'utiliser reshape2, tidyr, model.matrix, se croisent et bon vieux pour les boucles. J'ai trouvé quelques exemples de personnes créant des matrices factices à partir de trames de données, mais pas avec le nom de vecteur comme colonne et la valeur comme nom de scène, et pas avec des doublons.

Answer 1

Une solution dplyr:

df <- data.frame("IP" = unique(c(a,b))) 
df2 <- df%>%mutate(a = ifelse(df$IP %in% a,1,0),b = ifelse(df$IP %in% b,1,0)) 

Sortie:

> df2 
      IP a b 
1 192.168.0.1 1 0 
2 192.168.0.2 1 0 
3 192.168.0.3 1 0 
4 192.168.0.4 1 0 
5 192.168.0.5 1 1 
6 192.168.0.6 1 1 
7 192.168.0.7 1 1 
8 192.168.0.8 1 1 
9 192.168.0.9 1 1 
10 192.168.0.10 1 1 
11 192.168.1.1 0 1 
12 192.168.1.2 0 1 
13 192.168.1.3 0 1 
14 192.168.1.4 0 1 

Answer 2

D'abord, je vais vous présenter 2 nouvelles solutions

Une solution avec fusion

df1 <- merge(data.frame(ip=a,a=1), data.frame(ip=b,b=1),all=TRUE) %>% 
set_rownames(.,`[`(.,,'ip')) %>% select(-ip) %>% replace(.,is.na(.),0) 

#    a b 
# 192.168.0.1 1 0 
# 192.168.0.10 1 1 
# 192.168.0.2 1 0 
# 192.168.0.3 1 0 
# 192.168.0.4 1 0 
# 192.168.0.5 1 1 
# 192.168.0.6 1 1 
# 192.168.0.7 1 1 
# 192.168.0.8 1 1 
# 192.168.0.9 1 1 
# 192.168.1.1 0 1 
# 192.168.1.2 0 1 
# 192.168.1.3 0 1 
# 192.168.1.4 0 1 

---

Et voici également une solution avec Reshape

Ce qui est cool celui-ci est que cela fonctionne quand vous avez plus de 2 vecteurs source:

df2 <- list(data.frame(a),data.frame(b)) %>% 
    lapply(. %>% transform(source = names(.)) %>% rename_("ip" = names(.)[1])) %>% 
    do.call(rbind,.) %>% 
    transform(v=1) %>% 
    reshape(idvar="ip",timevar="source",direction="wide",sep="") %>% 
    replace(.,is.na(.),0) %>% 
    setNames(gsub("v","",colnames(.))) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip) 

#    a b 
# 192.168.0.1 1 0 
# 192.168.0.2 1 0 
# 192.168.0.3 1 0 
# 192.168.0.4 1 0 
# 192.168.0.5 1 1 
# 192.168.0.6 1 1 
# 192.168.0.7 1 1 
# 192.168.0.8 1 1 
# 192.168.0.9 1 1 
# 192.168.0.10 1 1 
# 192.168.1.1 0 1 
# 192.168.1.2 0 1 
# 192.168.1.3 0 1 
# 192.168.1.4 0 1 

---

Benchmark des solutions pour 2 vecteurs

comparons les solutions proposées jusqu'à présent. J'ajoute une variation de ma première solution en utilisant data.table et les variations de ma seconde solution en utilisant dcast de reshape2 et spread de tidyR

microbenchmark(
merge = merge(data.frame(ip=a,a=1), data.frame(ip=b,b=1),all=TRUE) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip) %>% replace(.,is.na(.),0), 
merge_dt = merge(data.table(ip=a,a=1,key="ip"), data.table(ip=b,b=1,key="ip"),all=TRUE) %>% 
    as.data.frame %>% # to go back to desired output format 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip) %>% replace(.,is.na(.),0), 
dcast = list(data.frame(a),data.frame(b)) %>% 
    lapply(. %>% transform(source = names(.)) %>% rename_("ip" = names(.)[1])) %>% 
    do.call(rbind,.) %>% 
    transform(v=1) %>% 
    dcast(ip ~ source,value.var="v") %>% 
    replace(.,is.na(.),0) %>% 
    setNames(gsub("v","",colnames(.))) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip), 
spread = list(data.frame(a),data.frame(b)) %>% 
    lapply(. %>% transform(source = names(.)) %>% rename_("ip" = names(.)[1])) %>% 
    do.call(rbind,.) %>% 
    transform(v=1) %>% 
    spread(source,v) %>% 
    replace(.,is.na(.),0) %>% 
    setNames(gsub("v","",colnames(.))) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip), 
reshape = list(data.frame(a),data.frame(b)) %>% 
    lapply(. %>% transform(source = names(.)) %>% rename_("ip" = names(.)[1])) %>% 
    do.call(rbind,.) %>% 
    transform(v=1) %>% 
    reshape(idvar="ip",timevar="source",direction="wide",sep="") %>% 
    replace(.,is.na(.),0) %>% 
    setNames(gsub("v","",colnames(.))) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip), 
akrun = {lvl <- unique(c(a,b));mapply(table, list(a = factor(a, levels = lvl),b = factor(b, levels = lvl)))}, 
p_routh = {df <- data.frame("IP" = unique(c(a,b)));df2 <- df%>%mutate(a = ifelse(df$IP %in% a,1,0),b = ifelse(df$IP %in% b,1,0))}, 
d.b  = {ALL <- unique(c(a,b));data.frame(sapply(list(a = a, b = b), function(x) as.numeric(ALL %in% x)), row.names = ALL)}, 
times = 100 
) 

Pour l'exemple donné:

# Unit: microseconds 
#  expr  min  lq  mean median  uq  max neval 
# merge 2368.754 2670.8205 3866.2288 2942.6280 3685.1415 38459.947 100 
# merge_dt 4220.084 4702.4700 5547.1978 5222.3705 6239.1685 9170.293 100 
# dcast 6153.875 6870.3760 9031.8770 7521.7570 8793.9045 46529.917 100 
# spread 4329.090 4814.6610 6023.5993 5313.3275 6301.9890 38972.416 100 
# reshape 4376.514 5007.1905 5995.1480 5694.1395 6811.4495 8744.180 100 
# akrun 238.893 304.3680 366.0376 327.7265 416.3815 654.744 100 
# p_routh 1013.967 1190.9255 1418.8037 1296.7450 1651.7220 2162.775 100 
#  d.b 133.072 183.8595 228.7220 207.0415 278.1780 417.974 100 

Pour un plus grand exemple: 140E6 est un peu beaucoup de benchmark donc j'essaye avec 1E5. Je choisis arbitrairement un chevauchement d'environ 50% entre a et b.

n <- 1E5 
set.seed(1) 
a <- sample(2*n,n) 
b <- sample(2*n,n) 

et je lance le benchmark 10 fois

# Unit: milliseconds 
#  expr  min  lq  mean median  uq  max neval 
# merge 582.41885 617.4348 676.40615 651.84618 698.1091 911.8320 10 
# merge_dt 98.72318 100.6648 114.72754 103.57925 119.9722 176.5360 10 
# dcast 267.51729 347.8337 366.85554 360.17472 411.5002 454.1912 10 
# spread 425.26005 447.7959 471.03577 477.02525 490.0484 502.8333 10 
# reshape 697.14005 738.6921 763.31876 751.01547 791.3207 818.0778 10 
# akrun 791.00964 815.5621 838.08296 832.31382 849.5231 923.6849 10 
# p_routh 78.77724 82.8646 98.38296 84.34238 101.7304 151.0339 10 
#  d.b 191.00546 194.5754 209.02133 200.35484 207.1666 279.7900 10 

On voit que la solution de P Routh est le plus rapide pour 2 vecteurs et dcast est la plus rapide solution générale. merge avec data.table pourrait être le plus rapide pour 140E6 lignes cependant.

---

solutions générales

Hopefulle modifier finale:

I conçu 2 solutions générales fondées sur mes meilleurs restreints, et les ont couru sur 3 vecteurs de taille 10E6.

merge_dt_gen <- function(...){ 
    args <- as.character(substitute(list(...)))[-1] 
    dts <- args %>% lapply(.%>% data.table(ip=get(.),key="ip")) 
    all_ips <- data.table(ip = unique(c(...)),key="ip") # all_ips <- data.table(ip = unique(c(a,b))) 
    for(dt in dts){ 
    all_ips <- merge(all_ips,dt,all.x = TRUE,by="ip") 
    } 
    all_ips %>% 
    as.data.frame %>% 
    set_rownames(.,`[`(.,,'ip')) %>% 
    select(-ip) %>% 
    setNames(args) %>% 
    replace(.,!is.na(.),1) %>% 
    replace(.,is.na(.),0) 
} 

d_cast_gen <- function(...){ 
    args <- as.character(substitute(list(...)))[-1] 
    args %>% 
    lapply(.%>% data.frame(get(.)) %>% setNames(c("src","ip"))) %>% 
    do.call(rbind,.) %>% 
    transform(v=1) %>% 
    dcast(ip ~ src,value.var="v") %>% 
    replace(.,is.na(.),0) %>% 
    setNames(gsub("v","",colnames(.))) %>% 
    set_rownames(.,`[`(.,,'ip')) %>% select(-ip) 
} 

n <- 10E6 
set.seed(1) 
a <- sample(2*n,n) 
b <- sample(2*n,n) 
d <- sample(unique(a,b),n) 

microbenchmark(
    d_cast_gen = d_cast_gen(a,b,d), 
    merge_dt_gen = merge_dt_gen(a,b,d), 
    times = 1 
) 

# Unit: seconds 
#   expr  min  lq  mean median  uq  max neval 
# d_cast_gen 70.99771 70.99771 70.99771 70.99771 70.99771 70.99771  1 
# merge_dt_gen 47.41809 47.41809 47.41809 47.41809 47.41809 47.41809  1 

merge avec data.table est le plus rapide

Answer 3

On peut le faire avec en convertissant 'a', 'b', à factor avec levels spécifié comme unique éléments combinés 'a', 'b' et obtenir la fréquence

lvl <- unique(c(a,b)) 
mapply(table, list(a = factor(a, levels = lvl),b = factor(b, levels = lvl))) 
#    a b 
#192.168.0.1 1 0 
#192.168.0.2 1 0 
#192.168.0.3 1 0 
#192.168.0.4 1 0 
#192.168.0.5 1 1 
#192.168.0.6 1 1 
#192.168.0.7 1 1 
#192.168.0.8 1 1 
#192.168.0.9 1 1 
#192.168.0.10 1 1 
#192.168.1.1 0 1 
#192.168.1.2 0 1 
#192.168.1.3 0 1 
#192.168.1.4 0 1