

Line 1: 
Line 1: 
−  <haskell>
 
−  module Main (main) where
 
−  import System.Environment (getArgs)
 
−  import Data.Char (toUpper,isAlpha)
 
−  import Data.List (sortBy)
 
−  import Data.Ord (comparing)
 
−  import qualified Data.ByteString.Char8 as B
 
− 
 
−  data CharCount = CharCount !Char !Int deriving (Show, Eq)
 
−  data WordData = WordData B.ByteString [CharCount] deriving (Show, Eq)
 
− 
 
−  main = do
 
−  [n] < getArgs
 
−  wl < B.readFile n
 
−  user < B.getLine
 
−  let results = findAnagrams (makeWordList wl) (countChars user)
 
−  B.putStr . B.unlines . map B.unwords $ results
 
− 
 
−  findAnagrams :: [WordData] > [CharCount] > [[B.ByteString]]
 
−  findAnagrams [] _ = []
 
−  findAnagrams lst@((WordData bs cc):rest) qcc =
 
−  case (qcc `minus` cc) of
 
−  Nothing > remaining
 
−  Just [] > [bs]:remaining
 
−  Just x > map ((:) bs) (findAnagrams lst x) ++ remaining
 
−  where remaining = findAnagrams rest qcc
 
− 
 
−  minus :: (Monad m) => [CharCount] > [CharCount] > m [CharCount]
 
−  minus x [] = return x
 
−  minus [] _ = fail "can't subtract from empty"
 
−  minus (lft@(CharCount c1 i1):xs) r@((CharCount c2 i2):ys)
 
−   (c1 == c2) && (i2 == i1) = xs `minus` ys
 
−   (c1 == c2) && (i2 < i1) = do rem < xs `minus` ys
 
−  return $! (CharCount c1 (i1  i2)):rem
 
−   (c1 < c2) = do rem < xs `minus` r
 
−  return $! lft:rem
 
−   (c1 == c2) && (i2 > i1) = fail "right has more chars than left"
 
−   (c1 > c2) = fail "right has chars not in left"
 
−   otherwise = error "Bad condition"
 
− 
 
−  countChars :: B.ByteString > [CharCount]
 
−  countChars = map counts . B.group . B.sort . B.map toUpper . B.filter isAlpha
 
−  where counts x = CharCount (B.head x) (B.length x)
 
− 
 
−  makeWordList :: B.ByteString > [WordData]
 
−  makeWordList = map (\w > WordData w (countChars w)) . sortBy (flip (comparing B.length)) . B.words
 
   
−  </haskell>
 
− 
 
−  [[Category:Code]]
 