使用 r base function 找到矩阵中每一行的相对最小值，但每个最小值在不同的列

Question

I have a matrix like this

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

I want to find the index of each row min value whose abs value is less equal 25, but each row min value should at different column. I use for loop to do it like this, which is not good enough.

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

the result is this

# > res
# [1]  2  1  4 NA

which means that the index of the first row is 2, whose value is -20. and since the second column is used, although the min value of the second row is still in the second column, it should be the first column value 10, and the index is 1. If it can not find the min value, the index is NA.

Is there vectorizing function that can do this? thanks guys. If there is any English expression problem, please also tell me.

Answer 1

If you want to get the column index with the minimal absolute value for each row, you can do:

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

^{Created on 2021-12-07 by the reprex package (v2.0.1)}

Is this your expected result?

Answer 2

Here is a base R way. It sets each value in the columns already in ok and each value not less than rng to Inf . And uses which.min to find the minima per row.

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 3

You can try for loop like below

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])))
  }
}

and you will see

> res
[1]  2  1  4 NA

Answer 4

Here's an option that removes the chosen column at each iteration.

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