Создание матрицы 5x5 с 0 выровненный по диагонали

Question

В 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, но я действительно не знаю, что именно мне нужно делать.

Answer 1

Как об этом:

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 

Answer 2

Возможно, не самое красивое решение когда-либо, но, может быть, элегантный в своей простоте:

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 

Answer 3

Вы можете использовать

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

Answer 4

Fun вопрос! В сутулясь, я увидел, что 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 

Answer 5

Или мы можем сделать:

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 

Answer 6

Вот решение который строит вектор данных с парой вызовов 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 

---

Benchma rking

Примечание: Для следующих тестов бенчмаркинга я при необходимости изменил все решения, чтобы обеспечить их параметризацию по размеру матрицы 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 

Answer 7

Другой вариант, непосредственно строительство каждая строка:

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