Skip to content

Instantly share code, notes, and snippets.

@bruno-cadorette

bruno-cadorette/minTransitions.hs

Created May 10, 2020 00:08
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save bruno-cadorette/4d911b95aecd0b4cf4c4c6fe37772067 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save bruno-cadorette/4d911b95aecd0b4cf4c4c6fe37772067 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. bruno-cadorette renamed this gist May 10, 2020. 1 changed file with 0 additions and 0 deletions.
    0 minTransitions → minTransitions.hs
    View file
    File renamed without changes.
  2. bruno-cadorette created this gist May 10, 2020.
    30 changes: 30 additions & 0 deletions minTransitions
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,30 @@
    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