Hello In the course of this thread mention of programming task from Lutz Prechelt has been made (for the purposes of language comparison..) http://www.ipd.uka.de/~prechelt/phonecode/ AFAIK there's no data for Haskell solutions for this problem so here's my effort (about 4 years too late:-) for the benefit of those folk gathering hard data on this topic. (Code attached to the bottom of this post) $ghc -O -o phonecode Main.hs $strip phonecode $time ./phonecode woerter2 z1000.t > results.txt real 0m6.330s user 0m5.110s sys 0m0.090s This is using ghc 6.0 on 1.2 GHz Athlon running redhat 9. This seems to compare quite favourably to the C solutions mentioned in Lutz paper (albeit on a completely different machine). I count 63 lines of real Haskell here. BTW, all type annotation has been commented out for the convenience of lispers :-) module Main (main) where import System (getArgs) import IO (stdout) import Directory (doesFileExist) import Char (toUpper,ord) import Array (Array,array,(!),(//)) import Data.List (foldl') import Data.PackedString (PackedString,packString,hPutPS) -- Type Synonyms type Key = Int type Keys = [Key] -- main :: IO () main = do -- Get command line arguments and check they're legit args <- getArgs case args of [wordz,numz] -> do wordzExists <- doesFileExist wordz if wordzExists then do numzExists <- doesFileExist numz if numzExists then do ws <- readFile wordz ns <- readFile numz process (lines ws) (lines ns) else error ("Can't find " ++ numz) else error ("Can't find " ++ wordz) _ -> error "Invalid Command Line" -- Process the input words and numbers -- process :: [String] -> [String] -> IO () process ws ns = mapM_ (encodeNum (encodings (makeSTree ws))) ns -- Output all encodings of a number -- encodeNum :: (Keys -> [[Match]]) -> String -> IO () encodeNum lookUp cs = mapM_ printEnc (lookUp rawKeys) where rawKeys = [ord c - ord '0' | c <- cs, c /='/', c /= '-' ] printEnc ms = putStr cs >> putChar ':' >> mapM_ printMatch ms >> putStrLn "" printMatch (MatchK k) = putChar ' ' >> putStr (show k) printMatch (MatchW w) = putChar ' ' >> hPutPS stdout w -- Get the Key for a character (upper case only!) -- getKey :: Char -> Key getKey c = getKey' ckMap where getKey' [] = error ("getKey: " ++ [c]) getKey' ((k,cs):xs) = if elem c cs then k else getKey' xs ckMap = [(0,"E") ,(1,"JNQ"),(2,"RWX"),(3,"DSY"),(4,"FT") ,(5,"AM"),(6,"CIV"),(7,"BKU"),(8,"LOP"),(9,"GHZ")] -- Match data type (either a single key or a word) data Match = MatchK Key | MatchW !PackedString -- Search Tree data type newtype STree = STree (Array Key (STree,[Match])) -- Initial value for Search Tree -- sTree0 :: STree sTree0 = STree (array (0,9) [(n,(sTree0,[]))| n <- [0..9]]) -- Make the search tree from a list of words -- makeSTree :: [String] -> STree makeSTree ws = foldl' putWord sTree0 pairs where pairs = [let ps = packString w in ps `seq` (word2keys w, MatchW ps) | w<- ws] word2keys cs = [getKey (toUpper c) | c <- cs, c /= '"' , c /= '-' ] putWord stree (keys,m) = put keys stree where put [] _ = error "makeSTree: empty Keys" put [k] (STree a) = let (t,ms) = a ! k a' = a // [(k,(t,m:ms))] in a' `seq` STree a' put (k:ks) (STree a) = let (t,ms) = a ! k t' = put ks t a' = a // [(k,(t',ms))] in t' `seq` a' `seq` STree a' -- Get all matching word prefixes and key suffixes for list of keys -- getWPrefixes :: STree -> Keys -> [([Match],Keys)] getWPrefixes _ [] = [] getWPrefixes (STree a) (k:ks) = let (t,ms) = a ! k in case ms of [] -> getWPrefixes t ks _ -> (ms,ks) : getWPrefixes t ks -- Get all encodings for a number (list of keys) -- encodings :: STree -> Keys -> [[Match]] encodings top = enc where enc [] = [[]] enc ks@(k:ks') = case getWPrefixes top ks of [] -> [MatchK k : e | e <- enc' ks'] xs -> combine xs -- This version does not allow key prefixes enc' [] = [[]] enc' ks = combine (getWPrefixes top ks) -- Combine all prefixes/(encoded suffix) pairs combine xs = concat [[p:e | p<-ps, e <- enc ks] | (ps,ks)<-xs] Regards -- Adrian Hey