索引R中矩陣的元素

Question

問題很愚蠢，但我想知道我是否遺漏了一些東西。 比方說，有一個包含一些數字的向量k

> k
 [1]  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15

我想將其轉換為矩陣

> m
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    2    3    4    5
[2,]    0    6    7    8    9
[3,]    0    0   10   11   12
[4,]    0    0    0   13   14
[5,]    0    0    0    0   15

我的第一個想法是使用upper.tri()東西，例如m[upper.tri(m, diag = TRUE)] <- k ，但是這不會給出上面的矩陣。

有更聰明的解決方案嗎？ 下面是我的解決方案，但我們只是說我並不為此感到驕傲。

---

rows <- rep(1:5, 5:1)

cols1 <- rle(rows)$lengths


cols <- do.call(c, lapply(1:length(cols1), function(x) x:5))

for(i in 1:length(k)) {
  m[rows[i], cols[i]] <- k[i]
}

Answer 1

這是一個使用lower.tri和t來轉置結果的選項：

k <- 1:15
m <- matrix(0, 5,5)
m[lower.tri(m, diag = TRUE)] <- k
m <- t(m)
m 
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    1    2    3    4    5
#[2,]    0    6    7    8    9
#[3,]    0    0   10   11   12
#[4,]    0    0    0   13   14
#[5,]    0    0    0    0   15

---

微基准

由於與約瑟夫的基准有一些混淆，這是另一個。 我測試了三種尺寸為10 * 10的矩陣的解決方案; 100 * 100; 1000 * 1000; 10000 * 10000。

結果：

顯然，性能在很大程度上取決於矩陣的大小。 對於大型矩陣，Joseph的答案表現最快，而對於較小的矩陣，我的答案最快。 請注意，這不會考慮內存效率。

可重復的基准：

Joseph <- function(k, n) {
  y <- 1L
  t <- rep(0L,n)
  j <- c(y, sapply(1:(n-1L), function(x) y <<- y+(n+1L)-x))
  t(vapply(1:n, function(x) c(rep(0L,x-1L),k[j[x]:(j[x]+n-x)]), t, USE.NAMES = FALSE))
}

Frank <- function(k, n) {
  m = matrix(0L, n, n)
  m[ which(lower.tri(m, diag=TRUE), arr.ind=TRUE)[, 2:1] ] = k
  m
}

docendo <- function(k,n) {
  m <- matrix(0L, n, n)
  m[lower.tri(m, diag = TRUE)] <- k
  t(m)
}

library(microbenchmark)
library(data.table)
library(ggplot2)
n <- c(10L, 100L, 1000L, 10000L)
k <- lapply(n, function(x) seq.int((x^2 + x)/2))

b <- lapply(seq_along(n), function(i) {
  bm <- microbenchmark(Joseph(k[[i]], n[i]), Frank(k[[i]], n[i]), docendo(k[[i]], n[i]), times = 10L)
  bm$n <- n[i]
  bm
})

b1 <- rbindlist(b)

ggplot(b1, aes(expr, time)) +
  geom_violin() +
  facet_wrap(~ n, scales = "free_y") +
  ggtitle("Benchmark for n = c(10L, 100L, 1000L, 10000L)")

檢查結果的相等性：

all.equal(Joseph(k[[1]], n[1]), Frank(k[[1]], n[1]))
#[1] TRUE
all.equal(Joseph(k[[1]], n[1]), docendo(k[[1]], n[1]))
#[1] TRUE

注意：我沒有在比較中包含喬治的方法，因為根據約瑟夫的結果判斷，它似乎要慢得多。 所以在我的基准測試中比較的所有方法都只寫在基礎R中。

Answer 2

@docendodiscimus'答案的一個變體：你可以通過包裝lower.tri來改變行和col索引，而不是轉置你可以改變which 。

n = 5
m = matrix(0, n, n)

m[ which(lower.tri(m, diag=TRUE), arr.ind=TRUE)[, 2:1] ] = seq(sum(seq(n)))


     [,1] [,2] [,3] [,4] [,5]
[1,]    1    2    3    4    5
[2,]    0    6    7    8    9
[3,]    0    0   10   11   12
[4,]    0    0    0   13   14
[5,]    0    0    0    0   15

要了解它的工作原理，請按步驟查看左側：

• lower.tri(m, diag=TRUE)
• which(lower.tri(m, diag=TRUE), arr.ind=TRUE)
• which(lower.tri(m, diag=TRUE), arr.ind=TRUE)[, 2:1]

我想如果矩陣很大，轉置可能會很昂貴，這就是為什么我會考慮這個選項。 注意：Joseph Wood的回答表明我錯了，因為他的基准測試中的轉置方式更快。

---

（感謝@JosephWood :)你可以使用(n^2 - n)/2 + n而不是用sum(seq(n))枚舉和求和。

Answer 3

library(miscTools)
k <- 1:15
triang(k, 5)

Answer 4

這是一個非常快速的基礎R解決方案：

更新

我稍微修改了代碼，所以我只調用一次vapply而不是之前的sapply/vapply組合（我也擺脫了USE.NAMES=FALSE因為它似乎沒有任何區別）。 雖然這有點干凈，但它並沒有在我的機器上顯着改變時間（我重新調整了docendo的基准測試圖，它看起來幾乎相同）。

Triangle1 <- function(k,n) {
    y <- -n
    r <- rep(0L,n)
    t(vapply(1:n, function(x) {y <<- y+n+2L-x; c(rep(0L,x-1L),k[y:(y+n-x)])}, r))
}

以下是一些時間安排：

Triangle2 <- function(k,n) {
    m <- matrix(0, n,n)
    m[lower.tri(m, diag = TRUE)] <- k
    t(m)
}

Triangle3 <- function(k, n) {
    m = matrix(0, n, n)
    m[ which(lower.tri(m, diag=TRUE), arr.ind=TRUE)[, 2:1] ] = k   ## seq(sum(seq(n)))  for benchmarking
    m
}

k2 <- 1:50005000
n2 <- 10^4

system.time(t1 <- Triangle1(k2,n2))
user  system elapsed           ## previously   user  system elapsed
2.29    0.08    2.41           ##              2.37    0.13    2.52

system.time(t2 <- Triangle2(k2,n2))
user  system elapsed 
5.40    0.91    6.30

system.time(t3 <- Triangle3(k2,n2))
user  system elapsed 
7.70    1.03    8.77 

system.time(t4 <- triang(k2,n2))
user  system elapsed 
433.45    0.20  434.88

對我來說有點令人費解的是， Triangle1生成的對象是所有其他解決方案的一半。

object.size(t1)
400000200 bytes

object.size(t2)   ## it's the same for t3 and t4
800000200 bytes

當我做一些檢查時，它只會變得更加混亂。

all(sapply(1:ncol(t1), function(x) all(t1[,x]==t2[,x])))
[1] TRUE

class(t1)
[1] "matrix"
class(t2)
[1] "matrix"

attributes(t1)
$dim
[1] 10000 10000
attributes(t2)
$dim
[1] 10000 10000

## not sure what's going on here
identical(t1,t2)
[1] FALSE

identical(t2,t3)
[1] TRUE

---

正如@Frank在評論中指出的那樣， t1是整數矩陣，而其他是數字。 我應該知道這是最重要的R函數之一從一開始就告訴我這些信息。

str(t1)
int [1:10000, 1:10000] 1 0 0 0 0 0 0 0 0 0 ...
str(t2)
num [1:10000, 1:10000] 1 0 0 0 0 0 0 0 0 0 ...