在不使用 apply 的情况下获取与一系列向量重合的矩阵行
Getting rows of a matrix which coincide with a series of vectors, without using apply
我的问题与 有关。
假设我有一个矩阵和 4 个向量（可以考虑这是另一个矩阵，因为向量的顺序很重要），我想按顺序获得与每个向量一致的行号。我希望解决方案避免重复向量并尽可能高效，因为问题规模很大。
示例。
set.seed(1)
M = matrix(rpois(50,5),5,10)
v1 = c(3, 2, 7, 7, 4, 4, 7, 4, 5, 6)
v2= c(8, 6, 4, 4, 3, 8, 3, 6, 5, 6)
v3= c(4, 8, 3, 5, 9, 4, 5, 6, 7 ,7)
v4= c(4, 9, 3, 6, 3, 1, 5, 7,6, 1)
Vmat = cbind(v1,v2,v3,v4)
M
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 4 8 3 5 9 4 5 6 7 7
[2,] 4 9 3 6 3 1 5 7 6 1
[3,] 5 6 6 11 6 4 5 2 7 5
[4,] 8 6 4 4 3 8 3 6 5 6
[5,] 3 2 7 7 4 4 7 4 5 6
Vmat
v1 v2 v3 v4
[1,] 3 8 4 4
[2,] 2 6 8 9
[3,] 7 4 3 3
[4,] 7 4 5 6
[5,] 4 3 9 3
[6,] 4 8 4 1
[7,] 7 3 5 5
[8,] 4 6 6 7
[9,] 5 5 7 6
[10,] 6 6 7 1
输出应该是...
5 4 1 2
如果我们将它们切换为 data.frames，那么我们可以使用 merge 来实现这一目的。此外，我们旋转 Vmat 以便于匹配。
haystack <- as.data.frame(M)
haystack$haystack_id <- rownames(haystack)
needle <- as.data.frame(t(Vmat))
needle$needle_id <- rownames(needle)
lookups <- merge(needle, haystack)
lookups <- lookups[order(lookups$needle_id), ]
如果我们将其与上面的 string/match 解决方案进行比较，它似乎在合理程度上更快
create_data <- function(haystack.rows, cols, needle.rows) {
M <- matrix(rpois(haystack.rows * cols, 5), haystack.rows, cols)
V <- M[sample(1:haystack.rows, needle.rows, replace=T),]
list(M=M, V=V)
}
> set.seed(1); data <- create_data(1000000, 20, 10000);
> system.time({haystack <- as.data.frame(data$M); haystack$hid <- seq_along(haystack$V1); needle <- as.data.frame(data$V); needle$nid <- seq_along(needle$V1); ret <- merge(needle, haystack); ret <- ret[order(ret$nid),]})
user system elapsed
5.900 0.000 5.906
> system.time({mstr <- apply(data$M, 1, paste0, collapse="_"); vstr <- apply(data$V, 1, paste0, collapse="_"); matchstr <- match(vstr, mstr)})
user system elapsed
8.372 0.000 8.377
字符串上的 match 比 merge 快得多，但您必须支付转换数据的成本，而转换为数据框非常便宜，因为它使用相同的基础数据.
编辑：向 merge 版本添加了一个排序步骤以按顺序获取行。还修复了合并版本的定时版本中的拼写错误。时间保持在同一数量级
EDIT2：感谢@Frank，在当时的 match 版本中发现了一个错误，它大大加快了速度（我一直在使用一个名为 asdf 的本地示例，它更大).不过，仍然不如 merge 解决方案快。
我认为将每个向量折叠成一个值是可行的方法，遵循@bunk:
m = do.call(function(...) paste(...,sep="_"), split(M, col(M)))
v = sapply(list(v1,v2,v3,v4), paste0, collapse="_")
match(v,m)
# [1] 5 4 1 2
构建 m 的更自然的方式是使用 apply，但这是被禁止的。如果将 M 存储为 data.frame，另一个选项是：
m = do.call(function(...) paste(...,sep="_"), as.data.frame(M))
与@user295691 的回答类似，我们合并，但现在 merge.data.table 中有 which=TRUE 选项：
set.seed(1)
matdata <- create_data(1e6,20,1e5) # using @user295691's example data
library(data.table)
M = as.data.table(matdata$M)
V = as.data.table(matdata$V)
r <- M[V, on=names(V), which=TRUE]
验证是否正确...
V[1,]
# V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20
# 1: 7 5 3 2 5 6 3 3 5 5 3 2 4 9 4 4 3 6 4 3
M[r[1],]
# V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20
# 1: 7 5 3 2 5 6 3 3 5 5 3 2 4 9 4 4 3 6 4 3
基准测试
OP 的示例数据（在已删除的答案中）：
set.seed(1)
NM = 1e6
NV = 1e5
Ncols = 20
MM = matrix(rpois(NM*Ncols,Ncols),NM,Ncols)
rows=sample(NM,NV,replace = FALSE)
Vmat=t(MM[rows,])
# converted to data.frames, because why not?
M = as.data.frame(MM)
V = as.data.frame(t(Vmat))
# converted to data.tables
M2 = setDT(copy(M))
V2 = setDT(copy(V))
要测试的函数：
match_strings <- function(){
m = do.call(function(...) paste(...,sep="_"), M)
v = do.call(function(...) paste(...,sep="_"), V)
match(v,m)
}
merge_df <- function(){ # from @user295691's answer
M$mid = seq(nrow(M))
V$vid = seq(nrow(V))
with(merge(M,V), mid[order(vid)])
}
merge_dt <- function(){
M2[V2, on=names(V2), which=TRUE]
}
结果：
system.time({r_strings = match_strings()})
# user system elapsed
# 10.40 0.06 10.49
system.time({r_merge_df = merge_df()})
# user system elapsed
# 14.71 0.10 14.84
system.time({r_merge_dt = merge_dt()})
# user system elapsed
# 0.39 0.00 0.40
identical(r_strings,r_merge_df) # TRUE
identical(r_strings,r_merge_dt) # TRUE
我的问题与
假设我有一个矩阵和 4 个向量（可以考虑这是另一个矩阵，因为向量的顺序很重要），我想按顺序获得与每个向量一致的行号。我希望解决方案避免重复向量并尽可能高效，因为问题规模很大。
示例。
set.seed(1)
M = matrix(rpois(50,5),5,10)
v1 = c(3, 2, 7, 7, 4, 4, 7, 4, 5, 6)
v2= c(8, 6, 4, 4, 3, 8, 3, 6, 5, 6)
v3= c(4, 8, 3, 5, 9, 4, 5, 6, 7 ,7)
v4= c(4, 9, 3, 6, 3, 1, 5, 7,6, 1)
Vmat = cbind(v1,v2,v3,v4)
M
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 4 8 3 5 9 4 5 6 7 7
[2,] 4 9 3 6 3 1 5 7 6 1
[3,] 5 6 6 11 6 4 5 2 7 5
[4,] 8 6 4 4 3 8 3 6 5 6
[5,] 3 2 7 7 4 4 7 4 5 6
Vmat
v1 v2 v3 v4
[1,] 3 8 4 4
[2,] 2 6 8 9
[3,] 7 4 3 3
[4,] 7 4 5 6
[5,] 4 3 9 3
[6,] 4 8 4 1
[7,] 7 3 5 5
[8,] 4 6 6 7
[9,] 5 5 7 6
[10,] 6 6 7 1
输出应该是...
5 4 1 2
如果我们将它们切换为 data.frames，那么我们可以使用 merge 来实现这一目的。此外，我们旋转 Vmat 以便于匹配。
haystack <- as.data.frame(M)
haystack$haystack_id <- rownames(haystack)
needle <- as.data.frame(t(Vmat))
needle$needle_id <- rownames(needle)
lookups <- merge(needle, haystack)
lookups <- lookups[order(lookups$needle_id), ]
如果我们将其与上面的 string/match 解决方案进行比较，它似乎在合理程度上更快
create_data <- function(haystack.rows, cols, needle.rows) {
M <- matrix(rpois(haystack.rows * cols, 5), haystack.rows, cols)
V <- M[sample(1:haystack.rows, needle.rows, replace=T),]
list(M=M, V=V)
}
> set.seed(1); data <- create_data(1000000, 20, 10000);
> system.time({haystack <- as.data.frame(data$M); haystack$hid <- seq_along(haystack$V1); needle <- as.data.frame(data$V); needle$nid <- seq_along(needle$V1); ret <- merge(needle, haystack); ret <- ret[order(ret$nid),]})
user system elapsed
5.900 0.000 5.906
> system.time({mstr <- apply(data$M, 1, paste0, collapse="_"); vstr <- apply(data$V, 1, paste0, collapse="_"); matchstr <- match(vstr, mstr)})
user system elapsed
8.372 0.000 8.377
match 比 merge 快得多，但您必须支付转换数据的成本，而转换为数据框非常便宜，因为它使用相同的基础数据.
编辑：向 merge 版本添加了一个排序步骤以按顺序获取行。还修复了合并版本的定时版本中的拼写错误。时间保持在同一数量级
EDIT2：感谢@Frank，在当时的 match 版本中发现了一个错误，它大大加快了速度（我一直在使用一个名为 asdf 的本地示例，它更大).不过，仍然不如 merge 解决方案快。
我认为将每个向量折叠成一个值是可行的方法，遵循@bunk:
m = do.call(function(...) paste(...,sep="_"), split(M, col(M)))
v = sapply(list(v1,v2,v3,v4), paste0, collapse="_")
match(v,m)
# [1] 5 4 1 2
构建 m 的更自然的方式是使用 apply，但这是被禁止的。如果将 M 存储为 data.frame，另一个选项是：
m = do.call(function(...) paste(...,sep="_"), as.data.frame(M))
与@user295691 的回答类似，我们合并，但现在 merge.data.table 中有 which=TRUE 选项：
set.seed(1)
matdata <- create_data(1e6,20,1e5) # using @user295691's example data
library(data.table)
M = as.data.table(matdata$M)
V = as.data.table(matdata$V)
r <- M[V, on=names(V), which=TRUE]
验证是否正确...
V[1,]
# V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20
# 1: 7 5 3 2 5 6 3 3 5 5 3 2 4 9 4 4 3 6 4 3
M[r[1],]
# V1 V2 V3 V4 V5 V6 V7 V8 V9 V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 V20
# 1: 7 5 3 2 5 6 3 3 5 5 3 2 4 9 4 4 3 6 4 3
基准测试
OP 的示例数据（在已删除的答案中）：
set.seed(1)
NM = 1e6
NV = 1e5
Ncols = 20
MM = matrix(rpois(NM*Ncols,Ncols),NM,Ncols)
rows=sample(NM,NV,replace = FALSE)
Vmat=t(MM[rows,])
# converted to data.frames, because why not?
M = as.data.frame(MM)
V = as.data.frame(t(Vmat))
# converted to data.tables
M2 = setDT(copy(M))
V2 = setDT(copy(V))
要测试的函数：
match_strings <- function(){
m = do.call(function(...) paste(...,sep="_"), M)
v = do.call(function(...) paste(...,sep="_"), V)
match(v,m)
}
merge_df <- function(){ # from @user295691's answer
M$mid = seq(nrow(M))
V$vid = seq(nrow(V))
with(merge(M,V), mid[order(vid)])
}
merge_dt <- function(){
M2[V2, on=names(V2), which=TRUE]
}
结果：
system.time({r_strings = match_strings()})
# user system elapsed
# 10.40 0.06 10.49
system.time({r_merge_df = merge_df()})
# user system elapsed
# 14.71 0.10 14.84
system.time({r_merge_dt = merge_dt()})
# user system elapsed
# 0.39 0.00 0.40
identical(r_strings,r_merge_df) # TRUE
identical(r_strings,r_merge_dt) # TRUE