(small) code review request

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/

Radu Grigore wrote:
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?
Assuming an O(1) + operation you can do fib n = f n 1 1 where f 0 _ b = b f n a b = f (n-1) (a+b) a List based solutions should also work if garbage collection is done right, e.g., fib n = fs !! n where fs = 1 : 1 : zipWith (+) fs (tail fs) -- Lennart

On 6/16/05, Lennart Augustsson
fib n = f n 1 1 where f 0 _ b = b f n a b = f (n-1) (a+b) a
Indeed. I should have seen this. It's a pretty standard trick for making a function tail recursive.
List based solutions should also work if garbage collection is done right, e.g., fib n = fs !! n where fs = 1 : 1 : zipWith (+) fs (tail fs)
So you mean my solution of the LCS problem should work in O(n) space "if garbage collection is done right"? What exactly does this condition mean in practice? -- regards, radu http://rgrig.blogspot.com/

Radu Grigore wrote:
List based solutions should also work if garbage collection is done right, e.g., fib n = fs !! n where fs = 1 : 1 : zipWith (+) fs (tail fs)
So you mean my solution of the LCS problem should work in O(n) space "if garbage collection is done right"? What exactly does this condition mean in practice?
Well, for fib I'd say that almost any implementation manages to garbage collect the part of the list that is no longer needed. But in this example the difficult part is that (+) operation isn't typically performed until the (!!) has returned the value. I say typically, because a clever strictness analyzer might get it right. And so can a modestly clever garbage collector, it can collapse the (+) operations. As far as I know, no currently available implementations do this. :( To make this fib function run in constant space you need to make it a little stricter. In cases like these, the heap profiler is your friend. It can show you where memory is leaking. -- Lennart
participants (2)
-
Lennart Augustsson
-
Radu Grigore