Question

我想编写一个输入为方矩阵的函数，它返回一个方矩阵，其从右上角到左下角的数字被保留，其他数字为零。

例如假设A在下面是4 * 4矩阵。（对不起，我不知道如何键入矩阵表达式）

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

如何在R中编写没有循环的矩阵来转换为函数？

[0,0,0,4]
[0,0,7,0]
[0,10,0,0]
[13,0,0,0]

Answer 1

这感觉像是体操...

xy <- matrix(1:16, ncol = 4, byrow = TRUE)

xy <- apply(xy, MARGIN = 1, rev)

xy[lower.tri(xy)] <- 0
xy[upper.tri(xy)] <- 0

t(apply(xy, MARGIN = 1, rev))

     [,1] [,2] [,3] [,4]
[1,]    0    0    0    4
[2,]    0    0    7    0
[3,]    0   10    0    0
[4,]   13    0    0    0

Answer 2

这是另一种选择。

mat <- matrix(1:16, 4, byrow = TRUE)

idx <- cbind(seq_len(nrow(mat)),
             ncol(mat):1)
values <- mat[idx]

mat <- matrix(0, nrow = dim(mat)[1], ncol = dim(mat)[2])
mat[idx] <- values
mat
#     [,1] [,2] [,3] [,4]
#[1,]    0    0    0    4
#[2,]    0    0    7    0
#[3,]    0   10    0    0
#[4,]   13    0    0    0

Answer 3

一种不适用的解决方案，使用一些数学方法来生成从@Roman窃取xy的索引

xy <- matrix(1:16, ncol = 4, byrow = TRUE)

ind <- nrow(xy)
xy[setdiff(1:length(xy), seq(ind, by = ind -1, length.out = ind))] <- 0

xy
#     [,1] [,2] [,3] [,4]
#[1,]    0    0    0    4
#[2,]    0    0    7    0
#[3,]    0   10    0    0
#[4,]   13    0    0    0

在5 X 5矩阵上尝试

xy <- matrix(1:25, 5, byrow = TRUE)

ind <- nrow(xy)
xy[setdiff(1:length(xy), seq(ind, by = ind -1, length.out = ind))] <- 0

xy
#     [,1] [,2] [,3] [,4] [,5]
#[1,]    0    0    0    0    5
#[2,]    0    0    0    9    0
#[3,]    0    0   13    0    0
#[4,]    0   17    0    0    0
#[5,]   21    0    0    0    0

Answer 4

此答案采用的方法与其他答案略有不同。除了尝试将对角线以外的所有内容都归零，我们可以自己构建对角线：

m <- matrix(rep(0,16), nrow = 4, byrow = TRUE)
for (i in 0:15) {
    row <- floor(i / 4)
    col <- i %% 4
    if (i == 3 + (row*3)) {
        m[row+1, col+1] <- i+1
    }
}

m

     [,1] [,2] [,3] [,4]
[1,]    0    0    0    4
[2,]    0    0    7    0
[3,]    0   10    0    0
[4,]   13    0    0    0

Answer 5

apply家族真的只是领结而已。

这是不使用apply的一种方法。经过一些输入检查，并且可以在任何大小的矩阵上工作。

off_diag = function(X)
{
    if(!is.matrix(X)) stop('Argument is not a matrix')
    n <- nrow(X)
    if(ncol(X) != n) stop('Matrix is not square')
    if(n<2) return(X)
    Y <- X * c(0,rep(rep(c(0,1),c(n-2,1)),n),rep(0,n-1))
    return(Y)
}

现在它可以处理数字向量，字符向量和NA。

mat <-  matrix(1:16, 4, byrow = TRUE)

off_diag(mat)

#      [,1] [,2] [,3] [,4]
# [1,]    0    0    0    4
# [2,]    0    0    7    0
# [3,]    0   10    0    0
# [4,]   13    0    0    0

编辑：改进

我意识到，由于NA为NA*0，因此如果存在NA，则我的函数将失败，此外，它将对字符不起作用，但不会检查矩阵的模式是否为数字。所以我改为使用相同的设置来制作逻辑向量

minor_diag = function(X)
{
    if(!is.matrix(X)) stop('Argument is not a matrix')
    n <- nrow(X)
    if(ncol(X) != n) stop('Matrix is not square')
    if(n<2) return(X)
    index = c(TRUE,rep(rep(c(TRUE,FALSE),c(n-2,1)),n),rep(TRUE,n-1))
    X[index]=0
    return(X)
}

mat <-  matrix(letters[1:16], 4, byrow = TRUE)
minor_diag(mat)
##      [,1] [,2] [,3] [,4]
## [1,] "0"  "0"  "0"  "d" 
## [2,] "0"  "0"  "g"  "0" 
## [3,] "0"  "j"  "0"  "0" 
## [4,] "m"  "0"  "0"  "0" 

minor_diag(matrix(NA,2,2))
##      [,1] [,2]
## [1,]    0   NA
## [2,]   NA    0

Answer 6

我只是想了一种从diag R反转原始base函数的方法。

您只需在控制台中输入diag即可看到它。

这是我在diag_reverse中所做的突出显示的更改：

y <- x[((m - 1L):0L * (dim(x)[1L])) + (1L:m)] # m is min(dim(x))

这是完整的功能（除一行外，我保留了所有代码）：

diag_reverse <- function (x = 1, nrow, ncol, names = TRUE) 
{
  if (is.matrix(x)) {
    if (nargs() > 1L && (nargs() > 2L || any(names(match.call()) %in% 
                                             c("nrow", "ncol")))) 
      stop("'nrow' or 'ncol' cannot be specified when 'x' is a matrix")
    if ((m <- min(dim(x))) == 0L) 
      return(vector(typeof(x), 0L))
    y <- x[((m - 1L):0L * (dim(x)[1L])) + (1L:m)] # HERE I made the change 
    if (names) {
      nms <- dimnames(x)
      if (is.list(nms) && !any(vapply(nms, is.null, NA)) && 
          identical((nm <- nms[[1L]][seq_len(m)]), nms[[2L]][seq_len(m)])) 
        names(y) <- nm
    }
    return(y)
  }
  if (is.array(x) && length(dim(x)) != 1L) 
    stop("'x' is an array, but not one-dimensional.")
  if (missing(x)) 
    n <- nrow
  else if (length(x) == 1L && nargs() == 1L) {
    n <- as.integer(x)
    x <- 1
  }
  else n <- length(x)
  if (!missing(nrow)) 
    n <- nrow
  if (missing(ncol)) 
    ncol <- n
  .Internal(diag(x, n, ncol))
}

然后我们可以称之为：

m <- matrix(1:16,nrow=4,ncol=4,byrow = T)

diag_reverse(m)
#[1]  4  7 10 13

我将在其他矩阵上对其进行测试，以查看它是否始终为提供正确的答案。

如何编写函数以在R中从右上到左下创建对角矩阵？

6 个答案:

编辑：改进