创建一个三角矩阵

14

一定有一种优雅的方式来做到这一点,但我想不出来:

列是从右边开始从1到0的概率

行是从下往上从0到1的概率

这个笨拙的代码能够产生所需的结果(但我想在一个比这个大得多的矩阵上实现):

# Vector entries are rowname - colname, if >= 0
#
rb0 <-  c(NA,NA,NA,NA,NA,NA,NA,NA,NA,NA, 0)
rb1 <-  c(NA,NA,NA,NA,NA,NA,NA,NA,NA, 0,.1)
rb2 <-  c(NA,NA,NA,NA,NA,NA,NA,NA, 0,.1,.2)
rb3 <-  c(NA,NA,NA,NA,NA,NA,NA, 0,.1,.2,.3)
rb4 <-  c(NA,NA,NA,NA,NA,NA, 0,.1,.2,.3,.4)
rb5 <-  c(NA,NA,NA,NA,NA, 0,.1,.2,.3,.4,.5)
rb6 <-  c(NA,NA,NA,NA, 0,.1,.2,.3,.4,.5,.6)
rb7 <-  c(NA,NA,NA, 0,.1,.2,.3,.4,.5,.6,.7)
rb8 <-  c(NA,NA, 0,.1,.2,.3,.4,.5,.6,.7,.8)
rb9 <-  c(NA, 0,.1,.2,.3,.4,.5,.6,.7,.8,.9)
rb10 <- c( 0,.1,.2,.3,.4,.5,.6,.7,.8,.9,1 )
indbias <- rbind(rb0,rb1,rb2,rb3,rb4,rb5,rb6,rb7,rb8,rb9,rb10)
colnames(indbias) <- seq(1,0,by=-.1)
rownames(indbias) <- seq(0,1,by=.1)
indbias

谢谢!

4个回答

19
 mat <- matrix(NA, 10,10)
 mat[row(mat)+col(mat) >=11] <- (row(mat)+col(mat) -11)[row(mat)+col(mat)>=11]/10
 mat
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]   NA   NA   NA   NA   NA   NA   NA   NA   NA   0.0
 [2,]   NA   NA   NA   NA   NA   NA   NA   NA  0.0   0.1
 [3,]   NA   NA   NA   NA   NA   NA   NA  0.0  0.1   0.2
 [4,]   NA   NA   NA   NA   NA   NA  0.0  0.1  0.2   0.3
 [5,]   NA   NA   NA   NA   NA  0.0  0.1  0.2  0.3   0.4
 [6,]   NA   NA   NA   NA  0.0  0.1  0.2  0.3  0.4   0.5
 [7,]   NA   NA   NA  0.0  0.1  0.2  0.3  0.4  0.5   0.6
 [8,]   NA   NA  0.0  0.1  0.2  0.3  0.4  0.5  0.6   0.7
 [9,]   NA  0.0  0.1  0.2  0.3  0.4  0.5  0.6  0.7   0.8
[10,]    0  0.1  0.2  0.3  0.4  0.5  0.6  0.7  0.8   0.9

我认为这种方法比使用plyr要快得多,而且我认为它更容易理解。它基本上为右下角“三角形”中的条目设置了一个测试,然后将该“测试”矩阵的结果除以10。您可以使用以下代码查看测试矩阵:

row(mat)+col(mat) -11

编辑:我认为像sebastian-c所示那样只制作一次矩阵,然后进行单个测试以进行NA设置可能会更快(调用rowcol的次数只有三分之一),但实际上只有三分之一那么快。看起来两个seq调用所花费的时间比额外的:

mat <- round(outer(seq(-0.5, 0.5, 0.1), seq(-0.5, 0.5, 0.1), `+`), 1)
is.na(mat) <- row(mat)+col(mat) <= 11
mat

我找到了另一种基于鲜为人知的embed函数的解决方案:

mat <- embed(seq(-1,1, by=0.1), 11 )[,11:1]
is.na(mat) <- row(mat)+col(mat) <= 11

虽然它比新解决方案快50%,但仍然比原始方案慢。


(+1) 优雅且快速的解决方案。 - chl

10

一个稍微不同的解决方案,与@DWin的风格相似:

创建一个适当的下三角矩阵(我认为四舍五入并非绝对必要,但否则浮点误差会使其看起来很糟):

mat <- round(outer(seq(-0.5, 0.5, 0.1), seq(-0.5, 0.5, 0.1), `+`), 1)
mat

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
 [1,] -1.0 -0.9 -0.8 -0.7 -0.6 -0.5 -0.4 -0.3 -0.2  -0.1   0.0
 [2,] -0.9 -0.8 -0.7 -0.6 -0.5 -0.4 -0.3 -0.2 -0.1   0.0   0.1
 [3,] -0.8 -0.7 -0.6 -0.5 -0.4 -0.3 -0.2 -0.1  0.0   0.1   0.2
 [4,] -0.7 -0.6 -0.5 -0.4 -0.3 -0.2 -0.1  0.0  0.1   0.2   0.3
 [5,] -0.6 -0.5 -0.4 -0.3 -0.2 -0.1  0.0  0.1  0.2   0.3   0.4
 [6,] -0.5 -0.4 -0.3 -0.2 -0.1  0.0  0.1  0.2  0.3   0.4   0.5
 [7,] -0.4 -0.3 -0.2 -0.1  0.0  0.1  0.2  0.3  0.4   0.5   0.6
 [8,] -0.3 -0.2 -0.1  0.0  0.1  0.2  0.3  0.4  0.5   0.6   0.7
 [9,] -0.2 -0.1  0.0  0.1  0.2  0.3  0.4  0.5  0.6   0.7   0.8
[10,] -0.1  0.0  0.1  0.2  0.3  0.4  0.5  0.6  0.7   0.8   0.9
[11,]  0.0  0.1  0.2  0.3  0.4  0.5  0.6  0.7  0.8   0.9   1.0

反转列

mat <- mat[,rev(seq.int(ncol(mat)))]

删除上三角:

mat[upper.tri(mat)] <- NA

重新反转列:

mat <- mat[,rev(seq_len(ncol(mat)))]
mat

      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
 [1,]   NA   NA   NA   NA   NA   NA   NA   NA   NA    NA   0.0
 [2,]   NA   NA   NA   NA   NA   NA   NA   NA   NA   0.0   0.1
 [3,]   NA   NA   NA   NA   NA   NA   NA   NA  0.0   0.1   0.2
 [4,]   NA   NA   NA   NA   NA   NA   NA  0.0  0.1   0.2   0.3
 [5,]   NA   NA   NA   NA   NA   NA  0.0  0.1  0.2   0.3   0.4
 [6,]   NA   NA   NA   NA   NA  0.0  0.1  0.2  0.3   0.4   0.5
 [7,]   NA   NA   NA   NA  0.0  0.1  0.2  0.3  0.4   0.5   0.6
 [8,]   NA   NA   NA  0.0  0.1  0.2  0.3  0.4  0.5   0.6   0.7
 [9,]   NA   NA  0.0  0.1  0.2  0.3  0.4  0.5  0.6   0.7   0.8
[10,]   NA  0.0  0.1  0.2  0.3  0.4  0.5  0.6  0.7   0.8   0.9
[11,]    0  0.1  0.2  0.3  0.4  0.5  0.6  0.7  0.8   0.9   1.0

您可以从那里更改行名称。

编辑:鉴于有这么多解决方案,您可能会对它们进行基准测试。使用microbenchmark

Unit: microseconds
   expr       min         lq     median         uq       max
1 AGS()   682.491   738.9370   838.0955   892.8815  4518.740
2  DW()    23.244    27.1680    31.3930    34.8650    70.937
3 MvG() 15469.664 15920.4820 17352.3215 17827.4380 18989.270
4  SC()   118.629   131.4575   144.1360   157.7190   631.779

@DWin的解决方案似乎是迄今为止速度最快的。


5

一种可能的方法,使用我目前最喜欢的库:

library(plyr)
daply(expand.grid(x=seq(1,0,-.1), y=seq(0,1,.1)),
      .(y, x), with,
      if (x+y >= 1) x+y-1 else NA)

这将产生以下结果:
     x
y      0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9   1
  0   NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 0.0
  0.1 NA  NA  NA  NA  NA  NA  NA  NA  NA 0.0 0.1
  0.2 NA  NA  NA  NA  NA  NA  NA  NA 0.0 0.1 0.2
  0.3 NA  NA  NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3
  0.4 NA  NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4
  0.5 NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5
  0.6 NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6
  0.7 NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7
  0.8 NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8
  0.9 NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
  1    0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0

这个想法是使用expand.grid创建一个包含所有可能单元格值的数据框。你也可以使用merge实现相同的功能。然后,对每个值应用一个函数来计算单元格内容。最后,使用daply将其转换为一个漂亮的矩阵,其中包括名称。
编辑:好的,你希望列按相反顺序标记。 ddply将按升序排序。因此,请尝试以下操作:
daply(expand.grid(x=seq(0,1,.1), y=seq(0,1,.1)),
      .(y, x), with,
      if (y-x >= 0) y-x else NA)[,11:1]

     x
y      1 0.9 0.8 0.7 0.6 0.5 0.4 0.3 0.2 0.1   0
  0   NA  NA  NA  NA  NA  NA  NA  NA  NA  NA 0.0
  0.1 NA  NA  NA  NA  NA  NA  NA  NA  NA 0.0 0.1
  0.2 NA  NA  NA  NA  NA  NA  NA  NA 0.0 0.1 0.2
  0.3 NA  NA  NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3
  0.4 NA  NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4
  0.5 NA  NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5
  0.6 NA  NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6
  0.7 NA  NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7
  0.8 NA  NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8
  0.9 NA 0.0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
  1    0 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0

2
require(matlab)
x=matrix(seq(0,1,.1),1)
X=x[rep(1,c(11)),]
X[upper.tri(X)]=NA
X=t(X)
for(a in 1:11){
  X[1:a,a]=rev(X[1:a,a])
}
X=flipud(X)
colnames(X) <- seq(1,0,by=-.1)
rownames(X) <- seq(0,1,by=.1)

我修复了你的代码格式,但是我还给你点了踩,因为结果看起来与 OP 要求的完全不一样。 :-( - GSee

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接