共通の値を持つ2つのリストからダミー行列を作成するにはどうすればよいですか？

Question

Rでは、IPアドレスの非常に大きな（140e6のオーダの）複数のリストがあります。複数のリストの間には多くの重複IPがあります。私はrowname（重複なし）としてIPアドレスを含むデータフレームまたはデータテーブルを作成し、カラムとしてリスト名を、そのリストにIPが存在するかどうかを示す0または1を作成したいとします。

たとえば、次の2つのリストがあり、これらのリストの間には％交差記号がいくつかあります。私が望む何

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") 

はこれです：

   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 

私はreshape2、tidyr、model.matrix、交差し、ループの古き良き」を使用して試してみました。私は、データフレームからダミー行列を作成する人々の例をいくつか見出しましたが、ベクトル名は列と値としてrownameではなく、複製ではありません。

Answer 1

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)) 

出力：

> 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

まず、私は2つの新しいソリューション

マージとソリューションを紹介します

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 

以下のためのすべてのソリューションの

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 

---

ベンチマーク：

---

そして、ここでは、あなたが2つの以上のソースベクトルを持っている場合は、この1のすごいところは、それが動作することでもリシェイプ

とソリューションです2ベクター

これまで提供されているソリューションをベンチマークしましょう。 Iは、与えられた例えば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 
) 

からdata.tableとreshape2からdcastを使用して私の第二の溶液の変形およびspreadを使用して私の第一の溶液の変化に追加：

# 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 

大きいたとえば： 私は1E5で試しています。私はaとbの間で約50％のオーバラップを任意に選ぶ。

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

と私は我々がPラウスのソリューションは、2つのベクトルの最速であるとdcastは最速の一般解であることがわかりベンチマーク10回

# 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 

を実行します。しかしmergeとdata.tableは、140E6行の中で最も速いかもしれません。

---

一般的なソリューション

Hopefulle最終編集：

私は私の最高の制限されたものに基づいて2つの一般的なソリューションを設計し、サイズ10E6の3つのベクトルにそれらを実行しました。 data.tableと

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最速

Answer 3

である我々は、組み合わせでunique要素として指定levelsでfactorに、 'A'、 'B' を変換することによってでこれを行うことができ ''、 'B' となぜ

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