Question

让M为来自称为G的集合的字符串的字符向量的列表，P和Q为矩阵，其行对应于G的每个元素：

M <- list(a=sample(LETTERS, 10), b=sample(LETTERS, 5), 
          c=sample(LETTERS, 15), d=sample(LETTERS, 8))
G <- LETTERS
Ncol <- 5
P <- matrix(rnorm(length(G) * Ncol), ncol=Ncol)
Q <- matrix(rnorm(length(G) * Ncol), ncol=Ncol)
rownames(P) <- rownames(Q) <- G

让t_p和t_q为任意阈值：

t_p <- 0.5
t_q <- -0.5

对于M的每个元素m，每个数字i = 1…Ncol，我想知道P和Q中有多少个值满足以下条件之一：

P [，i]和Q [，i]都分别小于t_p和t_q
P [，i]和Q [，i]都分别大于t_p和t_q
以上都不是

换句话说，对于元素m <- "a"和i <- 1，我需要以下数字：

i <- 1
m <- "a"
n1 <- sum(P[ M[[m]] %in% G, i ] < t_p & Q[ M[[m]] %in% G, i ] < t_q)
n2 <- sum(P[ M[[m]] %in% G, i ] > t_p & Q[ M[[m]] %in% G, i ] > t_q)

（第三个数字是从n1 + n2中减去length(M[[m]])得出的。）

结果应该是一个列表，其中P和Q的每列i都具有一个元素，是一个矩阵，其中M的每个元素均具有一行，并且三列对应于上述数字。

这是我解决此问题的方法：

Pl1 <- P > t_p
Pl2 <- P < t_p
Ql1 <- Q > t_q
Ql2 <- Q < t_q
cond1 <- Pl1 & Ql1
cond2 <- Pl2 & Ql2

## given m, calculate for each column i
calc_for_m <- function(m) {
  sel <- G %in% m
  Nsel <- length(m)
  sel.cond1 <- cond1[sel, ]
  res.cond1 <- colSums(sel.cond1)
  sel.cond2 <- cond2[sel, ]
  res.cond2 <- colSums(sel.cond2)
  cbind(cond1=res.cond1, cond2=res.cond2, 
       cond3=Nsel - (res.cond1 + res.cond2))
}

Yl <- lapply(M, calc_for_m)
Yl <- simplify2array(Yl)
res <- lapply(1:Ncol, function(i) t(Yl[i,,]))

但是，鉴于在现实世界中G是数以万计的项的集合，M是数千个长度的列表，每个元素都是数千的向量，因此上述解决方案似乎有点慢侧。有没有更好（更优雅，更快）的方法来解决此问题？

Answer 1

您的方法已经非常优化。我这样做只是为了给您一些想法。

另一种方法是一次完成所有操作而没有任何循环。

# parameters
arr_ind <- match(unlist(M), G)

cond1[arr_ind,]
cond2[arr_ind,]

这是我的解决方案中唯一速度更快的部分，但几乎没有。

calc_for_m2 <- function(m) {
  sel <- G %in% m
  sel.cond1 <- cond1[sel, ]
  sel.cond2 <- cond2[sel, ]
}

microbenchmark(
access_lapply = Yl <- lapply(M, calc_for_m2)
, access_arr_ind = {
arr_ind <- match(unlist(M), G)
cond1[arr_ind,]
cond2[arr_ind,]
}
)
Unit: microseconds
           expr  min   lq   mean median    uq   max neval
  access_lapply 27.1 28.1 30.516   28.7 29.40 144.6   100
 access_arr_ind 22.8 23.9 25.516   24.4 24.95  96.5   100

现在，不幸的是，我剩下的时间都花在拆分数据上。

arr_ind <- match(unlist(M), G)
grp_ind <- rep(seq_along(M), grp_len)

res.cond1 <- xtabs(cond1[arr_ind,] ~ grp_ind)
res.cond2 <- xtabs(cond2[arr_ind,] ~ grp_ind)

grp_len <- unname(lapply(M, length))
res.cond3 <- sweep(-(res.cond1 + res.cond2), 1, unlist(grp_len), '+')

res2 <- cbind(cond1 = unlist(res.cond1), cond2 = unlist(res.cond2), cond3 = unlist(res.cond3))

所有这些功能的运行速度仍然比原始速度慢20倍：

Unit: microseconds
     expr    min      lq     mean  median      uq    max neval
 original   98.3  106.10  192.255  120.80  128.15 7005.4   100
     cole 2113.7 2146.65 2234.289 2165.45 2205.25 5915.4   100

在rbind期间，我也进入了xtabs，虽然很有希望，但它的速度仍然慢了15倍。

res_1_2 <- xtabs(rbind(cond1[arr_ind, ], cond2[arr_ind,]) ~ rep(grp_ind,2) + rep(1:2, each = length(grp_ind)) )

祝你好运！

在R

1 个答案: