[Haskell-cafe] Re: Software Tools in Haskell

apfelmus apfelmus at quantentunnel.de
Sat Dec 15 04:51:39 EST 2007


Benja Fallenstein wrote:
> Henning Thielemann wrote:
>> I remember there was a discussion about how to implement full 'wc' in an
>> elegant but maximally lazy form, that is counting bytes, words and lines
>> in one go. Did someone have a nice idea of how to compose the three
>> counters from implementations of each counter? I'm afraid one cannot
>> simply use the "split and count fragments" trick then.

Well, you could rely on catamorphism fusion

   (foldr f1 x1, foldr f2 x2) = foldr (f1 *** f2) (x1,x2)

but that's not so compositional.

> Could you turn the folds into scans and use zip3 and last? I.e.,
> something like this:

This approach is really clever!

> data Triple a b c = Triple !a !b !c deriving Show
> 
> countChars :: String -> [Int]
> countChars = scanl (\n _ -> n+1) 0
> 
> countChar :: Char -> String -> [Int]
> countChar c = scanl (\n c' -> if c == c' then n+1 else n) 0
> 
> countLines = countChar '\n'
> countWords = countChar ' '
> 
> last' [x] = x
> last' (x:xs) = x `seq` last' xs
> 
> zip3' (x:xs) (y:ys) (z:zs) = Triple x y z : zip3' xs ys zs
> zip3' _ _ _ = []

   zipWith3 Triple

> wc :: String -> Triple Int Int Int
> wc xs = last' $ zip3' (countChars xs) (countWords xs) (countLines xs)
>
> main = print . wc =<< getContents
> 
> (or use Data.Strict.Tuple -- but that only has pairs and no zip...)

Slightly simplified (uses BangPatterns):

   import Data.List

   scanl' :: (b -> a -> b) -> b -> [a] -> [a]
   scanl' f !b []     = [b]
   scanl' f !b (x:xs) = b:scanl' (f b x) xs

   counts :: (a -> Bool) -> [a] -> [Int]
   counts p = scanl' (\n c -> if p c then n+1 else n) 0

   wc :: String -> (Int,Int,Int)
   wc = last $ zip3 (charc xs) (wordc xs) (linec xs)
      where
      charc = counts (const True)
      wordc = counts (== ' ')
      linec = counts (== '\n')

The  scanl'  basically ensures that the forcing the resulting list spine 
automatically forces the elements. This makes sense to do early and we 
can use normal list functions after that.


Regards,
apfelmus



More information about the Haskell-Cafe mailing list