24

In R, I want create a 5x5 matrix of 0,1,3,5,7 such that:

     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

So obviously I can generate the starting matrix:

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

but I'm unsure of how to move the 0's position. I'm sure I have to use some sort of for/in loop, but I really don't know what exactly I need to do.

989
  • 12,579
  • 5
  • 31
  • 53
Paul
  • 289
  • 2
  • 10

7 Answers7

26

How about this:

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
Josh O'Brien
  • 159,210
  • 26
  • 366
  • 455
10

Or we can do:

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

Yet another solution just to enjoy combn as well:

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

Or using 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
989
  • 12,579
  • 5
  • 31
  • 53
8

Here's a solution that builds the data vector with a couple of calls to rep(), a couple of calls to c(), a seq(), and an rbind(), and then wraps it in a call to 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

Another idea, using two calls to diag() and 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

Benchmarking

Note: For the following benchmarking tests I modified everyone's solutions where necessary to ensure they are parameterized on the matrix size N. For the most part, this just involved replacing some literals with N, and replacing instances of c(1,3,5,7) with seq(1,(N-1)*2,2). I think this is fair.

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
bgoldst
  • 34,190
  • 6
  • 38
  • 64
7

Perhaps not the most beautiful solution ever, but maybe elegant in its simplicity:

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
BarkleyBG
  • 664
  • 5
  • 16
  • Wow that's really cool! Thank you, exactly what I was looking for. My only question is what exactly is my_mat[i, -i] doing? – Paul Jun 02 '16 at 19:48
  • @Paul That is a way to use the indexing operations in `R`; it's very helpful or maybe even necessary. The code `my_mat[i,-i]` takes the subset of `my_mat` that is the `i`th row and every column BUT the `ith`. So when `i=2` then `my_mat[i,-i]` is equivalent to `my_mat[2,c(1,3,4,5)]`. . So, I would assign the vector `my_vec` to the entries in that subset. For more information, perhaps see http://adv-r.had.co.nz/Subsetting.html#subsetting or https://cran.r-project.org/doc/manuals/R-intro.html#Index-matrices – BarkleyBG Jun 02 '16 at 20:04
6

You could use

n <- 5
matrix(rbind(0,col(diag(n))*2-1),nrow=n,ncol=n)
Marat Talipov
  • 13,064
  • 5
  • 34
  • 53
6

Fun question! In poking around, I saw that append has a after argument.

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
Gregor Thomas
  • 136,190
  • 20
  • 167
  • 294
1

Another option, directly constructing each row:

v = c(1, 3, 5, 7)
n = length(v)

t(sapply(0:n, function(i) c(v[0:i], 0, v[seq(to = n, length.out = n - i)])))
#     [,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
eddi
  • 49,088
  • 6
  • 104
  • 155