私は 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私は 2 つのクラスを定義することを考えました。これには、現在のソリューションを格納BBNodeする型と共に、これらの操作が必要です。また、2 つの型のBBStateダミー実装も作成しました(それらは何も興味深いものにはなりません。プログラムに型チェックをさせたいだけです)。ConcreteSolutionConcreteBBNode
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
ただし、このプログラムは型チェックを行いません。getSolutionインスタンスに関数を実装するとエラーが発生しますBBNode。
Could not deduce (solution ~ ConcreteSolution)
from the context (Solution solution)
bound by the type signature for
getSolution :: Solution solution => ConcreteBBNode -> solution
実際には、これが正しいアプローチであるかどうかさえわかりません。BBNodeクラスでは、関数はどのgetSolution型でも機能するはずですが、具体的な型が 1 つだけ必要な場合に限られます。 Solution
getSolution :: Solution solution => bbnode -> solution
また、マルチパラメータ型クラスを使用してみました:
{-# 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.
...
しかし、次の行でまだチェックを入力していません。
| isLeaf node =
エラーが発生します：
Ambiguous type variable `solution0' in the constraint:
(BBNode bbnode1 solution0) arising from a use of `isLeaf'