-- Language extensions {{{ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UnicodeSyntax #-} -- }}} -- Imports {{{ import Control.Applicative import Control.Arrow ((***)) import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.State.Strict import Data.Bits import Data.List import qualified Data.Set as Set import Data.Set (Set) import Data.Word import Test.Framework import Test.Framework.Providers.HUnit import Test.Framework.Providers.QuickCheck2 import Test.HUnit import Text.Printf import LogicGrowsOnTrees import LogicGrowsOnTrees.Examples.Queens import LogicGrowsOnTrees.Examples.Queens.Advanced import LogicGrowsOnTrees.Utils.WordSum -- }}} -- Functions {{{ checkBlocks :: [(Word,Word)] → Int → Int → Word64 → Word64 → Word64 → Word64 → Assertion -- {{{ checkBlocks solution window_start window_size original_occupied_rows original_occupied_columns original_occupied_negative_diagonals original_occupied_positive_diagonals = go (map (fromIntegral *** fromIntegral) solution) (original_occupied_rows .&. rows_and_columns_mask) (original_occupied_columns .&. rows_and_columns_mask) (original_occupied_negative_diagonals .&. negative_diagonals_mask) (original_occupied_positive_diagonals .&. positive_diagonals_mask) where rows_and_columns_mask = bit window_size - 1 negative_diagonals_mask = bit (2*window_size-1) - 1 positive_diagonals_mask = negative_diagonals_mask `rotateR` (window_size-1) window_end = window_start+window_size-1 go :: [(Int,Int)] → Word64 → Word64 → Word64 → Word64 → IO () go [] 0 0 0 0 = return () go [] occupied_rows occupied_columns occupied_negative_diagonals occupied_positive_diagonals = assertFailure ( printf "non-zero blocks %i %i %i %i (from %i %i %i %i) at row %i for solution: %s" occupied_rows occupied_columns occupied_negative_diagonals occupied_positive_diagonals original_occupied_rows original_occupied_columns original_occupied_negative_diagonals original_occupied_positive_diagonals window_start (show solution) ) go ((row,col):rest_solution) occupied_rows occupied_columns occupied_negative_diagonals occupied_positive_diagonals = do let row_bit = if row >= window_start && row <= window_end then bit (row-window_start) else 0 when (row_bit /= 0) $ assertBool (printf "bit for row %i (%i) in %i was not set for solution %s" row (row-window_start) occupied_rows (show solution)) (row_bit .&. occupied_rows /= 0) let col_bit = if col >= window_start && col <= window_end then bit (col-window_start) else 0 when (col_bit /= 0) $ assertBool (printf "bit for col %i (%i) in %i was not set for solution %s" col (col-window_start) occupied_columns (show solution)) (col_bit .&. occupied_columns /= 0) let neg_bit = if col+row - 2*window_start >= 0 && col+row - 2*window_start <= 2*(window_size-1) then bit (col+row-2*window_start) else 0 when (neg_bit /= 0) $ assertBool (printf "bit for negative diagonal %i (%i) in %i was not set for solution %s" (col+row) (col+row-2*window_start) occupied_negative_diagonals (show solution)) (neg_bit .&. occupied_negative_diagonals /= 0) let pos_bit = if col-row >= -(window_size-1) && col-row <= (window_size-1) then 1 `rotate` (col-row) else 0 when (pos_bit /= 0) $ assertBool (printf "bit for positive diagonal %i (%i) in %i was not set for solution %s" (col-row) (col-row) occupied_positive_diagonals (show solution)) (pos_bit .&. occupied_positive_diagonals /= 0) go rest_solution (occupied_rows `xor` row_bit) (occupied_columns `xor` col_bit) (occupied_negative_diagonals `xor` neg_bit) (occupied_positive_diagonals `xor` pos_bit) -- }}} checkRightPositiveBlocks :: Int → Word64 → Word64 → Assertion -- {{{ checkRightPositiveBlocks size occupied_positive_diagonals occupied_right_positive_diagonals = go 0 1 1 where go column top_bit right_bit | column == size = return () | otherwise = do assertEqual (printf "for %i, column bit (%s in %i) does not match row bit (%s in %i)" column (show top_bit_value) occupied_positive_diagonals (show right_bit_value) occupied_right_positive_diagonals ) top_bit_value right_bit_value go (column+1) (top_bit `rotateR` 1) (right_bit `unsafeShiftL` 1) where top_bit_value = occupied_positive_diagonals .&. top_bit /= 0 right_bit_value = occupied_right_positive_diagonals .&. right_bit /= 0 -- }}} checkSolutionIsValid :: Word → NQueensSolution → Assertion -- {{{ checkSolutionIsValid n solution = forM_ (zip [0..] solution) $ \(i,(row1,col1)) → do assertBool "row within bounds" $ row1 >= 0 && row1 < n assertBool "column within bounds" $ col1 >= 0 && col1 < n forM_ (drop (i+1) solution) $ \(row2,col2) → do assertBool ("rows conflict in " ++ show solution) $ row1 /= row2 assertBool ("columns conflict in " ++ show solution) $ col1 /= col2 assertBool ("negative diagonals conflict in " ++ show solution) $ row1+col1 /= row2+col2 assertBool ("positive diagonals conflict in " ++ show solution) $ row1-col1 /= row2-col2 -- }}} checkSolutionsAreValid :: Word → NQueensSolutions → Assertion -- {{{ checkSolutionsAreValid = mapM_ . checkSolutionIsValid -- }}} checkSymmetry :: MonadIO m ⇒ Word → NQueensSymmetry → [(Word,Word)] → m () -- {{{ checkSymmetry n correct_symmetry solution = liftIO . assertEqual ("solution has wrong symmetry: " ++ show (reverse solution)) correct_symmetry . symmetryOf n $ solution -- }}} remdups :: (Eq a) => [a] -> [a] -- {{{ remdups [] = [] remdups (x : []) = [x] remdups (x : xx : xs) | x == xx = remdups (x : xs) | otherwise = x : remdups (xx : xs) -- }}} testSolutionsUsing :: (Word → NQueensSolutions) → (Word → Tree WordSum) → [Test.Framework.Test] -- {{{ testSolutionsUsing nqueensSolutions nqueensCount = [testGroup "are valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) $ checkSolutionsAreValid n (nqueensSolutions n)) [1..10] -- }}} ,testGroup "are unique" $ -- {{{ [ testCase ("n = " ++ show n) $ let solutions_as_list = nqueensSolutions n solutions_as_set = Set.fromList solutions_as_list in length solutions_as_list @?= Set.size solutions_as_set | n ← [1..10] ] -- }}} ,testGroup "have correct size" -- {{{ [ testCase ("n = " ++ show n) $ (correct_count @=?) . getWordSum . exploreTree . nqueensCount $ n | n ← [1..14] , let correct_count = nqueensCorrectCount n ] -- }}} ,testGroup "match count" -- {{{ [ testCase ("n = " ++ show n) $ (nqueensCorrectCount n @=?) . getWordSum . exploreTree . nqueensCount $ n | n ← [1..10] ] -- }}} ] -- }}} -- }}} main = defaultMain tests tests = -- {{{ [testProperty "reflectBits" $ liftA2 (==) id (reflectBits . reflectBits) ,testGroup "reflections and rotations" -- {{{ [testProperty "reflecting twice = id" $ \n → -- {{{ liftA2 (==) (reflectSolution n . reflectSolution n) id -- }}} ,testProperty "rotating left twice = rotate 180"$ \n → -- {{{ liftA2 (==) (rotateLeft n . rotateLeft n) (rotate180 n) -- }}} ,testProperty "rotating left four times = id" $ \n → -- {{{ liftA2 (==) (rotateLeft n . rotateLeft n . rotateLeft n . rotateLeft n) id -- }}} ,testProperty "rotating right twice = rotate 180" $ \n → -- {{{ liftA2 (==) (rotateRight n . rotateRight n) (rotate180 n) -- }}} ,testProperty "rotating right four times = id" $ \n → -- {{{ liftA2 (==) (rotateRight n . rotateRight n . rotateRight n . rotateRight n) id -- }}} ] -- }}} ,testGroup "symmetry breaking" -- {{{ [testGroup "start" $ -- {{{ let getAllSolutions :: MonadPlus m ⇒ Word → m [(Word,Word)] -- {{{ getAllSolutions = nqueensStart (++) (const . return) (const . return) (const . const . return) [] in -- }}} [testGroup "correct blocks" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ nqueensStart (++) (\solution NQueensBreak90State{..} → liftIO $ checkBlocks solution b90_window_start b90_window_size b90_occupied_rows_and_columns b90_occupied_rows_and_columns b90_occupied_negative_diagonals b90_occupied_positive_diagonals ) (\solution NQueensBreak180State{..} → liftIO $ do checkBlocks solution b180_window_start b180_window_size b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals checkRightPositiveBlocks b180_window_size b180_occupied_positive_diagonals b180_occupied_right_positive_diagonals ) (\solution window_size NQueensSearchState{..} → liftIO $ do checkBlocks solution s_row window_size s_occupied_rows s_occupied_columns s_occupied_negative_diagonals s_occupied_positive_diagonals ) [] n | n ← [2..20] ] -- }}} ,testGroup "correct symmetries" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ nqueensStart (++) (const . checkSymmetry n AllRotations) (const . checkSymmetry n Rotate180Only) (const . const . checkSymmetry n NoSymmetries) [] n | n ← [2..20] ] -- }}} ,testGroup "includes all solution exteriors" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ do let start_exteriors = Set.fromList . map sort $ getAllSolutions n solution ← nqueensBruteForceSolutions n liftIO . assertBool ("solution " ++ show solution ++ " --> " ++ show (sort . map sort . multiplySolution n NoSymmetries $ extractExteriorFromSolution n 1 solution :: [[(Word,Word)]]) ++ " does not have an exterior in the starting set") . any ( flip Set.member start_exteriors . sort ) . multiplySolution n NoSymmetries $ extractExteriorFromSolution n 1 solution | n ← [2..11] ] -- }}} ,testGroup "includes all solutions" -- {{{ [ testCase ("n = " ++ show n) $ let finalizeValueWithMultiplicity m original_solution = do liftIO $ checkSolutionIsValid n (sort original_solution) solutions ← lift get solution ← allFrom . remdups . map sort $ do rotated_solution ← take m . iterate (rotateLeft n) $ original_solution allFrom [rotated_solution,reflectSolution n rotated_solution] liftIO $ assertBool ("solution appears twice: " ++ show solution) (not $ Set.member solution solutions) lift $ modify (Set.insert solution) in (flip execStateT Set.empty . exploreTreeT $ nqueensStart (++) (\value NQueensBreak90State{..} → nqueensSearch (++) (finalizeValueWithMultiplicity 1) value b90_window_size $ NQueensSearchState b90_number_of_queens_remaining b90_window_start b90_occupied_rows_and_columns b90_occupied_rows_and_columns b90_occupied_negative_diagonals b90_occupied_positive_diagonals ) (\value NQueensBreak180State{..} → nqueensSearch (++) (finalizeValueWithMultiplicity 2) value b180_window_size $ NQueensSearchState b180_number_of_queens_remaining b180_window_start b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals ) (nqueensSearch (++) (finalizeValueWithMultiplicity 4)) [] n ) >>= (assertEqual "missing solutions" Set.empty . Set.difference ( Set.fromList . map sort $ nqueensBruteForceSolutions n ) ) | n ← [4..12] ] -- }}} ,testGroup "unique" -- {{{ [ testCase ("n = " ++ show n) . flip evalStateT Set.empty . exploreTreeT $ do old_solutions ← lift get solution ← sort <$> getAllSolutions n >>= multiplySolution n NoSymmetries if Set.member solution old_solutions then liftIO $ assertFailure ("solution " ++ show solution ++ " occurs twice") else lift $ modify (Set.insert solution) | n ← [1..20] ] -- }}} ,testGroup "valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) . checkSolutionsAreValid n . getAllSolutions $ n) [1..20] -- }}} ] -- }}} ,testGroup "break90" $ -- {{{ let getAllSolutions :: MonadPlus m ⇒ Word → m [(Word,Word)] -- {{{ getAllSolutions n = break90 [] $ NQueensBreak90State n 0 (fromIntegral n) 0 0 0 where break90 = nqueensBreak90 (++) return (\value state → return value `mplus` break90 value state) (const . return) (const . const . return) in -- }}} [testGroup "correct blocks" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let break90 = nqueensBreak90 (++) (const $ return ()) (\solution state@NQueensBreak90State{..} → do liftIO $ checkBlocks solution b90_window_start b90_window_size b90_occupied_rows_and_columns b90_occupied_rows_and_columns b90_occupied_negative_diagonals b90_occupied_positive_diagonals break90 solution state ) (\solution NQueensBreak180State{..} → liftIO $ do checkBlocks solution b180_window_start b180_window_size b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals checkRightPositiveBlocks b180_window_size b180_occupied_positive_diagonals b180_occupied_right_positive_diagonals ) (\solution window_size NQueensSearchState{..} → liftIO $ checkBlocks solution s_row window_size s_occupied_rows s_occupied_columns s_occupied_negative_diagonals s_occupied_positive_diagonals ) in break90 [] $ NQueensBreak90State n 0 (fromIntegral n) 0 0 0 | n ← [2..20] ] -- }}} ,testGroup "correct symmetries" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let break90 = nqueensBreak90 (++) (liftIO . assertEqual "solution has the wrong symmetry" AllRotations . symmetryOf n) (\solution next_state → do checkSymmetry n AllRotations solution break90 solution next_state ) (const . checkSymmetry n Rotate180Only) (const . const . checkSymmetry n NoSymmetries) in break90 [] $ NQueensBreak90State n 0 (fromIntegral n) 0 0 0 | n ← [2..20] ] -- }}} ,testGroup "includes all solution exteriors" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ do let break90_exteriors = Set.fromList . map sort $ getAllSolutions n solution ← nqueensBruteForceSolutions n let maximum_layers = (n+1) `div` 2 go layers | layers > maximum_layers = return () | otherwise = (assertBool ("solution " ++ show solution ++ " --> " ++ show (sort . map sort . allRotationsOf n $ exterior :: [[(Word,Word)]]) ++ " (" ++ show (symmetryOf n exterior) ++ ") does not have a " ++ show layers ++ " exterior in the break90 set") . any ( flip Set.member break90_exteriors . sort ) . allRotationsOf n $ exterior ) >> if hasRotate90Symmetry n exterior then go (layers+1) else return () | otherwise = go (layers+1) where exterior = extractExteriorFromSolution n layers solution liftIO $ go 1 | n ← [4..12] ] -- }}} ,testGroup "includes all solutions" -- {{{ [ testCase ("n = " ++ show n) $ let finalizeValueWithMultiplicity m original_solution = do liftIO $ checkSolutionIsValid n (sort original_solution) solutions ← lift get solution ← allFrom . remdups . map sort . take m . iterate (rotateLeft n) $ original_solution liftIO $ assertBool ("solution appears twice: " ++ show solution) (not $ Set.member solution solutions) lift $ modify (Set.insert solution) break90 = nqueensBreak90 (++) (finalizeValueWithMultiplicity 4) break90 (\value NQueensBreak180State{..} → nqueensSearch (++) (finalizeValueWithMultiplicity 2) value b180_window_size $ NQueensSearchState b180_number_of_queens_remaining b180_window_start b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals ) (nqueensSearch (++) (finalizeValueWithMultiplicity 4)) in (flip execStateT Set.empty . exploreTreeT $ break90 [] $ NQueensBreak90State n 0 (fromIntegral n) 0 0 0 :: IO (Set NQueensSolution) ) >>= assertEqual "missing solutions" Set.empty . Set.difference ( Set.fromList . map sort $ nqueensBruteForceSolutions n ) | n ← [4..12] ] -- }}} ,testGroup "unique" -- {{{ [ testCase ("n = " ++ show n) . flip evalStateT Set.empty . exploreTreeT $ do old_solutions ← lift get solution ← sort <$> getAllSolutions n >>= multiplySolution n NoSymmetries if (Set.member solution old_solutions) then liftIO $ assertFailure ("solution " ++ show solution ++ " occurs twice") else lift $ modify (Set.insert solution) | n ← [1..20] ] -- }}} ,testGroup "valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) . checkSolutionsAreValid n . getAllSolutions $ n) [2..20] -- }}} ] -- }}} ,testGroup "break180" $ -- {{{ let getAllSolutions :: MonadPlus m ⇒ Word → m [(Word,Word)] -- {{{ getAllSolutions n = break180 [] $ NQueensBreak180State n 0 (fromIntegral n) 0 0 0 0 0 where break180 = nqueensBreak180 (++) return (\value state → return value `mplus` break180 value state) (const . const . return) in -- }}} [testGroup "correct blocks" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let break180 = nqueensBreak180 (++) (const $ return ()) (\solution state@NQueensBreak180State{..} → do liftIO $ do checkBlocks solution b180_window_start b180_window_size b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals checkRightPositiveBlocks b180_window_size b180_occupied_positive_diagonals b180_occupied_right_positive_diagonals break180 solution state ) (\solution window_size NQueensSearchState{..} → liftIO $ checkBlocks solution s_row window_size s_occupied_rows s_occupied_columns s_occupied_negative_diagonals s_occupied_positive_diagonals ) in break180 [] $ NQueensBreak180State n 0 (fromIntegral n) 0 0 0 0 0 | n ← [2..14] ] -- }}} ,testGroup "correct symmetries" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let break180 = nqueensBreak180 (++) (liftIO . assertBool "solution does not have 180 symmetry" . hasRotate180Symmetry n) (\solution next_state → do liftIO $ assertBool (printf "solution does not have 180 symmetry: %s" (show solution)) (hasRotate180Symmetry n solution) break180 solution next_state ) (const . const . checkSymmetry n NoSymmetries) in break180 [] $ NQueensBreak180State n 0 (fromIntegral n) 0 0 0 0 0 | n ← [2..14] ] -- }}} ,testGroup "includes all solution exteriors" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ do let break180_exteriors = Set.fromList . map sort $ getAllSolutions n solution ← nqueensBruteForceSolutions n let maximum_layers = (n+1) `div` 2 go layers | layers > maximum_layers = return () | otherwise = (assertBool ("solution " ++ show solution ++ " --> " ++ show (sort . map sort . allRotationsOf n $ exterior :: [[(Word,Word)]]) ++ " (" ++ show (symmetryOf n exterior) ++ ") does not have a " ++ show layers ++ " exterior in the break90 set") . any ( flip Set.member break180_exteriors . sort ) . allRotationsOf n $ exterior ) >> if hasRotate180Symmetry n exterior then go (layers+1) else return () | otherwise = go (layers+1) where exterior = extractExteriorFromSolution n layers solution liftIO $ go 1 | n ← [4..12] ] -- }}} ,testGroup "includes all solutions" -- {{{ [ testCase ("n = " ++ show n) $ let finalizeValueWithMultiplicity multiply original_solution = do liftIO $ checkSolutionIsValid n (sort original_solution) solutions ← lift get let rotated_solutions = remdups . map sort . multiply $ original_solution solution ← allFrom rotated_solutions liftIO $ assertBool (printf "solution appears twice: %s --> %s" (show solution) (show rotated_solutions)) (not $ Set.member solution solutions) lift $ modify (Set.insert solution) break180 = nqueensBreak180 (++) (finalizeValueWithMultiplicity $ \x → [x]) break180 (nqueensSearch (++) (finalizeValueWithMultiplicity $ \x → [x,rotate180 n x])) in (flip execStateT Set.empty . exploreTreeT $ break180 [] $ NQueensBreak180State n 0 (fromIntegral n) 0 0 0 0 0 :: IO (Set NQueensSolution) ) >>= assertEqual "missing solutions" Set.empty . Set.difference ( Set.fromList . map sort $ nqueensBruteForceSolutions n ) | n ← [4..12] ] -- }}} ,testGroup "unique" -- {{{ [ testCase ("n = " ++ show n) . flip evalStateT Set.empty . exploreTreeT $ do old_solutions ← lift get solution ← sort <$> getAllSolutions n >>= multiplySolution n NoSymmetries if (Set.member solution old_solutions) then liftIO $ assertFailure ("solution " ++ show solution ++ " occurs twice") else lift $ modify (Set.insert solution) | n ← [1..14] ] -- }}} ,testGroup "valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) . checkSolutionsAreValid n . getAllSolutions $ n) [2..14] -- }}} ] -- }}} ,testGroup "start + break90 + break180" $ -- {{{ let getAllSolutions :: MonadPlus m ⇒ Word → m [(Word,Word)] -- {{{ getAllSolutions = nqueensStart (++) callback90 callback180 search [] where callback90 value state = return value `mplus` break90 value state callback180 value state = return value `mplus` break180 value state break90 = nqueensBreak90 (++) return callback90 callback180 search break180 = nqueensBreak180 (++) return callback180 search search = const . const . return in -- }}} [testGroup "correct blocks" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let callback90 solution state@NQueensBreak90State{..} =do liftIO $ checkBlocks solution b90_window_start b90_window_size b90_occupied_rows_and_columns b90_occupied_rows_and_columns b90_occupied_negative_diagonals b90_occupied_positive_diagonals break90 solution state callback180 solution state@NQueensBreak180State{..} = do liftIO $ do checkBlocks solution b180_window_start b180_window_size b180_occupied_rows b180_occupied_columns b180_occupied_negative_diagonals b180_occupied_positive_diagonals checkRightPositiveBlocks b180_window_size b180_occupied_positive_diagonals b180_occupied_right_positive_diagonals break180 solution state callbackSearch solution window_size NQueensSearchState{..} = liftIO $ checkBlocks solution s_row window_size s_occupied_rows s_occupied_columns s_occupied_negative_diagonals s_occupied_positive_diagonals break90 = nqueensBreak90 (++) (const $ return ()) callback90 callback180 callbackSearch break180 = nqueensBreak180 (++) (const $ return ()) callback180 callbackSearch in nqueensStart (++) callback90 callback180 callbackSearch [] n | n ← [2..14] ] -- }}} ,testGroup "correct symmetries" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ let callback90 solution state = do checkSymmetry n AllRotations solution break90 solution state callback180 solution next_state = do liftIO $ assertBool (printf "solution does not have 180 symmetry: %s" (show solution)) (hasRotate180Symmetry n solution) break180 solution next_state callbackSearch = const . const . checkSymmetry n NoSymmetries break90 = nqueensBreak90 (++) (liftIO . assertEqual "solution has the correct symmetry" AllRotations . symmetryOf n) callback90 callback180 callbackSearch break180 = nqueensBreak180 (++) (liftIO . assertEqual "solution has the correct symmetry" Rotate180Only . symmetryOf n) callback180 callbackSearch in nqueensStart (++) callback90 callback180 callbackSearch [] n | n ← [2..14] ] -- }}} ,testGroup "includes all solution exteriors" -- {{{ [ testCase ("n = " ++ show n) . exploreTreeT $ do let all_exteriors = Set.fromList . map sort $ getAllSolutions n solution ← nqueensBruteForceSolutions n let maximum_layers = (n+1) `div` 2 go layers | layers > maximum_layers = return () | otherwise = (assertBool ("solution " ++ show solution ++ " --> " ++ show (sort . map sort . allRotationsAndReflectionsOf n $ exterior :: [[(Word,Word)]]) ++ " (" ++ show (symmetryOf n exterior) ++ ") does not have a " ++ show layers ++ " exterior in the set") . any ( flip Set.member all_exteriors . sort ) . allRotationsAndReflectionsOf n $ exterior ) >> if symmetryOf n exterior > NoSymmetries then go (layers+1) else return () | otherwise = go (layers+1) where exterior = extractExteriorFromSolution n layers solution liftIO $ go 1 | n ← [2..12] ] -- }}} ,testGroup "includes all solutions" -- {{{ [ testCase ("n = " ++ show n) $ let finalizeValueWithSymmetry symmetry original_solution = do liftIO $ checkSolutionIsValid n (sort original_solution) liftIO $ checkSymmetry n symmetry (sort original_solution) solutions ← lift get let multiplied_solutions = map sort . multiplySolution n symmetry $ original_solution solution ← allFrom multiplied_solutions liftIO $ assertBool (printf "solution appears twice: %s --> %s" (show solution) (show multiplied_solutions)) (not $ Set.member solution solutions) lift $ modify (Set.insert solution) break90 = nqueensBreak90 (++) (finalizeValueWithSymmetry AllRotations) break90 break180 search break180 = nqueensBreak180 (++) (finalizeValueWithSymmetry Rotate180Only) break180 search search = nqueensSearch (++) (finalizeValueWithSymmetry NoSymmetries) in (flip execStateT Set.empty . exploreTreeT $ nqueensStart (++) break90 break180 search [] n :: IO (Set NQueensSolution) ) >>= assertEqual "missing solutions" Set.empty . Set.difference ( Set.fromList . map sort $ nqueensBruteForceSolutions n ) | n ← [4..12] ] -- }}} ,testGroup "unique" -- {{{ [ testCase ("n = " ++ show n) . flip evalStateT Set.empty . exploreTreeT $ do old_solutions ← lift get solution ← sort <$> getAllSolutions n >>= multiplySolution n NoSymmetries if (Set.member solution old_solutions) then liftIO $ assertFailure ("solution " ++ show solution ++ " occurs twice") else lift $ modify (Set.insert solution) | n ← [1..14] ] -- }}} ,testGroup "valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) . checkSolutionsAreValid n . getAllSolutions $ n) [2..14] -- }}} ] -- }}} ] -- }}} ,testGroup "brute force solutions" -- {{{ [testGroup "are valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) $ checkSolutionsAreValid n (nqueensBruteForceSolutions n)) [1..10] -- }}} ,testGroup "are unique" $ -- {{{ [ testCase ("n = " ++ show n) $ let solutions_as_list = nqueensBruteForceSolutions n solutions_as_set = Set.fromList solutions_as_list in length solutions_as_list @?= Set.size solutions_as_set | n ← [1..10] ] -- }}} ,testGroup "match count" -- {{{ [ testCase ("n = " ++ show n) $ (correct_count @=?) . getWordSum . exploreTree . nqueensBruteForceCount $ n | n ← [1..10] , let correct_count = nqueensCorrectCount n ] -- }}} ] -- }}} ,testGroup "C solutions" -- {{{ [testGroup "are valid" $ -- {{{ map (\n → testCase ("n = " ++ show n) $ checkSolutionsAreValid n (nqueensCSolutions n)) [1..10] -- }}} ,testGroup "are unique" $ -- {{{ [ testCase ("n = " ++ show n) $ let solutions_as_list = nqueensCSolutions n solutions_as_set = Set.fromList solutions_as_list in length solutions_as_list @?= Set.size solutions_as_set | n ← [1..10] ] -- }}} ,testGroup "match count" -- {{{ [ testCase ("n = " ++ show n) $ (correct_count @=?) . getWordSum . exploreTree . nqueensCCount $ n | n ← [1..10] , let correct_count = nqueensCorrectCount n ] -- }}} ] -- }}} ,testGroup "solutions" $ testSolutionsUsing nqueensSolutions nqueensCount ,testGroup "solutions using sets" $ testSolutionsUsing nqueensUsingSetsSolutions nqueensUsingSetsCount ,testGroup "solutions using bits" $ testSolutionsUsing nqueensUsingBitsSolutions nqueensUsingBitsCount ] -- }}}