never executed always true always false

    1 {-|
    2 Module:      Y2015.D06
    3 Description: Advent of Code Day 06 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 06 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2015.D06
   10   ( testA
   11   , testB
   12   , Instruction(..)
   13   , Range(..)
   14   , parseInstructions
   15   , configureGridA
   16   , configureGridB
   17   , lightSimulation
   18   ) where
   19 
   20 import Control.Applicative ((<|>))
   21 import Data.List (foldl')
   22 
   23 import qualified Data.Array.Repa as R
   24 import Data.Array.Repa (Z(..), (:.)(..))
   25 import qualified Text.Parsec as P
   26 import Text.Parsec.Char (char, endOfLine)
   27 import Text.Parsec.String (Parser)
   28 import Data.Vector.Unboxed.Base (Unbox)
   29 
   30 import Y2015.Util (regularParse, intParser)
   31 
   32 type Point = (Int, Int)
   33 
   34 -- |Represents a two-dimensional range of lights.
   35 data Range =
   36   Range Point
   37         Point
   38   deriving (Eq, Show)
   39 
   40 -- |Type of light grid instruction.
   41 data Instruction
   42   = On Range
   43   | Off Range
   44   | Toggle Range
   45   deriving (Show)
   46 
   47 size :: Int
   48 size = 1000
   49 
   50 initialGrid :: R.Array R.U R.DIM2 Int
   51 initialGrid =
   52   R.fromListUnboxed (Z :. size :. size :: R.DIM2) (replicate (size * size) 0)
   53 
   54 instructionsParser :: Parser [Instruction]
   55 instructionsParser = P.many (instruction <* P.optional endOfLine)
   56 
   57 instruction :: Parser Instruction
   58 instruction = On <$> directive "turn on"
   59           <|> Off <$> directive "turn off"
   60           <|> Toggle <$> directive "toggle"
   61 
   62 directive :: String -> Parser Range
   63 directive s = P.skipMany1 (P.try (P.string s *> P.skipMany1 P.space)) *> range
   64 
   65 range :: Parser Range
   66 range = Range <$> point <* P.string " through " <*> point
   67 
   68 point :: Parser Point
   69 point = (,) <$> intParser <* char ',' <*> intParser
   70 
   71 -- |Folding function to aggregate computation for 'Instruction's per part
   72 -- |A spec.
   73 configureGridA
   74   :: R.Array R.U R.DIM2 Int -- ^ Light grid.
   75   -> Instruction -- ^ Operation 'Instruction'.
   76   -> R.Array R.U R.DIM2 Int -- ^ Resultant light grid.
   77 configureGridA a (On r) = switch a (const 1) r
   78 configureGridA a (Off r) = switch a (const 0) r
   79 configureGridA a (Toggle r) = switch a toggle r
   80 
   81 -- |Folding function to aggregate computation for 'Instruction's per part
   82 -- |B spec.
   83 configureGridB
   84   :: R.Array R.U R.DIM2 Int -- ^ Light grid.
   85   -> Instruction -- ^ Operation 'Instruction'.
   86   -> R.Array R.U R.DIM2 Int -- ^ Resultant light grid.
   87 configureGridB a (On r) = switch a (+ 1) r
   88 configureGridB a (Off r) = switch a dim r
   89 configureGridB a (Toggle r) = switch a (+ 2) r
   90 
   91 toggle :: Int -> Int
   92 toggle 1 = 0
   93 toggle _ = 1
   94 
   95 dim :: Int -> Int
   96 dim = max 0 . subtract 1
   97 
   98 switch
   99   :: (R.Source r a, Unbox a)
  100   => R.Array r R.DIM2 a -> (a -> a) -> Range -> R.Array R.U R.DIM2 a
  101 switch a f r = R.computeS $ R.traverse a id (set f r)
  102 
  103 -- This is pretty confusing:
  104 --    Custom mapping function (set the lights)
  105 -- -> Range to apply the function upon
  106 -- -> Function to retrieve original elements from
  107 -- -> Original array constructor
  108 -- -> New (or unchanged) value
  109 set :: (a -> a) -> Range -> (R.DIM2 -> a) -> R.DIM2 -> a
  110 set f (Range (x', y') (x'', y'')) g (Z :. x :. y)
  111   | withinX && withinY = f orig
  112   | otherwise = orig
  113   where
  114     withinX = x >= x' && x <= x''
  115     withinY = y >= y' && y <= y''
  116     orig = g (Z :. x :. y)
  117 
  118 -- |Execute 'Instruction' and return number of lit lights per part A spec.
  119 testA
  120   :: Instruction -- ^ Given 'Instruction'.
  121   -> Int -- ^ Number of lit lights.
  122 testA = R.foldAllS (+) 0 . configureGridA initialGrid
  123 
  124 -- |Execute 'Instruction' and return number of lit lights per part B spec.
  125 testB
  126   :: Instruction -- ^ Given 'Instruction'
  127   -> Int -- ^ Number of lit lights.
  128 testB = R.foldAllS (+) 0 . configureGridB initialGrid
  129 
  130 -- |Parses a string into a list of 'Instruction's.
  131 parseInstructions
  132   :: String -- ^ Input string to parse.
  133   -> [Instruction] -- ^ Either an error or parsed structure.
  134 parseInstructions = either err suc . regularParse instructionsParser
  135   where err = error . show
  136         suc r = r
  137 
  138 -- |Run a light simulation
  139 lightSimulation
  140   :: Foldable t
  141   => (R.Array R.U R.DIM2 Int -> a -> R.Array R.U R.DIM2 Int) -- ^ REPA Light grid
  142   -> t a -- ^ 'Instruction's
  143   -> Int -- ^ Lit lights
  144 lightSimulation f = R.sumAllS . foldl' f initialGrid