[Haskell-cafe] Mutable arrays
Jeff φ
jeff1.61803 at gmail.com
Sat Feb 2 05:32:44 EST 2008
Hello,
I'm trying to write code that will take a mutable 2D array and normalize it
by dividing all elements by the largest element.
I managed to write code to do this, but it seems overly complex. I could
write something much simpler in Clean or C++. Most likely, my code is
complex because I don't have any experience with mutable arrays in Haskell.
I couldn't find any tutorials on the Internet. I'd be grateful for
suggestions on simplifying the following code. Thanks.
{-# OPTIONS_GHC -fglasgow-exts -fbreak-on-exception #-}
-- normalize_ary This takes a mutable array. Determines the largest
-- element in the array (max_elem) and then divides every element by
-- max_elem.
normalize_ary :: (Num t1,
Num t,
Ix t,
Ix t1,
MArray a e t2,
Ord e,
Fractional e,
Enum t,
Enum t1) =>
a (t, t1) e -> t2 ()
normalize_ary ary =
do
-- The following two commented out lines of code show my first
-- attempt at determining a value for max_elem. However, this
-- produces a stack overflow.
-- elem_ary <- getElems ary
-- let max_elem = foldl1 max elem_ary
max_elem <- calc_max_2d_elem ary
max_elem `seq` map_in_place_2d_arr (\x -> x / max_elem) ary
map_in_place_2d_arr :: (MArray a e t, Enum t2, Enum t1, Ix t1, Ix t2) =>
(e -> e) -> a (t1, t2) e -> t ()
map_in_place_2d_arr fn arr = ret
where
ret = do ((i1,j1),(i2,j2)) <- getBounds arr
( mapM_ (\i -> do v <- readArray arr i
writeArray arr i (fn v) )
[(i,j) | i <- [i1..i2], j <- [j1..j2]])
calc_max_2d_elem :: (Ord t, MArray a t t1, Ix t2, Ix t3, Num t3, Num t2) =>
a (t3, t2) t -> t1 t
calc_max_2d_elem arr =
do m <- readArray arr (0,0)
(_,(i_max, j_max)) <- getBounds arr
let calc_max_loop arr m (i,j)
| j == j_max = return m
| otherwise = do e <- readArray arr (i,j)
let m2 = max e m
m2 `seq` calc_max_loop arr m2 nxt_idx
where nxt_idx | i == i_max - 1 = (0,j+1)
| otherwise = (i+1,j)
calc_max_loop arr m (0,0)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20080202/15382352/attachment.htm
More information about the Haskell-Cafe
mailing list