【问题标题】:applying cross product (kronecker) many times多次应用叉积(kronecker)
【发布时间】:2018-04-28 19:34:27
【问题描述】:

假设我有一个长度为D 的列表list0,其中每个元素都是一个矩阵N x T

我正在尝试创建一个 Kronecker 产品,逐行执行以下操作。

for(i in 1:N){

    dummy[,i] <-  list0[[D]][i,] %x% ...( (list0[[2]][i,] %x% list0[[1]][i,]))

            }

有谁知道应用此功能的最聪明的方法?下面是我手动输入的示例,但我想要任意 D。

    set.seed(1)
    N = 2
    T = 3
    D = 4
    dummy = matrix(0,(T)^D,N)

    list0 = list()

    for(d in 1:D) {

        list0[[d]] <- matrix(rnorm(N*T,0,1),N,T)

            }

for(i in 1:N){

        dummy[,i] <-  list0[[4]][i,] %x% (list0[[3]][i,] %x% (list0[[2]][i,] %x% list0[[1]][i,]))

                }



   head(dummy)
            [,1]       [,2]
[1,]  0.15578313 -0.1783412
[2,]  0.20779959 -1.5492222
[3,] -0.08194020  0.7967800
[4,]  0.18402067  0.0737661
[5,]  0.24546573  0.6407946
[6,] -0.09679284 -0.3295669

【问题讨论】:

  • 编辑:我的简单解决方案是将每个 kronecker 存储在一个单独的列表中,然后在 D>2 之后对其进行迭代,然后将其插入最终矩阵。不过可能有更聪明的解决方案。

标签: r list function apply cross-product


【解决方案1】:

lapply 给出第 i 行矩阵的列表,Reduce 将它们组合在一起。 sapply 然后将其组装成最终矩阵。

N <- nrow(list0[[1]])
sapply(1:N, function(i) Reduce("%x%", init = 1, lapply(rev(list0), "[", i, TRUE)))

【讨论】:

    【解决方案2】:

    看起来一个数组可以帮助你:

    set.seed(1)
    arr0 <- array(rnorm(N*T*D, 0, 1), c(N, T, D))
    
    result <- apply(arr0, 1, function (slice) {
      xx <- slice[, 1]
      for (i in seq_len(D)[-1]) xx <- xx %x% slice[, i]
      xx
    })
    

    输出:

    > head(result)
                [,1]         [,2]
    [1,]  0.15578313 -0.178341215
    [2,]  0.17432718 -0.234865849
    [3,]  0.01414475  0.597377689
    [4,] -0.28208921 -0.003618330
    [5,] -0.31566842 -0.004765147
    [6,] -0.02561305  0.012120078
    

    【讨论】:

      【解决方案3】:

      这是使用sapply()的解决方案:

      library(microbenchmark)
      
      microbenchmark(
      loop={
          dummy <- matrix(0, (T)^D, N)
          for(i in 1:N){
              dummy[, i] <-  list0[[4]][i, ] %x% (list0[[3]][i, ] %x% 
                                  (list0[[2]][i, ] %x% list0[[1]][i, ]))
          }
      },
      sapply={
          dummy2 <- sapply(1:N, function(i) list0[[4]][i,] %x% (list0[[3]][i,] %x% 
                                  (list0[[2]][i,] %x% list0[[1]][i,])))
          }
      )
      
      Unit: microseconds
         expr      min        lq      mean   median       uq      max neval cld
         loop 5014.211 5190.6955 5578.7469 5320.988 5505.053 9268.179   100   b
       sapply  199.230  212.0995  278.1589  229.025  244.364 4927.115   100  a 
      
      all.equal(dummy, dummy2)
      
      [1] TRUE
      

      我很惊讶循环速度这么慢。

      【讨论】:

      • 如果 D > 4 是否可以缩放?
      猜你喜欢
      • 2014-11-01
      • 2022-01-21
      • 2012-10-26
      • 2018-06-11
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2013-11-15
      相关资源
      最近更新 更多