我在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 :: *'。 –