|
|
| 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]]
| |