7/one.icl

   1 module one
   2
   3 import StdEnv
   4 import Data.Func
   5 import Data.Map => qualified updateAt
   6 import Text
   7
   8
   9 //A bit cheaty because I removed all occurances of bag and bags from the input
  10
  11 read :: *File -> [Char]
  12 read f
  13         # (ok, l, f) = freadc f
  14         | not ok = []
  15         = [l:read f]
  16
  17 Start w
  18         # (io, w) = stdio w
  19         # bag = fromList (makeBag (read io))
  20         = (one bag ['shiny gold'], dec $ two bag ['shiny gold'])
  21
  22 one bag color = dec $ length $ filter id $ map (canContain bag color) $ keys bag
  23 two bag color = inc $ sum [n*two bag c\\(n, c)<-findWithDefault [] color bag]
  24
  25 makeBag :: [Char] -> [([Char], [(Int, [Char])])]
  26 makeBag ls = [(b, mkItem c)\\[b,c]<-map (split [' contain ']) $ split ['.\n'] ls]
  27 where
  28         mkItem :: [Char] -> [(Int, [Char])]
  29         mkItem s = [(toInt (toString x), join [' '] xs)\\[x:xs]<-map (split [' ']) $ split [', '] s]
  30
  31 canContain :: (Map [Char] [(Int,[Char])]) [Char] [Char] -> Bool
  32 canContain bag color name
  33         = or [name == color:map (canContain bag color o snd) $ findWithDefault [] name bag]