Changes exclusivePossibilities to use mutable vector
parent
a320a7874c
commit
4a9a1531d5
|
@ -2,7 +2,9 @@ module Main where
|
||||||
|
|
||||||
import Control.Applicative ((<|>))
|
import Control.Applicative ((<|>))
|
||||||
import Data.Function ((&))
|
import Data.Function ((&))
|
||||||
|
import Data.Vector ((!))
|
||||||
import qualified Control.Monad
|
import qualified Control.Monad
|
||||||
|
import qualified Control.Monad.ST
|
||||||
import qualified Data.Char
|
import qualified Data.Char
|
||||||
import qualified Data.Function
|
import qualified Data.Function
|
||||||
import qualified Data.List
|
import qualified Data.List
|
||||||
|
@ -10,7 +12,9 @@ import qualified Data.Map.Strict as Map
|
||||||
import qualified Data.Word
|
import qualified Data.Word
|
||||||
import qualified Data.Bits
|
import qualified Data.Bits
|
||||||
import qualified Data.Vector
|
import qualified Data.Vector
|
||||||
import Data.Vector ((!))
|
import qualified Data.Vector.Unboxed
|
||||||
|
import qualified Data.Vector.Unboxed.Mutable
|
||||||
|
import qualified Data.STRef
|
||||||
|
|
||||||
fixM :: (Eq t, Monad m) => (t -> m t) -> t -> m t
|
fixM :: (Eq t, Monad m) => (t -> m t) -> t -> m t
|
||||||
fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
|
fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
|
||||||
|
@ -71,21 +75,29 @@ showGridWithPossibilities grid = unlines . map (unwords . map (showCell . (grid
|
||||||
showCell (Possible xs) =
|
showCell (Possible xs) =
|
||||||
"[" ++ map (\i -> if Data.Bits.testBit xs i then Data.Char.intToDigit i else ' ') [1..9] ++ "]"
|
"[" ++ map (\i -> if Data.Bits.testBit xs i then Data.Char.intToDigit i else ' ') [1..9] ++ "]"
|
||||||
|
|
||||||
|
cellIndicesList :: [Cell] -> [Data.Word.Word16]
|
||||||
|
cellIndicesList cells =
|
||||||
|
Data.Vector.Unboxed.toList $ Control.Monad.ST.runST $ do
|
||||||
|
vec <- Data.Vector.Unboxed.Mutable.replicate 9 Data.Bits.zeroBits
|
||||||
|
ref <- Data.STRef.newSTRef (1 :: Int)
|
||||||
|
Control.Monad.forM_ cells $ \cell -> do
|
||||||
|
i <- Data.STRef.readSTRef ref
|
||||||
|
case cell of
|
||||||
|
Fixed _ -> return ()
|
||||||
|
Possible xs -> Control.Monad.forM_ [0..8] $ \d ->
|
||||||
|
Control.Monad.when (Data.Bits.testBit xs (d+1)) $
|
||||||
|
Data.Vector.Unboxed.Mutable.unsafeModify vec (`Data.Bits.setBit` i) d
|
||||||
|
Data.STRef.writeSTRef ref (i+1)
|
||||||
|
Data.Vector.Unboxed.unsafeFreeze vec
|
||||||
|
|
||||||
exclusivePossibilities :: [Cell] -> [Data.Word.Word16]
|
exclusivePossibilities :: [Cell] -> [Data.Word.Word16]
|
||||||
exclusivePossibilities row =
|
exclusivePossibilities row =
|
||||||
row
|
row
|
||||||
|
& cellIndicesList
|
||||||
& zip [1..9]
|
& zip [1..9]
|
||||||
& filter (isPossible . snd)
|
& filter (\(_, xs) -> let p = Data.Bits.popCount xs in p > 0 && p < 4)
|
||||||
& Data.List.foldl'
|
& Data.List.foldl' (\acc (x, is) -> Map.insertWith prepend is [x] acc) Map.empty
|
||||||
(\acc ~(i, Possible xs) ->
|
& Map.filterWithKey (\is xs -> Data.Bits.popCount is == length xs)
|
||||||
Data.List.foldl'
|
|
||||||
(\acc' n -> if Data.Bits.testBit xs n then Map.insertWith prepend n [i] acc' else acc')
|
|
||||||
acc
|
|
||||||
[1..9])
|
|
||||||
Map.empty
|
|
||||||
& Map.filter ((< 4) . length)
|
|
||||||
& Map.foldlWithKey'(\acc x is -> Map.insertWith prepend is [x] acc) Map.empty
|
|
||||||
& Map.filterWithKey (\is xs -> length is == length xs)
|
|
||||||
& Map.elems
|
& Map.elems
|
||||||
& map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)
|
& map (Data.List.foldl' Data.Bits.setBit Data.Bits.zeroBits)
|
||||||
where
|
where
|
||||||
|
|
Loading…
Reference in New Issue