{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnicodeSyntax #-}

{-|
This module contains a heavily optimized solver for the n-queens problems.
Specifically, it uses the following tricks:

  * symmetry breaking to prune redundant solutions

  * unpacked datatypes instead of multiple arguments

  * optimized 'getOpenings'

  * C code for the inner-most loop

  * @INLINE@s in many places in order to create optimized specializations of
    the generic functions

Benchmarks were used to determine that all of these tricks resulted in
performance improvements using GHC 7.4.3.
 -}
module LogicGrowsOnTrees.Examples.Queens.Advanced
    (
    -- * Types
      NQueensSymmetry(..)
    , NQueensSolution
    , NQueensSolutions
    , PositionAndBit
    , PositionAndBitWithReflection
    -- * Main algorithm
    , nqueensGeneric
    -- ** Symmetry breaking
    -- $symmetry-breaking
    , nqueensStart
    , NQueensBreak90State(..)
    , nqueensBreak90
    , NQueensBreak180State(..)
    , nqueensBreak180
    -- ** Brute-force search
    -- $brute-force
    , NQueensSearchState(..)
    , nqueensSearch
    , nqueensBruteForceGeneric
    , nqueensBruteForceSolutions
    , nqueensBruteForceCount
    -- ** C inner-loop
    , c_LogicGrowsOnTrees_Queens_count_solutions
    , mkPushValue
    , mkPopValue
    , mkFinalizeValue
    , nqueensCSearch
    , nqueensCGeneric
    , nqueensCSolutions
    , nqueensCCount
    -- * Helper functions
    , allRotationsAndReflectionsOf
    , allRotationsOf
    , convertSolutionToWord
    , extractExteriorFromSolution
    , getOpenings
    , getSymmetricOpenings
    , hasReflectionSymmetry
    , hasRotate90Symmetry
    , hasRotate180Symmetry
    , multiplicityForSymmetry
    , multiplySolution
    , reflectBits
    , reflectSolution
    , rotate180
    , rotateLeft
    , rotateRight
    , symmetryOf
    ) where

import Control.Applicative ((<$>),liftA2)
import Control.Arrow ((***))
import Control.Exception (evaluate)
import Control.Monad (MonadPlus(..),(>=>),liftM,liftM2)

import Data.Bits ((.&.),(.|.),bit,rotateL,rotateR,unsafeShiftL,unsafeShiftR)
import Data.Function (on)
import Data.IORef (modifyIORef,newIORef,readIORef,writeIORef)
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Typeable (Typeable(..),cast)
import Data.Word (Word,Word64)

import Foreign.C.Types (CUInt(..))
import Foreign.Ptr (FunPtr,freeHaskellFunPtr,nullFunPtr)

import System.IO.Unsafe (unsafePerformIO)

import LogicGrowsOnTrees (Tree,between)
import LogicGrowsOnTrees.Utils.WordSum

--------------------------------------------------------------------------------
------------------------------------ Types -------------------------------------
--------------------------------------------------------------------------------

{-| The possible board symmetries. -}
data NQueensSymmetry =
    NoSymmetries {-^ the board has no symmetries at all -}
  | Rotate180Only {-^ the board is symmetric under 180 degree rotations -}
  | AllRotations {-^ the board is symmetric under all rotations -}
  | AllSymmetries {-^ the board is symmetric under all rotations and reflections -}
  deriving (Eq,Ord,Read,Show)

{-| Type alias for a solution, which takes the form of a list of coordinates. -}
type NQueensSolution = [(Word,Word)]

{-| Type alias for a list of solutions. -}
type NQueensSolutions = [NQueensSolution]

{-| Represents a position and bit at that position. -}
data PositionAndBit = PositionAndBit {-# UNPACK #-} !Int {-# UNPACK #-} !Word64

{-| Like 'PositionAndBit', but also including the same for the reflection of the
    position (i.e., one less than the board size minus the position).
 -}
data PositionAndBitWithReflection = PositionAndBitWithReflection {-# UNPACK #-} !Int {-# UNPACK #-} !Word64  {-# UNPACK #-} !Int {-# UNPACK #-} !Word64

--------------------------------------------------------------------------------
-------------------------------- Main algorithm --------------------------------
--------------------------------------------------------------------------------

-- NOTE:  the spaces before 'Typeable' are needed due to a haddock glitch
{-| Interface to the main algorithm;  note that α and β need to be   'Typeable'
    because of an optimization used in the C part of the code. This function
   takes functions for its first two operators that operate on partial solutions
   so that the same algorithm can be used both for generating solutions and
   counting them; the advantage of this approach is that it is much easier to
   find problems in the generated solution than it is in their count, so we can
   test it by looking for problems in the generated solutions, and when we are
   assured that it works we can trust it to obtain the correct counts.
 -}
nqueensGeneric ::
    (MonadPlus m
    ,Typeable α
    ,Typeable β
    ) ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solution -} →
    (Word → NQueensSymmetry → α → m β) {-^ function that finalizes a partial solution with the given board size and symmetry -} →
    α {-^ initial partial solution -} →
    Word {-^ board size -} →
    m β {-^ the final result -}
nqueensGeneric updateValue finalizeValueWithSymmetry initial_value 1 =
    finalizeValueWithSymmetry 1 AllSymmetries . updateValue [(0,0)] $ initial_value
nqueensGeneric _ _ _ 2 = mzero
nqueensGeneric _ _ _ 3 = mzero
nqueensGeneric updateValue finalizeValueWithSymmetry initial_value n =
    nqueensStart
        updateValue
        break90
        break180
        search
        initial_value
        n
  where
    break90 = nqueensBreak90 updateValue (finalizeValueWithSymmetry n AllRotations) break90 break180 search
    break180 = nqueensBreak180 updateValue (finalizeValueWithSymmetry n Rotate180Only) break180 search
    search value size state = nqueensSearch updateValue (finalizeValueWithSymmetry n NoSymmetries) value size state
{-# INLINE nqueensGeneric #-}

--------------------------------------------------------------------------------
------------------------------ Symmetry-breaking -------------------------------
--------------------------------------------------------------------------------

{- $symmetry-breaking
A performance gain can be obtained by factoring out symmetries because if, say,
a solution has rotational symmetry, then that means that there are four
configurations that are equivalent, and so we would ideally like to prune three
of these four equivalent solutions.

I call the approach used here "symmetry breaking". The idea is we start with a
perfectly symmetrical board (as it has nothing on it) and then we work our way
from the outside in. We shall use the term /layer/ to refer to a set of board
positions that form a centered (hollow) square on the board, so the outermost
layer is the set of all positions at the boundary of the board, the next layer
in is the square just nested in the outermost layer, and so in. At each step we
either preserve a given symmetry for the current layer or we break it; in the
former case we stay within the current routine to try to break it in the next
layer in, in the latter case we jump to a routine designed to break the new
symmetry in the next layer in. When all symmetries have been broken, we jump to
the brute-force search code. If we place all of the queens while having
preserved one or more symmetries, then either we apply the rotations and
reflections of the symmetry to generate all of the solutions or we multiply the
solution count by the number of equivalent solutions.

This code is unforunately quite complicated because there are many possibilities
for how to break or not break the symmetries and at each step it has to place
between 0 and 4 queens in such a way as to not conflict with any queen that has
already been placed.

Each function takes callbacks for each symmetry rather than directly calling
'nqueensBreak90', etc. in order to ease testing.

-}

-------------------------------- All symmeties ---------------------------------

{-| Break the reflection symmetry. -}
nqueensStart ::
    MonadPlus m ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → NQueensBreak90State → m β) {-^ function to break the rotational symmetry for the next inner layer -} →
    (α → NQueensBreak180State → m β) {-^ function to break the 180-degree rotational symmetry for the next inner layer -} →
    (α → Int → NQueensSearchState → m β) {-^ function to apply a brute-force search -} →
    α {-^ partial solution -} →
    Word {-^ board size -} →
    m β {-^ the final result -}
nqueensStart
  !updateValue_
  !break90
  !break180
  !search
  !value
  !n = (preserve90 `mplus` breakTo180) `mplus` (breakAtCorner `mplus` breakAtSides)
  where
    updateValue = updateValue_ . convertSolutionToWord
    half_inner_size = fromIntegral $ (n `div` 2) - 1
    last = fromIntegral $ n-1
    inner_last = last-1

    -- break to 90-degree rotational symmetry
    preserve90 = do
        position ← between 1 half_inner_size
        let reflected_position = last-position
            occupied_bits = bit position .|. bit reflected_position
        break90
            (updateValue
                [(position,last)
                ,(last,reflected_position)
                ,(reflected_position,0)
                ,(0,position)
                ]
                value
            )
            (NQueensBreak90State
                (n-4)
                 1
                (fromIntegral $ n-2)
                (occupied_bits `unsafeShiftR` 1)
                ((occupied_bits .|. (occupied_bits `unsafeShiftL` last)) `unsafeShiftR` 2)
                 (occupied_bits .|. (occupied_bits `rotateR` last))
            )

    -- break to 180-degree rotational symmetry
    breakTo180 = do
        top_column ← between 1 half_inner_size
        right_row ←
            if n .&. 1 == 0
                then between (top_column+1) (last-(top_column+1))
                else between (top_column+1) half_inner_size `mplus`
                     between (half_inner_size+2) (last-(top_column+1))
        let bottom_column = last-top_column
            left_row = last-right_row
            top_column_bit = bit top_column
            right_row_bit = bit right_row
            bottom_column_bit = bit bottom_column
            left_row_bit = bit left_row
        break180
            (updateValue
                [(left_row,last)
                ,(last,bottom_column)
                ,(right_row,0)
                ,(0,top_column)
                ]
                value
            )
            (NQueensBreak180State
                (n-4)
                 1
                (fromIntegral $ n-2)
                ((right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
                ((top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
                ((top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` last)) `unsafeShiftR` 2)
                 (top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `rotateR` last))
                 (right_row_bit .|. top_column_bit)
            )

    -- break all symmetries by placing a queen at a corner
    breakAtCorner = do
        left_row ← between 1 (inner_last-1)
        bottom_column ← between (left_row+1) inner_last
        let left_row_bit = bit left_row
            reflected_left_row_bit = bit (last-left_row)
            bottom_column_bit = bit bottom_column
        search
            (updateValue
                [(last,bottom_column)
                ,(left_row,last)
                ,(0,0)
                ]
                value
            )
            (fromIntegral $ n-2)
            (NQueensSearchState
                (n-3)
                 1
                (left_row_bit `unsafeShiftR` 1)
                (bottom_column_bit `unsafeShiftR` 1)
                ((left_row_bit .|. bottom_column_bit) `unsafeShiftL` (last-2))
                (1 .|. reflected_left_row_bit .|. (bottom_column_bit `rotateR` last))
            )

    -- break all symmetries without placing a queen at a corner
    breakAtSides = do
        top_column ← between 1 half_inner_size
        let reflected_top_column = last-top_column
            after_top_column = top_column+1
            reflected_after_top_column = reflected_top_column-1
        right_row ← between after_top_column reflected_after_top_column
        let reflected_right_row = last-right_row
        bottom_column ←
            between after_top_column (reflected_right_row-1) `mplus`
            between (reflected_right_row+1) reflected_top_column
        left_row ←
            if bottom_column == reflected_top_column
                then if reflected_right_row < right_row
                        then between top_column (reflected_right_row-1)
                        else between top_column (right_row-1) `mplus`
                             between (right_row+1) (reflected_right_row-1)
                else let (first,second)
                           | right_row < bottom_column = (right_row,bottom_column)
                           | otherwise                 = (bottom_column,right_row)
                     in  between top_column (first-1) `mplus`
                         between (first+1) (second-1) `mplus`
                         between (second+1) reflected_after_top_column
        let top_column_bit = bit top_column
            right_row_bit = bit right_row
            bottom_column_bit = bit bottom_column
            left_row_bit = bit left_row
        search
            (updateValue
                [(left_row,last)
                ,(last,bottom_column)
                ,(right_row,0)
                ,(0,top_column)
                ]
                value
            )
            (fromIntegral $ n-2)
            (NQueensSearchState
                (n-4)
                 1
                ((left_row_bit .|. right_row_bit) `unsafeShiftR` 1)
                ((top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
                ((top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` last)) `unsafeShiftR` 2)
                 (top_column_bit .|. bit (last-left_row) .|. (1 `rotateR` right_row) .|. (bottom_column_bit `rotateR` last))
            )

------------------------ 90-degree rotational symmetry -------------------------

{-| The state type while the 90-degree rotational symmetry is being broken. -}
data NQueensBreak90State = NQueensBreak90State
    {   b90_number_of_queens_remaining :: {-# UNPACK #-} !Word
    ,   b90_window_start :: {-# UNPACK #-} !Int
    ,   b90_window_size :: {-# UNPACK #-} !Int
    ,   b90_occupied_rows_and_columns :: {-# UNPACK #-} !Word64
    ,   b90_occupied_negative_diagonals :: {-# UNPACK #-} !Word64
    ,   b90_occupied_positive_diagonals :: {-# UNPACK #-} !Word64
    }

{-| Break the 90-degree rotational symmetry at the current layer. -}
nqueensBreak90 ::
    MonadPlus m ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    (α → NQueensBreak90State → m β) {-^ function to break the rotational symmetry for the next inner layer -} →
    (α → NQueensBreak180State → m β) {-^ function to break the 180-degree rotational symmetry for the next inner layer -} →
    (α → Int → NQueensSearchState → m β) {-^ function to apply a brute-force search -} →
    α {-^ partial solution -} →
    NQueensBreak90State {-^ current state -} →
    m β {-^ the final result -}
nqueensBreak90
  !updateValue_
  !finalizeValue
  !break90
  !break180
  !search
  !value
  !(NQueensBreak90State
      number_of_queens_remaining
      window_start
      window_size
      occupied_rows_and_columns
      occupied_negative_diagonals
      occupied_positive_diagonals
  )
  | number_of_queens_remaining == 0 = finalizeValue value
  | window_size > 3 =
     if occupied_rows_and_columns .&. 1 == 0
        then keep90 `mplus` breakTo180 `mplus`
                if occupied_negative_diagonals .&. 1 == 0
                    then breakAtCorner `mplus` breakAtSides
                    else breakAtSides
        else nextWindow
  | number_of_queens_remaining == 1 && occupied_rows_and_columns .&. 2 == 0 =
     finalizeValue ([(window_start+1,window_start+1)] `updateValue` value)
  | otherwise = mzero
  where
    updateValue = updateValue_ . convertSolutionToWord
    window_end = window_start+window_size-1
    end = window_size-1
    inner_size = window_size-2
    inner_end = window_size-3
    blocked = occupied_rows_and_columns .|. occupied_negative_diagonals .|. occupied_positive_diagonals
    inner_blocked = blocked `unsafeShiftR` 1
    inner_blocked_excluding_middle
      | window_size .&. 1 == 0 = inner_blocked
      | otherwise = inner_blocked .|. bit (inner_size `div` 2)

    -- place queens to preserve all rotational symmetries
    keep90 = do
        PositionAndBitWithReflection offset offset_bit reflected_offset reflected_offset_bit ←
            getSymmetricOpenings inner_size inner_blocked_excluding_middle
        let position = window_start+offset+1
            reflected_position = window_start+reflected_offset+1
            occupied_bits = (offset_bit .|. reflected_offset_bit) `unsafeShiftL` 1
        break90
            (updateValue
                [(position,window_end)
                ,(window_end,reflected_position)
                ,(reflected_position,window_start)
                ,(window_start,position)
                ]
                value
            )
            (NQueensBreak90State
                (number_of_queens_remaining-4)
                (window_start+1)
                (window_size-2)
                ((occupied_rows_and_columns .|. occupied_bits) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. occupied_bits .|. (occupied_bits `unsafeShiftL` end)) `unsafeShiftR` 2)
                 (occupied_positive_diagonals .|. occupied_bits .|. (occupied_bits `rotateR` end))
            )

    -- place queens to break down to 180-degree rotational symmetry
    breakTo180 = do
        PositionAndBit inner_top_column inner_top_column_bit ←
            getOpenings (inner_size-1) inner_blocked_excluding_middle
        PositionAndBit inner_right_row _ ←
            getOpenings (inner_end-inner_top_column) (inner_blocked_excluding_middle .|. inner_top_column_bit)
        let top_column = inner_top_column+1
            bottom_column = end-top_column
            right_row = inner_right_row+1
            left_row = end-right_row
            top_column_bit = bit top_column
            bottom_column_bit = bit bottom_column
            right_row_bit = bit right_row
            left_row_bit = bit left_row
            new_occupied_positive_diagonals = occupied_positive_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `rotateR` end)
        break180
            (updateValue
               [(window_start+left_row,window_end)
               ,(window_end,window_start+bottom_column)
               ,(window_start+right_row,window_start)
               ,(window_start,window_start+top_column)
               ]
               value
            )
            (NQueensBreak180State
                (number_of_queens_remaining-4)
                (window_start+1)
                (window_size-2)
                ((occupied_rows_and_columns .|. right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
                ((occupied_rows_and_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` end)) `unsafeShiftR` 2)
                 new_occupied_positive_diagonals
                (reflectBits new_occupied_positive_diagonals)
            )

    -- fully break all symmetries by placing a queen at a corner
    breakAtCorner = do
        PositionAndBit inner_left_row inner_left_row_bit ←
            getOpenings inner_size inner_blocked
        PositionAndBit inner_bottom_column _ ←
            getOpenings inner_size (inner_blocked .|. inner_left_row_bit)
        let left_row = inner_left_row+1
            bottom_column = inner_bottom_column+1                
            left_row_bit = bit left_row
            reflected_left_row_bit = bit (end-left_row)
            bottom_column_bit = bit bottom_column
        search
            (updateValue
                [(window_end,window_start+bottom_column)
                ,(window_start+left_row,window_end)
                ,(window_start,window_start)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-3)
                (window_start+1)
                ((occupied_rows_and_columns .|. left_row_bit) `unsafeShiftR` 1)
                ((occupied_rows_and_columns .|. bottom_column_bit) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. ((left_row_bit .|. bottom_column_bit) `unsafeShiftL` end)) `unsafeShiftR` 2)
                 (occupied_positive_diagonals .|. 1 .|. reflected_left_row_bit .|. (bottom_column_bit `rotateR` end))
            )

    -- fully break all symmetries placing no queens at a corner
    breakAtSides = do
        PositionAndBit inner_top_column _ ←
            getOpenings (inner_size-1) inner_blocked
        let inner_reflected_top_column = inner_end-inner_top_column
            inner_reflected_top_column_bit = bit inner_reflected_top_column
            size_of_space_above_inner_top_column = inner_end-inner_top_column
            size_of_space_above_and_including_inner_top_column = size_of_space_above_inner_top_column + 1
            shift_to_inner_top_column = inner_top_column
            shift_to_just_past_inner_top_column = inner_top_column+1
        PositionAndBit inner_right_offset _ ←
            getOpenings
                size_of_space_above_inner_top_column
                ((inner_blocked .|. bit inner_reflected_top_column) `unsafeShiftR` shift_to_just_past_inner_top_column)
        let inner_reflected_right_row = inner_right_offset + inner_top_column + 1
            inner_right_row = inner_end - inner_reflected_right_row 
        PositionAndBit inner_bottom_offset _ ←
            getOpenings
                size_of_space_above_and_including_inner_top_column
                ((inner_blocked .|. inner_reflected_top_column_bit .|. bit inner_right_row) `unsafeShiftR` shift_to_inner_top_column)
        let inner_bottom_column = inner_end - (inner_bottom_offset + inner_top_column)
        PositionAndBit inner_left_row_offset _ ←
            getOpenings
                (if inner_bottom_offset > 0
                    then size_of_space_above_and_including_inner_top_column
                    else inner_reflected_right_row-inner_top_column
                )
                ((inner_blocked .|. bit inner_right_row .|. bit inner_bottom_column .|. inner_reflected_top_column_bit) `unsafeShiftR` shift_to_inner_top_column)
        let top_column = inner_top_column + 1
            right_row = inner_right_row + 1
            bottom_column = inner_bottom_column + 1
            left_row = inner_left_row_offset + inner_top_column + 1
            top_column_bit = bit top_column
            right_row_bit = bit right_row
            bottom_column_bit = bit bottom_column
            left_row_bit = bit left_row
        search
            (updateValue
                [(window_start+left_row,window_end)
                ,(window_end,window_start+bottom_column)
                ,(window_start+right_row,window_start)
                ,(window_start,window_start+top_column)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-4)
                (window_start+1)
                ((occupied_rows_and_columns .|. left_row_bit .|. right_row_bit) `unsafeShiftR` 1)
                ((occupied_rows_and_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` end)) `unsafeShiftR` 2)
                 (occupied_positive_diagonals .|. top_column_bit .|. bit (end-left_row) .|. (1 `rotateR` right_row) .|. (bottom_column_bit `rotateR` end))
            )

    -- all squares in this layer are occupied, go to the next one
    nextWindow = break90 value $
        NQueensBreak90State
             number_of_queens_remaining
            (window_start+1)
            (window_size-2)
            (occupied_rows_and_columns `unsafeShiftR` 1)
            (occupied_negative_diagonals `unsafeShiftR` 2)
             occupied_positive_diagonals

----------------------- 180-degree rotational symmetry -------------------------

{-| The state while the 180-degree rotational symmetry is being broken. -}
data NQueensBreak180State = NQueensBreak180State
    {   b180_number_of_queens_remaining :: {-# UNPACK #-} !Word
    ,   b180_window_start :: {-# UNPACK #-} !Int
    ,   b180_window_size :: {-# UNPACK #-} !Int
    ,   b180_occupied_rows :: {-# UNPACK #-} !Word64
    ,   b180_occupied_columns :: {-# UNPACK #-} !Word64
    ,   b180_occupied_negative_diagonals :: {-# UNPACK #-} !Word64
    ,   b180_occupied_positive_diagonals :: {-# UNPACK #-} !Word64
    ,   b180_occupied_right_positive_diagonals :: {-# UNPACK #-} !Word64
    }

{-| Break the 180-degree rotational symmetry at the current layer. -}
nqueensBreak180 ::
    MonadPlus m ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    (α → NQueensBreak180State → m β) {-^ function to break the 180-degree rotational symmetry for the next inner layer -} →
    (α → Int → NQueensSearchState → m β) {-^ function to apply a brute-force search -} →
    α {-^ partial solution -} →
    NQueensBreak180State {-^ current state -} →
    m β {-^ the final result -}
nqueensBreak180
  !updateValue_
  !finalizeValue
  !break180
  !search
  !value
  !(NQueensBreak180State
      number_of_queens_remaining
      window_start
      window_size
      occupied_rows
      occupied_columns
      occupied_negative_diagonals
      occupied_positive_diagonals
      occupied_right_positive_diagonals
  )
  | number_of_queens_remaining == 0 = finalizeValue value
  | window_size > 3 =
     if occupied_rows .&. 1 == 0
        then if occupied_columns .&. 1 == 0
                then mplus preserve180 $
                    if occupied_negative_diagonals .&. end_bit .|. occupied_positive_diagonals .&. end_bit == 0
                        then if occupied_negative_diagonals .&. bit (2*end) .|. occupied_positive_diagonals .&. 1 == 0
                                then breakAtBottomLeftCorner `mplus` breakAtTopLeftCorner `mplus` breakAtSides
                                else breakAtTopLeftCorner `mplus` breakAtSides
                        else if occupied_negative_diagonals .&. bit (2*end) .|. occupied_positive_diagonals .&. 1 == 0
                                then breakAtBottomLeftCorner `mplus` breakAtSides
                                else breakAtSides
                else preserve180Horizontal `mplus` breakAtHorizontalSides
        else if occupied_columns .&. 1 == 0
                then preserve180Vertical `mplus` breakAtVerticalSides
                else nextWindow
  | number_of_queens_remaining == 1 && (occupied_rows .|. occupied_columns) .&. 2 == 0 =
     finalizeValue ([(window_start+1,window_start+1)] `updateValue` value)
  | otherwise = mzero
  where
    updateValue = updateValue_ . convertSolutionToWord
    end = window_size-1
    end_bit = bit end
    window_end = window_start+end
    inner_size = window_size-2
    inner_end = window_size-3
    horizontal_blocked = occupied_columns .|. occupied_negative_diagonals .|. occupied_positive_diagonals
    inner_horizontal_blocked = horizontal_blocked `unsafeShiftR` 1
    inner_horizontal_blocked_excluding_middle
      | window_size .&. 1 == 0 = inner_horizontal_blocked
      | otherwise = inner_horizontal_blocked .|. bit (window_size `div` 2 - 1)
    vertical_blocked = occupied_rows .|. occupied_negative_diagonals .|. occupied_right_positive_diagonals
    inner_vertical_blocked = vertical_blocked `unsafeShiftR` 1
    inner_vertical_blocked_excluding_middle
      | window_size .&. 1 == 0 = inner_vertical_blocked
      | otherwise = inner_vertical_blocked .|. bit (window_size `div` 2 - 1)

    -- break the symmetry without placing a queen at a corner
    breakAtSides = do
        PositionAndBit inner_top_column inner_top_column_bit ←
            getOpenings
                inner_size
                inner_horizontal_blocked
        let inner_reflected_top_column_bit = bit (inner_end - inner_top_column)
        PositionAndBit inner_right_row inner_right_row_bit ←
            getOpenings
                inner_size
               (inner_vertical_blocked .|. inner_top_column_bit)
        PositionAndBit inner_reflected_bottom_column_offset _ ←
            getOpenings
               (inner_end-inner_top_column+1)
              ((inner_horizontal_blocked .|. inner_reflected_top_column_bit .|. inner_right_row_bit) `unsafeShiftR` inner_top_column)
        let inner_reflected_bottom_column = inner_top_column + inner_reflected_bottom_column_offset
            inner_reflected_bottom_column_bit = bit inner_reflected_bottom_column
        PositionAndBit inner_reflected_left_row _ ←
            getOpenings
                (if inner_reflected_bottom_column_offset > 0
                    then inner_size
                    else inner_right_row
                )
                (inner_vertical_blocked .|. bit (inner_end - inner_right_row) .|. inner_reflected_bottom_column_bit .|. inner_top_column_bit)
        let top_column = inner_top_column + 1
            top_column_bit = bit top_column
            right_row = inner_right_row + 1
            right_row_bit = bit right_row
            reflected_right_row_bit = bit (end-right_row)
            bottom_column = inner_end - inner_reflected_bottom_column + 1
            bottom_column_bit = bit bottom_column
            left_row = inner_end - inner_reflected_left_row + 1
            left_row_bit = bit left_row
            reflected_left_row_bit = bit (end-left_row)
        search
            (updateValue
                [(window_start+left_row,window_end)
                ,(window_end,window_start+bottom_column)
                ,(window_start+right_row,window_start)
                ,(window_start,window_start+top_column)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-4)
                (window_start+1)
               ((occupied_rows .|. right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
               ((occupied_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. top_column_bit .|. reflected_left_row_bit .|. ((bottom_column_bit .|. reflected_right_row_bit) `rotateR` end))
            )

    -- break the symmetry by placing queens only on the horizontal sides
    breakAtHorizontalSides = do
        PositionAndBit inner_top_column _ ←
            getOpenings
               (inner_size-1)
                inner_horizontal_blocked
        PositionAndBit inner_reflected_bottom_column_offset _ ←
            getOpenings
               (inner_end-inner_top_column)
              ((inner_horizontal_blocked .|. bit (inner_end - inner_top_column)) `unsafeShiftR` (inner_top_column+1))
        let top_column = inner_top_column + 1
            top_column_bit = bit top_column
            bottom_column = inner_end - (inner_top_column + inner_reflected_bottom_column_offset + 1) + 1
            bottom_column_bit = bit bottom_column
        search
            (updateValue
                [(window_end,window_start+bottom_column)
                ,(window_start,window_start+top_column)
                ]
                value
           )
           (window_size-2)
           (NQueensSearchState
                (number_of_queens_remaining-2)
                (window_start+1)
                (occupied_rows `unsafeShiftR` 1)
               ((occupied_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. top_column_bit .|. (bottom_column_bit `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. top_column_bit .|. (bottom_column_bit `rotateR` end))
           )

    -- break the symmetry by placing queens only on the vertical sides
    breakAtVerticalSides = do
        PositionAndBit inner_right_row _ ←
            getOpenings
               (inner_size-1)
                inner_vertical_blocked
        PositionAndBit inner_reflected_left_row_offset _ ←
            getOpenings
               (inner_end-inner_right_row)
              ((inner_vertical_blocked .|. bit (inner_end - inner_right_row)) `unsafeShiftR` (inner_right_row+1))
        let right_row = inner_right_row + 1
            right_row_bit = bit right_row
            reflected_right_row_bit = bit (end-right_row)
            left_row = inner_end - (inner_right_row + inner_reflected_left_row_offset + 1) + 1
            left_row_bit = bit left_row
            reflected_left_row_bit = bit (end-left_row)
        search
            (updateValue
                [(window_start+left_row,window_end)
                ,(window_start+right_row,window_start)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-2)
                (window_start+1)
               ((occupied_rows .|. right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
                (occupied_columns `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. right_row_bit .|. (left_row_bit `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. reflected_left_row_bit .|. (reflected_right_row_bit `rotateR` end))
            )

    -- break by placing a queen at the bottom-left corner
    breakAtBottomLeftCorner = do
        PositionAndBit inner_right_row inner_right_row_bit ←
            getOpenings inner_size inner_vertical_blocked
        PositionAndBit inner_top_column _ ←
            getOpenings inner_size (inner_horizontal_blocked .|. inner_right_row_bit)
        let right_row = inner_right_row+1
            top_column = inner_top_column+1                
            right_row_bit = bit right_row
            reflected_right_row_bit = bit (end-right_row)
            top_column_bit = bit top_column
        search
            (updateValue
                [(window_start,window_start+top_column)
                ,(window_start+right_row,window_start)
                ,(window_end,window_end)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-3)
                (window_start+1)
                ((occupied_rows .|. right_row_bit) `unsafeShiftR` 1)
                ((occupied_columns .|. top_column_bit) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. right_row_bit .|. top_column_bit) `unsafeShiftR` 2)
                 (occupied_positive_diagonals .|. 1 .|. top_column_bit .|. (reflected_right_row_bit `rotateR` end))
            )

    -- break by placing a queen at the top-left corner
    breakAtTopLeftCorner = do
        PositionAndBit inner_right_row inner_right_row_bit ←
            getOpenings inner_size inner_vertical_blocked
        PositionAndBit inner_reflected_bottom_column _ ←
            getOpenings inner_size (inner_horizontal_blocked .|. inner_right_row_bit)
        let right_row = inner_right_row + 1
            bottom_column = inner_end - inner_reflected_bottom_column + 1                
            right_row_bit = bit right_row
            reflected_right_row_bit = bit (end-right_row)
            bottom_column_bit = bit bottom_column
        search
            (updateValue
                [(window_end,window_start+bottom_column)
                ,(window_start+right_row,window_start)
                ,(window_start,window_end)
                ]
                value
            )
            (window_size-2)
            (NQueensSearchState
                (number_of_queens_remaining-3)
                (window_start+1)
                ((occupied_rows .|. right_row_bit) `unsafeShiftR` 1)
                ((occupied_columns .|. bottom_column_bit) `unsafeShiftR` 1)
                ((occupied_negative_diagonals .|. end_bit .|. right_row_bit .|. (bottom_column_bit `unsafeShiftL` end)) `unsafeShiftR` 2)
                 (occupied_positive_diagonals .|. ((reflected_right_row_bit .|. bottom_column_bit) `rotateR` end))
            )

    -- preserve the 180-degree rotational symmetry
    preserve180 = do
        PositionAndBit inner_top_column inner_top_column_bit ←
            getOpenings
                inner_size
                inner_horizontal_blocked_excluding_middle
        let top_column = inner_top_column + 1
            top_column_bit = bit top_column
            bottom_column = inner_end - inner_top_column + 1
            bottom_column_bit = bit bottom_column
        PositionAndBit inner_right_row _ ←
            getOpenings
                inner_size
               (inner_vertical_blocked_excluding_middle .|. inner_top_column_bit)
        let right_row = inner_right_row + 1
            right_row_bit = bit right_row
            left_row = inner_end - inner_right_row + 1
            left_row_bit = bit left_row
        break180
            (updateValue
                [(window_start+left_row,window_end)
                ,(window_start+right_row,window_start)
                ,(window_end,window_start+bottom_column)
                ,(window_start,window_start+top_column)
                ]
                value
            )
            (NQueensBreak180State
                (number_of_queens_remaining-4)
                (window_start+1)
                (window_size-2)
               ((occupied_rows .|. right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
               ((occupied_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. top_column_bit .|. right_row_bit .|. ((bottom_column_bit .|. left_row_bit) `rotateR` end))
                (occupied_right_positive_diagonals .|. top_column_bit .|. right_row_bit)
            )

    -- preserve the 180-degree symmetry for the horizontal sides
    preserve180Horizontal = do
        PositionAndBit inner_top_column _ ←
            getOpenings
                inner_size
                inner_horizontal_blocked_excluding_middle
        let top_column = inner_top_column + 1
            top_column_bit = bit top_column
            bottom_column = inner_end - inner_top_column + 1
            bottom_column_bit = bit bottom_column
        break180
            (updateValue
                [(window_end,window_start+bottom_column)
                ,(window_start,window_start+top_column)
                ]
                value
           )
           (NQueensBreak180State
                (number_of_queens_remaining-2)
                (window_start+1)
                (window_size-2)
                (occupied_rows `unsafeShiftR` 1)
               ((occupied_columns .|. top_column_bit .|. bottom_column_bit) `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. top_column_bit .|. (bottom_column_bit `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. top_column_bit .|. (bottom_column_bit `rotateR` end))
                (occupied_right_positive_diagonals .|. top_column_bit)
           )

    -- preserve the 180-degree symmetry for the vertical sides
    preserve180Vertical = do
        PositionAndBit inner_right_row _ ←
            getOpenings
                inner_size
                inner_vertical_blocked_excluding_middle
        let right_row = inner_right_row + 1
            right_row_bit = bit right_row
            left_row = inner_end - inner_right_row + 1
            left_row_bit = bit left_row
        break180
            (updateValue
                [(window_start+left_row,window_end)
                ,(window_start+right_row,window_start)
                ]
                value
            )
            (NQueensBreak180State
                (number_of_queens_remaining-2)
                (window_start+1)
                (window_size-2)
               ((occupied_rows .|. right_row_bit .|. left_row_bit) `unsafeShiftR` 1)
                (occupied_columns `unsafeShiftR` 1)
               ((occupied_negative_diagonals .|. right_row_bit .|. (left_row_bit `unsafeShiftL` end)) `unsafeShiftR` 2)
                (occupied_positive_diagonals .|. right_row_bit .|. (left_row_bit `rotateR` end))
                (occupied_right_positive_diagonals .|. right_row_bit)
            )

    -- all sides are occupied, so go to the next layer in
    nextWindow = break180 value $
        NQueensBreak180State
             number_of_queens_remaining
            (window_start+1)
            (window_size-2)
            (occupied_rows `unsafeShiftR` 1)
            (occupied_columns `unsafeShiftR` 1)
            (occupied_negative_diagonals `unsafeShiftR` 2)
             occupied_positive_diagonals
             occupied_right_positive_diagonals

--------------------------------------------------------------------------------
---------------------------- Brute-force searching -----------------------------
--------------------------------------------------------------------------------

{- $brute-force
After the symmetry has been fully broken, the brute-force approach attempts to
place queens in the remaining inner sub-board.  When the number of queens falls
to 10 or less, it farms the rest of the search out to a routine written in C.
 -}

{-| The state during the brute-force search. -}
data NQueensSearchState = NQueensSearchState
    {   s_number_of_queens_remaining :: {-# UNPACK #-} !Word
    ,   s_row :: {-# UNPACK #-} !Int
    ,   s_occupied_rows :: {-# UNPACK #-} !Word64
    ,   s_occupied_columns :: {-# UNPACK #-} !Word64
    ,   s_occupied_negative_diagonals :: {-# UNPACK #-} !Word64
    ,   s_occupied_positive_diagonals :: {-# UNPACK #-} !Word64
    }

{-| Using brute-force to find placements for all of the remaining queens. -}
nqueensSearch ::
    (MonadPlus m
    ,Typeable α
    ,Typeable β
    ) ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    α {-^ partial solution -} →
    Int {-^ board size -} →
    NQueensSearchState {-^ current state -} →
    m β {-^ the final result -}
nqueensSearch updateValue_ finalizeValue initial_value size initial_search_state@(NQueensSearchState _ window_start _ _ _ _) =
    go initial_value initial_search_state
  where
    updateValue = updateValue_ . convertSolutionToWord
    go !value !s@(NQueensSearchState
                    number_of_queens_remaining
                    row
                    occupied_rows
                    occupied_columns
                    occupied_negative_diagonals
                    occupied_positive_diagonals
               )
      | number_of_queens_remaining <= 10 =
         nqueensCSearch
            updateValue_
            finalizeValue
            value
            size
            window_start
            s
      | occupied_rows .&. 1 == 0 =
         (getOpenings size $
            occupied_columns .|. occupied_negative_diagonals .|. occupied_positive_diagonals
         )
         >>=
         \(PositionAndBit offset offset_bit) → go
            ([(row,window_start+offset)] `updateValue` value)
            (NQueensSearchState
                (number_of_queens_remaining-1)
                (row+1)
                (occupied_rows `unsafeShiftR` 1)
                (occupied_columns .|. offset_bit)
                ((occupied_negative_diagonals .|. offset_bit) `unsafeShiftR` 1)
                ((occupied_positive_diagonals .|. offset_bit) `rotateL` 1)
            )
      | otherwise =
         go value
            (NQueensSearchState
                 number_of_queens_remaining
                (row+1)
                (occupied_rows `unsafeShiftR` 1)
                 occupied_columns
                (occupied_negative_diagonals `unsafeShiftR` 1)
                (occupied_positive_diagonals `rotateL` 1)
            )
{-# INLINE nqueensSearch #-}

{-| Interface for directly using the brute-force search approach -} 
nqueensBruteForceGeneric ::
    (MonadPlus m
    ,Typeable α
    ,Typeable β
    ) ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    α {-^ initial solution -} →
    Word {-^ board size -} →
    m β {-^ the final result -}
nqueensBruteForceGeneric updateValue finalizeValue initial_value 1 = finalizeValue . updateValue [(0,0)] $ initial_value
nqueensBruteForceGeneric _ _ _ 2 = mzero
nqueensBruteForceGeneric _ _ _ 3 = mzero
nqueensBruteForceGeneric updateValue finalizeValue initial_value n = nqueensSearch updateValue finalizeValue initial_value (fromIntegral n) $ NQueensSearchState n 0 0 0 0 0
{-# INLINE nqueensBruteForceGeneric #-}

{-| Generates the solutions to the n-queens problem with the given board size. -}
nqueensBruteForceSolutions :: MonadPlus m ⇒ Word → m NQueensSolution
nqueensBruteForceSolutions = nqueensBruteForceGeneric (++) return []
{-# SPECIALIZE nqueensBruteForceSolutions :: Word → NQueensSolutions #-}
{-# SPECIALIZE nqueensBruteForceSolutions :: Word → Tree NQueensSolution #-}

{-| Generates the solution count to the n-queens problem with the given board size. -}
nqueensBruteForceCount :: MonadPlus m ⇒ Word → m WordSum
nqueensBruteForceCount = nqueensBruteForceGeneric (const id) (const . return $ WordSum 1) ()
{-# SPECIALIZE nqueensBruteForceCount :: Word → [WordSum] #-}
{-# SPECIALIZE nqueensBruteForceCount :: Word → Tree WordSum #-}

--------------------------------------------------------------------------------
--------------------------------- C inner-loop ---------------------------------
--------------------------------------------------------------------------------

{-| C code that performs a brute-force search for the remaining queens.  The
    last three arguments are allowed to be NULL, in which case they are ignored
    and only the count is returned.
 -}
foreign import ccall safe "queens.h LogicGrowsOnTrees_Queens_count_solutions" c_LogicGrowsOnTrees_Queens_count_solutions ::
    CUInt {-^ board size -} →
    CUInt {-^ number of queens remaining -} →
    CUInt {-^ row number -} →
    Word64 {-^ occupied rows -} →
    Word64 {-^ occupied columns -} →
    Word64 {-^ occupied negative diagonals -} →
    Word64 {-^ occupied positive diagonals -} →
    FunPtr (CUInt -> CUInt → IO ()) {-^ function to push a coordinate on the partial solution;  may be NULL ^-} →
    FunPtr (IO ()) {-^ function to pop a coordinate from partial solution;  may be NULL ^-}  →
    FunPtr (IO ()) {-^ function to finalize a solution;  may be NULL ^-}  →
    IO CUInt

{-| wrapper stub for the push value function pointer -}
foreign import ccall "wrapper" mkPushValue :: (CUInt → CUInt → IO ()) → IO (FunPtr (CUInt → CUInt → IO ()))

{-| wrapper stub for the pop value function pointer -}
foreign import ccall "wrapper" mkPopValue :: IO () → IO (FunPtr (IO ()))

{-| wrapper stub for the finalize value function pointer -}
foreign import ccall "wrapper" mkFinalizeValue :: IO () → IO (FunPtr (IO ()))

{-| Calls C code to perform a brute-force search for the remaining queens.  The
    types α and β must be   'Typeable' because this function actually optimizes
    for the case where only counting is being done by providing null values for
    the function pointer inputs.
 -}
nqueensCSearch ::
    ∀ α m β.
    (MonadPlus m
    ,Typeable α
    ,Typeable β
    ) ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    α {-^ partial solution -} →
    Int {-^ board size -} →
    Int {-^ window start -} →
    NQueensSearchState {-^ current state -} →
    m β {-^ the final result -}
nqueensCSearch _ finalizeValue value _ _ NQueensSearchState{s_number_of_queens_remaining=0} = finalizeValue value
nqueensCSearch updateValue finalizeValue value size window_start NQueensSearchState{..}
  | typeOf value == typeOf () && typeOf (undefined :: β) == typeOf (undefined :: WordSum) = do
        Just (WordSum multiplier) ← liftM cast (finalizeValue value)
        let number_found =
                fromIntegral
                .
                unsafePerformIO
                $
                c_LogicGrowsOnTrees_Queens_count_solutions
                    (fromIntegral size)
                    (fromIntegral s_number_of_queens_remaining)
                    (fromIntegral s_row)
                    s_occupied_rows
                    s_occupied_columns
                    s_occupied_negative_diagonals
                    s_occupied_positive_diagonals
                    nullFunPtr
                    nullFunPtr
                    nullFunPtr
        return . fromJust . cast $ WordSum (multiplier * number_found)
  | otherwise = unsafePerformIO $ do
        value_stack_ref ← newIORef [value]
        finalized_values ← newIORef mzero
        push_value_funptr ← mkPushValue $ \row offset → modifyIORef value_stack_ref (\stack@(value:_) → updateValue [(fromIntegral row, fromIntegral window_start + fromIntegral offset)] value:stack)
        pop_value_funptr ← mkPopValue $ modifyIORef value_stack_ref tail
        finalize_value_funptr ← mkFinalizeValue $ do
            value ← head <$> readIORef value_stack_ref
            let finalized_value = finalizeValue value
            old_value ← readIORef finalized_values
            new_value ← evaluate $ old_value `mplus` finalized_value
            writeIORef finalized_values new_value
        _ ← c_LogicGrowsOnTrees_Queens_count_solutions
                (fromIntegral size)
                (fromIntegral s_number_of_queens_remaining)
                (fromIntegral s_row)
                s_occupied_rows
                s_occupied_columns
                s_occupied_negative_diagonals
                s_occupied_positive_diagonals
                push_value_funptr
                pop_value_funptr
                finalize_value_funptr
        freeHaskellFunPtr push_value_funptr
        freeHaskellFunPtr pop_value_funptr
        freeHaskellFunPtr finalize_value_funptr
        readIORef finalized_values

{-| Interface for directly using the C search approach -} 
nqueensCGeneric ::
    (MonadPlus m
    ,Typeable α
    ,Typeable β
    ) ⇒
    ([(Word,Word)] → α → α) {-^ function that adds a list of coordinates to the partial solutions -} →
    (α → m β) {-^ function that finalizes the partial solution -} →
    α {-^ initial value -} →
    Word {-^ the board size -} →
    m β {-^ the final result -}
nqueensCGeneric updateValue finalizeValue initial_value 1 =
    finalizeValue . updateValue [(0,0)] $ initial_value
nqueensCGeneric _ _ _ 2 = mzero
nqueensCGeneric _ _ _ 3 = mzero
nqueensCGeneric updateValue finalizeValue initial_value n =
    nqueensCSearch updateValue finalizeValue initial_value (fromIntegral n) 0 $
        NQueensSearchState n 0 0 0 0 0
{-# INLINE nqueensCGeneric #-}

{-| Generates the solutions to the n-queens problem with the given board size. -}
nqueensCSolutions :: MonadPlus m ⇒ Word → m NQueensSolution
nqueensCSolutions = nqueensCGeneric (++) return []
{-# SPECIALIZE nqueensCSolutions :: Word → NQueensSolutions #-}
{-# SPECIALIZE nqueensCSolutions :: Word → Tree NQueensSolution #-}

{-| Generates the solution count to the n-queens problem with the given board size. -}
nqueensCCount :: MonadPlus m ⇒ Word → m WordSum
nqueensCCount = nqueensCGeneric (const id) (const . return $ WordSum 1) ()
{-# SPECIALIZE nqueensCCount :: Word → [WordSum] #-}
{-# SPECIALIZE nqueensCCount :: Word → Tree WordSum #-}

--------------------------------------------------------------------------------
------------------------------ Utility functions -------------------------------
--------------------------------------------------------------------------------

{-| Computes all rotations and reflections of the given solution. -}
allRotationsAndReflectionsOf ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolutions {-^ all rotations and reflections of the given solution -}
allRotationsAndReflectionsOf = flip multiplySolution NoSymmetries

{-| Computes all rotations of the given solution. -}
allRotationsOf ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolutions {-^ all rotations of the given solution -}
allRotationsOf n = take 4 . iterate (rotateLeft n)

{-| Converts coordinates of type 'Int' to type 'Word'. -}
convertSolutionToWord :: [(Int,Int)] → [(Word,Word)]
convertSolutionToWord = map (fromIntegral *** fromIntegral)

{-| Extracts the outermost layers of a solution. -}
extractExteriorFromSolution ::
    Word {-^ board size -} →
    Word {-^ number of outer layers to extract -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolution {-^ the outermost layers of the solution -}
extractExteriorFromSolution size layers = filter . uncurry $ ((||) `on` (liftA2 (||) (< threshold_1) (> threshold_2)))
  where
    threshold_1 = layers
    threshold_2 = size-layers-1

{-| Get the openings for a queen -}
getOpenings ::
    MonadPlus m ⇒
    Int {-^ board size -} →
    Word64 {-^ occupied positions -} →
    m PositionAndBit {-^ open positions and their corresponding bits -}
getOpenings size blocked
    | blocked .&. mask == mask = mzero
    | otherwise = go (PositionAndBit 0 1)
  where
    mask = bit size - 1
    go !x@(PositionAndBit i b)
     | i >= size          = mzero
     | b .&. blocked == 0 = return x `mplus` go next_x
     | otherwise          = go next_x
     where
       next_x = PositionAndBit (i+1) (b `unsafeShiftL` 1)
{-# INLINE getOpenings #-}

{-| Get the symmetric openings for a queen -}
getSymmetricOpenings ::
    MonadPlus m ⇒
    Int {-^ board size -} →
    Word64 {-^ occupied positions -} →
    m PositionAndBitWithReflection {-^ open positions and their corresponding bits and reflections -}
getSymmetricOpenings size blocked
    | blocked .&. mask == mask = mzero
    | otherwise = go (PositionAndBitWithReflection 0 1 end end_bit)
  where
    end = size-1
    end_bit = bit end
    mask = bit size - 1
    go x@(PositionAndBitWithReflection i b ri rb)
     | i >= ri            = mzero
     | b .&. blocked == 0 = return x `mplus` return (PositionAndBitWithReflection ri rb i b) `mplus` go next_bit
     | otherwise          = go next_bit
     where
       next_bit = PositionAndBitWithReflection (i+1) (b `unsafeShiftL` 1) (ri-1) (rb `unsafeShiftR` 1)
{-# INLINE getSymmetricOpenings #-}

{-| Checks if a solution has reflection symmetry. -}
hasReflectionSymmetry ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    Bool {-^ true if the given solution has reflection symmetry -}
hasReflectionSymmetry n = liftA2 ((==) `on` sort) id (reflectSolution n)

{-| Checks if a solution has 90-degree rotation symmetry. -}
hasRotate90Symmetry ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    Bool {-^ true if the given solution has 90-degree rotation symmetry -}
hasRotate90Symmetry n = liftA2 ((==) `on` sort) id (rotateLeft n)

{-| Checks if a solution has 180-degree rotation symmetry. -}
hasRotate180Symmetry ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    Bool {-^ true if the given solution has 180-degree rotation symmetry -}
hasRotate180Symmetry n = liftA2 ((==) `on` sort) id (rotate180 n)

{-| Returns the number of equivalent solutions for a solution with a given symmetry. -}
multiplicityForSymmetry :: NQueensSymmetry → Word
multiplicityForSymmetry AllSymmetries = 1
multiplicityForSymmetry AllRotations = 2
multiplicityForSymmetry Rotate180Only = 4
multiplicityForSymmetry NoSymmetries = 8
{-# INLINE multiplicityForSymmetry #-}

{-| Gets all of the equivalent solutions with an equivalent symmetry. -}
multiplySolution :: MonadPlus m ⇒
    Word {-^ board size -} →
    NQueensSymmetry {-^ the symmetry of the solution -} →
    NQueensSolution {-^ a solution with the given symmetry -} →
    m NQueensSolution {-^ the equivalent solutions of the given solution -}
multiplySolution n = go
  where
    go AllSymmetries = return
    go AllRotations = liftM2 (mplus `on` return) id (reflectSolution n) >=> go AllSymmetries
    go Rotate180Only = liftM2 (mplus `on` return) id (rotateLeft n) >=> go AllRotations
    go NoSymmetries = liftM2 (mplus `on` return) id (rotate180 n) >=> go Rotate180Only
{-# INLINE multiplySolution #-}

{-| Reflects the bits in a number so that each bit at position i is moved to
    position -i (i.e., what you get when you take a bit at position 0 and rotate
    it i positions to the right)
 -}
reflectBits :: Word64 → Word64
reflectBits = go 0 (0::Int) 1
  where
    go !accum 64 _ _ = accum
    go !accum !column !column_bit !bits =
        go (accum + column_bit * (bits .&. 1))
           (column + 1)
           (column_bit `unsafeShiftL` 1)
           (bits `rotateL` 1)

{-| Reflects the columns of a solution -}
reflectSolution ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolution {-^ the solution with its columns reflected -}
reflectSolution n old_solution = map (\(row,col) → (row,last-col)) old_solution
  where
    last = n - 1

{-| Rotate a solution left by 180 degrees. -}
rotate180 ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolution {-^ the given solution rotated by 180 degrees -}
rotate180 n = map (\(row,col) → (last-row,last-col))
  where
    last = n - 1

{-| Rotate a solution left by 90 degrees. -}
rotateLeft ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolution {-^ the given solution rotated left by 90 degrees -}
rotateLeft n = map (\(row,col) → (col,last-row))
  where
    last = n - 1

{-| Rotate a solution right by 90 degrees. -}
rotateRight ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSolution {-^ the given solution rotated right by 90 degrees -}
rotateRight n = map (\(row,col) → (last-col,row))
  where
    last = n - 1

{-| Computes the symmetry class of the given solution -}
symmetryOf ::
    Word {-^ board size -} →
    NQueensSolution {-^ given solution -} →
    NQueensSymmetry {-^ the symmetry of the given solution -}
symmetryOf n solution
  | hasReflectionSymmetry n solution = AllSymmetries
  | hasRotate90Symmetry n solution = AllRotations
  | hasRotate180Symmetry n solution = Rotate180Only
  | otherwise = NoSymmetries