diff --git a/Changes.md b/Changes.md
new file mode 100644
--- /dev/null
+++ b/Changes.md
@@ -0,0 +1,23 @@
+# Change log for the `set-cover` package
+
+## 0.0.8
+
+ * `SetCover.Exact.Priority` implements the Algorithm X
+   using a priority queue that registers the sets
+   each element is contained in.
+   This allows for drastic speedup of the `Nonogram` example.
+
+## 0.0.7
+
+ * `ESC.bitVectorFromSetAssigns` allows to turn sets
+   into bit vectors without manual bit position gymnastics.
+
+ * Use it in `Sudoku` and `Nonogram` examples.
+
+## 0.0.6
+
+ * Add `SetCover.Exact.Set` instances for `Map`, `Integer`, `IntSet`.
+
+## 0.0.5.1
+
+ * `example/Nonogram`: explore different encodings of the problem
diff --git a/example/Nonogram.hs b/example/Nonogram.hs
--- a/example/Nonogram.hs
+++ b/example/Nonogram.hs
@@ -2,8 +2,8 @@
 * <https://en.wikipedia.org/wiki/Nonogram>
 * <https://de.wikipedia.org/wiki/Datei:Paint_by_numbers_Animation.gif>
 
-The solver works but is pretty slow
-although the Combinatoric set formulation minimizes the need to guess.
+With the Combinatoric encoding and the priority queue based solver
+the performance is appropriate but specialized solvers are still faster.
 -}
 module Main where
 
@@ -12,14 +12,22 @@
 import qualified Nonogram.Encoding.BlackWhite as BlackWhite
 import qualified Nonogram.Encoding.Plug as Plug
 import qualified Nonogram.Encoding.Naive as Naive
-import Nonogram.Base (Color(White, Black))
+import Nonogram.Base (Strip, Color(White, Black))
 
-import qualified Math.SetCover.Exact as ESC
+import qualified Math.SetCover.Exact.Priority as ESC
+import qualified Math.SetCover.Exact as ESCS
+import qualified Math.SetCover.BitPosition as BitPos
+import qualified Math.SetCover.BitSet as BitSet
+import qualified Math.SetCover.Queue as Queue
 
+import qualified Data.OrdPSQ as PSQ; import Data.OrdPSQ (OrdPSQ)
 import qualified Data.Map as Map; import Data.Map (Map)
 import qualified Data.Set as Set; import Data.Set (Set)
+import qualified Data.EnumMap as EnumMap
 import qualified Data.NonEmpty as NonEmpty
 import qualified Data.List.HT as ListHT
+import Data.IntPSQ (IntPSQ)
+import Data.EnumSet (EnumSet)
 import Data.Foldable (foldMap)
 import Data.NonEmpty ((!:))
 
@@ -28,23 +36,40 @@
 decode rows columns =
    map Set.unions $
    case 01::Int of
-      00 -> ESC.partitions $
+      00 -> ESC.partitions ESC.queueBit $
                Combinatoric.bitVectorAssigns (length rows) (length columns) $
                Combinatoric.assigns rows columns
-      01 -> ESC.partitions $
+      01 -> ESC.partitions queueMapBit $
                Combinatoric.bitAssigns $ Combinatoric.assigns rows columns
-      02 -> ESC.partitions $
+      02 -> ESCS.partitions $
                Combinatoric.intSetAssigns (length rows) (length columns) $
                Combinatoric.assigns rows columns
-      03 -> ESC.partitions $ Combinatoric.assigns rows columns
-      10 -> ESC.partitions $
+      03 -> partitionsSet $ Combinatoric.assigns rows columns
+      10 -> ESC.partitions queueMapBit $
                BlackWhite.bitAssigns rows columns $
                BlackWhite.assigns rows columns
-      11 -> ESC.partitions $ BlackWhite.assigns rows columns
-      20 -> ESC.partitions $ Plug.assigns rows columns
-      _  -> ESC.partitions $ Naive.assigns rows columns
+      11 -> partitionsSet $ BlackWhite.assigns rows columns
+      20 -> partitionsSet $ Plug.assigns rows columns
+      _  -> partitionsSet $ Naive.assigns rows columns
 
+partitionsSet :: (Ord a) => [ESC.Assign label (Map Strip (Set a))] -> [[label]]
+partitionsSet = ESC.partitions queueMap
 
+queueMap ::
+   (Ord a) =>
+   Queue.Methods
+      (OrdPSQ Strip Int (OrdPSQ a Int (EnumSet Queue.SetId)))
+      (Map Strip (Set a))
+queueMap = ESC.queueMap ESC.queueSet
+
+queueMapBit ::
+   (BitPos.C bits) =>
+   Queue.Methods
+      (OrdPSQ Strip Int (IntPSQ Int (EnumSet Queue.SetId)))
+      (Map Strip (BitSet.Set bits))
+queueMapBit = ESC.queueMap ESC.queueBit
+
+
 format :: Int -> Int -> Set (Int, Int) -> String
 format rows columns set =
    unlines $
@@ -79,7 +104,7 @@
    putStrLn "set union:"
    print $ foldMap ESC.labeledSet assigns
    mapM_ (putStrLn . format (length rows) (length columns) . Set.unions) $
-      ESC.partitions assigns
+      partitionsSet assigns
 
 decodeImage :: ([[Int]], [[Int]]) -> IO ()
 decodeImage (rows, columns) =
@@ -92,15 +117,14 @@
 evolve :: ([[Int]], [[Int]]) -> IO ()
 evolve (rows, columns) =
    let formatIntermediate state =
-          (show $ length $ ESC.availableSubsets state) ++ '\n' :
+          (show $ EnumMap.size $ ESC.availableSubsets state) ++ '\n' :
           (formatBW (length rows) (length columns) .
            Map.unionsWith (error "conflicting colors") .
-           map ESC.label . ESC.usedSubsets $ state)
+           ESC.usedSubsets $ state)
    in  mapM_ (putStrLn . besidesMany 2 . map formatIntermediate) $
-       fst $ ListHT.breakAfter (all (ESC.null . ESC.freeElements)) $
-       iterate (concatMap ESC.step)
-         [ESC.initState $ Combinatoric.bitAssigns $
-          Combinatoric.assignsBW rows columns]
+       fst $ ListHT.breakAfter (all (PSQ.null . ESC.queue)) $
+       iterate (concatMap (ESC.step queueMap))
+         [ESC.initState queueMap $ Combinatoric.assignsBW rows columns]
 
 main :: IO ()
 main = evolve Example.soccerEnc
diff --git a/set-cover.cabal b/set-cover.cabal
--- a/set-cover.cabal
+++ b/set-cover.cabal
@@ -1,5 +1,5 @@
 Name:             set-cover
-Version:          0.0.7
+Version:          0.0.8
 License:          BSD3
 License-File:     LICENSE
 Author:           Henning Thielemann, Helmut Podhaisky
@@ -25,13 +25,14 @@
 Tested-With:      GHC==7.4.2, GHC==7.6.3, GHC==7.8.2
 Cabal-Version:    >=1.8
 Build-Type:       Simple
+Extra-Source-Files: Changes.md
 
 Flag buildExamples
   description: Build example executables
   default:     False
 
 Source-Repository this
-  Tag:         0.0.7
+  Tag:         0.0.8
   Type:        darcs
   Location:    http://hub.darcs.net/thielema/set-cover/
 
@@ -41,8 +42,10 @@
 
 Library
   Build-Depends:
+    psqueues >=0.2 && <0.3,
+    enummapset >=0.1 && <0.6,
     containers >=0.4 && <0.6,
-    utility-ht >=0.0.1 && <0.1,
+    utility-ht >=0.0.12 && <0.1,
     base >=4 && <5
 
   GHC-Options:      -Wall
@@ -51,10 +54,19 @@
     Math.SetCover.Bit
     Math.SetCover.BitMap
     Math.SetCover.BitSet
+    Math.SetCover.BitPosition
+    Math.SetCover.Queue
     Math.SetCover.Exact
+    Math.SetCover.Exact.Priority
     Math.SetCover.Cuboid
   Other-Modules:
     Math.SetCover.IntSet
+    Math.SetCover.BitPriorityQueue
+    Math.SetCover.EnumMap
+    Math.SetCover.Queue.Set
+    Math.SetCover.Queue.Map
+    Math.SetCover.Queue.Bit
+    Math.SetCover.Queue.BitPriorityQueue
 
 Executable tetris-cube
   If flag(buildExamples)
@@ -194,6 +206,8 @@
     Build-Depends:
       set-cover,
       non-empty >=0.2 && <0.4,
+      psqueues,
+      enummapset,
       containers,
       utility-ht,
       base
diff --git a/src/Math/SetCover/Bit.hs b/src/Math/SetCover/Bit.hs
--- a/src/Math/SetCover/Bit.hs
+++ b/src/Math/SetCover/Bit.hs
@@ -13,7 +13,7 @@
 This class is similar to the 'Bits' class from the @base@ package
 but adds 'keepMinimum' and misses the rotation stuff.
 -}
-class Eq bits => C bits where
+class Ord bits => C bits where
    empty :: bits
    complement, keepMinimum :: bits -> bits
    xor, (.&.), (.|.) :: bits -> bits -> bits
@@ -58,12 +58,15 @@
    (.&.) = (Bits..&.)
    (.|.) = (Bits..|.)
 
+difference :: C bits => bits -> bits -> bits
+difference xs ys = xs .&. complement ys
 
+
 {-
 cf. package largeword
 -}
 data Sum a b = Sum !a !b
-   deriving (Eq, Show)
+   deriving (Eq, Ord, Show)
 
 instance (C a, C b) => C (Sum a b) where
    empty = Sum empty empty
diff --git a/src/Math/SetCover/BitMap.hs b/src/Math/SetCover/BitMap.hs
--- a/src/Math/SetCover/BitMap.hs
+++ b/src/Math/SetCover/BitMap.hs
@@ -1,10 +1,19 @@
-module Math.SetCover.BitMap where
+module Math.SetCover.BitMap (
+   Map(..),
+   fromSet,
+   add, inc,
+   sub, dec,
+   intersectionSet,
+   differenceSet,
+   minimumSet,
+   ) where
 
 import qualified Math.SetCover.BitSet as BitSet
 import qualified Math.SetCover.Bit as Bit
 import Math.SetCover.BitSet (Set(Set))
-import Math.SetCover.Bit (xor, (.|.), (.&.))
+import Math.SetCover.Bit (difference, xor, (.|.), (.&.))
 
+import qualified Data.List.Reverse.StrictSpine as ListRev
 import Data.Monoid (Monoid, mempty, mappend)
 
 
@@ -34,6 +43,33 @@
    let go c [] = if c==Bit.empty then [] else [c]
        go c (x:xs) = xor c x : go (c .&. x) xs
    in  Map $ go xs0 ys0
+
+
+sub :: Bit.C bits => Map bits -> Map bits -> Map bits
+sub (Map xs0) (Map ys0) =
+   let go c xs [] = normalize $ unMap $ dec (Set c) (Map xs)
+       go c [] ys =
+          if c==Bit.empty && all (==Bit.empty) ys
+            then []
+            else error "sub: underflow"
+       go c (x:xs) (y:ys) =
+          xor c (xor x y) : go (difference (c.|.y) x .|. c.&.y) xs ys
+   in  Map $ go Bit.empty xs0 ys0
+
+dec :: Bit.C bits => Set bits -> Map bits -> Map bits
+dec (Set xs0) (Map ys0) =
+   let go c [] = if c==Bit.empty then [] else error "dec: underflow"
+       go c (x:xs) = xor c x : go (difference c x) xs
+   in  Map $ go xs0 ys0
+
+intersectionSet :: (Bit.C bits) => Map bits -> Set bits -> Map bits
+intersectionSet (Map xs) (Set y) = Map $ normalize $ map (y.&.) xs
+
+differenceSet :: (Bit.C bits) => Map bits -> Set bits -> Map bits
+differenceSet (Map xs) (Set y) = Map $ normalize $ map (flip difference y) xs
+
+normalize :: (Bit.C bits) => [bits] -> [bits]
+normalize = ListRev.dropWhile (Bit.empty==)
 
 
 {-
diff --git a/src/Math/SetCover/BitPosition.hs b/src/Math/SetCover/BitPosition.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/BitPosition.hs
@@ -0,0 +1,116 @@
+module Math.SetCover.BitPosition (C, unpack, singleton, bitPosition) where
+
+import qualified Math.SetCover.BitSet as BitSet
+import qualified Math.SetCover.Bit as Bit
+import Math.SetCover.Bit ((.&.))
+
+import qualified Data.Bits as Bits
+import Data.Bits (Bits, shiftR)
+import Data.Word (Word8, Word16, Word32, Word64)
+
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Maybe.HT (toMaybe)
+
+
+unpackGen :: (C bits) => BitSet.Set bits -> [Int]
+unpackGen = map bitPosition . decompose
+
+decompose :: (Bit.C bits) => BitSet.Set bits -> [BitSet.Set bits]
+decompose =
+   List.unfoldr $ \set ->
+      toMaybe (not $ BitSet.null set) $
+         let x = BitSet.keepMinimum set
+         in  (x, BitSet.difference set x)
+
+{-# INLINE positionMasks #-}
+positionMasks :: (Integral bits, Bit.C bits) => [bits]
+positionMasks =
+   map (Bit.complement . div (-1) . (1+)) $
+   takeWhile (/=0) $ iterate (\w -> w*w) 2
+
+{-
+Alternative: @bits-extras:Data.Bits.Extras.lowestBitPlus1@
+-}
+{-# INLINE bitPositionGen #-}
+bitPositionGen ::
+   (Integral bits, Bits bits, Bit.C bits) => [bits] -> bits -> Int
+bitPositionGen masks w =
+   foldr
+      (\mask acc -> fromEnum (mask .&. w /= Bit.empty) + 2*acc)
+      0 masks
+
+class Bit.C bits => C bits where
+   bit :: Int -> bits
+   bitPositionPlain :: bits -> Int
+   unpack :: BitSet.Set bits -> [Int]
+
+instance C Word8 where
+   bit = Bits.bit
+   bitPositionPlain = bitPositionGen positionMasks
+   unpack = unpackGen
+
+instance C Word16 where
+   bit = Bits.bit
+   bitPositionPlain = bitPositionGen positionMasks
+   unpack = unpackGen
+
+instance C Word32 where
+   bit = Bits.bit
+   bitPositionPlain = bitPositionGen positionMasks
+   unpack = unpackGen
+
+instance C Word64 where
+   bit = Bits.bit
+   bitPositionPlain = bitPositionGen positionMasks
+   unpack = unpackGen
+
+instance C Integer where
+   bit = Bits.bit
+   bitPositionPlain =
+      ListHT.switchR
+         (error "bitPosition: zero Integer")
+         (\_ (offset,x) -> offset + bitPositionPlain (word64 x)) .
+      zip [0, 64 ..] . takeWhile (/=0) . iterate (flip shiftR 64)
+   unpack =
+      concatMap (\(offset,x) -> map (offset+) $ unpack (BitSet.Set x)) .
+      zip [0, 64 ..] . map (\w -> word64 $ w .&. fromIntegral (-1 :: Word64)) .
+      takeWhile (/=0) . iterate (flip shiftR 64) . (\(BitSet.Set x) -> x)
+
+word64 :: Integer -> Word64
+word64 = fromIntegral
+
+{- |
+Instantiating @a@ with 'Integer' will end badly because it has no fixed size!
+-}
+instance (Integral a, C a, C b) => C (Bit.Sum a b) where
+   bit = bitSum $ bitSize positionMasks
+   bitPositionPlain = bitSumPosition $ bitSize positionMasks
+   unpack = bitSumUnpack $ bitSize positionMasks
+
+newtype Size bits = Size Int
+
+bitSize :: C bits => [bits] -> Size bits
+bitSize = Size . Bits.bit . length
+
+bitSum :: (C a, C b) => Size a -> Int -> Bit.Sum a b
+bitSum (Size offset) pos =
+   if pos < offset
+     then Bit.Sum (bit pos) Bit.empty
+     else Bit.Sum Bit.empty (bit $ pos-offset)
+
+bitSumPosition :: (C a, C b) => Size a -> Bit.Sum a b -> Int
+bitSumPosition (Size offset) (Bit.Sum a b) =
+   if a == Bit.empty
+     then offset + bitPositionPlain b
+     else bitPositionPlain a
+
+bitSumUnpack :: (C a, C b) => Size a -> BitSet.Set (Bit.Sum a b) -> [Int]
+bitSumUnpack (Size offset) (BitSet.Set (Bit.Sum a b)) =
+   unpack (BitSet.Set a) ++ map (offset +) (unpack (BitSet.Set b))
+
+bitPosition :: (C bits) => BitSet.Set bits -> Int
+bitPosition (BitSet.Set bits) = bitPositionPlain bits
+
+singleton :: (C bits) => Int -> BitSet.Set bits
+singleton = BitSet.Set . bit
diff --git a/src/Math/SetCover/BitPriorityQueue.hs b/src/Math/SetCover/BitPriorityQueue.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/BitPriorityQueue.hs
@@ -0,0 +1,64 @@
+module Math.SetCover.BitPriorityQueue where
+
+import qualified Math.SetCover.EnumMap as EnumMapX
+import qualified Math.SetCover.BitPosition as BitPos
+import qualified Math.SetCover.BitMap as BitMap
+import qualified Math.SetCover.BitSet as BitSet
+import Math.SetCover.EnumMap (constIntMap)
+
+import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
+import qualified Data.IntMap as IntMap; import Data.IntMap (IntMap)
+import qualified Data.Foldable as Fold
+import Data.EnumMap (EnumMap)
+import Data.Monoid (mempty, mconcat)
+import Data.Maybe.HT (toMaybe)
+
+
+{-
+We could generalize @EnumSet e@ to @a@
+and pretend that the priorities are independent of the 'EnumSet' sizes.
+However, 'difference' makes only sense if the priorities match the set sizes.
+-}
+data Queue bits e = Queue (BitMap.Map bits) (IntMap (EnumSet e))
+
+null :: Queue bits e -> Bool
+null (Queue _ns m) = IntMap.null m
+
+fromSets ::
+   (Enum e, BitPos.C bits) => EnumMap e (BitSet.Set bits) -> Queue bits e
+fromSets xs =
+   Queue
+      (Fold.foldl' (flip BitMap.inc) mempty xs)
+      (EnumMapX.transposeBitSet xs)
+
+elemUnions :: (Enum e) => Queue t e -> EnumSet e
+elemUnions (Queue _ns m) = Fold.fold m
+
+keysBits :: (BitPos.C bits) => Queue bits e -> BitSet.Set bits
+keysBits (Queue _ m) =
+   mconcat $ map BitPos.singleton $ IntMap.keys m
+
+findMin :: (BitPos.C bits) => Queue bits e -> Maybe (EnumSet e)
+findMin q@(Queue ns m) =
+   let used = keysBits q
+   in  toMaybe (not $ BitSet.null used) $
+          IntMap.findWithDefault
+             (error "findMin: key with minimal priority must be in IntMap")
+             (BitPos.bitPosition $ BitSet.keepMinimum $
+              BitMap.minimumSet used ns)
+             m
+
+difference ::
+   (BitPos.C bits, Enum e) => Queue bits e -> Queue bits e -> Queue bits e
+difference q0@(Queue ns0 m0) (Queue ns1 m1) =
+   Queue
+      (BitMap.sub ns0 $ BitMap.intersectionSet ns1 $ keysBits q0)
+      (IntMap.differenceWith ((Just.) . EnumSet.difference) m0 m1)
+
+partition ::
+   (BitPos.C bits, Enum e) =>
+   Queue bits e -> BitSet.Set bits -> (Queue bits e, Queue bits e)
+partition (Queue ns m) s =
+   let section = IntMap.intersection m $ constIntMap () s
+   in  (Queue (BitMap.intersectionSet ns s) section,
+        Queue (BitMap.differenceSet ns s) $ IntMap.difference m section)
diff --git a/src/Math/SetCover/BitSet.hs b/src/Math/SetCover/BitSet.hs
--- a/src/Math/SetCover/BitSet.hs
+++ b/src/Math/SetCover/BitSet.hs
@@ -6,7 +6,7 @@
 import Data.Monoid (Monoid, mempty, mappend)
 
 
-newtype Set bits = Set bits deriving (Show)
+newtype Set bits = Set bits deriving (Eq, Ord, Show)
 
 instance (Bit.C bits) => Monoid (Set bits) where
    mempty = empty
@@ -25,4 +25,4 @@
 disjoint (Set xs) (Set ys)  =  xs.&.ys == Bit.empty
 
 difference :: Bit.C bits => Set bits -> Set bits -> Set bits
-difference (Set xs) (Set ys) = Set $ xs .&. Bit.complement ys
+difference (Set xs) (Set ys) = Set $ Bit.difference xs ys
diff --git a/src/Math/SetCover/EnumMap.hs b/src/Math/SetCover/EnumMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/EnumMap.hs
@@ -0,0 +1,54 @@
+module Math.SetCover.EnumMap where
+
+import qualified Math.SetCover.BitPosition as BitPos
+import qualified Math.SetCover.BitSet as BitSet
+
+import qualified Data.EnumMap as EnumMap; import Data.EnumMap (EnumMap)
+import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
+import qualified Data.IntMap as IntMap; import Data.IntMap (IntMap)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+import Prelude hiding (const)
+
+
+-- EnumMap.fromSet is available from containers-0.5
+const :: (Enum e) => a -> EnumSet e -> EnumMap e a
+const a = EnumMap.fromAscList . map (\k -> (k, a)) . EnumSet.toAscList
+
+intersection :: (Enum e) => EnumMap e a -> EnumSet e -> EnumMap e a
+intersection m s = EnumMap.intersection m $ const () s
+
+partition ::
+   (Enum e) => EnumMap e a -> EnumSet e -> (EnumMap e a, EnumMap e a)
+partition m s =
+   let section = intersection m s
+   in  (section, EnumMap.difference m section)
+
+
+-- Map.fromSet is available from containers-0.5
+constMap :: (Ord a) => b -> Set.Set a -> Map.Map a b
+constMap a = Map.fromAscList . map (\k -> (k, a)) . Set.toAscList
+
+transposeSet ::
+   (Enum e, Ord a) => EnumMap e (Set.Set a) -> Map.Map a (EnumSet e)
+transposeSet =
+   Map.unionsWith EnumSet.union . EnumMap.elems .
+   EnumMap.mapWithKey (constMap . EnumSet.singleton)
+
+
+transposeMap ::
+   (Enum e, Ord a) => EnumMap e (Map.Map a b) -> Map.Map a (EnumMap e b)
+transposeMap =
+   Map.unionsWith EnumMap.union . EnumMap.elems .
+   EnumMap.mapWithKey (fmap . EnumMap.singleton)
+
+
+constIntMap :: (BitPos.C bits) => b -> BitSet.Set bits -> IntMap b
+constIntMap a = IntMap.fromAscList . map (\k -> (k, a)) . BitPos.unpack
+
+transposeBitSet ::
+   (BitPos.C bits, Enum e) => EnumMap e (BitSet.Set bits) -> IntMap (EnumSet e)
+transposeBitSet =
+   IntMap.unionsWith EnumSet.union . EnumMap.elems .
+   EnumMap.mapWithKey (constIntMap . EnumSet.singleton)
diff --git a/src/Math/SetCover/Exact/Priority.hs b/src/Math/SetCover/Exact/Priority.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Exact/Priority.hs
@@ -0,0 +1,99 @@
+{- |
+This implementation uses priority queues
+and avoids full scans through available sets.
+It can be faster than "Math.SetCover.Exact"
+if there is a huge number of sets.
+-}
+module Math.SetCover.Exact.Priority (
+   Assign, ESC.label, ESC.labeledSet, ESC.assign,
+   partitions, search, step,
+   State(..), initState, updateState,
+   SetId, queueMap, queueSet, queueBit, queueBitPQ,
+   ) where
+
+import qualified Math.SetCover.Queue.Map as QueueMap
+import qualified Math.SetCover.Queue.Set as QueueSet
+import qualified Math.SetCover.Queue.Bit as QueueBit
+import qualified Math.SetCover.Queue.BitPriorityQueue as QueueBitPQ
+
+import qualified Math.SetCover.BitPosition as BitPos
+
+import qualified Math.SetCover.Queue as Queue
+import qualified Math.SetCover.Exact as ESC
+import Math.SetCover.Queue (Methods, SetId(SetId))
+import Math.SetCover.Exact (Assign(Assign), labeledSet)
+
+import qualified Math.SetCover.EnumMap as EnumMapX
+import qualified Data.EnumMap as EnumMap; import Data.EnumMap (EnumMap)
+import qualified Data.Foldable as Fold
+
+
+data State queue label set =
+   State {
+      availableSubsets :: EnumMap SetId (Assign label set),
+      queue :: queue,
+      usedSubsets :: [label]
+   }
+
+initState ::
+   Methods queue set -> [Assign label set] -> State queue label set
+initState dict subsets =
+   let numberedSets = EnumMap.fromList $ zip [SetId 0 ..] subsets
+   in  State {
+         availableSubsets = numberedSets,
+         queue = Queue.fromEnumMap dict $ fmap labeledSet numberedSets,
+         usedSubsets = []
+       }
+
+{-# INLINE updateState #-}
+updateState ::
+   Methods queue set ->
+   Assign label set -> State queue label set -> State queue label set
+updateState dict (Assign attemptLabel attemptedSet) s =
+   let (attemptElems, remainingQueue) =
+         Queue.partition dict (queue s) attemptedSet
+       (removed, remaining) =
+         EnumMapX.partition (availableSubsets s) attemptElems
+   in  State {
+         availableSubsets = remaining,
+         queue = Queue.difference dict remainingQueue $ fmap labeledSet removed,
+         usedSubsets = attemptLabel : usedSubsets s
+       }
+
+{-# INLINE step #-}
+step :: Methods queue set -> State queue label set -> [State queue label set]
+step dict s =
+   if EnumMap.null (availableSubsets s)
+     then []
+     else
+         flip Fold.foldMap (Queue.findMin dict (queue s)) $
+            map (flip (updateState dict) s) . EnumMap.elems .
+            EnumMapX.intersection (availableSubsets s)
+
+{-# INLINE search #-}
+search :: Methods queue set -> State queue label set -> [[label]]
+search dict =
+   let go s =
+         if Queue.null dict (queue s)
+           then [usedSubsets s]
+           else step dict s >>= go
+   in  go
+
+{-# INLINE partitions #-}
+partitions :: Methods queue set -> [Assign label set] -> [[label]]
+partitions dict = search dict . initState dict
+
+
+-- * different priority queue implementations
+
+queueMap :: Ord a => Queue.Methods queue set -> QueueMap.Methods a queue set
+queueMap = QueueMap.methods
+
+queueSet :: Ord a => QueueSet.Methods a
+queueSet = QueueSet.methods
+
+queueBit :: BitPos.C bits => QueueBit.Methods bits
+queueBit = QueueBit.methods
+
+queueBitPQ :: BitPos.C bits => QueueBitPQ.Methods bits
+queueBitPQ = QueueBitPQ.methods
diff --git a/src/Math/SetCover/IntSet.hs b/src/Math/SetCover/IntSet.hs
--- a/src/Math/SetCover/IntSet.hs
+++ b/src/Math/SetCover/IntSet.hs
@@ -7,7 +7,7 @@
 
 
 data Set = Set {_complement :: Bool, _set :: IntSet}
-   deriving (Eq)
+   deriving (Eq, Ord)
 
 fromIntSet :: IntSet -> Set
 fromIntSet = Set False
diff --git a/src/Math/SetCover/Queue.hs b/src/Math/SetCover/Queue.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Queue.hs
@@ -0,0 +1,21 @@
+module Math.SetCover.Queue (SetId(..), Methods(..)) where
+
+import Data.EnumMap (EnumMap)
+import Data.EnumSet (EnumSet)
+
+
+newtype SetId = SetId Int
+
+instance Enum SetId where
+   fromEnum (SetId n) = n
+   toEnum = SetId
+
+
+data Methods queue set =
+   Methods {
+      fromEnumMap :: EnumMap SetId set -> queue,
+      partition :: queue -> set -> (EnumSet SetId, queue),
+      difference :: queue -> EnumMap SetId set -> queue,
+      findMin :: queue -> Maybe (EnumSet SetId),
+      null :: queue -> Bool
+   }
diff --git a/src/Math/SetCover/Queue/Bit.hs b/src/Math/SetCover/Queue/Bit.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Queue/Bit.hs
@@ -0,0 +1,67 @@
+{- |
+Alternative to "Math.SetCover.Queue.Set"
+that represents sets by bit masks and uses the faster Int priority queue.
+-}
+module Math.SetCover.Queue.Bit (Methods, methods) where
+
+import qualified Math.SetCover.Queue as Queue
+import Math.SetCover.Queue (SetId)
+
+import qualified Math.SetCover.EnumMap as EnumMapX
+import qualified Math.SetCover.BitPosition as BitPos
+import qualified Math.SetCover.BitSet as BitSet
+
+import qualified Data.IntPSQ as PSQ
+import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
+import qualified Data.IntMap as IntMap
+import qualified Data.List as List
+import Data.Tuple.HT (swap, mapFst, thd3)
+
+
+type
+   Methods bits =
+      Queue.Methods (PSQ.IntPSQ Int (EnumSet SetId)) (BitSet.Set bits)
+
+methods :: BitPos.C bits => Methods bits
+methods =
+   Queue.Methods {
+      Queue.fromEnumMap =
+         PSQ.fromList . map (\(elm, ns) -> (elm, EnumSet.size ns, ns)) .
+         IntMap.toList . EnumMapX.transposeBitSet,
+      Queue.partition =
+         \q -> mapFst EnumSet.unions . partitionPSQ q . BitPos.unpack,
+      Queue.difference = \q ->
+         foldl (flip deleteSetFromPSQ) q .
+         IntMap.toList . EnumMapX.transposeBitSet,
+      Queue.findMin = fmap thd3 . PSQ.findMin,
+      Queue.null = PSQ.null
+   }
+
+
+{- |
+The list of keys must be a subset of the queue keys.
+-}
+partitionPSQ :: (Ord p) => PSQ.IntPSQ p v -> [Int] -> ([v], PSQ.IntPSQ p v)
+partitionPSQ =
+   (swap .) .
+   List.mapAccumL
+      (\q0 k ->
+         maybe
+            (error "partitionPSQ: key not contained in queue's key set")
+            (\(_p,v,q1) -> (q1, v)) $
+         PSQ.deleteView k q0)
+
+deleteSetFromPSQ ::
+   (Int, EnumSet e) -> PSQ.IntPSQ Int (EnumSet e) ->
+   PSQ.IntPSQ Int (EnumSet e)
+deleteSetFromPSQ (elm, ns) =
+   updatePSQ (flip differenceSizedSet ns) elm
+
+differenceSizedSet :: (Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e)
+differenceSizedSet (size, a) b =
+   let section = EnumSet.intersection a b
+   in  (size - EnumSet.size section, EnumSet.difference a section)
+
+updatePSQ ::
+   (Ord p) => ((p, v) -> (p, v)) -> Int -> PSQ.IntPSQ p v -> PSQ.IntPSQ p v
+updatePSQ f k = snd . PSQ.alter ((,) () . fmap f) k
diff --git a/src/Math/SetCover/Queue/BitPriorityQueue.hs b/src/Math/SetCover/Queue/BitPriorityQueue.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Queue/BitPriorityQueue.hs
@@ -0,0 +1,27 @@
+{- |
+Alternative to "Math.SetCover.Queue.Set"
+that represents sets by bit masks and uses a bitset-based Int priority queue.
+-}
+module Math.SetCover.Queue.BitPriorityQueue (Methods, methods) where
+
+import qualified Math.SetCover.Queue as Queue
+import Math.SetCover.Queue (SetId)
+
+import qualified Math.SetCover.BitPriorityQueue as BitPQ
+import qualified Math.SetCover.BitPosition as BitPos
+import qualified Math.SetCover.BitSet as BitSet
+
+import Data.Tuple.HT (mapFst)
+
+
+type Methods bits = Queue.Methods (BitPQ.Queue bits SetId) (BitSet.Set bits)
+
+methods :: BitPos.C bits => Methods bits
+methods =
+   Queue.Methods {
+      Queue.fromEnumMap = BitPQ.fromSets,
+      Queue.partition = (mapFst BitPQ.elemUnions.) . BitPQ.partition,
+      Queue.difference = \q -> BitPQ.difference q . BitPQ.fromSets,
+      Queue.findMin = BitPQ.findMin,
+      Queue.null = BitPQ.null
+   }
diff --git a/src/Math/SetCover/Queue/Map.hs b/src/Math/SetCover/Queue/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Queue/Map.hs
@@ -0,0 +1,61 @@
+module Math.SetCover.Queue.Map (Methods, methods) where
+
+import qualified Math.SetCover.Queue as Queue
+
+import qualified Math.SetCover.EnumMap as EnumMapX
+import qualified Data.OrdPSQ as PSQ
+import qualified Data.EnumSet as EnumSet
+import qualified Data.Map as Map; import Data.Map (Map)
+import Control.Monad.HT ((<=<))
+import Control.Applicative ((<$>))
+import Data.Monoid (Monoid, mempty, mappend)
+import Data.Maybe (mapMaybe)
+import Data.Tuple.HT (mapFst, mapSnd, thd3)
+
+
+type Methods a queue set = Queue.Methods (PSQ.OrdPSQ a Int queue) (Map a set)
+
+methods :: Ord a => Queue.Methods queue set -> Methods a queue set
+methods m =
+   Queue.Methods {
+      Queue.fromEnumMap =
+         PSQ.fromList .
+         mapMaybe
+            (\(elm, sets) ->
+               (\(minSize, ns) -> (elm, minSize, ns)) <$>
+               (addMinSize m $ Queue.fromEnumMap m sets)) .
+         Map.toList . EnumMapX.transposeMap,
+      Queue.partition =
+         applyWriter ((mapSnd (addMinSize m) .) . Queue.partition m),
+      Queue.difference = \q s ->
+         apply ((addMinSize m .) . Queue.difference m)
+            q (EnumMapX.transposeMap s),
+      Queue.findMin = Queue.findMin m . thd3 <=< PSQ.findMin,
+      Queue.null = PSQ.null
+   }
+
+addMinSize :: Queue.Methods queue set -> queue -> Maybe (Int, queue)
+addMinSize m q = flip (,) q . EnumSet.size <$> Queue.findMin m q
+
+applyWriter ::
+   (Ord p, Ord k, Monoid c) =>
+   (v -> b -> (c, Maybe (p, v))) ->
+   PSQ.OrdPSQ k p v -> Map k b -> (c, PSQ.OrdPSQ k p v)
+applyWriter f q =
+   Map.foldlWithKey
+      (\(sis, qi) a ss ->
+         mapFst (mappend sis) $
+         PSQ.alter (maybe (mempty, Nothing) $ \(_p,subq) -> f subq ss) a qi)
+      (mempty,q)
+
+apply ::
+   (Ord k, Ord p) =>
+   (a -> b -> Maybe (p, a)) ->
+   PSQ.OrdPSQ k p a -> Map k b -> PSQ.OrdPSQ k p a
+apply f =
+   Map.foldlWithKey (\qi a ss -> updatePSQ (\(_p,subq) -> f subq ss) a qi)
+
+updatePSQ ::
+   (Ord p, Ord k) =>
+   ((p, v) -> Maybe (p, v)) -> k -> PSQ.OrdPSQ k p v -> PSQ.OrdPSQ k p v
+updatePSQ f k = snd . PSQ.alter ((,) () . (f=<<)) k
diff --git a/src/Math/SetCover/Queue/Set.hs b/src/Math/SetCover/Queue/Set.hs
new file mode 100644
--- /dev/null
+++ b/src/Math/SetCover/Queue/Set.hs
@@ -0,0 +1,64 @@
+{- |
+Alternative to "Math.SetCover.Exact" that uses a priority queue
+and avoids full scans through available sets.
+-}
+module Math.SetCover.Queue.Set (Methods, methods) where
+
+import qualified Math.SetCover.Queue as Queue
+import Math.SetCover.Queue (SetId)
+
+import qualified Math.SetCover.EnumMap as EnumMapX
+import qualified Data.OrdPSQ as PSQ
+import qualified Data.EnumSet as EnumSet; import Data.EnumSet (EnumSet)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.List as List
+import Data.Tuple.HT (swap, mapFst, thd3)
+
+
+type Methods a = Queue.Methods (PSQ.OrdPSQ a Int (EnumSet SetId)) (Set.Set a)
+
+methods :: Ord a => Methods a
+methods =
+   Queue.Methods {
+      Queue.fromEnumMap =
+         PSQ.fromList . map (\(elm, ns) -> (elm, EnumSet.size ns, ns)) .
+         Map.toList . EnumMapX.transposeSet,
+      Queue.partition =
+         \q -> mapFst EnumSet.unions . partitionPSQ q . Set.toList,
+      Queue.difference = \q ->
+         foldl (flip deleteSetFromPSQ) q . Map.toList . EnumMapX.transposeSet,
+      Queue.findMin = fmap thd3 . PSQ.findMin,
+      Queue.null = PSQ.null
+   }
+
+{- |
+The list of keys must be a subset of the queue keys.
+-}
+partitionPSQ ::
+   (Ord k, Ord p) => PSQ.OrdPSQ k p v -> [k] -> ([v], PSQ.OrdPSQ k p v)
+partitionPSQ =
+   (swap .) .
+   List.mapAccumL
+      (\q0 k ->
+         maybe
+            (error "partitionPSQ: key not contained in queue's key set")
+            (\(_p,v,q1) -> (q1, v)) $
+         PSQ.deleteView k q0)
+
+deleteSetFromPSQ ::
+   (Ord k) =>
+   (k, EnumSet e) -> PSQ.OrdPSQ k Int (EnumSet e) ->
+   PSQ.OrdPSQ k Int (EnumSet e)
+deleteSetFromPSQ (elm, ns) =
+   updatePSQ (flip differenceSizedSet ns) elm
+
+differenceSizedSet :: (Int, EnumSet e) -> EnumSet e -> (Int, EnumSet e)
+differenceSizedSet (size, a) b =
+   let section = EnumSet.intersection a b
+   in  (size - EnumSet.size section, EnumSet.difference a section)
+
+updatePSQ ::
+   (Ord p, Ord k) =>
+   ((p, v) -> (p, v)) -> k -> PSQ.OrdPSQ k p v -> PSQ.OrdPSQ k p v
+updatePSQ f k = snd . PSQ.alter ((,) () . fmap f) k