Question

我希望在R中实现类似Knuth's Algorithm X的功能。

问题：我有一个n x k矩阵A，n> = k，其中实值条目表示成本。通常，n和k都将非常小（n <10，k <5）。我想找到行到列的映射，以最大程度地减少矩阵的总成本，但要考虑到任何一行都不能使用两次的约束。

我认为这有点像算法X，因为一种合理的方法似乎是：

在A中选择一列，然后在其中找到最小值。
删除该行和该列。现在您剩下了Asub。
转到步骤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函数中处理递归的基本知识。如果此算法实际上不是最合适的话，我也很高兴听到其他解决此问题的方法。

Answer 1

您错过了将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)
}

Answer 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)
}

在R中实现算法X

2 个答案: