[Haskell-cafe] Mutable arrays

Rodrigo Queiro overdrigzed at gmail.com
Sat Feb 2 07:57:47 EST 2008


This is my attempt at some nicer code:

maximum' (x:xs) = foldl' max x xs
maximum' _ = undefined

modifyArray :: (MArray a e m, Ix i) => (e -> e) -> a i e -> m ()
modifyArray fn arr = do
    bounds <- getBounds arr
    forM_ (range bounds) (modifyElement fn arr)

modifyElement :: (MArray a e m, Ix i) => (e -> e) -> a i e -> i -> m ()
modifyElement fn arr i = do
    x <- readArray arr i
    writeArray arr i (fn x)

normalizeArray :: (MArray a e m, Ix i, Fractional e, Ord e) => a i e -> m ()
normalizeArray arr = do
    arr_elems <- getElems arr
    let max_elem = maximum' arr_elems
    modifyArray (/max_elem) arr

On 02/02/2008, Jeff φ <jeff1.61803 at gmail.com> wrote:
> 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)
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20080202/0575fc32/attachment.htm


More information about the Haskell-Cafe mailing list