R函数创建带状矩阵

问题描述

我需要编写两个函数toBand()和replaceBand():

I need to write two functions toBand() and replaceBand():

test3 <- toBand(test1,3)
test4 <- replaceBand(test1, toBand(test2,3))

以获取下面的输出.

第一个使用X的下三角形返回对角元素和对角元素的矩阵.第二个使用提供的带矩阵中的数据替换X中的相应元素.然后该函数返回修改后的X.

The first returns a matrix of the diagonal and co-diagonal elements, using the lower triangle of X. The second replaces the corresponding elements in X from the data in the band matrix supplied. The function then returns the modified X.

我可以使用任何软件包来执行此操作吗?有关如何执行此操作的任何建议?

Are there any packages that I can use to do this? Any suggestions on how to do this?

谢谢

> test1
     [,1]  [,2]  [,3]  [,4]  [,5]  [,6]
[1,] "a11" "a21" "a31" "a41" "a51" "a61"
[2,] "a21" "a22" "a32" "a42" "a52" "a62"
[3,] "a31" "a32" "a33" "a43" "a53" "a63"
[4,] "a41" "a42" "a43" "a44" "a54" "a64"
[5,] "a51" "a52" "a53" "a54" "a55" "a65"
[6,] "a61" "a62" "a63" "a64" "a65" "a66"
> test2
     [,1]    [,2]    [,3]    [,4]    [,5]    [,6]
[1,] "*a11*" "*a21*" "*a31*" "*a41*" "*a51*" "*a61*"
[2,] "*a21*" "*a22*" "*a32*" "*a42*" "*a52*" "*a62*"
[3,] "*a31*" "*a32*" "*a33*" "*a43*" "*a53*" "*a63*"
[4,] "*a41*" "*a42*" "*a43*" "*a44*" "*a54*" "*a64*"
[5,] "*a51*" "*a52*" "*a53*" "*a54*" "*a55*" "*a65*"
[6,] "*a61*" "*a62*" "*a63*" "*a64*" "*a65*" "*a66*"
> test3
     [,1]  [,2]  [,3]  [,4]  [,5]  [,6]
[1,] "a11" "a22" "a33" "a44" "a55" "a66"
[2,] "a21" "a32" "a43" "a54" "a65" NA
[3,] "a31" "a42" "a53" "a64" NA    NA
[4,] "a41" "a52" "a63" NA    NA    NA
> test4
     [,1]    [,2]    [,3]    [,4]    [,5]    [,6]
[1,] "*a11*" "*a21*" "*a31*" "*a41*" "a51"   "a61"
[2,] "*a21*" "*a22*" "*a32*" "*a42*" "*a52*" "a62"
[3,] "*a31*" "*a32*" "*a33*" "*a43*" "*a53*" "*a63*"
[4,] "*a41*" "*a42*" "*a43*" "*a44*" "*a54*" "*a64*"
[5,] "a51"   "*a52*" "*a53*" "*a54*" "*a55*" "*a65*"
[6,] "a61"   "a62"   "*a63*" "*a64*" "*a65*" "*a66*"

推荐答案

如果您不需要使用toBand的输出，则很简单:

This is straightforward if you don't need to use the output from toBand:

replaceBand <- function(a, b, k) {
  swap <- abs(row(a) - col(a)) <= k
  a[swap] <- b[swap]
  a
}

使矩阵演示:

test1 <- matrix(ncol=6, nrow=6)
test1 <- matrix(paste("a", row(test1), col(test1), sep=""), nrow=6)
test1b <- matrix(paste("a", col(test1), row(test1), sep=""), nrow=6)
test1[upper.tri(test1)] <- test1b[upper.tri(test1b)]
test2 <- matrix(paste("*", test1, "*", sep=""), nrow=6)

输出完全符合要求:

> replaceBand(test1, test2, 3)

     [,1]    [,2]    [,3]    [,4]    [,5]    [,6]
[1,] "*a11*" "*a21*" "*a31*" "*a41*" "a51"   "a61"
[2,] "*a21*" "*a22*" "*a32*" "*a42*" "*a52*" "a62"
[3,] "*a31*" "*a32*" "*a33*" "*a43*" "*a53*" "*a63*"
[4,] "*a41*" "*a42*" "*a43*" "*a44*" "*a54*" "*a64*"
[5,] "a51"   "*a52*" "*a53*" "*a54*" "*a55*" "*a65*"
[6,] "a61"   "a62"   "*a63*" "*a64*" "*a65*" "*a66*"

以下是toBand和replaceBand的版本，其功能如上所述.我认为进行算术运算以弄清楚如何精确地填充矩阵会更清洁，但这是一种无需费力思考就可以做到的方法.也许其他人会这样回答.

Here are versions of toBand and replaceBand that work as described. I imagine it would be cleaner to do the arithmetic to figure out exactly how to fill in the matrices, but this is a way to do it without having to think very hard. Perhaps someone else will answer it that way.

toBand <- function(x,k) {
  n <- nrow(x)
  out <- matrix(nrow=n, ncol=n)
  out[row(out) + col(out) - 1 <= n] <- x[lower.tri(x, diag=TRUE)]
  out[1:(k+1),]
}

replaceBand <- function(a, b) {
  b[row(b)+col(b)-1 <= ncol(b)]
  swap <- abs(row(a) - col(a)) <= nrow(b) - 1
  a[swap & lower.tri(a, diag=TRUE)] <- b[row(b)+col(b)-1 <= ncol(b)]
  a[upper.tri(a)] <- t(a)[upper.tri(a)]
  a
}

这篇关于R函数创建带状矩阵的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！