\begin{comment}
\begin{code}
{-# LANGUAGE ScopedTypeVariables
  #-}

{-|
Description: Deterministic finite state transducers
-}
module Control.DFST
  ( DFST(..)
  , runDFST, runDFST'
  , toFST
  , dotDFST
  ) where

import Data.Map.Lazy (Map, (!?), (!))
import qualified Data.Map.Lazy as Map

import Data.Set (Set)
import qualified Data.Set as Set

import Data.Sequence (Seq(..))
import qualified Data.Sequence as Seq

import Data.Bool (bool)

import Data.Monoid

import Numeric.Natural

import Control.Monad
import Control.Monad.State

import Control.FST (FST(FST))
import qualified Control.FST as FST

import Text.Dot
\end{code}
\end{comment}

\begin{defn}[deterministic finite state transducer]
  Wir nennen einen FST \emph{deterministic}, wenn jedes Paar aus Ausgabezustand und Eingabesymbol maximal eine Transition zulässt, $\epsilon$-Transitionen keine Schleifen bilden und die Menge von initialen Zustände einelementig ist.

  Zusätzlich ändern wir die Darstellung indem wir $\epsilon$-Transitionen kontrahieren.
  Wir erweitern hierfür die Ausgabe pro Transition von einem einzelnen Zeichen zu einem Wort beliebiger Länge und fügen, bei jeder Kontraktion einer $\epsilon$-Transition $A \rightarrow B$, die Ausgabe der Transition vorne an die Ausgabe aller Transitionen $B \rightarrow \ast$ von $B$ an.
\end{defn}

\begin{rem}
  Die FSTs aus den bisherigen Beispielen \ref{eg:linebreak}, \ref{eg:w100}, \ref{eg:l80timesw100} sind deterministisch.
\end{rem}
  
\begin{code}
data DFST state input output = DFST
  { stInitial :: state
  , stTransition :: Map (state, input) (state, Seq output)
  , stAccept :: Set state
  }
\end{code}

Die in der Definition von DFSTs beschriebene Umwandlung lässt sich umkehren, sich also jeder DFST auch als FST auffassen.

Hierfür trennen wir Transitionen $A \overset{(\sigma, \delta^\ast)}{\rightarrow} B$ mit Eingabe $\sigma$ und Ausgabe-Wort $\delta^\ast = \delta_1 \delta_2 \ldots \delta_n$ in eine Serie von Transitionen $A \overset{(\sigma, \delta_1)}{\rightarrow} A_1 \overset{(\epsilon, \delta_2)}{\rightarrow} \ldots \overset{(\epsilon, \delta_n)}{\rightarrow} B$ auf.

\begin{code}
toFST :: forall state input output. (Ord state, Ord input, Ord output) => DFST state input output -> FST (state, Maybe (input, Natural)) input output
-- ^ View a DFST as a FST splitting apart non-singleton outputs into a series of epsilon-transitions
\end{code}
\begin{comment}
\begin{code}
toFST DFST{..} = flip execState initialFST $ forM_ (Map.toList stTransition) handleTransition
  where
    initialFST = FST
      { stInitial = Set.singleton (stInitial, Nothing)
      , stTransition = Map.empty
      , stAccept = Set.map (, Nothing) stAccept
      }
    addTransition :: forall state input output. (Ord state, Ord input, Ord output) => (state, Maybe input) -> (state, Maybe output) -> State (FST state input output) ()
    addTransition k v = modify $ \f@FST{ stTransition } -> f { FST.stTransition = Map.insertWith Set.union k (Set.singleton v) stTransition }
    handleTransition :: ((state, input), (state, Seq output)) -> State (FST (state, Maybe (input, Natural)) input output) ()
    handleTransition ((st, inS), (st', outs)) = handleTransition' (st, Nothing) (Just inS) outs (st', Nothing)
    handleTransition' :: (state, Maybe (input, Natural)) -> Maybe input -> Seq output -> (state, Maybe (input, Natural)) -> State (FST (state, Maybe (input, Natural)) input output) ()
    handleTransition' from inS Empty to = addTransition (from, inS) (to, Nothing)
    handleTransition' from inS (outS :<| Empty) to = addTransition (from, inS) (to, Just outS)
    handleTransition' from@(st, chain) inS (outS :<| oo) to = do
      let next
            | Just (inS', i) <- chain = (st, Just (inS', succ i))
            | Just inS'      <- inS   = (st, Just (inS', 0     ))
              -- Both calls to `handleTransition'` (one in `handleTransition`, the other below) satisfy one of the above cases
      addTransition (from, inS) (next, Just outS)
      handleTransition' next Nothing oo to
\end{code}
\end{comment}

Das Ausführen eines DFST auf eine gegebene Eingabe ist komplett analog zum Ausführen eines FST.
Unsere Implementierung nutzt die restriktivere Struktur aus unserer Definition von DFSTs um den Determinismus bereits im Typsystem zu kodieren.

\begin{code}
runDFST :: forall state input output. (Ord state, Ord input) => DFST state input output -> Seq input -> Maybe (Seq output)
\end{code}
\begin{comment}
\begin{code}
runDFST dfst@DFST{..} str = do
  let (str', finalState') = runDFST' dfst stInitial str Seq.empty
  finalState <- finalState'
  str' <$ guard (finalState `Set.member` stAccept)

runDFST' :: forall state input output. (Ord state, Ord input)
         => DFST state input output
         -> state               -- ^ Current state
         -> Seq input           -- ^ Remaining input
         -> Seq output          -- ^ Accumulator containing previous output
         -> (Seq output, Maybe state) -- ^ Altered output, Next state
runDFST' _             st  Empty     acc = (acc, Just st)
runDFST' dfst@DFST{..} st (c :<| cs) acc = case stTransition !? (st, c) of
  Just (st', mc') -> runDFST' dfst st' cs $ acc <> mc'
  Nothing -> (acc, Nothing)
  
dotDFST :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => DFST state input output -> Dot ()
dotDFST DFST{..} = do
  let
    stTransition' = Map.toList stTransition
    states = Set.singleton stInitial <> stAccept <> foldMap (Set.singleton . fst . fst) stTransition' <> foldMap (Set.singleton . fst . snd) stTransition'
  stateIds <- sequence . (flip Map.fromSet) states $ \st -> node
    [ ("label", show st)
    , ("peripheries", bool "1" "2" $ st `Set.member` stAccept)
    ]
  init <- node [ ("label", ""), ("shape", "none") ]
  init .->. (stateIds ! stInitial)
  forM_ stTransition' $ \((f, inS), (t, outS)) -> do
    edge (stateIds ! f) (stateIds ! t)
      [ ("label", show (inS, outS))
      ]
\end{code}
\end{comment}