some refactoring

1 files changed, 31 insertions, 14 deletions

diff --git a/puzzle.hs b/puzzle.hs
index 0401dc3..5da1ff0 100644
--- a/puzzle.hs
+++ b/puzzle.hs
@@ -3,8 +3,8 @@ module Main where
 import Data.Array (Array, array, bounds, (!), (//))
 import Data.Functor ((<$>))
 import Data.Maybe
-import Data.List (sortBy)
-import Data.Ord (comparing)
+import Data.List (sort)
+import Data.Ord (compare)
 import Data.Char (toUpper)
 import System.Random (RandomGen, getStdGen, split, randomR, randomRs)
 import System.Random.Shuffle
@@ -30,6 +30,12 @@ data Pose = Pose { position::Vec, orientation::Vec } deriving (Show, Eq)
 advance :: Pose -> Pose
 advance p = p {position = add (position p) (orientation p)}
 
+-- Move is a pose combined with a cost.
+data Move = Move { pose::Pose, cost::Int } deriving (Show, Eq)
+
+instance Ord Move where
+    (Move _ a) `compare` (Move _ b) = a `compare` b
+
 -- We just use Char for each field.
 empty = '.'
 
@@ -55,20 +61,31 @@ charAt b p =
         Nothing
   where ((sX, sY), (eX, eY)) = bounds b
 
+allPoses :: Board -> [Pose]
+allPoses b =
+    [Pose (Vec x y) o | x <- [sX..eX], y <- [sY..eY], o <- [right, down]]
+  where
+    ((sX, sY), (eX, eY)) = bounds b
+
 -- Test whether it's possible to insert a string at the given pose.
 -- Return the associated cost or Nothing, if the string didn't fit.
-tryInsert :: String -> Pose -> Board -> Maybe Int
-tryInsert [] _ _ = Just 0
-tryInsert (w:ws) p b =
+computeCost :: String -> Pose -> Board -> Maybe Int
+computeCost [] _ _ = Just 0
+computeCost (w:ws) p b =
   case charAt b (position p) of
     Nothing -> Nothing
     Just c ->
         if c /= empty && c /= w then
             Nothing
         else do
-          t <- tryInsert ws (advance p) b
+          t <- computeCost ws (advance p) b
           return ((if c == w then 0 else 1) + t)
 
+tryInsert :: String -> Pose -> Board -> Maybe Move
+tryInsert w p b = do
+  cost <- computeCost w p b
+  return $ Move p cost
+
 -- Given a string and a pose, return a list of updates for a board to
 -- insert the string.
 mkPatch :: String -> Pose -> [((Int, Int), Char)]
@@ -79,24 +96,24 @@ mkPatch (w:ws) p = (index $ position p, w) : mkPatch ws (advance p)
 insert :: String -> Pose -> Board -> Maybe Board
 insert [] _ b = Just b
 insert w p b =
-  if isNothing (tryInsert w p b) then
+  if isNothing (computeCost w p b) then
     Nothing
   else
     Just (b // mkPatch w p)
 
+-- Insert all given words into the board.
 insertAll :: RandomGen gen => gen -> [String] -> Board -> Maybe Board
 insertAll _ [] b = Just b
 insertAll rnd (w:ws) b = do
-  b' <- insert w pose b
+  b' <- insert w (pose $ sort moves !! nth) b
   insertAll rnd' ws b'
   where
-    pose = fst (sortBy (comparing snd) (map (\t -> (fst t, fromJust $ snd t)) weightedMoves) !! nth)
-    (nth, rnd') = randomR (0, min 10 (length weightedMoves)) rnd
-    weightedMoves = filter (\x -> case snd x of Just x' -> x' > 0; Nothing -> False) [(po, tryInsert w po b) | po <- posOrientation']
-    posOrientation' = shuffle' posOrientation (length posOrientation) rnd
-    posOrientation = [Pose (Vec x y) o | x <- [sX..eX], y <- [sY..eY], o <- [right, down]]
-    ((sX, sY), (eX, eY)) = bounds b
+    (nth, rnd') = randomR (0, min 10 (length moves)) rnd
+    moves = mapMaybe (\x -> tryInsert w x b) shuffled
+    shuffled = shuffle' all (length all) rnd
+    all = allPoses b
 
+-- Fill all empty fields with a random character.
 fill :: RandomGen gen => gen -> Board -> Board
 fill rnd b = b // zip [(x, y) | x <- [sX..eX], y <- [sY..eY], (b ! (x, y)) == empty] (randomRs ('A', 'Z') rnd)
      where