创建一个5x5矩阵,对角线为0

Pau*_*ul 24 r matrix

在R中,我想创建一个这样的5x5矩阵0,1,3,5,7:

     0    1    3    5    7

     1    0    3    5    7

     1    3    0    5    7 

     1    3    5    0    7 

     1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)

所以显然我可以生成起始矩阵:

    z <- c(0,1,3,5,7)
    matrix(z, ncol=5, nrow=5, byrow = TRUE)
Run Code Online (Sandbox Code Playgroud)

但我不确定如何改变其0立场.我确定我必须使用某种for/in循环,但我真的不知道我到底需要做什么.

Jos*_*ien 26

这个怎么样:

m <- 1 - diag(5)
m[m==1] <- rep(c(1,3,5,7), each=5)
m
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    0    1    3    5    7
# [2,]    1    0    3    5    7
# [3,]    1    3    0    5    7
# [4,]    1    3    5    0    7
# [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)


989*_*989 10

或者我们可以这样做:

z <- c(1,3,5,7)
mat <- 1-diag(5)
mat[mat==1] <- z
t(mat)

  # [,1] [,2] [,3] [,4] [,5]
# [1,]    0    1    3    5    7
# [2,]    1    0    3    5    7
# [3,]    1    3    0    5    7
# [4,]    1    3    5    0    7
# [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)

另一种解决方案也是为了享受combn:

r <- integer(5)
t(combn(5, 1, function(v) {r[v]<-0;r[-v]<-z;r}))

   # [,1] [,2] [,3] [,4] [,5]
# [1,]    0    1    3    5    7
# [2,]    1    0    3    5    7
# [3,]    1    3    0    5    7
# [4,]    1    3    5    0    7
# [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)

或使用sapply:

v <- integer(5)
t(sapply(seq(5), function(x) {v[x]<-0;v[-x]<-z;v}))

   # [,1] [,2] [,3] [,4] [,5]
# [1,]    0    1    3    5    7
# [2,]    1    0    3    5    7
# [3,]    1    3    0    5    7
# [4,]    1    3    5    0    7
# [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)


bgo*_*dst 8

这是一个构建数据向量的解决方案,通过几次调用rep(),对a c(),a seq()和a进行几次调用rbind(),然后将其包含在对以下内容的调用中matrix():

N <- 5L;
matrix(rep(c(0,rbind(seq(1,(N-1)*2,2),0)),rep(c(1,N),len=N*2-1)),N);
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    0    1    3    5    7
## [2,]    1    0    3    5    7
## [3,]    1    3    0    5    7
## [4,]    1    3    5    0    7
## [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)

另一个想法,使用两个调用diag()和a cumsum():

N <- 5L;
(1-diag(N))*(cumsum(diag(N)*2)-1);
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    0    1    3    5    7
## [2,]    1    0    3    5    7
## [3,]    1    3    0    5    7
## [4,]    1    3    5    0    7
## [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)

标杆

注意:对于以下基准测试,我在必要时修改了每个人的解决方案,以确保它们在矩阵大小上进行参数化N.在大多数情况下,这只是涉及更换一些文字N,和更换的情况下,c(1,3,5,7)seq(1,(N-1)*2,2).我认为这是公平的.

library(microbenchmark);

josh <- function(N) { m <- 1-diag(N); m[m==1] <- rep(seq(1,(N-1)*2,2),each=N); m; };
marat <- function(N) matrix(rbind(0,col(diag(N))*2-1),nrow=N,ncol=N);
gregor <- function(N) { x = seq(1,(N-1)*2,2); t(mapply(FUN = append, after = c(0, seq_along(x)), MoreArgs = list(x = x, values = 0))); };
barkley <- function(N) { my_vec <- seq(1,(N-1)*2,2); my_val <- 0; my_mat <- matrix(NA, ncol = length(my_vec)+1, nrow = length(my_vec)+1); for (i in 1:nrow(my_mat)) { my_mat[i, i] <- my_val; my_mat[i, -i] <- my_vec; }; my_mat; };
m0h3n <- function(N) { z <- seq(1,(N-1)*2,2); mat=1-diag(N); mat[mat==1]=z; t(mat); };
bgoldst1 <- function(N) matrix(rep(c(0,rbind(seq(1,(N-1)*2,2),0)),rep(c(1,N),len=N*2-1)),N);
bgoldst2 <- function(N) (1-diag(N))*(cumsum(diag(N)*2)-1);
Run Code Online (Sandbox Code Playgroud)
## small-scale: 5x5
N <- 5L;
ex <- josh(N);
identical(ex,marat(N));
## [1] TRUE
identical(ex,gregor(N));
## [1] TRUE
identical(ex,barkley(N));
## [1] TRUE
identical(ex,m0h3n(N));
## [1] TRUE
identical(ex,bgoldst1(N));
## [1] TRUE
identical(ex,bgoldst2(N));
## [1] TRUE

microbenchmark(josh(N),marat(N),gregor(N),barkley(N),m0h3n(N),bgoldst1(N),bgoldst2(N));
## Unit: microseconds
##         expr    min      lq     mean  median      uq     max neval
##      josh(N) 20.101 21.8110 25.71966 23.0935 24.8045 108.197   100
##     marat(N)  5.987  8.1260  9.01131  8.5535  8.9820  24.805   100
##    gregor(N) 49.608 51.9605 57.61397 53.8850 61.7965  98.361   100
##   barkley(N) 29.081 32.0750 36.33830 33.7855 41.9110  54.740   100
##     m0h3n(N) 22.666 24.8040 28.45663 26.0870 28.4400  59.445   100
##  bgoldst1(N) 20.528 23.0940 25.49303 23.5220 24.8050  56.879   100
##  bgoldst2(N)  3.849  5.1320  5.73551  5.5600  5.9880  16.251   100
Run Code Online (Sandbox Code Playgroud)
## medium-scale: 50x50
N <- 50L;
ex <- josh(N);
identical(ex,marat(N));
## [1] TRUE
identical(ex,gregor(N));
## [1] TRUE
identical(ex,barkley(N));
## [1] TRUE
identical(ex,m0h3n(N));
## [1] TRUE
identical(ex,bgoldst1(N));
## [1] TRUE
identical(ex,bgoldst2(N));
## [1] TRUE

microbenchmark(josh(N),marat(N),gregor(N),barkley(N),m0h3n(N),bgoldst1(N),bgoldst2(N));
## Unit: microseconds
##         expr     min       lq      mean   median       uq      max neval
##      josh(N) 106.913 110.7630 115.68488 113.1145 116.1080  179.187   100
##     marat(N)  62.866  65.4310  78.96237  66.7140  67.9980 1163.215   100
##    gregor(N) 195.438 205.2735 233.66129 213.6130 227.9395 1307.334   100
##   barkley(N) 184.746 194.5825 227.43905 198.6455 207.1980 1502.771   100
##     m0h3n(N)  73.557  76.1230  92.48893  78.6885  81.6820 1176.045   100
##  bgoldst1(N)  51.318  54.3125  95.76484  56.4500  60.0855 1732.421   100
##  bgoldst2(N)  18.817  21.8110  45.01952  22.6670  23.5220 1118.739   100
Run Code Online (Sandbox Code Playgroud)
## large-scale: 1000x1000
N <- 1e3L;
ex <- josh(N);
identical(ex,marat(N));
## [1] TRUE
identical(ex,gregor(N));
## [1] TRUE
identical(ex,barkley(N));
## [1] TRUE
identical(ex,m0h3n(N));
## [1] TRUE
identical(ex,bgoldst1(N));
## [1] TRUE
identical(ex,bgoldst2(N));
## [1] TRUE

microbenchmark(josh(N),marat(N),gregor(N),barkley(N),m0h3n(N),bgoldst1(N),bgoldst2(N));
## Unit: milliseconds
##         expr      min       lq     mean   median       uq      max neval
##      josh(N) 40.32035 43.42810 54.46468 45.36386 80.17241 90.69608   100
##     marat(N) 41.00074 45.34248 54.74335 47.00904 50.74608 93.85429   100
##    gregor(N) 33.65923 37.82393 50.50060 40.24914 75.09810 83.27246   100
##   barkley(N) 31.02233 35.42223 43.08745 36.85615 39.81999 85.28585   100
##     m0h3n(N) 27.08622 31.00202 38.98395 32.33244 34.33856 90.82652   100
##  bgoldst1(N) 12.53962 13.02672 18.31603 14.92314 16.96433 59.87945   100
##  bgoldst2(N) 13.23926 16.87965 28.81906 18.92319 54.60009 62.01258   100
Run Code Online (Sandbox Code Playgroud)
## very large scale: 10,000x10,000
N <- 1e4L;
ex <- josh(N);
identical(ex,marat(N));
## [1] TRUE
identical(ex,gregor(N));
## [1] TRUE
identical(ex,barkley(N));
## [1] TRUE
identical(ex,m0h3n(N));
## [1] TRUE
identical(ex,bgoldst1(N));
## [1] TRUE
identical(ex,bgoldst2(N));
## [1] TRUE

microbenchmark(josh(N),marat(N),gregor(N),barkley(N),m0h3n(N),bgoldst1(N),bgoldst2(N));
## Unit: seconds
##         expr      min       lq     mean   median       uq      max neval
##      josh(N) 3.698714 3.908910 4.067409 4.046770 4.191938 4.608312   100
##     marat(N) 6.440882 6.977273 7.272962 7.223293 7.493600 8.471888   100
##    gregor(N) 3.546885 3.850812 4.032477 4.022563 4.221085 4.651799   100
##   barkley(N) 2.955906 3.162409 3.324033 3.279032 3.446875 4.444848   100
##     m0h3n(N) 3.355968 3.667484 3.829618 3.777151 3.973279 4.649226   100
##  bgoldst1(N) 1.044510 1.260041 1.363827 1.369945 1.441194 1.819248   100
##  bgoldst2(N) 1.144168 1.391711 1.517189 1.519653 1.629994 2.478636   100
Run Code Online (Sandbox Code Playgroud)


小智 7

也许不是有史以来最美丽的解决方案,但其简洁性可能优雅:

my_vec <- c(1,3,5,7)
my_val <- 0
my_mat <- matrix(NA, ncol = length(my_vec)+1, nrow = length(my_vec)+1)
for (i in 1:nrow(my_mat)) {
  my_mat[i, i] <- my_val
  my_mat[i, -i] <- my_vec
}

my_mat
     [,1] [,2] [,3] [,4] [,5]
[1,]    0    1    3    5    7
[2,]    1    0    3    5    7
[3,]    1    3    0    5    7
[4,]    1    3    5    0    7
[5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)


Mar*_*pov 6

你可以用

n <- 5
matrix(rbind(0,col(diag(n))*2-1),nrow=n,ncol=n)
Run Code Online (Sandbox Code Playgroud)


Gre*_*gor 6

有趣的问题!在四处寻找,我看到append有一个after争论.

x = c(1, 3, 5, 7)
t(mapply(FUN = append, after = c(0, seq_along(x)),
         MoreArgs = list(x = x, values = 0)))
#      [,1] [,2] [,3] [,4] [,5]
# [1,]    0    1    3    5    7
# [2,]    1    0    3    5    7
# [3,]    1    3    0    5    7
# [4,]    1    3    5    0    7
# [5,]    1    3    5    7    0
Run Code Online (Sandbox Code Playgroud)