Оптимизирующая функция для создания матриц смежности для сетей - PullRequest
0 голосов
/ 23 января 2019

Я пытаюсь провести сетевой анализ в R, рассматривая аминокислотный репертуар отдельных субъектов.

Связь между одной аминокислотой и другой основана на любой паре, у которой расстояние Левенштейна равно 1.

Проблема в том, что функция, которую я создал для вывода матрицы смежности, которую мне нужно было бы использовать для диаграммы сети, чрезвычайно медленная, и я хотел бы получить несколько советов о том, как возможно использовать возможности векторизации Rs для такогооперация или иначе.

Я прочитал много сообщений на форуме относительно того, насколько медленны циклы for в R, однако для целей этого анализа я просто не нашел другого способа сделать это.

Вот фрагментобщедоступного набора данных, аналогично тому, что я анализирую:

structure(list(Gene = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L), .Label = c("TRA", "TRB"), class = "factor"), 
    aminos = c("CASSSSMESGNTIYF", "CASSGPGGGAFF", "CASSDSLVRGYQETQYF", 
    "CASSLVENTEAFF", "CASSLQEWDPNYGYTF", "CASSLVENTEAFF", "CASSQEGGTEQFF", 
    "CASSYLGDIQFNQPQHF", "CASSPRTSGGYQEPQYF", "CASSPRTSGGYQETQYF", 
    "CASQHGPGIGTGELFF", "CASSLPDRAGEKLFF", "CASSSGQGNIQYF", "CASSYSVKGLNTEAFF", 
    "CASSWRQGATNYGYTF", "CASSDDVGRLAYEQYF", "CASSEIGRSTGELFF", 
    "CASSFGRQAYEQYF", "CASSAGQGGEHQPQHF", "CASSRSDREMFNYGYTF", 
    "CASSLFSQGWTEAFF", "CASSLYIQGGEQYF", "CASSFGRQAYEQYF", "CASSLENGQYEQYF", 
    "CASSLDKPPPDTGELFF", "CASNQGTATEAFF", "CASSLLLAGGYQETQYF", 
    "CASSYSVKGLNTEAFF", "CASSFEIAGGNEQFF", "CASSHSAGVFMNTEAFF", 
    "CASSLARQEETQYF", "CSATGGRHTGELFF", "CSATRSSGEPEQFF", "CASSQEVAAGGGDTQYF", 
    "CASSLPDRAGEKLFF", "CASSQEMSTGLGEQYF", "CASSQEGSGAPYEQYF", 
    "CASSQEPGAPNTGELFF", "CASSLTVSLSPDLNEQFF", "CASSQDPLAGYTGELFF", 
    "CASSQEPSGGTNTGELFF", "CASSLETGKWGEQYF", "CASSQEGQGAPYEQYF", 
    "CSAGESTPEAFF", "CASSQEASGGPYEQYF", "CASRETGGVWETQYF", "CASSLEGNGHREQYF", 
    "CASSLEGTSGSPDLNEQFF", "CASSLTVSLSPDLNEQFF", "CASSQDPLAGYTGELFF", 
    "CASSQGGDTEAFF", "CASSDLGQGRMNTEAFF", "CASSQEVGTSGEGEQFF", 
    "CASSQEVGQRLLNTGELFF", "CASSQEQGGWGEQYF", "CAVEDTGGFKTIF", 
    "CAASARGQAGTALIF", "CAMREHTSGTYKYIF", "CAENGGNTPLVF", "CAFMITGAGSYQLTF", 
    "CALSVVNQAGTALIF", "CAETGGFKTIF", "CAFMKLESYMDSNYQLIW", "CALSESANSGGYQKVTF", 
    "CALSESANSGGYQKVTF", "CASFPTTSGTYKYIF", "CAVDLTGAGSYQLTF", 
    "CAVEPNSGYALNF", "CAVEPPDGQKLLF", "CAVEPPSGSRLTF", "CAVERSDGQKLLF", 
    "CAVGAGPSGTYKYIF", "CAVQANTNAGKSTF", "CAVSNFMNSGYSTLTF", 
    "CAYRGFYGGATNKLIF", "CAYRSLALIQGAQKLVF", "CAYRSLDLSGNTPLVF", 
    "CAYRSLDVSRDDKIIF", "CAYRTLEGTYKYIF", "CAYRTTLSGGGADGLTF", 
    "CGRTGFQKLVF", "CILSATTSGTYKYIF", "CIVRVPFLYNQGGKLIF", "CLVANGNNRLAF", 
    "CLVARGGSYIPTF", "CLVASPSGGYNKLIF", "CLVEPPPGNGGFKTIF", "CLVGAPLVF", 
    "CLVGDGRGGSQGNLIF", "CLVGDGYGNNRLAF", "CLVGDLTNYQLIW", "CLVGDSGDRGSTLGRLYF", 
    "CLVGDTSSGSARQLTF", "CLVGEAGGFKTIF", "CLVGEAGGFKTIF", "CLVGEGDNYQLIW", 
    "CLVGEGRGGMDSNYQLIW", "CLVGENNNARLMF", "CLVGETNAGKSTF", "CLVGGNNNDMRF", 
    "CLVGGTGTASKLTF", "CLVGPGGFGNEKLTF", "CLVGVPAGNMLTF", "CLVGVPGSARQLTF", 
    "CLVGVPGSARQLTF", "CLVGVPLGGGGNKLTF", "CLVGVPNDYKLSF", "CLVGVYNQGGKLIF", 
    "CLVNTNAGKSTF", "CLVTGSARQLTF")), class = "data.frame", row.names = c(NA, 
-110L))

Вот функция, которую я создал:

getAdjMat4AAs <- function(x){
  SR1 <- x #assignment to input bcause i started this operation on SR1
  net_SR1 <- stringdistmatrix(SR1$aminos, SR1$aminos) 

  colnames(net_SR1) <- SR1$aminos
  rownames(net_SR1) <- SR1$aminos
  #Must find indexes of those w lev dist == 1 out of this huge matrix. Proceed like this.
  ##down there changed from nrow(SR1) -> nrow(net_SR1)
  idx_loc <- matrix(nrow = 2*nrow(net_SR1), ncol = 2) #dont know exact NROW dim of mat, so chose (2x)
  ii <- 1
  for(i in 1:nrow(net_SR1)){
    for(j in 1:ncol(net_SR1)){
      idx <- which(net_SR1[i,j] == 1)
      if(length(idx) == 0){
        next
      }else{
        #idx_loc[[i]] <- paste(i,j, sep = ",")
        idx_loc[ii,c(1,2)] <- c(i,j) 
        ii <- ii+1
      }
    }  
  }

  idx_loc <- idx_loc[complete.cases(idx_loc),] #remove NAs from surplus nrow assignment matrix

  #Also, use unique(AAs) for this calculation, will use rowsums() or colsums() for making centres?
  AAs_col <- colnames(net_SR1)[idx_loc[,2]]
  AAs_row <- rownames(net_SR1)[idx_loc[,1]]

  AAs_colUnq <- AAs_col %>% unique()
  AAs_rowUnq <- AAs_row %>% unique()

  adjMat_SR1 <- matrix(nrow = length(AAs_colUnq), ncol = length(AAs_colUnq))
  #should have the same order of AAs in rows and col for adjacency matrix.. proceed as such
  colnames(adjMat_SR1) <- AAs_colUnq
  rownames(adjMat_SR1) <- AAs_colUnq

  for(i in 1:nrow(adjMat_SR1)){
    for(j in 1:ncol(adjMat_SR1)){
      if(stringdist(rownames(adjMat_SR1)[i], colnames(adjMat_SR1)[j]) == 1){
        adjMat_SR1[i,j] = 1
      }else{
        adjMat_SR1[i,j] = 0
      }
    }
  }
  return(adjMat_SR1)
}

Если вы запускаете функцию в наборе данных при условии, что онаоднако не будет медленным, как только мы наберем тысячи, оно станет чрезвычайно медленным.

Любые советы по оптимизации этой процедуры или даже по фактическому методу, который я использую для сетевого анализа, будут высоко оценены..

1 Ответ

0 голосов
/ 23 января 2019

Вот кое-что простое, что вы можете сделать, чтобы получить ожидаемую матрицу смежности (вы можете легко обернуть ее в функцию).SR1 - предоставленные вами данные.

# define a Levenshtein distance matrix with all the aminos
levenshtein.dist.mat <- stringdist::stringdistmatrix(unique(SR1$aminos),
                                                     unique(SR1$aminos),
                                                     useNames = "strings") # I think you should add method = "lv", right ?
# in row are the aminos with a Levenshtein distance of 1 to at least one another amino
levenshtein.dist.mat <- levenshtein.dist.mat[rowSums(sapply(as.data.frame(levenshtein.dist.mat), '==', 1)) > 0, ]
# we can filter the relevant columns
levenshtein.dist.mat <- levenshtein.dist.mat[, colnames(levenshtein.dist.mat) %in% rownames(levenshtein.dist.mat)]
# values not equal to 1 do not represent a connection. Let's set them to zero
levenshtein.dist.mat[levenshtein.dist.mat != 1] <- 0
# output
levenshtein.dist.mat
                  CASSPRTSGGYQEPQYF CASSPRTSGGYQETQYF CASSQEGSGAPYEQYF CASSQEGQGAPYEQYF
CASSPRTSGGYQEPQYF                 0                 1                0                0
CASSPRTSGGYQETQYF                 1                 0                0                0
CASSQEGSGAPYEQYF                  0                 0                0                1
CASSQEGQGAPYEQYF                  0                 0                1                0
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...