Тип класса, который зависит от класса другого типа

Question

Я пишу обобщенную ветвь и связанную реализацию в 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 (они ничего не делают интересными, я просто хочу, чтобы программа вводила проверку).

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 должна работать любой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' 

Answer 1

Похоже, что это типичный p Решение проблемы решалось functional dependencies или associated types.

Вы второй подход почти правильный. bbnode и solution, то есть 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.

Другим способом для этого является связанный тип, но я точно не помню, как помещать границу типа на связанные типы. Может быть, кто-то еще напишет пример.