Reputation: 1706
I am writing a generic branch and bound implementation in Haskell. The algorithm explores the branch tree in this way (actually there is no bounding, to keep things simple):
- 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.
What a solution and node are, it depends on the actual problem. How to generate children, whether the node is a leaf, how to extract a solution from a leaf node, it again depends on the actual problem.
I thought of defining two classes Solution
and BBNode
that requires those operations, along with a BBState
type that stores the current solution. I also made a dummy implementation for two types ConcreteSolution
and ConcreteBBNode
(they do not make anything interesting, I just want the program to type 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
However, this program does not type check. I get an error when implementing the function getSolution
in the instance BBNode
:
Could not deduce (solution ~ ConcreteSolution)
from the context (Solution solution)
bound by the type signature for
getSolution :: Solution solution => ConcreteBBNode -> solution
In facts, I'm not even sure this is the right approach, since in BBNode
class the getSolution
function should work for any Solution
type, while I only need it for a single concrete one.
getSolution :: Solution solution => bbnode -> solution
I also tried using multi parameters type classes:
{-# 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.
...
But it still does not type check, at line:
| isLeaf node =
I get the error:
Ambiguous type variable `solution0' in the constraint:
(BBNode bbnode1 solution0) arising from a use of `isLeaf'
Upvotes: 1
Views: 377
Reputation: 128091
It looks like it is a typical problem solved by functional dependencies or associated types.
You're second approach is almost correct. bbnode
and solution
types are connected, i.e. solution
type is uniquely determined by bbnode
type. You use functional dependencies or associated types to encode this relationship in Haskell. Here is FD example:
{-# 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
Note the definition of BBNode
type class. This program typechecks.
Another way to do this is associated types, but I don't remember exactly how to put typeclass boundary on associated types. Maybe someone else will write an example.
Upvotes: 2