Парное двоичное сравнение - оптимизирующий код в R

Question

У меня есть файл, который представляет генную структуру моделей бактерий. Каждый ряд представляет модель. Строка - это двоичная строка фиксированной длины, в которой присутствуют гены (1 для настоящего и 0 для отсутствующего). Моя задача состоит в том, чтобы сравнить последовательность генов для каждой пары моделей и получить оценку того, насколько они похожи, и вычислить матрицу различий.

Всего в одном файле 450 моделей (рядов) и 250 файлов. У меня есть рабочий код, однако для всего одного файла требуется примерно 1,6 часа.

#Sample Data    
Generation: 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]

Что делает мой код:

1. Читает файл
2. Преобразовать двоичную строку во фрейм данных Gene, Model_1, Model_2, Model_3, … Model_450
3. Запустите вложенный цикл for для парного сравнения (только верхняя половина матрицы) - я беру два соответствующих столбца и добавляю их, затем подсчитываю позиции, где сумма равна 2 (имеется в виду в обеих моделях)
4. Запишите данные в файл
5. Создайте матрицу позже

код сравнения

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)

  #convert the string into a data frame
      for(i in 1:nrow(geneData)){

    #remove the square brackets
    dataRow = substring(geneData[i,1], 2, nchar(geneData[i,1]) - 1)

    #removing white spaces
    dataRow = gsub(" ", "", dataRow, fixed = T)

    #splitting the string 
    dataRow = strsplit(dataRow, ",")

    #converting to numeric
    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

}

преобразование в матрицу

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)

Есть ли способ ускорить процесс? Есть ли более эффективный способ сделать сравнение?

Answer 1

Этот код должен быть быстрее. Вложенные циклы медленны в кошмарах в R. Операции типа rbind-ing одна строка за раз также является одной из худших и медленных идей в программировании на R.

Создайте 450 строк с 20 элементами по 0, 1 на каждый ряд.

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

Создать список комбинаций (450, 2) номеров пар строк

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

Примените любую функцию сравнения, которую вы хотите. В этом случае количество единиц в одной позиции для каждой комбинации строк. Если вы хотите рассчитать разные метрики, просто напишите другую функцию (x) где M[x[1],] это первый ряд и M[x[2],] это второй ряд.

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

Код занимает ~4 секунды довольно медленного 2,6 ГГц песчаного моста

Получите чистый data.frame со своими результатами, три столбца: строка 1, строка 2, метрика между двумя строками

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

Если честно, я не тщательно прочесывал ваш код, чтобы точно воспроизвести то, что вы делали. Если это не то, что вы ищете (или не можете быть изменены для достижения того, что вы ищете), оставьте комментарий.