使用r基函数可以找到矩阵中每一行的相对最小值，但每个最小值位于不同的列

Question

我有一个类似的矩阵

d <- matrix(c(10, -20, -30, 20, 30,
10, -15, -30, 20, 30,
10, 40, -30, 20, 30,
10, -20, -30, 20, 40), byrow = TRUE, nrow = 4)
# > d
#      [,1] [,2] [,3] [,4] [,5]
# [1,]   10  -20  -30   20   30
# [2,]   10  -15  -30   20   30
# [3,]   10   40  -30   20   30
# [4,]   10  -20  -30   20   40

我想找到abs值小于25的每行最小值的索引，但是每一行的最小值应该在不同的列。我用for循环这样做，这还不够好。

rng <- 25
ok <- abs(d) < rng
res <- rep(NA, 4)
for (i in seq_len(nrow(d))) {
if (any(ok[i, ])) {
dd <- d[i, ]
idx <- which(ok[i, ])
idx.min <- idx[which.min(dd[idx])]
res[i] <- idx.min
ok[, idx.min] <- FALSE
}
}
res

结果就是这个

# > res
# [1]  2  1  4 NA

这意味着第一行的索引为2，其值为-20。并且由于使用第二列，尽管第二行的最小值仍然在第二列中，它应该是第一列值10，并且索引为1。如果找不到最小值，则索引为NA。

有矢量化函数可以做到这一点吗？谢谢大家。如果有任何英语表达问题，也请告诉我。

Answer 1

如果您想获得每行具有最小绝对值的列索引，您可以执行：

library(tidyverse)
d <- matrix(c(
10, -20, -30, 20, 30,
10, -15, -30, 20, 30,
10, 40, -30, 20, 30,
10, -20, -30, 20, 40
), byrow = TRUE, nrow = 4)
d %>%
as_tibble(rownames = "row") %>%
pivot_longer(-row, names_to = "col") %>%
mutate(col = col %>% str_extract("[0-9]+") %>% as.numeric()) %>%
group_by(row) %>%
# only consider values with small abs volaue
filter(abs(value) < 25) %>%
# get the smallest value
arrange(abs(value)) %>%
slice(1) %>%
# get column indicies
pull(col)
#> Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
#> Using compatibility `.name_repair`.
#> [1] 1 1 1 1

^{创建于2021-12-07由reprex包(v2.0.1(}

这是你预期的结果吗？

Answer 2

您可以像下面的一样尝试for循环

res <- c()
for (i in 1:nrow(d)) {
v <- d[i, ]
idx <- abs(v) <= 25 & !(1:ncol(d) %in% res)
if (all(!idx)) {
res <- c(res, NA)
} else {
res <- c(res, which(v == min(v[idx])))
}
}

你会看到

> res
[1]  2  1  4 NA

Answer 3

这里是一个基本的R方式。它设置已经在ok中的列中的每个值以及不小于rng到Inf的每个值。并用which.min求出每行的最小值。

rng <- 25
ok <- rep(NA_integer_, nrow(d))
for(i in seq_len(nrow(d))) {
x <- abs(d[i,])
x[ok] <- Inf
x[x >= rng] <- Inf
if(any(is.finite(x))) ok[i] <- which.min(x)
}
ok
#[1]  1  2  4 NA

Answer 4

这里有一个选项，可以在每次迭代时删除所选列。

d <- matrix(c(10, -20, -30, 20, 30,
10, -15, -30, 20, 30,
10, 40, -30, 20, 30,
10, -20, -30, 20, 40), byrow = TRUE, nrow = 4)
d[abs(d) > 25] <- NA
res <- integer(nrow(d))
# rbind the column index
d <- rbind(1:ncol(d), d)
for (i in 2:nrow(d)) {
idx <- which.min(d[i,])

if (length(idx)) {
res[i - 1L] <- d[1, idx]
d <- d[, -idx]
} else {
res[i - 1L] <- NA
}
}
res
#> [1]  2  1  4 NA