How does one delare a 2D STUArray in Haskell?

How does one delare a 2D STUArray in Haskell? I see the following from a diffusion program segment: module Diffusion where import Data.Array import Data.List (sortBy) type VFieldElem = Float type VField = Array (Int,Int) VFieldElem <snip> zeros = listArray ((1,1),(imax,jmax)) (repeat 0) From Real World Haskell to declare a 1D array (I changed some of the value names) there is the following: import Data.Array.ST (STUArray) import Data.Array.Unboxed (UArray) import Data.Word (Word32) data PlayingField1D a = PF1D { pf1DState :: (a -> [Word32]) , pf1DArray :: UArray Word32 Bool } data MutPlayingField1D s a = MPF1D { mpf1DState :: (a -> [Word32]) , mutpf1DArray :: STUArray s Word32 Bool } But I cannot see how to declare a 2D array. Although, it is not "strictly" necessary, pun intended, since one can reframe the 1D array as 2D array by using row/column mapping functions. -- Regards, Casey

2009/9/25 Casey Hawthorne
How does one delare a 2D STUArray in Haskell?
Hi, STUArray, like other arrays is parametrized by the type of the index, the "i" in "STUArray s i e" [1]. That "i" is should be an instance of Ix which is a class of the types that can be used as indices. If you want to use 2D indices, that's fine as pairs (of types that are themselves in Ix) are instances of Ix. In your code, (Int,Int) (2d) and Word32 (1d) are the indice types. So STUArray s (Word32,Word32) Bool would be the 2d version of an array indiced by Word32 (that is, an array indiced by pairs of Word32). Cheers, Thu [1] http://hackage.haskell.org/packages/archive/array/0.2.0.0/doc/html/Data-Arra...

Well that makes sense, but for a learner, how is he/she supposed to know that 'i' could be '(i,i)' or for that matter a tuple of n of those i's? "STUArray s i e" Could you also have a tuple of states? Obviosly, 'e' could be a tuple, for instance (Int,Char) -- Regards, Casey

2009/9/25 Casey Hawthorne
Well that makes sense, but for a learner, how is he/she supposed to know that 'i' could be '(i,i)' or for that matter a tuple of n of those i's?
"STUArray s i e"
Could you also have a tuple of states?
Obviosly, 'e' could be a tuple, for instance (Int,Char)
Well, 'i' is just a type variable, just like 'a' and 'b' are type variables in the function type map :: (a -> b) -> [a] -> [b] I guess you know that you can "map" a suitable function on a list of pairs, right ? Type variable mean you can use whatever type you want, including pairs, lists, or whatever. So you can have list of whaterver you want, and use whatever you want as indices in arrays.... BUT! But the whatever you want can be constrained a bit: here, the constraint is that the type of the indices must be in Ix, this is what the "Ix i =>" means. For instance, we said we can put whatever you want in a list. But ask GHCi what is the type of inc = map (+1) : Prelude> :t map (+1) map (+1) :: (Num a) => [a] -> [a] You see that you can use "inc" on list of whatever you want (the "a") *provided* the "a" is in Num, the "Num a =>" part of the type signature. Now, you have to look if the type you want to use for your indices is in Ix. Look at [1] and you see that (Ix a, Ix b) => Ix ((,) a b) is an Instance of Ix. (The right part can be read as (a,b) instead of (,) a b). So a pair is in Ix provided its elements are in Ix too. [1] http://hackage.haskell.org/packages/archive/base/4.0.0.0/doc/html/GHC-Arr.ht...

2009/9/25 minh thu
2009/9/25 Casey Hawthorne
: Well that makes sense, but for a learner, how is he/she supposed to know that 'i' could be '(i,i)' or for that matter a tuple of n of those i's?
"STUArray s i e"
Could you also have a tuple of states?
Obviosly, 'e' could be a tuple, for instance (Int,Char)
Well, 'i' is just a type variable, just like 'a' and 'b' are type variables in the function type
map :: (a -> b) -> [a] -> [b]
I guess you know that you can "map" a suitable function on a list of pairs, right ?
Type variable mean you can use whatever type you want, including pairs, lists, or whatever.
So you can have list of whaterver you want, and use whatever you want as indices in arrays.... BUT!
But the whatever you want can be constrained a bit: here, the constraint is that the type of the indices must be in Ix, this is what the "Ix i =>" means.
For instance, we said we can put whatever you want in a list. But ask GHCi what is the type of
inc = map (+1) :
Prelude> :t map (+1) map (+1) :: (Num a) => [a] -> [a]
You see that you can use "inc" on list of whatever you want (the "a") *provided* the "a" is in Num, the "Num a =>" part of the type signature.
Now, you have to look if the type you want to use for your indices is in Ix. Look at [1] and you see that
(Ix a, Ix b) => Ix ((,) a b)
is an Instance of Ix.
(The right part can be read as (a,b) instead of (,) a b).
So a pair is in Ix provided its elements are in Ix too.
[1] http://hackage.haskell.org/packages/archive/base/4.0.0.0/doc/html/GHC-Arr.ht...
Forget to say this: You don't have a pair of indices or a pair of states: you have an index which is a pair, and you can have a state which is a pair. Cheers, Thu

Am Freitag 25 September 2009 09:22:25 schrieb Casey Hawthorne:
Well that makes sense, but for a learner, how is he/she supposed to know that 'i' could be '(i,i)' or for that matter a tuple of n of those i's?
minh thu already explained this very well.
"STUArray s i e"
Could you also have a tuple of states?
You can't choose the state 's', the documentation says "The strict state-transformer monad. A computation of type ST s a transforms an internal state indexed by s, and returns a value of type a. The s parameter is either * an uninstantiated type variable (inside invocations of runST), or * RealWorld (inside invocations of Control.Monad.ST.stToIO). " Without evil hackery (or stToIO), you can only use ST actions/ST(U)Arrays via runST :: (forall s. ST s a) -> a or runST(U)Array :: Ix i => (forall s. ST s (ST(U)Array s i e)) -> (U)Array i e which have rank 2 types (universally qualified type as type of argument [result]), the 'forall s' within the parentheses says it has to work whatever type the rts chooses (actually none), so if you write myFancyArray :: forall s1, s2. ST (s1,s2) (STUArray (s1,s2) Int Int) you can't use it.
Obviosly, 'e' could be a tuple, for instance (Int,Char)
Not for STUArrays, but for STArrays, there's no problem.
-- Regards, Casey

Hello Casey, Friday, September 25, 2009, 11:22:25 AM, you wrote:
Well that makes sense, but for a learner, how is he/she supposed to know that 'i' could be '(i,i)' or for that matter a tuple of n of those i's?
look at Ix class instances: http://www.haskell.org/ghc/docs/latest/html/libraries/base/GHC-Arr.html#v%3A... -- Best regards, Bulat mailto:Bulat.Ziganshin@gmail.com
participants (4)
-
Bulat Ziganshin
-
Casey Hawthorne
-
Daniel Fischer
-
minh thu