fork download
copy 
  1. set.seed(123)
  2. X <- matrix(rnorm(500), 5, 100)
  3. alpha <- matrix(NA, 5, 5)
  4. for (i in 1:5) {
  5.   for (j in i:5) {
  6.     alpha[i, j] <- alpha[j, i] <- var(X[i,], X[j,])
  7.   }
  8. }
  9. print(alpha)
  10.  
  11. # 改成一個 apply
  12. library(magrittr) # for the "%>%" pipe
  13. ind <- expand.grid(1:nrow(X), 1:nrow(X))
  14. res <- 
  15.   apply(ind,
  16.       1,
  17.       function(k) {
  18.         var(X[k[1], ], X[k[2], ])
  19.       }) %>%
  20.   matrix(nrow = nrow(X))
  21. print(res)
  22. identical(alpha, res)
  23.  
  24. # 對角與非對角分別做，不重覆算
  25. res1 <- matrix(data = NA_real_, nrow = nrow(X), ncol = nrow(X))
  26. diag(res1) <- apply(X, 1, var)
  27. res1[lower.tri(res1)] <- 
  28.   combn(1:nrow(X), 2) %>%
  29.   apply(2, function(k){
  30.     var(X[k[1], ], X[k[2], ])
  31.   })
  32. res1[upper.tri(res1)] <- res1 %>% t %>% .[upper.tri(.)]
  33. print(res1)
  34.  
  35. identical(alpha, res, res1)
  36.  
Success #stdin #stdout 0.25s 40052KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
            [,1]        [,2]         [,3]        [,4]         [,5]
[1,]  1.16126994 -0.03244024 -0.205993645  0.01021443 -0.027761195
[2,] -0.03244024  0.83010514  0.047276073 -0.13219726  0.015491835
[3,] -0.20599364  0.04727607  0.790555193 -0.13062105  0.003433207
[4,]  0.01021443 -0.13219726 -0.130621048  1.04629443  0.016307109
[5,] -0.02776120  0.01549183  0.003433207  0.01630711  0.906947822
            [,1]        [,2]         [,3]        [,4]         [,5]
[1,]  1.16126994 -0.03244024 -0.205993645  0.01021443 -0.027761195
[2,] -0.03244024  0.83010514  0.047276073 -0.13219726  0.015491835
[3,] -0.20599364  0.04727607  0.790555193 -0.13062105  0.003433207
[4,]  0.01021443 -0.13219726 -0.130621048  1.04629443  0.016307109
[5,] -0.02776120  0.01549183  0.003433207  0.01630711  0.906947822
[1] TRUE
            [,1]        [,2]         [,3]        [,4]         [,5]
[1,]  1.16126994 -0.03244024 -0.205993645  0.01021443 -0.027761195
[2,] -0.03244024  0.83010514  0.047276073 -0.13219726  0.015491835
[3,] -0.20599364  0.04727607  0.790555193 -0.13062105  0.003433207
[4,]  0.01021443 -0.13219726 -0.130621048  1.04629443  0.016307109
[5,] -0.02776120  0.01549183  0.003433207  0.01630711  0.906947822
[1] TRUE
https://ideone.com/zT9qTP
language:
R (R 3.5.2)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!