可复制示例

Question

我具有以下功能：

CFC_GLM <- function(data, frequency_bins){
    adj_mat <- matrix(0, nrow = dim(data)[1], ncol = dim(data)[1])
    bf_filters <- list()
    combs <- combinations(length(frequency_bins), 2, repeats.allowed = T)
    all_adj_mat <- list()

for(z in 1:length(frequency_bins)){
bf_filters[[z]] <- butter(3, c(frequency_bins[[z]][1]/1200, 
frequency_bins[[z]][2]/1200), type = "pass")
}

for(f in 1:nrow(combs)){
  for(i in 1:dim(data)[1]){
    for(j in 1:dim(data)[1]){

      sensor_1 <- data[i,]
      sensor_2 <- data[j,]

      sensor_1_filt = filtfilt(bf_filters[[combs[f,1]]], sensor_1)
      sensor_2_filt = filtfilt(bf_filters[[combs[f,2]]], sensor_2)

      a_y <- abs(hilbert(sensor_2_filt, 1200))
      a_x <- abs(hilbert(sensor_1_filt, 1200))
      theta_x <- angle(hilbert(sensor_1_filt, 1200)) %% 2*pi

      a_x_norm <- (a_x - mean(a_x))/std(a_x)
      a_y_norm <- (a_y - mean(a_y))/std(a_y)
      theta_x_norm <- (theta_x - mean(theta_x))/std(theta_x)

      fit <- lm(a_y_norm ~ sin(theta_x_norm) + cos(theta_x_norm) + 
      a_x_norm)
      summ <- summary(fit)
      r <- sqrt(summ$r.squared)

      adj_mat[i,j] <- r
    }
  }
  all_adj_mat[[f]] <- adj_mat
}
return(all_adj_mat)
}

总结一下，该函数采用信号矩阵（246个传感器乘以2400个样本），执行一些信号处理，然后在每对可能的传感器对之间执行GLM。对4个频率带宽及其组合（内部和交叉频率耦合）重复此过程。现在，此代码似乎效率极低，并且运行时间非常长。有没有办法向量化/并行化此功能？我已经对这个问题进行了广泛的研究，似乎找不到答案。

我不确定是将函数内的某些任务并行化还是仅使parApply（矢量化）调用整个函数。我的直觉是后者，但我不确定该如何处理。任何帮助是极大的赞赏。

可复制示例

test_data <- c(-347627.104358097, 821947.421444641, 496824.676355433, 
-178091.364312102, -358842.250713998, 234666.210462063, 
-1274153.04141668, 
1017066.42839987, -158388.137875357, 191691.279588641, 
-16231.2106151229, 
378249.600546794, 1080850.88212858, -688841.640871254, 
-616713.991288002, 
639401.465180969, -1625802.44142751, 472370.867686569, 
-631863.239075449, 
-598755.248911174, 276422.966753179, -44010.9403226763, 
1569374.08537143, 
-1138797.2585617, -824232.849278583, 955783.332556046, 
-1943384.98409094, 
-54443.829280377, -1040354.44654998, -1207674.05255178, 
496481.331429747, 
-417435.356472725, 1886817.1254085, -1477199.59091112, 
-947353.716505171, 
1116336.49812969, -2173805.84111182, -574875.152250742, 
-1343996.2219146, 
-1492260.06197604, 626856.67540728, -713761.48191904, 1987730.27341334, 
-1673384.77863935, -968522.886481198, 1089458.71433614, 
-2274932.19262517, 
-1096749.79392427, -1520842.86946059, -1390794.61065106, 
669864.477272507, 
-906096.822125892, 1863506.59188299, -1720956.06310511, 
-889359.420058576, 
885300.628410276, -2224340.54992297, -1619386.88041896, 
-1570131.07127786, 
-934848.556063722, 644671.113108699, -973418.329437102, 
1541962.53750178, 
-1636863.31666018, -728992.972371437, 551297.997356909, 
-2026413.5471505, 
-2129730.49230266, -1511423.25789691, -236962.889589694, 
580683.399845852, 
-906261.700784793, 1080101.95011954, -1455931.89179814, 
-518630.187846405, 
158846.288141661, -1715610.22092989, -2601349.5081924, 
-1380068.64260811, 
541310.557194977, 509125.333244057, -711696.682554995, 
551748.792106809, 
-1222430.29467688, -293847.487823853, -215078.751157158, 
-1354005.89576504, 
-2997647.23289805, -1220136.14918605, 1231169.98678596, 
455388.081391798, 
-415489.975542684, 32724.7895795912, -980848.930757441, 
-86618.5594163355, 
-506333.915891838, -1022235.58829567, -3279232.01820961, 
-1076344.95091665, 
1696655.88400158), .Dim = c(10L, 10L))

frequency_bins <- list(band1 = c(2,4), band2 = c(4,12), band3 = 
c(12,30), band4 = c(30,100))

system.time(test_result <- CFC_GLM(test_data, frequency_bins))
user  system elapsed 
1.839   0.009   1.849

我不确定如何以可管理的方式包含结果。抱歉，天真。只有10个样本中的10个传感器才能提供可管理的测试集。

Answer 1

马上开始，我建议您预先声明列表的长度。

bf_filters <- rep(list(NA), length(frequency_bins))
all_adj_mat <- rep(list(NA), nrow(combos))

#this is your function to be applied
i_j_fun <- function ( perms ) {
        sensor_1_filt = filtfilt(bf_filters[[combos[f,1]]], data[perms[1],])
        sensor_2_filt = filtfilt(bf_filters[[combos[f,2]]], data[persm[2],])
        a_y <- abs(hilbert(sensor_2_filt, 1200))
        a_x <- abs(hilbert(sensor_1_filt, 1200))
        theta_x <- angle(hilbert(sensor_1_filt, 1200)) %% 2*pi

        a_x_norm <- (a_x - mean(a_x))/std(a_x)
        a_y_norm <- (a_y - mean(a_y))/std(a_y)
        theta_x_norm <- (theta_x - mean(theta_x))/std(theta_x)

        fit <- lm(a_y_norm ~ sin(theta_x_norm) + cos(theta_x_norm) + 
                  a_x_norm)
        summ <- summary(fit)
        r <- sqrt(summ$r.squared)

        return(r)
    }

您的i和j for循环可以变成一个函数，并与apply一起使用。

#perms acts like the for loop 
perms <- permuations(dim(data)[1], 2, seq_len(dim(data)[1]))
for(f in 1:nrow(combs)){
    all_adj_mat[[f]] <- matrix(apply(perms, 1, i_j_fun), 
    nrow = dim(data)[1], ncol = dim(data[2]), byrow = TRUE)
}

应该这样做。

邻接矩阵的矢量化计算

可复制示例

1 个答案: