1

我正在用 Haskell 编写一个通用的分支和绑定实现。该算法以这种方式探索分支树（实际上没有边界，为了简单起见）：

- Start from an initial node and an initial solution.
- While there are nodes on the stack:
    - Take the node on the top.
    - If it's a leaf, then it contains a solution:
        - If it's better than the best one so far, replace it
    - Otherwise, generate the children node and add them on the top of the stack.
- When the stack is empty, return the best solution found.

解决方案和节点是什么，取决于实际问题。如何生成子节点，节点是否为叶子，如何从叶子节点中提取解，这又取决于实际问题。

我想定义两个类Solution，BBNode这需要这些操作，以及一个BBState存储当前解决方案的类型。ConcreteSolution我还为两种类型做了一个虚拟实现ConcreteBBNode（它们没有任何有趣的东西，我只是想让程序进行类型检查）。

import Data.Function (on)

class Solution solution where
  computeValue :: solution -> Double

class BBNode bbnode where
  generateChildren :: bbnode -> [bbnode]
  getSolution :: Solution solution => bbnode -> solution
  isLeaf :: bbnode -> Bool

data BBState solution = BBState {
      bestValue :: Double
    , bestSolution :: solution
    }

instance Eq (BBState solution) where
  (==) = (==) `on` bestValue

instance Ord (BBState solution) where
  compare = compare `on` bestValue


branchAndBound :: (BBNode bbnode, Solution solution) => solution -> bbnode -> Maybe solution
branchAndBound initialSolution initialNode = do
  let initialState = BBState { bestValue = computeValue initialSolution
                             , bestSolution = initialSolution
                             }
  explore [initialNode] initialState

  where

  explore :: (BBNode bbnode, Solution solution) => [bbnode] -> BBState solution -> Maybe solution
  explore [] state =
    -- Completely explored the tree, return the best solution found.
    Just (bestSolution state)

  explore (node:nodes) state
    | isLeaf node =
      -- New solution generated. If it's better than the current one, replace it.
      let newSolution = getSolution node
          newState = BBState { bestValue = computeValue newSolution
                             , bestSolution = newSolution
                             }
      in explore nodes (min state newState)

    | otherwise =
      -- Generate the children nodes and explore them.
      let childrenNodes = generateChildren node
          newNodes = childrenNodes ++ nodes
      in explore newNodes state





data ConcreteSolution = ConcreteSolution [Int]
                      deriving Show

instance Solution ConcreteSolution where
  computeValue (ConcreteSolution xs) = fromIntegral . maximum $ xs

data ConcreteBBNode = ConcreteBBNode {
      remaining :: [Int]
    , chosen :: [Int]
    }

instance BBNode ConcreteBBNode where
  generateChildren node =
    let makeNext next = ConcreteBBNode {
                chosen = next : chosen node
              , remaining = filter (/= next) (remaining node)
              }
    in map makeNext (remaining node)

  getSolution node = ConcreteSolution (chosen node)
  isLeaf node = null (remaining node)



solve :: Int -> Maybe ConcreteSolution
solve n =
  let initialSolution = ConcreteSolution [0..n]
      initialNode = ConcreteBBNode {
                chosen = []
              , remaining = [0..n]
              }
  in branchAndBound initialSolution initialNode

main :: IO ()
main = do
  let n = 10
      sol = solve n
  print sol

但是，该程序不进行类型检查。getSolution在实例中实现函数时出现错误BBNode：

Could not deduce (solution ~ ConcreteSolution)
  from the context (Solution solution)
    bound by the type signature for
           getSolution :: Solution solution => ConcreteBBNode -> solution

事实上，我什至不确定这是不是正确的方法，因为在BBNode类中该getSolution函数应该适用于任何 Solution类型，而我只需要它用于单个具体的类型。

  getSolution :: Solution solution => bbnode -> solution

我还尝试使用多参数类型类：

{-# LANGUAGE MultiParamTypeClasses #-}

...

class (Solution solution) => BBNode bbnode solution where
  generateChildren :: bbnode -> [bbnode]
  getSolution :: bbnode -> solution
  isLeaf :: bbnode -> Bool

...

branchAndBound :: (BBNode bbnode solution) => solution -> bbnode -> Maybe solution
branchAndBound initialSolution initialNode = do
  let initialState = BBState { bestValue = computeValue initialSolution
                             , bestSolution = initialSolution
                             }
  explore [initialNode] initialState

  where

  explore :: (BBNode bbnode solution) => [bbnode] -> BBState solution -> Maybe solution
  explore [] state =
    -- Completely explored the tree, return the best solution found.
    Just (bestSolution state)

  explore (node:nodes) state
    | isLeaf node =
      -- New solution generated. If it's better than the current one, replace it.
...

但它仍然没有在以下行键入检查：

  | isLeaf node =

我得到错误：

  Ambiguous type variable `solution0' in the constraint:
    (BBNode bbnode1 solution0) arising from a use of `isLeaf'
4

1 回答 1

2

看起来这是一个由功能依赖或关联类型解决的典型问题。

你的第二种方法几乎是正确的。bbnode和solution类型是相连的，即solution类型是由类型唯一确定的bbnode。在 Haskell 中，您使用函数依赖或关联类型来编码这种关系。这是FD示例：

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
module Main where

import Data.Function

class Solution solution where
  computeValue :: solution -> Double

class (Solution solution) => BBNode bbnode solution | bbnode -> solution where
  generateChildren :: bbnode -> [bbnode]
  getSolution :: bbnode -> solution
  isLeaf :: bbnode -> Bool

data BBState solution = BBState {
      bestValue :: Double
    , bestSolution :: solution
    }

instance Eq (BBState solution) where
  (==) = (==) `on` bestValue

instance Ord (BBState solution) where
  compare = compare `on` bestValue

branchAndBound :: (BBNode bbnode solution) => solution -> bbnode -> Maybe solution
branchAndBound initialSolution initialNode = do
  let initialState = BBState { bestValue = computeValue initialSolution
                             , bestSolution = initialSolution
                             }
  explore [initialNode] initialState

  where

  explore :: (BBNode bbnode solution) => [bbnode] -> BBState solution -> Maybe solution
  explore [] state =
    -- Completely explored the tree, return the best solution found.
    Just (bestSolution state)

  explore (node:nodes) state
    | isLeaf node = undefined

注意BBNode类型类的定义。这个程序类型检查。

另一种方法是关联类型，但我不记得如何将类型类边界放在关联类型上。也许其他人会写一个例子。

于 2013-07-03T08:59:30.293 回答