2013-07-03 47 views
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类型。我还为ConcreteSolutionConcreteBBNode两个类型做了一个虚拟实现(它们没有做任何有趣的事情,我只是想让程序键入check)。

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 

但是,该程序没有进行类型检查。

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

在事实,我甚至不能确定这是正确的做法,因为在BBNodegetSolution功能应该任何Solution工作:在实例BBNode实现功能getSolution,当我得到一个错误类型,而我只需要它为单个具体一个。

{-# 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. 
... 

但它仍然没有类型检查,在线路:

getSolution :: Solution solution => bbnode -> solution 

我还使用多参数类型类试图

| isLeaf node = 

我得到的错误:

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

回答

2

它看起来像一个典型的p由functional dependenciesassociated types解决。

你是第二种方法几乎是正确的。 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类型类的定义。这个程序typechecks。

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

+2

如果第一眼看起来有些奇怪,那么添加一个边界就很容易理解:类D(T a)=> C a其中类型T a :: *'。 –