You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

76 lines
3.5 KiB

import Datatypes
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))
checkForNothing::[Maybe(Cell, Fallimento)] -> Maybe(Cell, Fallimento)
checkForNothing (Nothing:xs) = checkForNothing xs
checkForNothing ((Just v):xs) = Just v
checkForNothing [] = Nothing
testTutteRotazioni = checkForNothing [
testDoppieRotazioni (2,3) [(2,0), (4,1), (5,4), (3,6), (0,5), (0,2), (2,0)],
testDoppieRotazioni (2,4) [(2,1), (4,3), (4,6), (1,7), (-1,5), (0,2), (2,1)],
testDoppieRotazioni (1,5) [(1,3), (3,4), (3,6), (1,7), (0,6), (0,4), (1,3)]
]
testCentering = deepCheck (\up um um1 -> let b = Board 5 10 (Set.fromList [])
u = Unit (Set.fromList (um1:um)) up
c = centerUnit u b
bw = 5
xCoords = Set.map (\(x, y) -> x) (unitMembers c)
yCoords = Set.map (\(x, y) -> y) (unitMembers c)
unitLeft = Set.findMin xCoords
unitRight = Set.findMax xCoords
unitTop = Set.findMin yCoords
deltaLeft = unitLeft
deltaRight = bw - unitRight - 1
in (deltaLeft == deltaRight || (deltaRight - deltaLeft) == 1) && unitTop == 0)
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 testControRotazioni pivot (y:xs)
else Just x