[Haskell-beginners] Howto reverse a Data.Array

Timothy Washington twashing at gmail.com
Sun Jul 3 18:27:31 UTC 2016


Hmm, this is very helpful - didn't know it existed. Thanks very much, I'll
check it out!

Tim


On Thu, Jun 23, 2016 at 7:41 AM, David McBride <toad3k at gmail.com> wrote:

> The problem isn't with array, but rather your index.  Ix instances are
> always sorted in ascending order, as you might imagine.  You can however,
> use your own index in arrays and they can be indexed in whatever order you
> like.
>
>
> {-# LANGUAGE GeneralizedNewtypeDeriving #-}
>
> import Data.Array
> import Data.Ix
>
> newtype MyIx = MyIx Int deriving (Eq, Num, Show)
>
> instance Ord MyIx where
>   compare (MyIx a) (MyIx b) =
>     case compare a b of
>       LT -> GT
>       GT -> LT
>       EQ -> EQ
>
> instance Ix MyIx where
>   range (MyIx a, MyIx b) = map MyIx $ reverse [b..a]
>   index (MyIx a, MyIx b) (MyIx c) = a - c
>   inRange (MyIx a, MyIx b) (MyIx c) = c <= a && c >= b
>
> blah :: Array MyIx Char
> blah = array (3,0) [(0,'a'),(1,'b'),(2,'c'),(3,'d')]
>
> Warning:  I only very lightly tested the above code.
>
> You can mix your index and normal indexes to get the row / col ordering
> you are hoping for.
>
> blah2 :: [((MyIx, Int), Char)] -> Array (MyIx, Int) Char
> blah2 = array ((3,0),(0,3))
>
> Finally, if you are really looking for something that is designed to be a
> matrix, you might try one of several libraries that are out there, like
> hmatrix.
>
> Hopefully this helps.
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/beginners/attachments/20160703/de2cfd5d/attachment.html>


More information about the Beginners mailing list