我在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
兩個類型做了一個虛擬實現(它們沒有做任何有趣的事情,我只是想讓程序鍵入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
在事實,我甚至不能確定這是正確的做法,因爲在BBNode
類getSolution
功能應該任何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'
如果第一眼看起來有些奇怪,那麼添加一個邊界就很容易理解:類D(T a)=> C a其中類型T a :: *'。 –