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.

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

我想定义两个类SolutionBBNode这需要这些操作,以及一个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

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

你的第二种方法几乎是正确的。bbnodesolution类型是相连的,即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 回答