[Haskell-cafe] (small) code review request

[Radu Grigore]

The programming language I know best is C++. Wait, don't close the message.

I also know OCaml and a couple of days ago I read "A Gentle
Introduction to Haskell". In order to practice what I've learned a bit
above "hello world" programs I chose to solve some easy tasks from
SPOJ. They have automatic testing so I know if I got it right or not
and I can also look at submission statistics (number and accuracy) to
choose easy problems. Aside from "easiness" I've chosen at random
these:

https://spoj.sphere.pl/problems/ADDREV/
https://spoj.sphere.pl/problems/CRSCNTRY/

So these are my first two Haskell "programs" and I'd appreciate any
comments you might have, especially better ways of solving the
problems.

The first one asks you to print rev(rev a + rev b) for two numbers a
and b where rev is a function that transforms an integer into an
integer you get by reversing the digits.

--- BEGIN addrev.hs ---
rev :: Int -> Int
rev = read . reverse . show

solve :: Int -> IO ()
solve 0 = do return ()
solve n = do
  line <- getLine
  let 
    a:b:_ = words line 
    an = read a
    bn = read b in
      (putStrLn . show . rev) (rev an + rev bn)
  solve (n-1)
	

main = do
  hSetBuffering stdin LineBuffering
  line <- getLine
  solve (read line)
--- END addrev.hs ---

The second problem happens to be the Longest Common Subsequence
problem, which is a classical DP problem. After searching a bit how to
do memoisation/dp in Haskell I've found two resources:

http://www.haskell.org/hawiki/MemoisingCafs
http://portal.acm.org/citation.cfm?id=871896&coll=Portal&dl=ACM&CFID=46143395&CFTOKEN=4814124

I chose to try the approach in the Bird&Hinze article. The result is
my second Haskell program:

--- BEGIN crscntry.lhs ---
One of the problems at SPOJ, namely CRSCNTRY, asks you to implement
the classical (DP) algorithm for finding the length of the longest
common subsequence. The reccurence relation is:

lcs [] _      = 0
lcs _ []      = 0
lcs (x:xs) (y:ys) =
  | x == y    = 1 + lcs xs ys
  | otherwise = lcs (x:xs) ys `max` lcs xs (y:ys)

There are of course only mn distinct calls to lcs, where
m = 1 + length xs, n = 1 + length ys. I will try here a memoisation
approach about which I have read in "Trouble shared is trouble halved",
by Bird and Hinze. The basic idea is to explicitly construct the
call tree and store in it the result of computing the function.

First, note that the reccurence relation above makes either one or
two calls. I think we can get by with a binary tree that has this
invariant:

  left . right n = right . left n

Let's define the tree.

> data Tree a = Empty | Node { left :: Tree a, info :: a, right :: Tree a }
> leaf :: a -> Tree a
> leaf x = Node Empty x Empty

Now imagine the tree nodes put into a matrix
     l      l
 x <--- x <--- x
 ^      ^      ^
 |r  l  |r  l  |r
 x <--- x <--- x

We use two memoisation functions. One of them constructs all the rows
above (memo_lcs), while the other reuses the nodes above and constructs
only one row to the left (memo_lcs'). We also pass around the lists so
that we can constructs nodes correctly.

> memo_lcs :: Eq a => [a] -> [a] -> Tree Integer
> memo_lcs [] _ = Empty
> memo_lcs _ [] = Empty
> memo_lcs (x:xs) (y:ys) = 
>     node x y (memo_lcs' t xs (y:ys)) t
>  where t = memo_lcs (x:xs) ys

> memo_lcs' :: Eq a => Tree Integer -> [a] -> [a] -> Tree Integer
> memo_lcs' _ [] _ = Empty
> memo_lcs' _ _ [] = Empty
> memo_lcs' z (x:xs) (y:ys) = 
>     node x y (memo_lcs' l xs (y:ys)) l
>  where l = tree_left z

Both of these functions use a smart constructor. It takes the left
and right branches and constructs a new node while also computing the
correct value the function must have.

> node :: Eq a => a -> a -> Tree Integer -> Tree Integer -> Tree Integer
> node x y l r
>     | x == y    = Node l (1 + (value . tree_left) r) r
>     | otherwise = Node l (value l `max` value r) r

The inspection of the value returns 0 for empty nodes.

> value :: Tree Integer -> Integer
> value Empty  = 0
> value (Node _ r _) = r

You might be wondering by now what is the function tree_left.

> tree_left :: Tree a -> Tree a
> tree_left Empty  = Empty
> tree_left (Node l _ _) = l

(I wonder if all this would be simpler if I'd use a border of 0-valued
leafs instead of the functions tree_left and value. I'll try soon.)

Now the definition of lcs is simple.

> lcs :: Eq a => [a] -> [a] -> Integer
> lcs x y = value (memo_lcs x y)

This is the basic solution of the problem CRSCNTRY. A testcase is just
a bit more complicated.

> testcase        :: [[Integer]] -> Integer
> testcase (x:xs) = foldl max 0 (map (lcs x) xs)


In order to finish we just need to take care of the IO.

> myReadList :: String -> [Integer]
> myReadList s = 
>   let (a, t) =  head (lex s) in
>     case read a of
>       0 -> []
>       n -> n : (myReadList t)

> readTest :: IO [[Integer]]
> readTest = do
>     line <- getLine
>     case myReadList line of
>       [] -> do return []
>       lst -> do 
>         rest <- readTest
>         return (lst : rest)

The solve function reads n tests and solves each of them.

> solve :: Integer -> IO ()
> solve 0     = return ()
> solve (n+1) = do
>     test <- readTest
>     putStrLn (show (testcase test))
>     solve n

In the main function we read the number of tests we should handle
and then solve them

> main = do
>    line <- getLine
>    solve (read line)

That's it. I hope it works (fast enough).
--- END crscntry.lhs ---

It worked fast enough.

Anyway, I was wondering if the O(n) space and O(n^2) time solution can
be implemented in Haskell. Another way to ask this. Consider the
classic fibonacci example. Can one compute the n-th fibonacci number
in O(n) time and O(1) space, i.e. remember only the "last" two values
during computation?

-- 
regards,
 radu
http://rgrig.blogspot.com/