lib for the image processing stuff

This is the library file for that image processing project.

-- PPMlib.hs
-- Library for 433-152 Project 2007
-- Bernard Pope

module PPMlib where

import Text.ParserCombinators.Parsec

type Pixel = (Int, Int, Int)

data PPM
= PPM Int Int Int [Pixel]
deriving Show

getPixels :: PPM -> [Pixel]
getPixels (PPM _ _ _ ps) = ps

getWidth :: PPM -> Int
getWidth (PPM w _ _ _) = w

getHeight :: PPM -> Int
getHeight (PPM _ h _ _) = h

getMaxVal :: PPM -> Int
getMaxVal (PPM _ _ m _) = m

{- transform interface
example: transform verify greyScale "in.ppm" "out.ppm"
-}

transform :: (PPM -> Maybe String) -> (PPM -> PPM) -> String -> String -> IO ()
transform verify trans inFile outFile = do
result <- parser inFile
case result of
Left e -> print e
Right ppm -> do
case verify ppm of
Nothing -> do
let newPPM = trans ppm
case verify newPPM of
Nothing -> writeFile outFile $ pretty newPPM
Just err -> do
putStrLn "Error in transformed image"
putStrLn err
Just err -> do
putStrLn "Error in input image"
putStrLn err

{- pretty printing PPM files -}

pretty :: PPM -> String
pretty (PPM width height maxVal pixels)
= "P3 " ++ unwords [show width, show height] ++ "\n" ++
unlines (show maxVal : prettyPixels pixels)
where
prettyPixels :: [Pixel] -> [String]
prettyPixels = map prettyPixel
prettyPixel :: Pixel -> String
prettyPixel (r,g,b) = unwords $ map show [r,g,b]

{- parsing PPM files -}

parser :: String -> IO (Either ParseError PPM)
parser = parseFromFile parsePPM

parsePPM :: Parser PPM
parsePPM = do
string "P3"
junk
width <- parseInt
junk
height <- parseInt
junk
maxVal <- parseInt
junk
pixels <- many parseTriplet
return $ PPM width height maxVal pixels

comment :: Parser ()
comment = do
char '#'
manyTill anyChar newline
spaces

junk :: Parser ()
junk = do
spaces
optional comment

parseTriplet :: Parser (Int, Int, Int)
parseTriplet = do
red <- parseInt
spaces
green <- parseInt
spaces
blue <- parseInt
spaces
return (red, green, blue)

parseInt :: Parser Int
parseInt = do
ds <- many1 digit
return $ read ds

my Proj.hs

This is our project for 433-152: Algorithmic Problem Solving. Had finished the 8 functions a few days before, but found that the pictures my program generated were different from the example files provided using the Unix tool 'diff'. Then I spent about 8 hours fixing and debugging. This was really painful! I struggled for two hours just with the order of base case for 'enlarge'! I should have put it before the main body of the function but didn't realize that! WTF!! Okay, I'll cut my crap, it's the project main file Proj.hs. I'll put the library file on here using another blog entry. Take a look at it if you're interested in Haskell or image processing!


-- Proj.hs
-- Your file for 433-152 Project 2007
-- Stub code by Bernard Pope and Anthony Wirth

module Proj where

import PPMlib
import Data.Map hiding (map)

type Coord = (Int, Int)

noVerify :: PPM -> Maybe String
noVerify _ = Nothing

verify :: PPM -> Maybe String
verify (PPM w h m pixel) =
-- if there's at least one wrong pixel, return error msg otherwise return Nothing
if (and (map (verify' w h m) pixel) == False) then Just "Invalid PPM file" else Nothing
-- see whether the attributes of the picture are valid
where
verify' w h m (r, g, b)
| g > m || r > m || b > m = False
| g < 0 || r < 0 || b < 0 = False
| w < 0 || h < 0 || m < 0 = False
| otherwise = True


-- simple one!
greyScale :: PPM -> PPM
greyScale (PPM w h m pixel) =
PPM w h m (map change pixel)
where
change :: (Int, Int, Int) -> (Int, Int, Int)
change (r, g, b) = (grey, grey, grey)
where
-- grey = floor (0.3 * (fromIntegral (r::Int)) + 0.59 * (fromIntegral (g::Int)) + 0.11 * (fromIntegral (b::Int)))
grey = div (r + b + g) 3


-- mothod is like the one above.
negative :: PPM -> PPM
negative (PPM w h m pixel) =
PPM w h m (map (invert m) pixel)
where
invert :: Int -> (Int, Int, Int) -> (Int, Int, Int)
invert m (a, b, c) = (m - a, m - b, m - c)

-- Stupid way which I used at first!
-- inverter m ([]) = []
-- inverter m ((a, b, c) : rest) = (m - a, m - b, m - c) : (inverter m rest)


-- This seems perfectly right, but it never stops when run.
-- replicate and concat
-- replicate n : get a list of n duplicated items
-- concat : convert a list of tuples into a list with all the original iterms
-- (left, right) = splitAt halfway pixel. this is a really useful way, learnt from the lecture. A good way to split things up.
enlarge :: Int -> PPM -> PPM
enlarge n (PPM w h m pixel) =
PPM (w * n) (h * n) m (vertical w n (horizontal n pixel))
-- horizontally stretching
horizontal :: Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
horizontal n pixel = concat $ map (replicate n) pixel
-- vertically stretching
-- duplicate each row and append the handled rest to it
vertical :: Int -> Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
vertical w n [] = []
vertical w n pix = (concat $ replicate n row) ++ (vertical w n rest)
where
(row, rest) = splitAt (n * w) pix

--crap this is what I did at first, obviously it's wrong
--concat $ map (replicate n) pixel
--concat (map (replicate n) pixel)


-- I have an idea, but don't know how to write code for it.
-- I take the average value of the corresponding pixels and let it be the new pixel.
-- What I'm not sure is, what if w or h is not divisible by n? How to handle the remainder?
reduce :: Int -> PPM -> PPM
reduce _ _ = undefined


-- reconstruct rows in the reverse order, pretty simple.
reflectRow :: PPM -> PPM
reflectRow (PPM w h m pixel) =
PPM w h m (reflect w pixel)
reflect :: Int -> [a] -> [a]
-- base case
reflect w [] = []
-- append rows from the bottom to the top
reflect w pixel = (reflect w right) ++ left
where
(left, right) = splitAt w pixel


-- reverse all the pixels in each row and then append all the rows together!
reflectCol :: PPM -> PPM
reflectCol (PPM w h m pixel) =
PPM w h m (revcol w pixel)
revcol :: Int -> [a] -> [a]
revcol w [] = []
-- reverse and append
revcol w pixel = (reverse left) ++ (revcol w right)
where
(left, right) = splitAt w pixel

-- Really don't know how to do it
rotate :: Float -> Coord -> PPM -> PPM
rotate _ _ _ = undefined


-- a pretty easy one, used the function min
threshold :: Int -> PPM -> PPM
threshold t (PPM w h m pixel) =
PPM w h m (map change pixel)
where
change :: (Int, Int, Int) -> (Int, Int, Int)
change (a, b, c) = ((min t a), (min t b), (min t c))


-- First take out extra columns and then rows
crop :: Coord -> Coord -> PPM -> PPM
crop (a, b) (c, d) (PPM w h m pixel) =
PPM (d - b + 1) (c - a + 1) m (croprow h a c (d - b + 1) (cropcol w b d pixel))
-- eliminate columns that we don't need
cropcol w b d [] = []
cropcol w b d pix = image ++ (cropcol w b d rest)
where
-- get each row
(row, rest) = splitAt w pix
-- for each row, take out unwanted part to the left of the selected area
(junk1, rowrest) = splitAt b pix
-- for each row, take out the part to the right of the wanted image part
(image, junk2) = splitAt (d - b + 1) rowrest
--take out extra rows
croprow h a c w' [] = []
croprow h a c w' pix = image
where
-- extra rows above the selected image
(upperjunk, rest) = splitAt (a * w') pix
-- rows delow the wanted part of image
(image, lowerjunk) = splitAt (w' * (c - a + 1)) rest


translate :: Coord -> PPM -> PPM
translate (a, b) (PPM w h m pixel) =
PPM w h m (transrow w h a (transcol w b pixel))
-- move the left edge of the picture to the correct column.
transcol :: Int -> Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
transcol w b [] = []
transcol w b pix = case b >= 0 of
True -> black b ++ left ++ transcol w b rest
False -> rightn ++ black (-b) ++ transcol w b rest
where
(row, rest) = splitAt w pix
(left, right) = splitAt (w - b) row
(leftn, rightn) = splitAt (-b) row
-- move the top edge to the correct row.
transrow :: Int -> Int -> Int -> [(Int, Int, Int)] -> [(Int, Int, Int)]
transrow w h a [] = []
transrow w h a pix = case a >= 0 of
True -> black (a * w) ++ image
False -> uimage ++ black ((-a) * w)
where
(image, rest) = splitAt ((h - a) * w) pix
(urest, uimage) = splitAt ((-a) * w) pix
-- make black pixels
black :: Int -> [(Int, Int, Int)]
black 0 = []
black n = (0, 0, 0) : black (n - 1)


-- don't have enough time to do it.
normalize :: PPM -> PPM
normalize _ = undefined