Я пытаюсь реализовать что-то вроде Алгоритм Кнута X в R.

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

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

  1. Выберите столбец в A и найдите в нем минимальное значение.
  2. Удалить эту строку и этот столбец. Теперь вы остались с Асубом.
  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. Я также рад услышать другие способы решения этой проблемы, если этот алгоритм на самом деле не подходит лучше всего.

1
ErinMcJ 19 Апр 2019 в 17:14

2 ответа

Лучший ответ

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

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)
}
1
ErinMcJ 19 Апр 2019 в 20:02

Вы пропустили настройку 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)
}
1
user2554330 19 Апр 2019 в 19:00