[Haskell-beginners] permuting a list
Daniel Fischer
daniel.is.fischer at web.de
Thu Feb 12 13:20:27 EST 2009
Am Donnerstag, 12. Februar 2009 17:53 schrieb Brent Yorgey:
> On Thu, Feb 12, 2009 at 10:20:32AM +0100, Jan Snajder wrote:
> > this is what I get:
> >
> > <interactive>:1:0:
> > No instance for (MArray a1 t IO)
> > arising from a use of `permute' at <interactive>:1:0-14
> > Possible fix: add an instance declaration for (MArray a1 t IO)
> > In the expression: permute [1, 2, 3]
> > In the definition of `it': it = permute [1, 2, 3]
> >
> > How can I fix this?
>
> <rant>
> It seems everyone has just been reading the first few words of Jan's
> email and not the actual content. Jan is clearly trying to write a
> *random list shuffling* function, not a function to generate
> permutations. Let's try to be helpful, people...
> </rant>
>
> Jan, this is tricky. The type of permute is indeed (MArray a1 a IO)
> => [a] -> IO [a], but this is fine, it just means that there has to be
> some sort of mutable array which can store the things you are trying
> to shuffle. This is not the problem. The problem seems to be that
> Haskell has no way to know what sort of array you want to use. I was
>
> able to get the code to work, but it's sort of sneaky:
> > {-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
> >
> > import Data.Array.MArray
> > import Data.Array.IO
> > import Control.Monad
> > import System.Random
> >
> > permute :: forall a. (MArray IOArray a IO) => [a] -> IO [a]
> > permute xs = do
> > let n = length xs - 1
> > arr0 <- (newListArray (0, n) xs :: IO (IOArray Int a))
> > arr <- foldM swap arr0 [n..1]
> > getElems arr
> > where swap arr n = do
> > x <- readArray arr n
> > r <- randomRIO (0, n)
> > y <- readArray arr r
> > writeArray arr n y
> > writeArray arr r x
> > return arr
>
> We have to give an explicit type annotation on the newListArray, to
> tell Haskell what kind of array we want to use. But then we also need
> to use the ScopedTypeVariables extension, so that the 'a' in the type
> signature for permute scopes over the definition, so that Haskell
> knows we want the 'a' in the IOArray Int a to be the same type as the
> 'a' in the type signature. Otherwise it doesn't know they are the
> same and complains.
>
> Also, when I try running permute, it seems to be the identity
> function, but I guess that's a separate issue!
>
That's because [n .. 1] is almost always an empty list. That code changes only
lists of length 2. Make it foldM swap arr0 [n, n-1 .. 1] and it works.
*Main> permute [1 .. 5]
[3,2,1,5,4]
> -Brent
More information about the Beginners
mailing list