diff --git a/vm/Tests.hs b/vm/Tests.hs new file mode 100644 index 0000000..77bb38e --- /dev/null +++ b/vm/Tests.hs @@ -0,0 +1,50 @@ +import VM + +import Data.Hashable (hash, Hashable(..)) +import Data.Set (Set) +import qualified Data.Set as Set +import Test.QuickCheck + +test :: (Cell -> Cell) -> [Bool] +test f = [f (0,3) == (2,5), f (1,3) == (3, 6), f (2,3) == (3,7), f (3, 3) == (4,8), f (2, 4) == (2,7)] + +test2 :: (Cell -> Cell) -> [Bool] +test2 f = [f (2,5) == (3,6), f (3,6) == (2, 7), f (2,7) == (1,7), f (1, 7) == (1,6), f (1, 6) == (1,5), f (1, 5) == (2, 5)] + +deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p + +testTutto = do + deepCheck (\pivot cell -> let r2 = rotateCell pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell) + deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell)) + deepCheck (\pivot cell -> cell == counterRotateCell2 pivot (rotateCell pivot cell)) + +testGame = let board = Board 5 10 (Set.fromList []) + unit = Unit (Set.fromList [(2, 8)]) (2, 8) + game = Game board [unit] (Set.fromList [hash unit]) + in game + +data Fallimento = Rotazione | ControRotazione deriving Show + +testDoppieRotazioni :: Cell -> [Cell] -> Maybe (Cell, Fallimento) +testDoppieRotazioni pivot cells = + case testRotazioni pivot cells of + Just v -> Just (v, Rotazione) + Nothing -> case testControRotazioni pivot (reverse cells) of + Just w -> Just (w, ControRotazione) + Nothing -> Nothing + +-- restituisce eventualmente il primo valore per cui fallisce +testRotazioni :: Cell -> [Cell] -> Maybe Cell +testRotazioni _ [] = Nothing +testRotazioni _ [x] = Nothing +testRotazioni pivot (x:y:xs) = if rotateCell pivot x == y + then testRotazioni pivot (y:xs) + else Just x + +-- restituisce eventualmente il primo valore per cui fallisce +testControRotazioni :: Cell -> [Cell] -> Maybe Cell +testControRotazioni _ [] = Nothing +testControRotazioni _ [x] = Nothing +testControRotazioni pivot (x:y:xs) = if counterRotateCell pivot x == y + then testRotazioni pivot (y:xs) + else Just x diff --git a/vm/VM.hs b/vm/VM.hs index e002c33..5e7c070 100644 --- a/vm/VM.hs +++ b/vm/VM.hs @@ -4,7 +4,6 @@ import Data.Hashable (hash, Hashable(..)) import qualified Data.List as List import Data.Set (Set) import qualified Data.Set as Set -import Test.QuickCheck type Cell = (Int, Int) @@ -107,30 +106,11 @@ rotateCell (px, py) (x, y) = (px - ddiag + (doriz + py `mod` 2) `div` 2, py + do counterRotateCell :: Cell -> Cell -> Cell counterRotateCell pivot = rp . rp . rp . rp . rp where rp = rotateCell pivot +counterRotateCell2 :: Cell -> Cell -> Cell +counterRotateCell2 (px, py) (x, y) = (px + (ddiag + doriz + py `mod` 2) `div` 2, py + ddiag - doriz) where + (ddiag, doriz) = relativePosition (px, py) (x, y) relativePosition :: Cell -> Cell -> (Int, Int) relativePosition (px, py) (x, y) = (diagDir, horizDir) where diagDir = y - py horizDir = x - px + (if py `mod` 2 == 0 then diagDir + diagDir `mod` 2 else diagDir - diagDir `mod` 2) `div` 2 - -test :: (Cell -> Cell) -> [Bool] -test f = [f (0,3) == (2,5), f (1,3) == (3, 6), f (2,3) == (3,7), f (3, 3) == (4,8), f (2, 4) == (2,7)] - -test2 :: (Cell -> Cell) -> [Bool] -test2 f = [f (2,5) == (3,6), f (3,6) == (2, 7), f (2,7) == (1,7), f (1, 7) == (1,6), f (1, 6) == (1,5), f (1, 5) == (2, 5)] - -deepCheck p = quickCheckWith (stdArgs { maxSuccess = 10000 }) p - -testTutto = do - deepCheck (\pivot cell -> let r2 = rotateCell pivot in (r2 . r2 . r2 . r2 . r2 . r2) cell == cell) - deepCheck (\pivot cell -> cell == counterRotateCell pivot (rotateCell pivot cell)) - deepCheck (\pivot cell -> cell == counterRotateCell2 pivot (rotateCell pivot cell)) - -testGame = let board = Board 5 10 (Set.fromList []) - unit = Unit (Set.fromList [(2, 8)]) (2, 8) - game = Game board [unit] (Set.fromList [hash unit]) - in game - -counterRotateCell2 :: Cell -> Cell -> Cell -counterRotateCell2 (px, py) (x, y) = (px + doriz - (ddiag + px `mod` 2) `div` 2, py + ddiag - doriz) where - (ddiag, doriz) = relativePosition (px, py) (x, y)