2013-07-03 55 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 :: *'。 –