带有矩阵和向量的 R 循环：更好（更快）的解决方案？

Question

我编写了一些函数来用我从数据集中选择的相关数据点填充一个空矩阵。 该函数有效，但随着数据集大小的增加（完整数据集大约有 100k 行），它变得很慢，因为我使用了很多循环。 如果有人对如何更有效地做到这一点有任何提示，我将不胜感激。我已经实现了table()[] 函数，并尝试了许多其他应用系列之外的东西，但这是我能做的最好的了。

假设数据集如下所示：

data<-structure(c("concentration permitted by column 3", "concentration permitted under the national", 
            "concentration phenomena  nonlinear dynamics", "concentration phosphorus concentrations phosphorus load", 
            "concentration plan in greek language", "concentration plan in political science", 
            "58", "104", "43", "114", "102", "58"), .Dim = c(6L, 2L), .Dimnames = list(
              c("", "", "", "", "", ""), NULL))

假设矩阵如下所示：

mat<-structure(c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), .Dim = c(4L, 
                                                                          4L), .Dimnames = list(c("phosphorus", "interest", "concentration", "phenomena"
                                                                          ), c("phosphorus", "interest", "concentration", "phenomena")))

如果包含在行名+列名中的单词，比如说mat[1,3]，同时出现在data[,1]中，我想将相应的计数从data[,2]保存到mat[1,3]。 换句话说，“磷”和“浓度”一起出现在数据集(data[4,]) 中，计数为“114”data[4,2]。该值应写入mat[1,3].

因此，我想要的是这样的：

      mat
              phosphorus interest concentration phenomena
phosphorus           114        0           114         0
interest               0        0             0         0
concentration        114        0           479        43
phenomena              0        0            43        43

这就是我目前的做法：

data_words<-list()
length(data_words)<-nrow(data)


for (i in 1:nrow(data)){
  data_words[[i]]<-unlist(regmatches(data[i,1],gregexpr("(\\S+)",data[i,1],perl=TRUE)))
}

for(i in 1:nrow(mat)){
  for(j in 1:ncol(mat)){
    for(k in seq_along(data_words)){

      if( sum(table(rownames(mat)[i])[data_words[[k]]],na.rm = T)>0 & 
            sum(table(colnames(mat)[j])[data_words[[k]]],na.rm = T)>0){
        mat[i,j]<-as.numeric(mat[i,j])+as.numeric(data[k,2])
      }
    }
  }
}

Answer 1

y <- sapply(colnames(mat), function(x) grepl(x,data[,1]))
z <- expand.grid(seq_along(colnames(mat)),seq_along(colnames(mat)))
x <- matrix(0,dim(z)[1],length(colnames(mat)))
x[cbind(seq_along(z[,1]),z[,1])] <- 1
x[cbind(seq_along(z[,1]),z[,2])] <- x[cbind(seq_along(z[,1]),z[,2])] + 1 
mat[as.matrix(z)] <- (x %*% t(y) > 1) %*% as.numeric(data[,2])

> mat
              phosphorus interest concentration phenomena
phosphorus           114        0           114         0
interest               0        0             0         0
concentration        114        0           479        43
phenomena              0        0            43        43