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
Subscribe to:
Post Comments (Atom)
No comments:
Post a Comment