Difference between revisions of "Anagrams"
Jump to navigation
Jump to search
DonStewart (talk | contribs) m (category) |
(updated to for 6.6.. minor cleanups.) |
||
Line 4: | Line 4: | ||
import Data.Char (toUpper,isAlpha) |
import Data.Char (toUpper,isAlpha) |
||
import Data.List (sortBy) |
import Data.List (sortBy) |
||
− | import |
+ | import Data.Ord (comparing) |
import qualified Data.ByteString.Char8 as B |
import qualified Data.ByteString.Char8 as B |
||
+ | |||
− | |||
data CharCount = CharCount !Char !Int deriving (Show, Eq) |
data CharCount = CharCount !Char !Int deriving (Show, Eq) |
||
data WordData = WordData B.ByteString [CharCount] deriving (Show, Eq) |
data WordData = WordData B.ByteString [CharCount] deriving (Show, Eq) |
||
+ | |||
− | |||
− | main |
+ | main = do |
+ | [n] <- getArgs |
||
− | main = |
||
− | + | wl <- B.readFile n |
|
+ | user <- B.getLine |
||
− | wl <- liftM makeWordList $ B.readFile n |
||
− | + | let results = findAnagrams (makeWordList wl) (countChars user) |
|
⚫ | |||
− | case (findAnagrams wl user) of |
||
− | [] -> print "No anagrams." |
||
⚫ | |||
findAnagrams :: [WordData] -> [CharCount] -> [[B.ByteString]] |
findAnagrams :: [WordData] -> [CharCount] -> [[B.ByteString]] |
||
Line 27: | Line 25: | ||
Just x -> map ((:) bs) (findAnagrams lst x) ++ remaining |
Just x -> map ((:) bs) (findAnagrams lst x) ++ remaining |
||
where remaining = findAnagrams rest qcc |
where remaining = findAnagrams rest qcc |
||
+ | |||
− | |||
minus :: (Monad m) => [CharCount] -> [CharCount] -> m [CharCount] |
minus :: (Monad m) => [CharCount] -> [CharCount] -> m [CharCount] |
||
minus x [] = return x |
minus x [] = return x |
||
Line 35: | Line 33: | ||
| (c1 == c2) && (i2 < i1) = do rem <- xs `minus` ys |
| (c1 == c2) && (i2 < i1) = do rem <- xs `minus` ys |
||
return $! (CharCount c1 (i1 - i2)):rem |
return $! (CharCount c1 (i1 - i2)):rem |
||
⚫ | |||
⚫ | |||
| (c1 < c2) = do rem <- xs `minus` r |
| (c1 < c2) = do rem <- xs `minus` r |
||
return $! lft:rem |
return $! lft:rem |
||
⚫ | |||
⚫ | |||
| otherwise = error "Bad condition" |
| otherwise = error "Bad condition" |
||
+ | |||
− | |||
countChars :: B.ByteString -> [CharCount] |
countChars :: B.ByteString -> [CharCount] |
||
countChars = map counts . B.group . B.sort . B.map toUpper . B.filter isAlpha |
countChars = map counts . B.group . B.sort . B.map toUpper . B.filter isAlpha |
||
− | where counts x = CharCount (B. |
+ | where counts x = CharCount (B.head x) (B.length x) |
+ | |||
− | |||
makeWordList :: B.ByteString -> [WordData] |
makeWordList :: B.ByteString -> [WordData] |
||
− | makeWordList = map (\w -> WordData w (countChars w)) . sortBy |
+ | makeWordList = map (\w -> WordData w (countChars w)) . sortBy (flip (comparing B.length)) . B.words |
− | where bsLenCmp x y = compare (B.length y) (B.length x) |
||
</haskell> |
</haskell> |
Revision as of 11:08, 25 October 2006
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