{-
tests.hs provides test cases and examples for the library Automata.hs
Copyright (C) 2002 Leon P Smith

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library 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
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

lps@po.cwru.edu
-}

import Automata
import Prelude hiding (concat, reverse)
import qualified Prelude
import qualified Assoc as F
import qualified Collection as S
import qualified Tree234Map
import qualified UnbalancedSet

type FM  = Tree234Map.FM
type Set = UnbalancedSet.Set

emptyFM :: (F.AssocX FM k) => FM k a
emptyFM = F.empty

emptySet :: (S.CollX Set e) => Set e
emptySet = S.empty

instance (Show k, Show a, Ord k) => Show (FM k a) where
   show = show . F.toList

instance (Show st, Show ab, Alphabet ab, Ord st) => Show (DFA st ab) where
   show m@(DFA d s f) = Prelude.concat [ "(" ++ show st ++ ", " 
				             ++ show ab ++ (if f st then ")* -> " else ") ->") 
                                             ++ show (d st ab) ++ "\n" 
				         | st <- reachable_list m, ab <- alphabet]

instance (Show st, Show ab, Alphabet ab, Ord st) => Show (NFA st ab) where
   show m@(NFA d s f) = Prelude.concat [ "(" ++ show st ++ ", " 
				             ++ show ab ++ (if f st then ")* -> " else ") ->") 
                                             ++ show (d st ab) ++ "\n" 
				         | st <- reachable_list m, ab <- alphabet]

newtype Digit = Digit Int deriving (Eq, Ord, Show)

instance Alphabet Digit where
   alphabet = map Digit [0..9]

test_reachable_list n = reachable_list (divisible n)  == [0..n-1] 

test_reachable      n = fst (reachable (divisible n)) == [0..n-1]

test_reachable_set  n = S.toOrdList (reachable_set (divisible n)) == [0..n-1]

test_equals      n n' = (n == n') == (divisible n `equals` divisible n')

test_isect       n n' = isect (divisible n) (divisible n') `equals` divisible (lcm n n')

test_minimize      n  = (min `equals` divisible n) && (min' `equals` divisible n) && size min == size min' 
   where 
       min  = minimize (divisible n)
       min' = minimize_brzozowski (divisible n)

divisible :: Int -> DFA Int Digit
divisible n = DFA d s f
  where
    d st (Digit ab) = (st * 10 + ab) `mod` n
    s               = 0
    f st            = (st == 0)

mkDigits :: Int -> [Digit]
mkDigits 0 = [Digit 0]
mkDigits x 
    | x > 0 = mkDigits' x
    where
    mkDigits' 0 = []
    mkDigits' x = Digit (x `mod` 10) : mkDigits (x `div` 10)


contains :: (Eq a) => [a] -> NFA (Bool,[a]) a 
contains str = NFA d s f
    where
    d (start, [])        ab = [ (start, []) ]
    d st@(start, (x:xs)) ab 
      | start     = st' ++ [st]
      | otherwise = st'
      where
      st' | x == ab   = [(False, xs)] 
          | otherwise = []
    s = [(True, str)]
    f (_,  []) = True
    f (_, _:_) = False

data Move   = MLeft  | MRight | MUp  | MDown  deriving (Eq, Ord, Show)

instance Alphabet Move where
  alphabet = [MLeft, MRight, MUp, MDown]

type Pos = (Int, Int)

type State = (Pos, Set Pos, Set Pos)

--instance (S.OrdColl set a) => Ord (set a) where
instance Ord a => Ord (Set a) where
   set <  set' = S.toOrdList set <  S.toOrdList set'
   set <= set' = S.toOrdList set <= S.toOrdList set'

puzzle_16 :: DFA State Move
puzzle_16 =  DFA d s f
  where
  outBounds (x,y) = not (  0 <= x && x < 4   &&   0 <= y && y < 4  ) 
  target (x,y) MUp    = (x,y-1)
  target (x,y) MDown  = (x,y+1)
  target (x,y) MLeft  = (x+1,y)
  target (x,y) MRight = (x-1,y)
  d tup@(pos, whites, reds) move 
    | outBounds pos'       = tup
    | S.member whites pos' = (pos', S.insert pos (S.delete pos' whites), reds)
    | otherwise            = (pos', whites,  S.insert pos (S.delete pos' reds))
    where pos' = target pos move
  s = ((3,3), S.fromList [(1,1),(1,2),(2,1),(2,2)], S.fromList [(0,0),(0,1),(0,2),(0,3),(1,0),(1,3),(2,0),(2,3),(3,0),(3,1),(3,2)])
  f _ = error "puzzle_16 : final function not defined"


test1 :: DFA Int Bool
test1 = DFA d 1 (==9)
  where
  d  1 True  = 3
  d  1 False = 5
  d  2 True  = 3
  d  2 False = 3
  d  3 True  = 6
  d  3 False = 6
  d  4 True  = 5
  d  4 False = 5
  d  5 True  = 7
  d  5 False = 10
  d  6 True  = 2
  d  6 False = 8
  d  7 True  = 4
  d  7 False = 9
  d  8 True  = 11
  d  8 False = 11
  d  9 True  = 10
  d  9 False = 10
  d 10 True  = 9
  d 10 False = 10
  d 11 True  = 11
  d 11 False = 11


untilRep f x = x : takeWhile (x /=) (iterate f (f x))

main = return ()