Saturday, July 18, 2009

Solutions to Chapter 14 (p. 352)

#1. Note that the example down the page gives bold hints. The solution is:

doGetRandom :: Random a => RandomState a
doGetRandom = do
  gen <- get
  let (val, gen') = random gen
  put gen'
  return val

Sunday, July 12, 2009

Solutions to Chapter 13 (p. 316)

#1. The decision about dropping the parentheses depends on which side of the operator we're on. So, here's the new prettyShow -- changes in bold:

prettyShow :: (Show a, Num a) => SymbolicManip a -> String

-- Show a number or symbol as a bare number or serial
prettyShow (Number x) = show x
prettyShow (Symbol x) = x

prettyShow (BinaryArith op a b) =
    let pa = maybeLeftParen a op
        pb = maybeRightParen b op
        pop = op2str op
        in pa ++ pop ++ pb
prettyShow (UnaryArith opstr a) =
    opstr ++ "(" ++ show a ++ ")"

Now, for the helper functions. Let's start with handling the left-paren:

maybeLeftParen :: (Show a, Num a) => SymbolicManip a -> Op -> String
maybeLeftParen x@(BinaryArith op1 _ _) op
   | op1 == op && isRightAssociative op = "(" ++ prettyShow x ++ ")"
   | (opPrio op1) < (opPrio op) = "(" ++ prettyShow x ++ ")"
   | otherwise = prettyShow x
maybeLeftParen x _ = simpleParen x

For this to work, we need to know each operator's priority, and whether the operator is right-associative. These are trivial (the priorities are taken from Haskell's definitions; type :i (+) in ghci, for example):

opPrio :: Op -> Int
opPrio Plus = 6
opPrio Minus = 6
opPrio Mul = 7
opPrio Div = 7
opPrio Pow = 8

isRightAssociative :: Op -> Bool
isRightAssociatove Pow = True
isRightAssociative _ = False

Finally, for handling parenthesis to the right of the operator, we have this:

maybeRightParen :: (Show a, Num a) => SymbolicManip a -> Op -> String
maybeRightParen x@(BinaryArith op1 _ _) op
   | prio1 < prio = "(" ++ prettyShow x ++ ")"
   | prio1 == prio && opIsMinusOrDiv = "(" ++ prettyShow x ++ ")"
   | otherwise = prettyShow x
   where prio1 = opPrio op1
         prio = opPrio op
         opIsMinusOrDiv = (op == Minus) || (op == Div)
maybeRightParen x _ = simpleParen x

Friday, July 3, 2009

Solutions to Chapter 12 (p. 274)

#1. Trivially,

getElem4 :: (t,t,t,t) -> Int -> t
getElem4 (a,_,_,_) 0 = a
getElem4 (_,b,_,_) 1 = b
getElem4 (_,_,c,_) 2 = c
getElem4 (_,_,_,d) 3 = d

#2. Not too different:

getElem6 :: (t,t,t,t,t,t) -> Int -> t
getElem6 (a,_,_,_,_,_) 0 = a
getElem6 (_,b,_,_,_,_) 1 = b
getElem6 (_,_,c,_,_,_) 2 = c
getElem6 (_,_,_,d,_,_) 3 = d
getElem6 (_,_,_,_,e,_) 4 = e
getElem6 (_,_,_,_,_,f) 5 = f

#3. There are two ways to go about this. First, we can implement getElem6 in terms of getElem4, like this:

getElem6' :: (t,t,t,t,t,t) -> Int -> t
getElem6' (a,b,c,d,e,f) i
  | i < 4     = getElem4 (a,b,c,d) i
  | otherwise = getElem4 (c,d,e,f) (i - 2)

Note how the error cases are handled -- whenever we hand of an invalid index, it is getElem4 that will encounter and report the problem.

The second approach is to implement getElem4 in terms of getElem6. But how do we build a six-tuple when all we're given is a four-tuple? We could, for example, copy the 1st element twice (at the end), i.e., given (a,b,c,d), pass the constructed value (a,b,c,d,a,a) to getElem6. While this ensures the synthesized elements are of the correct type, we'd get the wrong result for indexes 4 and 5, unless we add our own error-checking.

A better alternative lies in directly indicating these values don't really exist, and any attempt to access them is an error:

getElem4' :: (t,t,t,t) -> Int -> t
getElem4' (a,b,c,d) i = getElem6 (a,b,c,d,er,er) i
    where er = error "Out of range"

Saturday, June 27, 2009

Solutions to Chapter 10 (p. 254)

First, an apology: no answers to the questions in Chapter 9 following those in page 228. Why, you ask? Because there's a bug in the authors' code leading to the questions on page 232; their implementation of foldTree compiles, but is broken (try it on non-shallow hierarchy trees to see why). While I don't mind trying to answer the exercises, debugging the authors' code is a bit too much for my patience.

(For the record, I am losing patience with this book; too many bugs, too many errors, too much hand-waving and unclear explanations.)

And now, answers to the exercises of Chapter 10:

#1. It's pretty trivial to modify parseRawPGM to parsePlainPGM; the modified lines are in bold:

parseAsciiPGM =
    parseWhileWith w2c notWhite ==> \header -> skipSpaces ==>&
    assert (header == "P2") "invalid ASCII header" ==>&
    parseNat ==> \width -> skipSpaces ==>&
    parseNat ==> \height -> skipSpaces ==>&
    parseNat ==> \maxGrey -> skipSpaces ==>&
    parseNats (width * height) ==> \bitmap ->
    identity (Greymap width height maxGrey bitmap)
  where notWhite = (`notElem` " \r\n\t")

The main challenge is defining parseNats (plural), which repeatedly uses parseNat (singular) to construct a ByteString:

parseNats :: Int -> Parse L.ByteString
parseNats 0 = identity L.empty
parseNats n = parseNat ==> \v -> (L.cons (fromIntegral v)) <$> parseNats (n - 1)

#2. Let's start by thinking about how will the parsed data be stored. We can replace the type of the greyData field in Greymap, from ByteString to [Int] for example. Or, we can keep it a ByteString, but always allocate two bytes per value. Or, we can keep it a ByteString, and have the ByteString's size vary based on the greyMax value. The last option is the most space-efficient, which is why I've chosen it for the following implementation (changes from the original are in bold):

parseRawPGM =
    parseWhileWith w2c notWhite ==> \header -> skipSpaces ==>&
    assert (header == "P5") "invalid raw header" ==>&
    parseNat ==> \width -> skipSpaces ==>&
    parseNat ==> \height -> skipSpaces ==>&
    parseNat ==> \maxGrey ->
    parseByte ==>&
    parseBytes (width * height * (pixelSize maxGrey)) ==> \bitmap ->
    identity (Greymap width height maxGrey bitmap)
  where notWhite = (`notElem` " \r\n\t")

pixelSize :: Int -> Int
pixelSize maxGrey = if maxGrey < 256 then 1 else 2

Why make pixelSize a top-level function, rather than put it in the where part of parseRawPGM? Because we'll want to use it elsewhere; the new greymap representation is best used with accessor functions. Here's a function that will read the pixel at position x, y:

getPixel :: Greymap -> Int -> Int -> Int
getPixel (Greymap w h greyMax greyData) x y
    | pixSize == 1 = firstByte
    | pixSize == 2 = (256 * firstByte) + secondByte
  where pixSize = pixelSize greyMax
        offset = fromIntegral $ (y * w + x) * pixSize
        dataFromOffset = L8.drop offset greyData
        firstByte = ord $ L8.head dataFromOffset
        secondByte = ord $ L8.head $ L8.tail dataFromOffset

Of course, scanning the entire image using this function would be mighty inefficient; a Greymap -> [[Int]] function can make life easier.

#3. One alternative is to peek into the data, and if switch to either parseRawPGM or parsePlainPGM, based on the file's header. However, the two functions are similar enough that I decided to create a single, unified function, thus:

parsePGM =
    parseWhileWith w2c notWhite ==> \header -> skipSpaces ==>&
    assert (header == "P5" || header == "P2") "invalid PGM header" ==>&
    parseNat ==> \width -> skipSpaces ==>&
    parseNat ==> \height -> skipSpaces ==>&
    parseNat ==> \maxGrey -> (skipAfterMaxGrey header) ==>&
    (parseData header) (width * height * (valuesPerPixel header maxGrey)) ==> \bitmap ->
    identity (Greymap width height maxGrey bitmap)
  where notWhite = (`notElem` " \r\n\t")
        isRaw header = header == "P5"
        skipAfterMaxGrey header = if (isRaw header) then skipByte else skipSpaces
        parseData header = if (isRaw header) then parseBytes else parseNats
        valuesPerPixel header maxGrey = if (isRaw header) then (pixelSize maxGrey) else 1

skipByte :: Parse ()
skipByte = parseByte ==>& identity ()

Basically, in every location where the two parsers would behave differently, I've used a helper function. The helper function often returns which function to call, as the data passed to the function is identical in both cases; thus, parseData returns either parseBytes (for raw files) or parseNats (for plain files), and skipAfterMaxGrey returns either skipByte or skipSpaces.

Ever wondered why the raw parser used parseByte rather than skipSpaces after the grey-max value? Because the actual value bytes could happen to be, say, 8 (tab) or 32 (space), and this would cause them to be erroneously skipped. I had to define skipByte here since parseByte has a different return type than skipSpaces, so the helper function skipAfterMaxGrey couldn't be used to pick between them. skipByte has the same type as skipSpaces, which solves the problem.

(There's a subtle bug here, since the function defined in solution #1 above wasn't updated with the change dictated by solution #2. Can you fix that?)