never executed always true always false

    1 {-|
    2 Module:      Y2015.D19
    3 Description: Advent of Code Day 19 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 19 set of problems for <adventofcode.com>.
    8 -}
    9 
   10 module Y2015.D19 (distinctMols, molSteps) where
   11 
   12 import Data.Char (isLower, isUpper)
   13 import Data.List (foldl', inits, tails)
   14 import Data.Map.Strict (Map)
   15 import qualified Data.Map.Strict as M
   16 import Data.Set  (Set)
   17 import qualified Data.Set as S
   18 
   19 type Mol   = [String]
   20 type Repls = Map String (Set String)
   21 
   22 -- |Returns the number of steps required to form a specified molecule
   23 molSteps :: String -- ^ Target molecule composition as a raw string
   24          -> Int    -- ^ Number of steps required to create indicated molecule
   25 molSteps = (+) (-1) . sum . map replCount . toMol . last . lines
   26   where replCount "Rn" =  0
   27         replCount "Ar" =  0
   28         replCount "Y"  = -1
   29         replCount _    =  1
   30 
   31 -- |Finds the number of possible distinct molecules
   32 distinctMols :: String -- ^ List of starting molecules as a raw string
   33              -> Int    -- ^ Number of distinct modules that can be formed
   34 distinctMols s = S.size $ compounds mols repls
   35   where input = lines s
   36         mols  = toMol $ last input
   37         repls = toRepls $ init input
   38 
   39 compounds :: Mol -> Repls -> Set String
   40 compounds m r = foldl' S.union S.empty $ map combine molTrips
   41   where molTrips = zip3 (inits m) m (tail $ tails m)
   42         combine t@(_,m',_) = subRepl t $ M.findWithDefault S.empty m' r
   43 
   44 subRepl :: (Mol, String, Mol) -> Set String -> Set String
   45 subRepl (pre,_,post) = foldl' (flip S.insert) S.empty
   46                        . map (concat . construct) . S.toList
   47   where construct repl = pre ++ [repl] ++ post
   48 
   49 toRepls :: [String] -> Repls
   50 toRepls = M.fromListWith S.union . map (molPair S.singleton . words)
   51 
   52 molPair :: (a -> b) -> [a] -> (a, b)
   53 molPair f [from,_,to] = (from, f to)
   54 molPair f xs = (head xs, f $ last xs)
   55 
   56 toMol :: String -> Mol
   57 toMol []                                = []
   58 toMol (x:y:ys) | isUpper x && isLower y = (x:[y]) : toMol ys
   59 toMol (x:xs)   | isUpper x || x == 'e'  = [x]     : toMol xs
   60                | otherwise              = toMol xs