Automaton.hs

-- GenI surface realiser
-- Copyright (C) 2005 Carlos Areces and Eric Kow
--
-- This program is free software; you can redistribute it and/or
-- modify it under the terms of the GNU General Public License
-- as published by the Free Software Foundation; either version 2
-- of the License, or (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.


-- TODO: I'd love to reuse some other library out there, but Leon P. Smith's
-- Automata library requires us to know before-hand the size of our alphabet,
-- Maybe HaLeX?

-- | This module provides a simple, naive implementation of nondeterministic
--   finite automata (NFA).
--
--   The transition function consists of a 'Map', but there are also accessor
--   function which help you query the automaton without worrying about how
--   it's implemented.
--
--    1.  The states are a list of lists, not just a simple flat list as
--        you might expect.  This allows you to optionally group your
--        states into \"columns\" which is something we use in the
--        GenI polarity automaton optimisation.
--
--    2.  We model the empty an empty transition as the transition on
--        @Nothing@.  All other transitions are @Just@ something.
module NLP.GenI.Automaton
  ( NFA(..),
    finalSt,
    addTrans, lookupTrans,
    automatonPaths, automatonPathSets,
    numStates, numTransitions )
where

import qualified Data.Map as Map
import Data.Maybe (catMaybes)

import NLP.GenI.General (combinations)


-- | Note: you can define the final state either by setting 'isFinalSt'
--   to @Just f@ where @f@ is some function or by putting them in
--   'finalStList'
data NFA st ab = NFA 
  { startSt     :: st
  , isFinalSt   :: Maybe (st -> Bool) -- ^ 'finalSt' will use this if defined
  , finalStList :: [st]   -- ^ can be ignored if 'isFinalSt' is defined
  -- 
  , transitions :: Map.Map st (Map.Map st [Maybe ab])
                -- ^ there can be more than one transition between any two states
                --   and a transition could be the empty symbol
  , states      :: [[st]] -- ^ if you don't care about grouping states into columns
                          --   you can just dump everything in one big list
  }

-- | 'finalSt' returns all the final states of an automaton
finalSt :: NFA st ab -> [st]
finalSt aut =
  case isFinalSt aut of
  Nothing -> finalStList aut
  Just fn -> concatMap (filter fn) (states aut)

-- | 'lookupTrans' @aut st1 ab@ returns the states that @st1@ transitions
--   to via @a@.
lookupTrans :: (Ord ab, Ord st) => NFA st ab -> st -> (Maybe ab) -> [st]
lookupTrans aut st ab = Map.keys $ Map.filter (elem ab) subT
  where subT = Map.findWithDefault Map.empty st (transitions aut) 

addTrans :: (Ord ab, Ord st) =>
            NFA st ab
         -> st        -- ^ from state
         -> Maybe ab  -- ^ transition
         -> st        -- ^ to state
         -> NFA st ab
addTrans aut st1 ab st2 = 
  aut { transitions = Map.insert st1 newSubT oldT }
  where oldT     = transitions aut
        oldSubT  = Map.findWithDefault Map.empty st1 oldT 
        newSubT  = Map.insertWith (++) st2 [ab] oldSubT

-- | Returns all possible paths through an automaton from the
--   start state to any dead-end.
--
--   Each path is represented as a list of labels.
--
--   We assume that the automaton does not have any loops
--   in it.
automatonPaths :: (Ord st, Ord ab) => (NFA st ab) -> [[ab]]
automatonPaths aut = concatMap combinations $ map (filter (not.null)) $ automatonPathSets aut

-- | The set of all bundled paths.  A bundled path is a sequence of
--   states through the automaton from the start state to any dead
--   end.  Any two neighbouring states can have more than one
--   possible transition between them, so the bundles can multiply
--   out to a lot of different possible paths.
--
--   The output is a list of lists of lists:
--
--   * Each item in the outer list is a bundled path through the
--   automaton, i.e. without distinguishing between the possible
--   transitions from any two neighbouring states
--
--   * Each item in the middle list is represents the set of
--   transitions between two given neighbouring states
--
--   * Each item in the inner list represents a transition
--   between two given states
automatonPathSets :: (Ord st, Ord ab) => (NFA st ab) -> [[ [ab] ]]
automatonPathSets aut = helper (startSt aut)
 where
  transFor st = Map.toList `fmap` Map.lookup st (transitions aut)
  -- all the states you can get to from @st@ (and how to get there)
  -- (one item per state)
  helper st = maybe [] (concatMap next) $ transFor st
  next (st2, mtr) =
   case helper st2 of
     []  -> [[labels]]
     res -> map (labels :) res
   where labels = catMaybes mtr

numStates :: NFA st ab ->  Int
numStates = sum . (map length) . states

numTransitions :: NFA st ab ->  Int
numTransitions = sum . (map subTotal) . (Map.elems) . transitions
  where subTotal = sum . (map length) . (Map.elems)