从矩阵中提取排序的行

Question

从矩阵中提取排序的行

4

给定矩阵 m：

      # [,1] [,2] [,3] [,4]
 # [1,]    2    1    3    4
 # [2,]    4    3    2    1
 # [3,]    2    3    1    4
 # [4,]    1    2    3    4
 # [5,]    4    2    3    1
 # [6,]    4    3    1    2
 # [7,]    2    4    3    1
 # [8,]    4    3    2    1
 # [9,]    3    2    1    4
# [10,]    1    2    3    4
# [11,]    3    2    4    1
# [12,]    4    3    2    1
# [13,]    2    1    3    4
# [14,]    2    1    3    4
# [15,]    1    2    3    4
# [16,]    4    3    2    1
# [17,]    2    1    3    4
# [18,]    1    4    3    2
# [19,]    3    2    1    4
# [20,]    1    2    3    4

m <- structure(c(2L, 4L, 2L, 1L, 4L, 4L, 2L, 4L, 3L, 1L, 3L, 4L, 2L, 
2L, 1L, 4L, 2L, 1L, 3L, 1L, 1L, 3L, 3L, 2L, 2L, 3L, 4L, 3L, 2L, 
2L, 2L, 3L, 1L, 1L, 2L, 3L, 1L, 4L, 2L, 2L, 3L, 2L, 1L, 3L, 3L, 
1L, 3L, 2L, 1L, 3L, 4L, 2L, 3L, 3L, 3L, 2L, 3L, 3L, 1L, 3L, 4L, 
1L, 4L, 4L, 1L, 2L, 1L, 1L, 4L, 4L, 1L, 1L, 4L, 4L, 4L, 1L, 4L, 
2L, 4L, 4L), .Dim = c(20L, 4L))

我们可以通过以下方式提取排序后的行：

apply(m, 1, function(x) !is.unsorted(x) | !is.unsorted(rev(x)))

#[1] FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE  TRUE 
#FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE

如果矩阵不大，那么没问题。但是我说的是有数百万行的矩阵。我们能做得更好吗？我们能以向量化的方式完成吗？矩阵m只是一个玩具数据。我正在寻找一般解决方案.

- 989

您的向量化需求是出于性能考虑吗？如果是，那么您的真实数据是非常长、非常宽还是普遍较大的（这可能有助于确定时间差异的重要性）。 - sebastian-c

5

在我的机器上，使用||代替|在处理100万行数据的测试中将运行时间缩短了约60%。 - talat

@docendodiscimus - 聪明 - 虽然我很惊讶这会有这么大的影响。我猜当你可以时，明确表达是很值得的！ - thelatemail

这是关于使用短路逻辑的，它意味着如果第一个条件为真，计算机不会测试第二个条件。 - stephematician

1

如果要循环，应该始终限制它，以便只有需要循环的步骤在循环内完成。如果您拥有足够的RAM，则可以在循环外执行 m1 <- m[, rev(seq_len(ncol(m)))] 并避免为每一行调用 rev。 - Roland

6个回答

3

我采用了循环利用的方法：

n <- t(m)

forwards <- colSums(n == sort(m[1,])) == ncol(m)
backwards  <- colSums(n == rev(sort(m[1,]))) == ncol(m)

vec <- forwards | backwards
unvec <- apply(m, 1, function(x) !is.unsorted(x) | !is.unsorted(rev(x)))

identical(vec, unvec)
[1] TRUE

- sebastian-c

你可以将它泛化（对第一行进行排序，而不是使用 c(1,2,3,4) 并使用 ncol(m)）。它假设所有行都有相同的元素进行排序。我会进行这些更改。 - sebastian-c

只有当矩阵的行数相同时，它才能正常工作。 - 989

2

一个想法是，如果行已经排序，那么它们之间的差值将始终为1，因此方差将为0。因此，可以使用matrixStats包中的rowVarDiffs函数来计算。

library(matrixStats)

rowVarDiffs(m) == 0
#or 
rowVarDiffs(rowRanks(m)) == 0


#[1] FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE  TRUE FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE

- Sotos

2

好主意。你和我有同样的假设。不过现在我在想 c(1,1,2,3) 仍然是排序的。我想不出一个清晰的向量化解决方案来解决这个问题。我会等待看看 OP 的想法。 - thelatemail

是的，我刚想到这个情况。 - Sotos

2

我得到的最佳答案是检查元素之间（在一行中）的差异是否都是非负数或者全为非正数（借鉴了上面colSums答案中的方法，当我正在测试相同的方法时，竞争对手比我先完成了!）

system.time({
    dm2 <- m2[,-1] - m2[,-ncol(m2)]
    vec <- rowSums(dm2>=0) == (ncol(m2)-1) |
           rowSums(dm2<=0) == (ncol(m2)-1) 
})

这适用于任何具有任意间距的数值（整数或非整数）。

在一个拥有一百万行的矩阵中，我得到了以下结果：

   user  system elapsed 
   0.11    0.00    0.11

与OP相比：

   user  system elapsed 
   8.98    0.00    8.98

- stephematician

糟糕 - 打错字了 - 顺便提一下，我正在使用类似于thelatemails评论中的数据。 - stephematician

好的，谢谢。我以为只是复制代码时出现了拼写错误，结果发现 diff 没有做我想做的事情。现在它可以工作了。 - stephematician

1

这里是针对原问题中从矩阵m构造的1e+5 x 4矩阵所提出的解决方案的基准测试结果。请注意，矩阵m每行具有相同的数字且每行没有重复数字。

重要提示：只有以下解决方案是通用解决方案，即它们适用于任何整数矩阵，即使每行有重复数字：

f_m0h3n
f_thelatemail2
f_stephematician
f_Chirayu_Chamoli

也就是说，它们适用于以下矩阵，而其他解决方案则失败！

m <- structure(c(18, 1, 7, 1, 2, 12, 9, 6, 18, 20, 7, 2, 12, 13, 19, 
7, 20, 6, 5, 19, 17, 2, 2, 4, 5, 9, 18, 13, 9, 18, 1, 11, 13, 
7, 18, 10, 20, 2, 3, 3, 14, 8, 19, 8, 12, 7, 19, 16, 12, 16, 
17, 19, 7, 13, 15, 6, 18, 15, 2, 18, 9, 14, 8, 14, 15, 6, 13, 
18, 3, 10, 9, 5, 5, 9, 10, 6, 11, 17, 12, 15, 7, 15, 17, 15, 
16, 19, 3, 14, 2, 9, 4, 19, 14, 14, 7, 3, 10, 11, 18, 12, 3, 
18, 9, 18, 20, 12, 18, 10, 4, 7, 5, 2, 12, 11, 3, 4, 3, 7, 18, 
10), .Dim = c(20L, 6L))

set.seed(1)
library(matrixStats)
library(microbenchmark)
m1 <- structure(c(3, 1, 3, 3, 1, 5, 1, 5, 3, 5, 1, 3, 5, 3, 1, 3, 4, 
2, 5, 5, 5, 2, 2, 5, 5, 1, 2, 4, 2, 2, 2, 1, 4, 5, 2, 4, 1, 4, 
4, 3, 4, 3, 5, 2, 4, 2, 4, 3, 4, 4, 3, 5, 1, 1, 3, 5, 5, 1, 3, 
2, 2, 4, 1, 1, 2, 3, 3, 2, 1, 1, 4, 4, 3, 2, 4, 2, 3, 5, 2, 1, 
1, 5, 4, 4, 3, 4, 5, 1, 5, 3, 5, 2, 2, 4, 5, 1, 2, 3, 1, 4), .Dim = c(20L, 
5L))
m <- m1[sample(1:nrow(m1),1e5,replace=T),]
dim(m)
#[1] 100000  5
f_m0h3n <- function(m) apply(m, 1, function(x) !is.unsorted(x) || !is.unsorted(rev(x)))

f_thelatemail1 <- function(m) colSums(sign(diff(t(m)))) %in% c(-(ncol(m)-1), ncol(m)-1)
f_thelatemail2 <- function(m) {sdm <- diff(t(m));nc <- ncol(m) - 1;colSums(sdm <= 0)==nc | colSums(sdm >= 0)==nc}

f_sebastian_c <- function(m){n <- t(m);forwards <- colSums(n == sort(m[1,])) == ncol(m);
backwards  <- colSums(n == rev(sort(m[1,]))) == ncol(m);forwards | backwards}

f_Sotos1 <- function(m) rowVarDiffs(m) == 0
f_Sotos2 <- function(m) apply(m, 1, function(i) var(diff(i)) == 0)
f_Sotos3 <- function(m) rowVarDiffs(rowRanks(m)) == 0

f_stephematician <- function(m2)  {dm2 <- m2[,-1] - m2[,-ncol(m2)];
vec <- rowSums(dm2>=0) == (ncol(m2)-1) | rowSums(dm2<=0) == (ncol(m2)-1);vec}

f_Chirayu_Chamoli <- function(m) {i=apply(m, 1, is.unsorted);j=apply(m[,c(ncol(m):1),drop = FALSE], 1, is.unsorted);k=xor(i,j);k}

res <- f_m0h3n(m)
all(res==f_thelatemail1(m))
# [1] TRUE
all(res==f_thelatemail2(m))
# [1] TRUE
all(res==f_sebastian_c(m))
# [1] TRUE
all(res==f_Sotos1(m))
# [1] TRUE
all(res==f_Sotos2(m))
# [1] TRUE
all(res==f_Sotos3(m))
# [1] TRUE
all(res==f_stephematician(m))
# [1] TRUE
all(res==f_Chirayu_Chamoli(m))
# [1] TRUE

microbenchmark(f_m0h3n(m), f_thelatemail1(m), f_thelatemail2(m), f_sebastian_c(m), f_Sotos1(m), f_Sotos2(m), f_Sotos3(m), f_stephematician(m), f_Chirayu_Chamoli(m))

# Unit: milliseconds
                 # expr         min          lq        mean     median          uq        max neval
           # f_m0h3n(m)  504.901409  522.640977  542.398387  535.72417  561.723344  634.99808   100
    # f_thelatemail1(m)    9.426029   11.479137   23.454441   13.20548   17.308545   91.18738   100
    # f_thelatemail2(m)    8.841014   10.607174   25.820464   12.09675   17.740771  103.00244   100
     # f_sebastian_c(m)    5.358874    5.975436    9.709314    6.66186    8.725784   77.40695   100
          # f_Sotos1(m) 1526.461296 1604.177128 1639.571861 1644.11763 1669.721992 1752.77551   100
          # f_Sotos2(m) 1772.076169 1850.762817 1889.386328 1891.78832 1917.528489 2047.85548   100
          # f_Sotos3(m) 1538.428094 1600.285447 1637.314434 1644.03891 1671.703437 1738.84665   100
  # f_stephematician(m)    8.994555    9.986554   15.098616   10.97570   12.217240   83.86915   100
 # f_Chirayu_Chamoli(m)  273.571757  289.372545  321.199457  330.37146  346.979005  384.64962   100

- 989

@Sotos 为什么它表现得这么差？ - 989

我一开始想到了rowSums这种函数，认为它比任何apply过程都更有效率。结果证明确实如此，但总体来说......并不是那么高效...唉...有得必有失。 - Sotos

@Sotos 即使在 dim 20x4 的初始变量下，它的性能也不如 apply。apply 的平均值为 130.52451，而你的解决方案的平均值为 374.44257。 - 989

当我说应用程序时，我的意思是对应的（即apply(m, 1, function(i) var(diff(i)) == 0))）。在发布之前，我也没有测试过它。我认为零方差的想法会解决它。 - Sotos

@Sotos 啊哈。那么，如果我是你，我会用apply解决方案编辑我的答案。因为这个rowVarDiffs根本不起作用。 - 989

@Sotos 当然，感谢您的时间。虽然我之前已经用+1表示了感谢。关于那个包，我知道它，因为我在其他地方受益于rowProds函数。但是零方差的想法很好，这是我没有想到的。谢谢。 - 989

0

这里是另一件你可以做的简单事情。我认为这已经足够概括了，但在速度方面，它不如 latemail 的矢量化解决方案。

i=apply(m, 1, is.unsorted)
j=apply(m[,c(ncol(m):1),drop = FALSE], 1, is.unsorted)
k=xor(i,j)

- Chirayu Chamoli

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- thelatemail · Accepted Answer

这个方法不太美观，但你可以通过检查每一列中的差异是否为负或正来实现。

colSums(sign(diff(t(m)))) %in% c(-3,3)
# [1] FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE  TRUE
#[13] FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE

根据我的快速测试，执行速度要快得多。

您可以通过仅检查矩阵m的大小来进行概括：

colSums(sign(diff(t(m)))) %in% c(-(ncol(m)-1), ncol(m)-1)

如果您需要排序重复值的行，例如c(1,1,2,3)，您可以使用稍微冗长的方法：

sdm <- diff(t(m))
nc <- ncol(m) - 1
colSums(sdm <= 0)==nc | colSums(sdm >= 0)==nc
# [1] FALSE  TRUE FALSE  TRUE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE  TRUE
#[13] FALSE FALSE  TRUE  TRUE FALSE FALSE FALSE  TRUE

一些快速基准测试（请注意，这些并非在处理重复值方面完全相同）：

set.seed(1)
m2 <- m[sample(1:nrow(m),1e6,replace=T),]

## original apply code
system.time({
  apply(m2, 1, function(x) !is.unsorted(x) | !is.unsorted(rev(x)))
})
#   user  system elapsed 
# 14.888   0.272  15.153

比较结果如下：

system.time({
  n <- t(m2)
  forwards <- colSums(n == sort(m2[1,])) == ncol(m2)
  backwards  <- colSums(n == rev(sort(m2[1,]))) == ncol(m2)
  vec <- forwards | backwards
})
#   user  system elapsed 
#  0.104   0.020   0.123

system.time({
  sdm <- diff(t(m2))
  nc <- ncol(m) - 1
  colSums(sdm <= 0)==nc | colSums(sdm >= 0)==nc
})
#   user  system elapsed 
#  0.248   0.032   0.279

system.time({
  apply(m2[,-1] - m2[,-ncol(m2)], 1, function(x) all(x>=0) || all(x <= 0))
})
#   user  system elapsed 
#  3.724   0.004   3.731

library(matrixStats)
system.time(rowVarDiffs(m2) == 0)
#   user  system elapsed 
# 40.176   1.156  42.071