[Haskell-beginners] Re: permuting a list
Daniel Fischer
daniel.is.fischer at web.de
Fri Feb 13 04:56:16 EST 2009
Am Freitag, 13. Februar 2009 10:23 schrieb Jan Snajder:
> Brent Yorgey wrote:
> > 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>
>
> Thanks Brant, I forgot to mention explicitly that I need a random
> permutation.
>
> > 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 #-}
>
> I guess by 'sneaky' you mean this solution is GHC-specific?
>
> > > 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
>
> Ok, this seems to work! (after replacing '[n..1]' with [n,n-1,..1] as
> Daniel noted). Great!
>
> Why do I need 'forall a' ? Aren't type variables implicitly universaly
> quantified?
You need the forall a to bring the type variable a into scope. Without it, the
a in
arr0 <- (newListArray (0, n) xs :: IO (IOArray Int a))
would be implicitly universally quantified, too, and you would say that all
elements of xs had type (forall b. b), which means all are _|_.
Having brought the a from permute's type signature into scope, the a in the
above line is the *same* a as the one in permute's type signature.
>
> j.
Cheers,
Daniel
More information about the Beginners
mailing list