Parsing PPM images in Haskell - parsing

I'm starting to learn Haskell and wish to parse a PPM image for execrsice. The structure of the PPM format is rather simple, but it is tricky. It's described here. First of all, I defined a type for a PPM Image:
data Pixel = Pixel { red :: Int, green :: Int, blue :: Int} deriving(Show)
data BitmapFormat = TextualBitmap | BinaryBitmap deriving(Show)
data Header = Header { format :: BitmapFormat
, width :: Int
, height :: Int
, colorDepth :: Int} deriving(Show)
data PPM = PPM { header :: Header
, bitmap :: [Pixel]
}
bitmap should contain the entire image. This is where the first challange comes - the part that contains the actual image data in PPM can be either textual or binary (described in the header).
For textual bitmaps I wrote the following function:
parseTextualBitmap :: String -> [Pixel]
parseTextualBitmap = map textualPixel . chunksOf 3 . wordsBy isSpace
where textualPixel (r:g:b:[]) = Pixel (read r) (read g) (read b)
I'm not sure what to do with binary bitmaps, though. Using read converts a string representation of numbers to numbers. I want to convert "\x01" to 1 of type Int.
The second challange is parsing the header. I wrote the following function:
parseHeader :: String -> Header
parseHeader = constructHeader . wordsBy isSpace . filterComments
where
filterComments = unlines . map (takeWhile (/= '#')) . lines
formatFromText s
| s == "P6" = BinaryBitmap
| s == "P3" = TextualBitmap
constructHeader (format:width:height:colorDepth:_) =
Header (formatFromText format) (read width) (read height) (read colorDepth)
Which works pretty well. Now I should write the module exported function (let's call it parsePPM) which gets the entire file content (String) and then return PPM. The function should call parseHeader, deterime the bitmap format, call the apropriate parse(Textual|Binary)Bitmap and then construct a PPM with the result. Once parseHeader returns I should start decoding the bitmap from the point that parseHeader stopped in. However, I cannot know in which point of the string parseHeader stopped. The only solution I could think of is that instead of Header, parseHeader will return (Header,String), when the second element of the tuple is the remainder retrieved by constructHeader (which currently named as _). But I'm not really sure it's the "Haskell Way" of doing things.
To sum up my questions:
1. How do I decode the binary format into a list of Pixel
2. How can I know in which point the header ends
Since I'm learning Haskell by myself I have no one to actually review my code, so in addition to answering my questions I will appriciate any comment about the way I code (coding style, bugs, alternative way to do things, etc...).

Lets start with question 2 because it is easier to answer. Your approach is correct: as you parse things, you remove those characters from the input string, and return a tuple containing the result of the parse, and the remaining string. However, thereis no reason to write all this from scratch (except perhaps as an academic exercise) - there are plenty of parsers which will take care of this issue for you. The one I will use is Parsec. If you are new to monadic parsing you should first read the section on Parsec in RWH.
As for question 1, if you use ByteString instead of String, then parsing single bytes is easy since single bytes are the atomic elements of ByteStrings!
There is also the issue of the Char/ByteString interface. With Parsec, this is a non-issue since you can treat a ByteString as a sequence of Byte or Char - we will see this later.
I decided to just write the full parser - this is a very simple language so with all the primitives defined for you in the Parsec library, it is very easy and very concise.
The file header:
import Text.Parsec.Combinator
import Text.Parsec.Char
import Text.Parsec.ByteString
import Text.Parsec
import Text.Parsec.Pos
import Data.ByteString (ByteString, pack)
import qualified Data.ByteString.Char8 as C8
import Control.Monad (replicateM)
import Data.Monoid
First, we write the 'primitive' parsers - that is, parsing bytes, parsing textual numbers, and parsing whitespace (which the PPM format uses as a seperator):
parseIntegral :: (Read a, Integral a) => Parser a
parseIntegral = fmap read (many1 digit)
digit parses a single digit - you'll notice that many function names explain what the parser does - and many1 will apply the given parser 1 or more times. Then we read the resulting string to return an actual number (as opposed to a string). In this case, the input ByteString is being treated as text.
parseByte :: Integral a => Parser a
parseByte = fmap (fromIntegral . fromEnum) $ tokenPrim show (\pos tok _ -> updatePosChar pos tok) Just
For this parser, we parse a single Char - which is really just a byte. It is just returned as a Char. We could safely make the return type Parser Word8 because the universe of values that can be returned is [0..255]
whitespace1 :: Parser ()
whitespace1 = many1 (oneOf "\n ") >> return ()
oneOf takes a list of Char and parses any one of the characters in the order given - again, the ByteString is being treated as Text.
Now we can write the parser for the header.
parseHeader :: Parser Header
parseHeader = do
f <- choice $ map try $
[string "P3" >> return TextualBitmap
,string "P6" >> return BinaryBitmap]
w <- whitespace1 >> parseIntegral
h <- whitespace1 >> parseIntegral
d <- whitespace1 >> parseIntegral
return $ Header f w h d
A few notes. choice takes a list of parsers and tries them in order. try p takes the parser p, and 'remembers' the state before p starts parsing. If p succeeds, then try p == p. If p fails, then the state before p started is restored and you pretend you never tried p. This is necessary due to how choice behaves.
For the pixels, we have two choices as of now:
parseTextual :: Header -> Parser [Pixel]
parseTextual h = do
xs <- replicateM (3 * width h * height h) (whitespace1 >> parseIntegral)
return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs
We could use many1 (whitespace 1 >> parseIntegral) - but this wouldn't enforce the fact that we know what the length should be. Then, converting the list of numbers to a list of pixels is trivial.
For binary data:
parseBinary :: Header -> Parser [Pixel]
parseBinary h = do
whitespace1
xs <- replicateM (3 * width h * height h) parseByte
return $ map (\[a,b,c] -> Pixel a b c) $ chunksOf 3 xs
Note how the two are almost identical. You could probably generalize this function (it would be especially useful if you decided to parse the other types of pixel data - monochrome and greyscale).
Now to bring it all together:
parsePPM :: Parser PPM
parsePPM = do
h <- parseHeader
fmap (PPM h) $
case format h of
TextualBitmap -> parseTextual h
BinaryBitmap -> parseBinary h
This should be self-explanatory. Parse the header, then parse the body based on the format. Here are some examples to try it on. They are the ones from the specification page.
example0 :: ByteString
example0 = C8.pack $ unlines
["P3"
, "4 4"
, "15"
, " 0 0 0 0 0 0 0 0 0 15 0 15"
, " 0 0 0 0 15 7 0 0 0 0 0 0"
, " 0 0 0 0 0 0 0 15 7 0 0 0"
, "15 0 15 0 0 0 0 0 0 0 0 0" ]
example1 :: ByteString
example1 = C8.pack ("P6 4 4 15 ") <>
pack [0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 0, 15, 0, 0, 0, 0, 15, 7,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 7, 0, 0, 0, 15,
0, 15, 0, 0, 0, 0, 0, 0, 0, 0, 0 ]
Several notes: this doesn't handle comments, which are part of the spec. The error messages are not very useful; you can use the <?> function to create your own error messages. The spec also indicates 'The lines should not be longer than 70 characters.' - this is also not enforced.
edit:
Just because you see do-notation, doesn't necessarily mean that you are working with impure code. Some monads (like this parser) are still pure - they are just used for convenience. For example, you can write your parser with the type parser :: String -> (a, String), or, what we have done here, is we use a new type: data Parser a = Parser (String -> (a, String)) and have parser :: Parser a; we then write a monad instance for Parser to get the useful do-notation. To be clear, Parsec supports monadic parsing, but our parser is not monadic - or rather, uses the Identity monad, which is just newtype Identity a = Identity { runIdentity :: a }, and is only necessary because if we used type Identity a = a we would have 'overlapping instances' errors everywhere, which is not good.
>:i Parser
type Parser = Parsec ByteString ()
-- Defined in `Text.Parsec.ByteString'
>:i Parsec
type Parsec s u = ParsecT s u Data.Functor.Identity.Identity
-- Defined in `Text.Parsec.Prim'
So then, the type of Parser is really ParsecT ByteString () Identity. That is, the parser input is ByteString, the user state is () - which just means we aren't using the user state, and the monad in which we are parsing is Identity. ParsecT is itself just a newtype of:
forall b.
State s u
-> (a -> State s u -> ParseError -> m b)
-> (ParseError -> m b)
-> (a -> State s u -> ParseError -> m b)
-> (ParseError -> m b)
-> m b
All those functions in the middle are just used to pretty-print errors. If you are parsing 10's of thousands of characters and an error occurs, you won't be able to just look at it and see where that happened - but Parsec will tell you the line and column. If we specialize all the types to our Parser, and pretend that Identity is just type Identity a = a, then all the monads disappear and you can see that the parser is not impure. As you can see, Parsec is a lot more powerful than is required for this problem - I just used it due to familiarity, but if you were willing to write your own primitive functions like many and digit, then you could get away with using newtype Parser a = Parser (ByteString -> (a, ByteString)).

Related

Parsing large matrices in Haskell

I have recently started learning Haskell, I'm testing what I've learnt using the Google KickStart code challanges.
The problem I am looking at essentially asks to read square matrices from standard input and sum the elements on the diagonals parallel to the main diagonal.
I have written a simple program to solve the problem, this passes the first test but not the second.
The problem seems to be that the input in the second test is much larger than the first and the parsers I have written are either too slow or use too much memory.
The input is formatted as a sequence of matrices
n
a11 ... a1n
...
an1 ... ann
My first attempt using builtin function
type Matrix = [[Int]]
parseInput:: String -> [Matrix]
parseInput = parseInput' . lines
where
parseInput':: [String] -> [Matrix]
parseInput' [] = []
parseInput' (i:is) = let (m,rest) = splitAt (read i) is in
(map ((map read).words) m) : (parseInput' rest)
main = do
input <- getContents
let result = show $ parseInput input
putStr result
The second attempt using the parsec library
import Text.Parsec
import Text.Parsec.String (Parser)
type Row = [Int]
type Matrix = [[Int]]
matrixSize::(Integral a, Read a) => Parser a
matrixSize = do
n <- ( many1 digit ) <* newline
return $ read n
matrixRow:: Parser Row
matrixRow = do
row <- (sepBy1 (many1 digit) (char ' ')) <* (newline <|> (eof >> return ' '))
return $ map read row
parseMatrix:: Parser Matrix
parseMatrix = do
n <- matrixSize
mat <- count n matrixRow
return mat
parseInput:: Parser [Matrix]
parseInput = (many1 parseMatrix)
prepareInput:: String -> [Matrix]
prepareInput input = case parse parseInput "" input of
Right l -> l
Left _ -> []
main = do
input <- getContents
let result = show $ prepareInput input
putStr result
According to Google website the second test instance contains at most 100 matrices of which 10 are of size at most 1000 with elements of size at most 10^7, the remaining matrices are smaller of size at most 100.
I have generated a random test file with 10 large matrices of size at most 1000 and it turns out to be roughly 30MB in size.
Running either parser on the test file takes roughly 13s on my machine and the second uses more than 1GB of memory.
Both fail the requirements for running on the server: the first exceeds 20s execution time and the second fails the memory constraint of 1GB.
Is there a better way for parsing large files?
Is there any inefficiency that can be solved in my code?
Any advice will be greatly appreciated!

What's a difference between unary and binary operator parsing in Haskell?

I'm learning some techniques to make a very simple Haskell parser that serves to calculation consistence (addition, subtraction and other trivial operations). Library I use is Parsec. Although I've got some comprehension on binary calculation, it seems to be tough to me if I try to make a unary operator function, for example that of negation (~). There is a code snippet I use to implement parsing for multiplication:
import Text.Parsec hiding(digit)
import Data.Functor
type Parser a = Parsec String () a
digit :: Parser Char
digit = oneOf ['0'..'9']
number :: Parser Integer
number = read <$> many1 digit
applyMany :: a -> [a -> a] -> a
applyMany x [] = x
applyMany x (h:t) = applyMany (h x) t
multiplication :: Parser Integer
multiplication = do
lhv <- number
spaces
char '*'
spaces
rhv <- number
return $ lhv * rhv
Switching to an unary operation, my code for factorial as follows:
fact :: Parser Integer
fact = do
spaces
char '!'
rhv <- number
spaces
return $ factorial rhv
factorial :: Parser Integer -> Parser Integer
factorial n
| n == 0 || n == 1 = 1
| otherwise = n * factorial (n-1)
And once module is getting loaded, an error message appears just like that:
Couldn't match type `Integer'
with `ParsecT String () Data.Functor.Identity.Identity Integer'
Expected type: Parser Integer
Actual type: Integer
Confusingly, it's a hard case for me to realize what's wrong with my comprehension about unary ops comparing them to binary ones. Hoping any help to fix that.
factorial doesn't define a parser; it computes a factorial. The type should just be Integer -> Integer, not Parser Integer -> Parser Integer.

Backtracking Recursive Descent Parser for the following grammar

I am trying to figure out some details involving parsing expression grammars, and am stuck on the following question:
For the given grammar:
a = b Z
b = Z Z | Z
(where lower-case letters indicate productions, and uppercase letters indicate terminals).
Is the production "a" supposed to match against the string "Z Z"?
Here is the pseudo-code that I've seen the above grammar get translated to, where each production is mapped to a function that outputs two values. The first indicates whether the parse succeeded. And the second indicates the resulting position in the stream after the parse.
defn parse-a (i:Int) -> [True|False, Int] :
val [r1, i1] = parse-b(i)
if r1 : eat("Z", i1)
else : [false, i]
defn parse-b1 (i:Int) -> [True|False, Int] :
val [r1, i1] = eat("Z", i)
if r1 : eat("Z", i1)
else : [false, i]
defn parse-b2 (i:Int) -> [True|False, Int] :
eat("Z", i)
defn parse-b (i:Int) -> [True|False, Int] :
val [r1, i1] = parse-b1(i)
if r1 : [r1, i1]
else : parse-b2(i)
The above code will fail when trying to parse the production "a" on the input "Z Z". This is because the parsing function for "b" is incorrect. It will greedily consume both Z's in the input and succeed, and then leave nothing left for a to parse. Is this what a parsing expression grammar is supposed to do? The pseudocode in Ford's thesis seems to indicate this.
Thanks very much.
-Patrick
In PEGs, disjunctions (alternatives) are indeed ordered. In Ford's thesis, the operator is written / and called "ordered choice", which distinguishes it from the | disjunction operator.
That makes PEGs fundamentally different from CFGs. In particular, given PEG rules a -> b Z and b -> Z Z / Z, a will not match Z Z.
Thanks for your reply Rici.
I re-read Ford's thesis much more closely, and it reaffirms what you said. PEGs / operator are both ordered and greedy. So the rule presented above is supposed to fail.
-Patrick

Checking that a price value in a string is in the correct format

I use n <- getLine to get from user price. How can I check is value correct ? (Price can have '.' and digits and must be greater than 0) ?
It doesn't work:
isFloat = do
n <- getLine
let val = case reads n of
((v,_):_) -> True
_ -> False
If The Input Is Always Valid Or Exceptions Are OK
If you have users entering decimal numbers in the form of "123.456" then this can simply be converted to a Float or Double using read:
n <- getLine
let val = read n
Or in one line (having imported Control.Monad):
n <- liftM read getLine
To Catch Erroneous Input
The above code fails with an exception if the users enter invalid entries. If that's a problem then use reads and listToMaybe (from Data.Maybe):
n <- liftM (fmap fst . listToMaybe . reads) getLine
If that code looks complex then don't sweat it - the below is the same operation but doing all the work with explicit case statements:
n <- getLine
let val = case reads n of
((v,_):_) -> Just v
_ -> Nothing
Notice we pattern match to get the first element of the tuple in the head of the list, The head of the list being (v,_) and the first element is v. The underscore (_) just means "ignore the value in this spot".
If Floating Point Isn't Acceptable
Floating values are well known to be approximate, and not suitable for real world financial computations (but perhaps homework, depending on your professor). In this case you'd want to read the values into a Rational (from Data.Ratio).
n <- liftM maybeRational getLine
...
where
maybeRational :: String -> Maybe Rational
maybeRational str =
let (a,b) = break (=='.') str
in liftM2 (%) (readMaybe a) (readMaybe $ drop 1 b)
readMaybe = fmap fst . listToMaybe . reads
In addition to the parsing advice provided by TomMD, consider using the appropriate monad for error reporting. It allows you to conveniently chain computations which can fail, avoiding explicit error checking on every step.
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Error
parsePrice :: MonadError String m => String -> m Double
parsePrice s = do
x <- case reads s of
[(x, "")] -> return x
_ -> throwError "Not a valid real number."
when (x <= 0) $ throwError "Price must be positive."
return x
main = do
n <- getLine
case parsePrice n of
Left err -> putStrLn err
Right x -> putStrLn $ "Price is " ++ show x

F# How to tokenise user input: separating numbers, units, words?

I am fairly new to F#, but have spent the last few weeks reading reference materials. I wish to process a user-supplied input string, identifying and separating the constituent elements. For example, for this input:
XYZ Hotel: 6 nights at 220EUR / night
plus 17.5% tax
the output should resemble something like a list of tuples:
[ ("XYZ", Word); ("Hotel:", Word);
("6", Number); ("nights", Word);
("at", Operator); ("220", Number);
("EUR", CurrencyCode); ("/",
Operator); ("night", Word);
("plus", Operator); ("17.5",
Number); ("%", PerCent); ("tax",
Word) ]
Since I'm dealing with user input, it could be anything. Thus, expecting users to comply with a grammar is out of the question. I want to identify the numbers (could be integers, floats, negative...), the units of measure (optional, but could include SI or Imperial physical units, currency codes, counts such as "night/s" in my example), mathematical operators (as math symbols or as words including "at" "per", "of", "discount", etc), and all other words.
I have the impression that I should use active pattern matching -- is that correct? -- but I'm not exactly sure how to start. Any pointers to appropriate reference material or similar examples would be great.
I put together an example using the FParsec library. The example is not robust at all but it gives a pretty good picture of how to use FParsec.
type Element =
| Word of string
| Number of string
| Operator of string
| CurrencyCode of string
| PerCent of string
let parsePerCent state =
(parse {
let! r = pstring "%"
return PerCent r
}) state
let currencyCodes = [|
pstring "EUR"
|]
let parseCurrencyCode state =
(parse {
let! r = choice currencyCodes
return CurrencyCode r
}) state
let operators = [|
pstring "at"
pstring "/"
|]
let parseOperator state =
(parse {
let! r = choice operators
return Operator r
}) state
let parseNumber state =
(parse {
let! e1 = many1Chars digit
let! r = opt (pchar '.')
let! e2 = manyChars digit
return Number (e1 + (if r.IsSome then "." else "") + e2)
}) state
let parseWord state =
(parse {
let! r = many1Chars (letter <|> pchar ':')
return Word r
}) state
let elements = [|
parseOperator
parseCurrencyCode
parseWord
parseNumber
parsePerCent
|]
let parseElement state =
(parse {
do! spaces
let! r = choice elements
do! spaces
return r
}) state
let parseElements state =
manyTill parseElement eof state
let parse (input:string) =
let result = run parseElements input
match result with
| Success (v, _, _) -> v
| Failure (m, _, _) -> failwith m
It sounds like what you really want is just a lexer. A good alternative to FSParsec would be FSLex. (Good intro tutorial, albiet somewhat dated, can be found on my old blog here.) Using FSLex you can take your input text:
XYZ Hotel: 6 nights at 220EUR / night plus 17.5% tax
And get it properly tokenized into something like:
[ Word("XYZ"); Hotel; Int(6); Word("nights"); Word("at"); Int(220); EUR; ... ]
The next step, once you have an List of tokens, is to do some form of pattern matching / analysis to extract semantic information (which I assume is what you are really after). With the normalized token stream, it should be as simple as:
let rec processTokenList tokens =
match tokens with
| Float(x) :: Keyword("EUR") :: rest -> // Dollar amount x
| Word(x) :: Keyword("Hotel") :: rest -> // Hotel x
| hd :: rest -> // Couldn't find anything interesting...
processTokenList rest
That should at least get you started. But note that as your input gets more 'formal', so will the usefulness of your lexing. (And if you only accept a very specific input, then you can use a proper parser and be done with it!)

Resources