-- |
--
-- This module provides an efficient solver for exact set cover problems
-- (<http://en.wikipedia.org/wiki/Exact_cover>) using Algorithm X as described
-- in the paper /Dancing Links/, by Donald Knuth, in
-- /Millennial Perspectives in Computer Science/, P159, 2000
-- (<https://arxiv.org/abs/cs/0011047>).
--
-- For a quick start, go straight to the 'solve' function.

module Math.ExactCover
(
-- * Mathematical definition
-- $def -- * Simple interface solve -- * Types , ExactCoverProblem -- * Construction , transform -- * Solvers , solveEC ) where import Math.ExactCover.Internal.DLX import Foreign import System.IO.Unsafe (unsafePerformIO) import Control.Concurrent (MVar, newMVar, withMVar) import Control.Monad (forM, forM_, when) import Data.Map (Map) import qualified Data.Map.Strict as Map (lookup, keys) import Data.Set (Set) import qualified Data.Set as Set (size, toList, fromList) -- | Basic type that represents the exact cover problem. data ExactCoverProblem setlabel a = ExactCoverProblem { ec_sets :: !(Map (Set a) setlabel) -- ^ Associates each set with a label. , ec_dlx :: MVar (ForeignPtr DLXMatrix) -- ^ Dancing links representation. } -- PROGRAMMING NOTE: The Enum typeclass is needed as the set objects are -- internally represented as integers in the C portion of the library. -- | Constructs an 'ExactCoverProblem' given a collection of subsets \$$-- \\mathcal{S} \$$ as represented by a 'Map' between each subset and its label. -- The set \$$\\mathcal{X} \$$ over which the exact cover is to be found is -- assumed to be the union of the given collection of subsets \$$\\mathcal{S} -- \$$. transform :: (Enum a) => Map (Set a) setlabel -> ExactCoverProblem setlabel a transform m = unsafePerformIO$ do
dlxHead <- newForeignPtr c_free_matrix =<< c_create_empty_matrix
withForeignPtr dlxHead $\hPtr -> forM_ (Map.keys m)$ \k ->
withArray (fromIntegral . fromEnum <$> Set.toList k)$ \constrainPtr ->
with hPtr $\hPPtr -> do ret <- c_add_set hPPtr constrainPtr (fromIntegral$ Set.size k)
when (ret /= 0) $error "Could not add constraint." dlxM <- newMVar dlxHead pure$ ExactCoverProblem { ec_sets = m
, ec_dlx = dlxM
}

-- | Solves the given 'ExactCoverProblem', returning the labels of the subsets
-- that form the exact cover.
solveEC :: (Enum a, Ord a)
=> ExactCoverProblem setlabel a
-> [setlabel]
solveEC ExactCoverProblem{ ec_sets = setLabels, ec_dlx = dlxM } = unsafePerformIO $withMVar dlxM$ \dlxHead ->
withForeignPtr dlxHead $\hPtr -> alloca$ \setCoversPtrPtrPtr ->
alloca $\setCoverSizesPtrPtr -> alloca$ \nSetsPtr -> do
ret <- c_solve hPtr 4 setCoversPtrPtrPtr setCoverSizesPtrPtr nSetsPtr
case () of
_ | ret < 0 -> error ""
| ret == 0 -> do
-- Retrieve number of result sets.
nSets <- fromIntegral <$> peek nSetsPtr -- Retrieve list of set sizes. setCoverSizesPtr <- peek setCoverSizesPtrPtr setCoverSizes <- pure . map fromIntegral =<< peekArray nSets setCoverSizesPtr free setCoverSizesPtr -- Retrieve list of pointers to the result sets. setCoversPtrPtr <- peek setCoversPtrPtrPtr setCoversPtr <- peekArray nSets setCoversPtrPtr free setCoversPtrPtr -- Retrieve the result sets. forM (zip setCoverSizes setCoversPtr)$ $$setSize, setPtr) -> do setC <- Set.fromList . map (toEnum . fromIntegral) <> peekArray setSize setPtr free setPtr pure  case Map.lookup setC setLabels of Nothing -> error "Constrain set not in map." Just label -> label | ret == 1 -> pure mempty | otherwise -> error "Unknown error code." -- | Given a collection of subsets \\( \\mathcal{S} \$$, represented by a 'Map'
-- between each subset (of type @'Set' a@) and its label, returns a list of
-- labels that represents the exact cover \$$\\mathcal{S}^{*} \$$.
--
-- Example: To find the exact cover of the collection of subsets
-- \$$\\left\\{\\left\\{2,4,5\\right\\}, \\left\\{0,3,6\\right\\}, -- \\left\\{1,2,5\\right\\}, \\left\\{0,3\\right\\}, \\left\\{1,6\\right\\}, -- \\left\\{3,4,6\\right\\}\\right\\} \$$,
--
-- > solve (Map.fromList [ (Set.fromList [2,4,5], 'A')
-- >                     , (Set.fromList [0,3,6], 'B')
-- >                     , (Set.fromList [1,2,5], 'C')
-- >                     , (Set.fromList [0,3], 'D')
-- >                     , (Set.fromList [1,6], 'E')
-- >                     , (Set.fromList [3,4,6], 'F')
-- >                     ] :: Map (Set Int) Char)
-- > == "DAE"
solve :: (Enum a, Ord a) => Map (Set a) setlabel -> [setlabel]
solve = solveEC . transform

-- \$def
--
-- Given a collection \$$\\mathcal{S} \$$ of subsets of a set \$$\\mathcal{X} -- \$$, an exact cover is a subcollection \$$\\mathcal{S}^{*} \$$ of \$$-- \\mathcal{S} \$$ such that each element in \$$\\mathcal{X} \$$ is contained
-- in exactly one subset in \$$\\mathcal{S}^{*} \$$ (from wikipedia).