Comparaison binaire par paire - optimisation du code en R

Question

Je possède un fichier qui représente la structure génétique des modèles de bactéries. Chaque ligne représente un modèle. Une ligne est une chaîne binaire de longueur fixe indiquant quels gènes sont présents (1 pour présent et 0 pour absent). Ma tâche est de comparer la séquence génétique de chaque paire de modèles et d'obtenir un score de similarité entre eux afin de calculer une matrice de dissimilarité.

Il y a au total 450 modèles (lignes) dans un fichier et il y a 250 fichiers. J'ai un code fonctionnel mais il prend environ 1,6 heures pour réaliser l'ensemble du processus pour un seul fichier.

#Données d'exemple
Génération : 0
    [0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0]
    [1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1]
    [1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0]
    [0, 1, 1, 0, 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0]
    [0, 1, 0, 1, 1, 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0]
    [1, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0]

Le fonctionnement de mon code :

1. Lit le fichier
2. Convertit la chaîne binaire en un data frame Gene, Modèle_1, Modèle_2, Modèle_3, … Modèle_450
3. Exécute une boucle imbriquée pour effectuer la comparaison par paire (seulement la moitié de la matrice) - Je prends les deux colonnes correspondantes et les additionne, puis compte les positions où la somme est de 2 (ce qui signifie présent dans les deux modèles)
4. Écrit les données dans un fichier
5. Crée ensuite la matrice

Code de comparaison

generationFiles = list.files(pattern = "^Generation.*\\_\\d+.txt$")

start.time = Sys.time()

for(a in 1:length(generationFiles)){

  fname = generationFiles[a]

  geneData = read.table(generationFiles[a], sep = "\n", header = T, stringsAsFactors = F)

  geneCount = str_count(geneData[1,1],"[1|0]")

  geneDF <- data.frame(Gene = paste0("Gene_", c(1:geneCount)), stringsAsFactors = F)

  #convertir la chaîne en data frame
      for(i in 1:nrow(geneData)){

    #supprimer les crochets
    dataRow = substring(geneData[i,1], 2, nchar(geneData[i,1]) - 1)

    #supprimer les espaces blancs
    dataRow = gsub(" ", "", dataRow, fixed = T)

    #diviser la chaîne 
    dataRow = strsplit(dataRow, ",")

    #conversion en numérique
    dataRow = as.numeric(unlist(dataRow))

    colName = paste("M_",i,sep = "")
    geneDF <- cbind(geneDF, dataRow)
    colnames(geneDF)[colnames(geneDF) == 'dataRow'] <- colName

    dataRow <- NULL
  }

  summaryDF <- data.frame(Model1 = character(), Model2 = character(), Common = integer(),
                          Uncommon = integer(), Absent = integer(), stringsAsFactors = F)

  modelNames = paste0("M_",c(1:450))

  secondaryLevel = modelNames

  fileName = paste0("D://BellosData//GC_3//Summary//",substr(fname, 1, nchar(fname) - 4),"_Summary.txt")

  for(x in 1:449){

    secondaryLevel = secondaryLevel[-1]

    for(y in 1:length(secondaryLevel)){

      result = geneDF[modelNames[x]] + geneDF[secondaryLevel[y]]

      summaryDF <- rbind(summaryDF, data.frame(Model1 = modelNames[x],
                                               Model2 = secondaryLevel[y],
                                               Common = sum(result == 2),
                                               Uncommon = sum(result == 1),
                                               Absent = sum(result == 0)))

    }

  }

  write.table(summaryDF, fileName, sep = ",", quote = F, row.names = F)
  geneDF <- NULL
  summaryDF <- NULL
  geneData <-NULL

}

Conversion en matrice

maxNum = max(summaryDF$Common)
  normalizeData = summaryDF[,c(1:3)]
  normalizeData[c('Common')] <- lapply(normalizeData[c('Common')], function(x) 1 - x/maxNum)

  normalizeData[1:2] <- lapply(normalizeData[1:2], factor, levels=unique(unlist(normalizeData[1:2]))) 

  distMatrixN = xtabs(Common~Model1+Model2, data=normalizeData)

  distMatrixN = distMatrixN + t(distMatrixN)

Y a-t-il un moyen de rendre le processus plus rapide ? Existe-t-il une manière plus efficace de réaliser la comparaison ?

Answer 1

Ce code devrait être plus rapide. Les boucles imbriquées sont extrêmement lentes en R. Des opérations comme le rbind une ligne à la fois sont également parmi les pires et les plus lentes idées en programmation R.

Générer 450 lignes avec 20 éléments de 0, 1 sur chaque ligne.

M = do.call(rbind, replicate(450, sample(0:1, 20, replace = T), simplify = F))

Générer une liste des combinaisons (450, 2) nombres de paires de lignes

L = split(v<-t(utils::combn(450, 2)), seq(nrow(v))); rm(v)

Appliquer la fonction de comparaison que vous voulez. Dans ce cas, le nombre de 1 aux mêmes positions pour chaque combinaison de lignes. Si vous souhaitez calculer différentes métriques, écrivez simplement une autre fonction(x) où M[x[1],] est la première ligne et M[x[2],] est la deuxième ligne.

O = lapply(L, function(x) sum(M[x[1],]&M[x[2],]))

Le code prend environ 4 secondes sur un Sandy Bridge 2,6 Ghz assez lent.

Obtenez un data.frame propre avec vos résultats, trois colonnes : ligne 1, ligne 2, métrique entre les deux lignes

data.frame(row1 = sapply(L, `[`, 1),
           row2 = sapply(L, `[`, 2),
           similarity_metric = do.call(rbind, O))

Pour être honnête, je n'ai pas examiné méticuleusement votre code pour reproduire exactement ce que vous faisiez. Si ce n'est pas ce que vous recherchez (ou si cela ne peut pas être modifié pour obtenir ce que vous recherchez), laissez un commentaire.