Google Code Jam/The Price is Wrong

import Data.List import Data.Function import Data.Ord import Data.Maybe type Price = (String,Int) type Prices = [(String,Int)] -- | finding the longest strings bests :: [[a]] -> [[a]] bests = head . groupBy ((==) `on` length) . sortBy (flip . comparing $ length) -- | longest sequences of possibly nonconsecutive elements (from IRC help) longest xs = bests . foldr (\x bs -> bSW x bs ++ bs) [] $ xs where bSW x bs = bests $ [x] : (map (x:) . filter ((x <=). head) $ bs) -- solutions are the complements of the longest sequences sol xs = map (xs \\) . longest $ xs where parsePrices :: [String] -> Prices parsePrices [x,y] = zip (words x) (map read. words $ y) parseCases :: String -> [Prices] parseCases x = let (n:ts) = lines x in take (read n) . unfoldr (\x -> if null x then Nothing else Just (parsePrices. take 2 $ x, drop 2 x)) $ ts main = do ts <- parseCases `fmap` getContents flip mapM_ (zip [1..] ts) $ \(i,t) -> do putStr $ "Case #" ++ show i ++ ": " let (_,n) = unzip t r x = fromJust . find ((== x) . snd) $ t putStrLn . unwords . map fst . head . sort . map (sort . map r) . sol $ n