Merge branch '9-test-on-legal-games' into 'master'

Add Markov chain test case generator

Closes #9

See merge request eveen/Testing-Techniques!11

4 files changed, 76 insertions, 22 deletions

diff --git a/test/.gitignore b/test/.gitignore
index 0d7a855..0074782 100644
--- a/test/.gitignore
+++ b/test/.gitignore
@@ -1 +1,2 @@
-test_parser
+dataset.pgn
+Test
diff --git a/test/ArbitraryMove.hs b/test/ArbitraryMove.hs
index e786a68..4c6fb48 100644
--- a/test/ArbitraryMove.hs
+++ b/test/ArbitraryMove.hs
@@ -19,15 +19,7 @@ instance Arbitrary Board where arbitrary = return defaultBoard
 type Move = String
 
 arbitraryMove :: Gen Move
-arbitraryMove = frequency
-  [ (2, probableArbitraryMove)
-  --, (1, invalidMove)
-  ]
-  where
-    invalidMove :: Gen Move
-    invalidMove = oneof
-      [ liftM2 (\r c -> [r,c]) (choose ('i', 'z')) (elements "09")
-      ]
+arbitraryMove = probableArbitraryMove
 
 instance Arbitrary PGN
   where
@@ -69,7 +61,7 @@ instance Arbitrary PGN
  - on a set of PGN games, e.g. from http://theweekinchess.com/twic.
  -}
 
-probableArbitraryMove :: Gen String
+probableArbitraryMove :: Gen Move
 probableArbitraryMove = frequency $ map (return <$>)
   [ (8, "a1=B")
   , (2, "a1=B+")
diff --git a/test/Makefile b/test/Makefile
new file mode 100644
index 0000000..ba62dab
--- /dev/null
+++ b/test/Makefile
@@ -0,0 +1,31 @@
+EXE:=Test
+DEP:=ArbitraryMove
+AUX:=$(addsuffix .o,    $(EXE) $(DEP))\
+	$(addsuffix .hi,    $(EXE) $(DEP))\
+	$(addsuffix .dyn_o, $(EXE) $(DEP))\
+	$(addsuffix .dyn_hi,$(EXE) $(DEP))
+SRC:=$(addsuffix .hs,$(DEP))
+GHC:=ghc
+GHCFLAGS:=-O -main-is Test.main
+DATA:=dataset.pgn
+
+.PHONY=all run clean
+
+all: $(EXE)
+
+$(DATA):
+	for i in $$(seq 1000 1020); do wget -q http://www.theweekinchess.com/zips/twic$${i}g.zip; unzip -q twic$${i}g.zip; rm twic$${i}g.zip; done
+	cat twic*.pgn > $@
+	$(RM) twic*.pgn
+
+run: $(EXE) $(DATA)
+	./$(EXE) < $(DATA)
+
+$(EXE): %: %.hs $(SRC)
+	$(GHC) $(GHCFLAGS) $< -o $@
+
+clean:
+	$(RM) $(EXE) $(AUX)
+
+distclean: clean
+	$(RM) $(DATA)
diff --git a/test/Test.hs b/test/Test.hs
index 983b48d..b162a9f 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -2,15 +2,19 @@
 -- vim: sw=2 ts=2 et ai:
 module Test where
 
+import Control.Monad
+
 import Data.Array
-import Data.Attoparsec.ByteString.Char8
+import Data.Attoparsec.ByteString.Char8 (parseOnly)
 import Data.ByteString.Char8 (pack)
 import Data.Either
 import Data.Function
 import Data.List
+import Data.MarkovChain
 import Data.Maybe
 
-import Control.Monad
+import System.IO
+import System.Random
 
 import Test.QuickCheck
 import Test.QuickCheck.Random
@@ -27,7 +31,11 @@ atAnyState = atAnyTwoStates . const
 atAnyTwoStates :: (Board -> Board -> Bool) -> PGN -> Property
 atAnyTwoStates ok pgn =
   let moveList = seqList [moveSAN m | m <- moves pgn] $ Right defaultBoard in
-  classify True (let l = length moveList - 1 in show l ++ " legal move" ++ if (l == 1) then "" else "s") $
+  let moves = length moveList in
+  classify (                moves <  10) "   <10 legal moves" $
+  classify ( 10 <= moves && moves <  50) "10- 50 legal moves" $
+  classify ( 50 <= moves && moves < 100) "50-100 legal moves" $
+  classify (100 <= moves               ) "100+   legal moves" $
   and [ok b1 b2 | Right b1 <- moveList | Right b2 <- tail moveList]
   where
     seqList :: [r -> Either e r] -> Either e r -> [Either e r]
@@ -113,11 +121,7 @@ prop_not_in_check_twice = atAnyTwoStates (\b1 b2 ->
   not (check White b1 && check White b2))
 
 prop_move_not_result_check :: PGN -> Property
-prop_move_not_result_check = atAnyTwoStates (\b1 b2 ->
-  case turn b1 of
-    White -> not (check White b2)
-    Black -> not (check Black b2)
-  )
+prop_move_not_result_check = atAnyTwoStates (\b1 b2 -> not (check (turn b1) b2))
 
 prop_dont_touch_my_pieces :: PGN -> Property
 prop_dont_touch_my_pieces = atAnyTwoStates (\b1 b2 -> notMoved (turn b2) b1 b2)
@@ -125,6 +129,32 @@ prop_dont_touch_my_pieces = atAnyTwoStates (\b1 b2 -> notMoved (turn b2) b1 b2)
     notMoved :: Color -> Board -> Board -> Bool
     notMoved c = (\b a -> null (a \\ b)) `on` pieceCoords (Just c) Nothing
 
-return []
-main = $forAllProperties (quickCheckWithResult (stdArgs
-  {maxSuccess=100000, replay=Just (mkQCGen 37,0)}))
+main = do
+  pgns <- readPGN
+  let gen = growingElements $ take 10000 $ runMulti 4 (map moves pgns) 0 (mkStdGen 37)
+  putStrLn "Testing: parser"
+  quickCheck prop_checkPGN
+  putStrLn $ "Building Markov chain from " ++ show (length pgns) ++ " games"
+  check "only 2 kings"                            gen prop_only_2_kings
+  check "no pawns on rank 1 or 8"                 gen prop_no_pawns_on_1_and_8
+  check "no new pieces / more than one piece hit" gen prop_number_of_pieces
+  check "no check on same colour twice"           gen prop_not_in_check_twice
+  check "player cannot cause himself to be check" gen prop_move_not_result_check
+  check "player cannot move opponent's pieces"    gen prop_dont_touch_my_pieces
+  where
+    check name gen p = do
+      putStrLn $ "Testing: " ++ name
+      quickCheckWith args (forAll (mkPGN <$> gen) p)
+      where args = stdArgs {maxSuccess=10000, replay=Just (mkQCGen 37,0)}
+
+    mkPGN :: [String] -> PGN
+    mkPGN = PGN "" "" "" "" "" "" Nothing Nothing
+
+readPGN :: IO [PGN]
+readPGN = do
+  hSetEncoding stdin latin1
+  pgn <- pack <$> getContents
+  case parseOnly pgnParser pgn of
+    Left  err   -> error err
+    Right []    -> error "no games"
+    Right games -> return games