Блог

Я хочу реализовать что-то вроде алгоритма X Кнута в R.

Проблема: у меня есть n x k матрица A, n> = k, с вещественными значениями, представляющими стоимость. И n, и k в целом будут довольно маленькими (n <10, k<5). Я хочу найти отображение строк на столбцы, которое минимизирует общую стоимость матрицы с учетом ограничения, что ни одна строка не может быть использована дважды.

Я думаю, что это похоже на алгоритм X в том, что разумный подход кажется:

1. Выберите столбец в A и найдите в нем минимальное значение.
2. Удалите эту строку и этот столбец. Теперь у вас остался Asub.
3. Перейдите к шагу 1 и повторите с Asub и выбором нового столбца, пока ncol(Asub) = 1.

Но я не могу понять, как создать рекурсивную структуру данных в R, которая будет хранить результирующее дерево затрат на уровне ячеек. Вот что у меня есть до сих пор, что делает его только на одну ветку, и поэтому не находит оптимального решения.

 # This version of the algorithm always selects the first column. We need to make it 
# traverse all branches.
algorithmX <- function(A) {
  for (c in 1:ncol(A)) {
    r <- which.min(A[,c])
    memory <- data.frame(LP_Number = colnames(A)[c], 
                         Visit_Number = rownames(A)[r], 
                         cost = as.numeric(A[r,c]))
    if (length(colnames(A))>1) {
      Ared <- A[-r, -c, drop=FALSE]
      return( rbind(memory, algorithmX(Ared)) )
    }
    else {
      return(memory)
    }
  }
}

foo <- c(8.95,3.81,1.42,1.86,4.32,7.16,12.86,7.59,5.47,2.12,
         0.52,3.19,13.97,8.79,6.52,3.37,0.91,2.03)
colnames(foo) <- paste0("col",c(1:3))
rownames(foo) <- paste0("row",c(1:6))
algorithmX(foo)
 

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

Вы пропустили настройку foo как матрицы, поэтому вы не можете установить colnames(foo) или rownames(foo) . Предполагая, что это просто опечатка, существует также проблема, из-за которой вы никогда не посещаете ничего, кроме c = 1 , потому что обе ветви внутреннего теста возвращают что-то. Вероятно, вы хотите собрать результаты в цикле, выбрать лучший и вернуть его.

Например,

 algorithmX <- function(A) {
  bestcost <- Inf
  save <- NULL
  for (c in 1:ncol(A)) {
    r <- which.min(A[,c])
    memory <- data.frame(LP_Number = colnames(A)[c], 
                         Visit_Number = rownames(A)[r], 
                         cost = as.numeric(A[r,c]))
    if (length(colnames(A))>1) {
      Ared <- A[-r, -c, drop=FALSE]
      memory <- rbind(memory, algorithmX(Ared)) 
    }
    if (sum(memory$cost) < bestcost) {
      bestcost <- sum(memory$cost)
      save <- memory
    }
  }
  return(save)
}
 

Спасибо пользователю 2554330 выше за некоторые указания о том, как структурировать рекурсивную функцию так, чтобы значения сохранялись. Я изменил их код следующим образом, и теперь он, похоже, работает, улавливая все угловые случаи, которые я определил ранее, что потребовало от меня написания этой функции в первую очередь!

 algorithmX <- function(A) {
  best.match <- data.frame(LP_Number=numeric(), Visit_Number=numeric(), cost=numeric(), total.cost=numeric())
  for (c in 1:ncol(A)) {
    r <- which.min(A[,c])
    memory <- data.frame(LP_Number = colnames(A)[c], 
                         Visit_Number = rownames(A)[r], 
                         cost = as.numeric(A[r,c]),
                         total.cost = as.numeric(NA))
    if (length(colnames(A))>1) {
      Ared <- A[-r, -c, drop=FALSE]
      memory <- rbind(memory, algorithmX(Ared))
    }
    total.cost <- summarize(memory, sum(cost)) %>% unlist() %>% as.numeric()
    memory$total.cost <- total.cost
    if (length(best.match$total.cost)==0 | memory$total.cost[1] < best.match$total.cost[1]) {
      best.match <- memory
    }
  }
  return(best.match)
}