-- Solves the n-Queens puzzle
-- by Scot Drysdale, 9/14/07

module Queens where

import List

nQueens :: Int -> [[Int]]
nQueens n = placeQueens n [[]] where

  -- Place queens in given column down to column 1 in all possible ways 
  -- in all partial solutions
  placeQueens :: Int -> [[Int]] -> [[Int]]
  placeQueens 0 solutions = solutions
  placeQueens col partials = 
     do row <- [1 .. n]
        partial <- partials
        let possibles = return (row:partial)
        placeQueens (col-1) (filter firstIsValid possibles)
  
  -- Tests if the first queen location in the list conflicts with later ones
  firstIsValid :: [Int] -> Bool
  firstIsValid (row:rows) = all (noConflict row) (zip rows [1 .. n])

  -- Takes a row number and a (row, column difference) pair and tests for 
  -- a conflict.  (Note that the column difference is needed to test for
  -- two queens on the same diagonal.)
  noConflict :: Int -> (Int, Int) -> Bool
  noConflict r (row, colDiff) = r /= row && abs (r - row) /= colDiff

main = nQueens 8

nQueensUnique :: Int -> [[Int]]
nQueensUnique n = elimSym (nQueens n)

-- Keep only non-symmetrical solutions in a list of solutions
elimSym :: [[Int]] -> [[Int]]
elimSym [] = []
elimSym (sol:rest) = sol : filter (notSym sol) (elimSym rest)

-- Tests if a pair of solutions is not symmetrical
notSym :: [Int] -> [Int] -> Bool
notSym sol1 sol2 =  let
    n         = length sol2
    horiz     = reverse
    vert sol  = map ((n+1) -) sol
    rot180    = reverse . vert
    diag      = pairs2list . swapPairs . list2pairs
    offdiag   = reverse . diag . reverse
    rot90     = pairs2list . (map (\ (r,c) -> (c, n+1-r))) . list2pairs 
    rot270    = rot90 . rot180
  in not (any (== sol1) [fn sol2 | 
         fn <- [horiz, vert, rot180, diag, offdiag, rot90, rot180, rot270]])
  
-- Return list of first coordinates, after sorting by second coordinates   
pairs2list :: [(Int, Int)] -> [Int]
pairs2list pairlst = map snd (sort (swapPairs pairlst))

-- Turn list of rows into (row, col) pairs
list2pairs :: [Int] -> [(Int, Int)]
list2pairs lst = zip lst [1 .. (length lst)]

-- Swap the order of all pairs in a list
swapPairs :: [(a, a)] -> [(a, a)]
swapPairs = map (\ (x, y) -> (y, x))