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

时间:2016-06-02 19:35:18

标签: 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

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

    z <- c(0,1,3,5,7)
    matrix(z, ncol=5, nrow=5, byrow = TRUE)

但我不确定如何移动0的位置。我确定我必须使用某种for/in循环,但我真的不知道我到底需要做什么。

7 个答案:

答案 0 :(得分: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

答案 1 :(得分: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

另一种解决方案也是为了享受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

或使用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

答案 2 :(得分:8)

这是一个解决方案,通过对rep()的几次调用,对c()seq()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

另一个想法是,使用两次调用diag()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

基准

注意:对于以下基准测试,我在必要时修改了每个人的解决方案,以确保它们在矩阵大小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);
## 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
## 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
## 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
## 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

答案 3 :(得分: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

答案 4 :(得分:6)

您可以使用

n <- 5
matrix(rbind(0,col(diag(n))*2-1),nrow=n,ncol=n)

答案 5 :(得分: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

答案 6 :(得分:1)

另一个选项,直接构建每一行:

<?php
$text = $article->introtext;
$text = preg_replace('@<div[^>]*class=(["\'])mosimage_caption\\1[^>]*>[^>]*          </div>@', '', $text );
$preserv = "";
  $text = strip_tags($text, /* exclude */ $preserv );
  $text = preg_replace("@<script[^>]*?>.*?</script>@si","",$text);
  $text = preg_replace('/{.+?}/','',$text);
  $text = preg_replace('/(( )|(&nbsp;))+/',' ',$text);
  $text = preg_replace('/&quot;/',' ',$text);
  $text = str_replace(array("\r\n", "\n", "\r"), "", $text);
  $text = str_replace("caption","", $text);
  $shorttext = substr($text,0,300);
  echo '<p>' . $shorttext . '...</p><p><a href="' . JRoute::_(ContentHelperRoute::getArticleRoute($article->slug, $article->catid)) . '">Read more</a></p>';
?>