我正在尝试通过每列中NA
值的唯一位置对矩阵的行进行分组。
例如具有以下矩阵:
1, 2, NA, 3 NA
2, 5, NA, 4, 5
3, 2, 1, 0, 7
5, 3, NA, 9, 3
0, 2, 1, 4, 6
答案将是:
1, 2, 3, 2, 3
表示有3个不同的组,即第2行和第4行在同一组中。
问题在于我无法提出一种快速的方法来实现这一目标。这是我当前的实现:
mat <- matrix(rnorm(10000*100), ncol=100)
mat[sample(length(mat), nrow(mat))] <- NA
getNAgroups <- function(x) {
allnas <- t(!is.na(x))
nacases <- unique(allnas, MARGIN=2)
groups <- numeric(nrow(x))
for(i in 1:ncol(nacases)) {
groups[colMeans(allnas == nacases[,i]) == 1] <- i
}
groups
}
出于我的意图,这有点太慢了
system.time(getNAgroups(mat))
user system elapsed
7.672 1.686 9.386
答案 0 :(得分:5)
这是在NA位置列表中使用匹配的一种方法:
mat <- matrix(c(1, 2, NA, 3, NA,
2, 5, NA, 4, 5,
3, 2, 1, 0, 7,
5, 3, NA, 9, 3,
0, 2, 1, 4, 6), 5, byrow = TRUE)
categ <- apply(is.na(mat), 1, which)
match(categ, unique(categ))
答案 1 :(得分:2)
我们可以paste
将这些值按行排在一起,并match
以获得唯一索引。
vals <- apply(is.na(mat), 1, toString)
match(vals, unique(vals))
#[1] 1 2 3 2 3
答案 2 :(得分:1)
如果要考虑性能,我会尝试以下代码:
library(dplyr)
getNAgrps = function(df){
df = df %>%
dplyr::mutate(NAgrp = '')
lapply(1:nrow(df),function(i){
df$NAgrp[i] <<- paste0(which(is.na(df[i,])),collapse=",")
})
return(df)
}
此功能将输入作为数据框。要将矩阵转换为数据框:
library(dplyr)
dat = as_data_frame(mat)
性能如下:
> system.time(getNAgrps(mat))
user system elapsed
0.005 0.000 0.006
让我知道它是否有效。
注意:与其给出整数组,不如返回字符向量,其NA的位置用逗号分隔。
答案 3 :(得分:1)
如果您不介意顺序,可以使用std::unique_ptr<Base>
查找组。
interaction
或者使用tt <- interaction(as.data.frame(is.na(mat)), drop = TRUE)
unclass(tt)
#[1] 3 2 1 2 1
和sweep
也许更高效,但是最多只能使用30列。
rowSums
或者您可以使用tt <- is.na(mat)
tt <- rowSums(sweep(tt, 2, cumprod(rep(2L,ncol(tt))), "*"))
match(tt, unique(tt))
#[1] 1 2 3 2 3
库,该库虽然速度不快,但是遵循以前的想法,适用于许多行,并且在内存有限时可能会有所帮助。
bit
或者library("bit")
tt <- apply(is.na(mat), 1, as.bit)
match(tt, unique(tt))
#[1] 1 2 3 2 3
#For many columns
tt <- apply(apply(is.na(mat), 1, as.bit), 2, paste, collapse=" ")
match(tt, unique(tt))
#[1] 1 2 3 2 3
可以这样使用:
packBits
或使用tt <- is.na(mat)
tt <- cbind(tt, matrix(TRUE, nrow(tt), ncol=(8 - ncol(tt) %% 8)))
tt <- packBits(t(tt))
tt <- split(tt, rep(seq_len(nrow(mat)), each=length(tt)/nrow(mat)))
match(tt, unique(tt))
#[1] 1 2 3 2 3
或raw2hex
中的PKI
的高性能版本。
encryptr
答案 4 :(得分:0)
set.seed(42)
mat <- matrix(rnorm(10000*100), ncol=100)
mat[sample(length(mat), nrow(mat))] <- NA
getNAgroups_Orig <- function(x) {
allnas <- t(!is.na(x))
nacases <- unique(allnas, MARGIN=2)
groups <- numeric(nrow(x))
for(i in 1:ncol(nacases)) {
groups[colMeans(allnas == nacases[,i]) == 1] <- i
}
groups
}
getNAgroups_GKi <- function(mat) {
tt <- is.na(mat)
tt <- rowSums(sweep(tt, 2, cumprod(rep(2L,ncol(tt))), "*"))
match(tt, unique(tt))
}
getNAgroups_Clemsang <- function(mat) {
categ <- apply(is.na(mat), 1, which)
match(categ, unique(categ))
}
getNAgroups_RonakShah <- function(mat) {
vals <- apply(is.na(mat), 1, toString)
match(vals, unique(vals))
}
library("bit")
getNAgroups_bit <- function(mat) {
tt <- apply(apply(is.na(mat), 1, as.bit), 2, paste, collapse=" ")
match(tt, unique(tt))
}
getNAgroups_GKi2 <- function(mat) {
tt <- is.na(mat)
tt <- cbind(tt, matrix(TRUE, nrow(tt), ncol=(8 - ncol(tt) %% 8)))
tt <- packBits(t(tt))
tt <- split(tt, rep(seq_len(nrow(mat)), each=length(tt)/nrow(mat)))
match(tt, unique(tt))
}
library(PKI) #or library(encryptr)
getNAgroups_GKi3 <- function(mat) {
tt <- is.na(mat)
tt <- cbind(tt, matrix(TRUE, nrow(tt), ncol=(8 - ncol(tt) %% 8)))
tt <- raw2hex(packBits(t(tt)))
tt <- matrix(tt, ncol = nrow(mat))
tt <- apply(tt, 2, paste, collapse="")
match(tt, unique(tt))
}
system.time(getNAgroups_Orig(mat))
# User System verstrichen
# 6.928 1.316 8.244
system.time(getNAgroups_GKi(mat)) ###IS NOT WORKING CORRECT DUE TO TOO MANY COLUMNS
# User System verstrichen
# 0.016 0.000 0.016
system.time(getNAgroups_Clemsang(mat))
# User System verstrichen
# 0.045 0.004 0.049
system.time(getNAgroups_RonakShah(mat))
# User System verstrichen
# 0.347 0.000 0.347
system.time(getNAgroups_bit(mat))
# User System verstrichen
# 0.239 0.000 0.240
system.time(getNAgroups_GKi2(mat))
# User System verstrichen
# 0.119 0.000 0.119
system.time(getNAgroups_GKi3(mat))
# User System verstrichen
# 0.046 0.000 0.046