CODEWITHSUNDEEP
haskelltypeclass
Claudio
Claudio

Reputation: 1706

Type class that depends on another type class

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

Answers (1)

Vladimir Matveev
Vladimir Matveev

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

Related Questions