Minimization of automata

.gitignore

@@ -0,0 +1,4 @@
+dist
+.cabal-sandbox
+cabal.sandbox.config
+

Mini.cabal

@@ -0,0 +1,67 @@
+-- Initial Mini.cabal generated by cabal init.  For further documentation, 
+-- see http://haskell.org/cabal/users-guide/
+
+-- The name of the package.
+name:                Mini
+
+-- The package version.  See the Haskell package versioning policy (PVP) 
+-- for standards guiding when and how versions should be incremented.
+-- http://www.haskell.org/haskellwiki/Package_versioning_policy
+-- PVP summary:      +-+------- breaking API changes
+--                   | | +----- non-breaking API additions
+--                   | | | +--- code changes with no API change
+version:             0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:            
+
+-- A longer description of the package.
+-- description:         
+
+-- The license under which the package is released.
+-- license:             
+
+-- The file containing the license text.
+-- license-file:        LICENSE
+
+-- The package author(s).
+author:              Joshua Moerman
+
+-- An email address to which users can send suggestions, bug reports, and 
+-- patches.
+maintainer:          lakseru@gmail.com
+
+-- A copyright notice.
+-- copyright:           
+
+-- category:            
+
+build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or a 
+-- README.
+-- extra-source-files:  
+
+-- Constraint on the version of Cabal needed to build this package.
+cabal-version:       >=1.10
+
+
+executable Mini
+  -- .hs or .lhs file containing the Main module.
+  main-is:             Mini.hs
+  
+  -- Modules included in this executable, other than Main.
+  -- other-modules:       
+  
+  -- LANGUAGE extensions used by modules in this package.
+  -- other-extensions:    
+  
+  -- Other library packages from which modules are imported.
+  build-depends:       base >=4.7 && <4.8, data-fix
+  
+  -- Directories containing source files.
+  -- hs-source-dirs:      
+  
+  -- Base language which the package is written in.
+  default-language:    Haskell2010
+  

Mini.hs

@@ -0,0 +1,118 @@
+{-# LANGUAGE LambdaCase #-}
+
+import Data.Fix
+import Data.List
+import Data.Maybe
+
+
+-- Lib
+type Coalgebra f x = x -> f x
+
+behaviour :: (Functor f) => Coalgebra f x -> x -> Fix f
+behaviour = ana -- = (~> Fix) = Fix (fmap (behaviour phi) (phi x))
+
+data MooreF i o x = MooreF o (i -> x)
+type Moore i o x = Coalgebra (MooreF i o) x
+
+getO :: MooreF i o x -> o
+getO (MooreF o _) = o
+
+apply :: MooreF i o x -> i -> x
+apply (MooreF _ f) = f
+
+instance Functor (MooreF i o) where
+	fmap f (MooreF o phi) = MooreF o (f . phi)
+
+
+type DFA i x = Moore i Bool x
+type Language i = Fix (MooreF i Bool)
+type Word i = [i]
+
+singleton :: (Eq i) => DFA i (Maybe (Word i))
+singleton Nothing       = MooreF False (const Nothing)
+singleton (Just [])     = MooreF True  (const Nothing)
+singleton (Just (y:ys)) = MooreF False (\i -> if i == y then Just ys else Nothing)
+
+isMember :: Word i -> Language i -> Bool
+isMember [] l = getO . unFix $ l
+isMember (x:xs) l = isMember xs $ apply (unFix l) x
+
+test :: x -> [Word i] -> DFA i x -> ([Word i], [Word i])
+test s ws m = partition (\w -> isMember w (behaviour m s)) ws
+
+enumerate :: [x] -> [[x]] -> [[x]]
+enumerate xs [] = []
+enumerate xs (a:as) = map (:a) xs ++ enumerate xs as
+
+enumerateAll :: [x] -> [[x]]
+enumerateAll xs = concat $ iterate (enumerate xs) [[]]
+
+type Color    = Int
+type NewColor = Int
+
+algebra :: [i] -> (o -> Int) -> [Color] -> MooreF i o Color -> NewColor
+algebra is mp cs (MooreF o phi) = (mp o) * totalWidth + foldl (\acc d -> width * acc + d) 0 digits
+	where
+		width = length is
+		totalWidth = length cs ^ width
+		digits = map phi is
+
+allColours :: [x] -> (x -> Int) -> [Int]
+allColours xs p = map head . group . sort . map p $ xs
+
+-- maps [x1 ... xn] to [0 ... n]
+-- Can be implemented a lot better ;D
+reduce :: [Int] -> (Int -> Int)
+reduce xs x = fromJust $ lookup x indexed
+	where
+		sorted = map head . group $ sort xs
+		indexed = zip sorted [0..]
+
+
+base :: [x] -> [i] -> (o -> Int) -> Moore i o x -> (x -> Int)
+base _ _ _ _ = \x -> 0
+
+step :: [x] -> [i] -> (o -> Int) -> Moore i o x -> (x -> Int) -> (x -> Int)
+step states inputs outputs machine p = reducedP
+	where
+		colors = allColours states p
+		newP = algebra inputs outputs colors . fmap p . machine
+		reducedP = reduce (allColours states newP) . newP
+
+-- minimize :: [x] -> [i] -> (o -> Int) -> Moore i o x -> (x -> Int)
+minimize' states inputs outputs machine = stabilize $ iterate s b
+	where
+		b = base states inputs outputs machine
+		s = step states inputs outputs machine
+		size p = length (allColours states p)
+		conv l = zip l (tail l)
+		stabilize = snd . last . takeWhile (\(a, b) -> size a < size b) . conv
+
+-- Example
+data States = A | B | C | D | E | F
+data Input = Zero | One
+	deriving Show
+
+machine :: DFA Input States
+machine A = MooreF False (\case Zero -> B; One -> C)
+machine B = MooreF False (\case Zero -> A; One -> D)
+machine C = MooreF True  (\case Zero -> E; One -> F)
+machine D = MooreF True  (\case Zero -> E; One -> F)
+machine E = MooreF True  (\case Zero -> E; One -> F)
+machine F = MooreF False (\case Zero -> F; One -> F)
+
+states = [A, B, C, D, E, F]
+inputs = [Zero, One]
+outputs = (\o -> if o then 1 else 0)
+
+b = base states inputs outputs machine
+s = step states inputs outputs machine
+
+main :: IO ()
+main = print . limit 10 . onBoth evaluate . limit 200000 $ test startingState tests machine
+	where
+		startingState = A
+		tests = enumerateAll [Zero, One]
+		onBoth f (a, b) = (f a, f b)
+		limit n = onBoth (take n)
+		evaluate xs = seq (sum (map length xs)) xs

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain