minTransitions.hs

import Control.Applicative
import qualified Data.Map as Map
import Debug.Trace
import Data.Foldable
import Data.Maybe
import Data.Ord
import Data.List
import Data.List.NonEmpty (nonEmpty)

minTransitions :: 
  Ord state =>
  (state -> [transition]) -> 
  (state -> transition -> state) -> 
  (state -> Bool) -> 
  state ->
  Maybe Int
minTransitions findTransitions applyTransition isFinalState initialState = 
  minTrans Map.empty initialState
  where
    transitionList currentState cache trans = 
      let newState = applyTransition currentState trans in
      let result = fmap (+1) (Map.lookup newState cache <|> minTrans cache newState)
      in (maybe cache (\i -> Map.insert newState i cache) result, result)
    minTrans cache currentState
      | isFinalState currentState = Just 0
      | otherwise = 
        let trans = findTransitions currentState in
        let nextSteps = catMaybes $ snd $ mapAccumL (transitionList currentState) cache $ trans
        in fmap minimum $ nonEmpty $ nextSteps