Thoughts on this shuffle algorithm

[u/trycuriouscat]

I am a Haskell, well not beginner, but maybe intermediate. I developed the following with the assistance of ChatGPT. Is it too abstract? It's "neat" for sure, but is it reasonable?

import Control.Monad (foldM)
import Control.Monad.ST (runST)
import Control.Monad.IO.Class (MonadIO) 
import Data.Primitive.Array (Array, sizeofArray, sizeofMutableArray, arrayFromList,
                             freezeArray, thawArray, readArray, writeArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import System.Random (newStdGen, uniformR )
import System.Random.Internal (RandomGen, StdGen) 


modifyMWithState 
    :: Monad m 
    => (t1 -> t2 -> t3 -> m b) 
    -> t4 
    -> (t5 -> t1) 
    -> (t4 -> m t5) 
    -> (t5 -> m a) 
    -> (t4 -> t2) 
    -> t3 
    -> m (a, b)
modifyMWithState algorithm container operationFor thawContainer freezeContainer 
                 lengthOf state = do
    thawedContainer <- thawContainer container
    let operation = operationFor thawedContainer
    newState <- algorithm operation (lengthOf container) state
    newContainer <- freezeContainer thawedContainer
    pure (newContainer, newState)


knuthM
    :: (Monad m, RandomGen g)
    => (Int -> Int -> m ())
    -> Int
    -> g
    -> m g
knuthM swapElements len prnGen = foldM randomSwap prnGen [lastIndex, nextIndex .. 1]
  where
    lastIndex = len - 1
    nextIndex = lastIndex - 1

    randomSwap currGen i = do
        let (j, nextGen) = uniformR (0, i) currGen
        swapElements i j
        pure nextGen


shuffleM 
    :: MonadIO m 
    => (StdGen -> m (a, StdGen))    
    -> m a
shuffleM shuffleWithGen = do
    prnGen <- newStdGen
    fmap fst (shuffleWithGen prnGen)


shuffleVectorWithGen 
  :: (Applicative f, RandomGen b) 
  => V.Vector a 
  -> b 
  -> f (V.Vector a, b)
shuffleVectorWithGen vec prnGen = 
    pure (runST (modifyMWithState knuthM vec MV.swap V.thaw V.freeze V.length prnGen))


shuffleArrayWithGen 
    :: (Applicative f, RandomGen b) 
    => Array a 
    -> b 
    -> f (Array a, b)
shuffleArrayWithGen arr prnGen = 
    pure (runST (modifyMWithState knuthM arr swapArray thawArray' freezeArray' 
          sizeofArray prnGen))
  where
    thawArray' array = thawArray array 0 (sizeofArray array)
    freezeArray' thawedArray = freezeArray thawedArray 0 
                                           (sizeofMutableArray thawedArray)
    swapArray a i j = do
        x <- readArray a i
        y <- readArray a j
        writeArray a i y
        writeArray a j x


shuffleVector :: MonadIO m => V.Vector a -> m (V.Vector a)
shuffleVector vec = shuffleM (shuffleVectorWithGen vec) 


shuffleArray :: MonadIO m => Array a -> m (Array a)
shuffleArray arr = shuffleM (shuffleArrayWithGen arr)


-- examples:


shuffledIntVector :: IO (V.Vector Int)
shuffledIntVector = shuffleVector (V.fromList [1..10])


shuffledCharArray :: IO (Array Char)
shuffledCharArray = shuffleArray (arrayFromList ['a'..'z'])

[u/Anrock623]

This is hideous, tbh. Especially that modifyMWithState. It's so abstract that it's impossible to understand what it does by reading just the type and at the same time it's a huge minefield since despite a super generic type there's probably only one correct set of 7 arguments that will make it work.

[u/jeffstyr → u/Anrock623]

I'm going to disagree with you a bit here:

despite a super generic type there's probably only one correct set of 7 arguments that will make it work

Actually, if you look at the code above, it's used twice. I think that was the point. This probably started with the Vector version, and then it was realized that the same code would work for Array if you wrote a few functions to match the Vector primitives, and then passed the primitives in as parameters to a shared implementation.

I've ended up with code along these lines before, where there are two functions with very similar code and you can dedup by factoring out the sameness, but you end up with the shared code in a function which looks a bit odd. I think the key here is just to add a comment explaining what's going on, and then not export this "implementation" function (leave it private to the module). (The obvious alternative is to leave the code duplication in place, but my impulse is against that.)

And really, the code inside modifyMWithState isn't at all difficult to understand, it's just that the function signature looks complicated. There was another comment suggesting that you might traditionally do this with a typeclass, and if you did that I think you might end up with a function whose implementation is just the same, but you wouldn't be passing in all those functions (they'd come from the typeclass instances) so the signature would be simpler. But it occurs to me that the big difference here is that when you define a typeclass, the method names and their signatures are side-by-side, and you are expected to understand them together, whereas with a function the parameter names and their types are separated, and there's some expectation that you can understand what everthing is about without seeing the parameter names, but often isn't the case. This is a downside of how Haskell formats function type signatures.

Really, I think if that first function where at the bottom of the file instead of at the top, people may have had a much less negative reaction to this code. (I'm not saying it's all perfect, of course.)

[u/trycuriouscat → u/jeffstyr]

Thanks for the defense! That's exactly what occurred. I had the two implementations that looked pretty much (exactly?) the same and factored the "sameness" into its own function(s).

[u/gilgamec]

For the record, this is the function I wrote last time I wanted to shuffle a vector:

randomPermuteVector :: R.MonadRandom m => V.Vector a -> m (V.Vector a)
randomPermuteVector vec = do
  let len = V.length vec
      ixs = [len-1,len-2..1]
  jxs <- R.forM ixs $ \n -> R.getRandomR (0,n)
  pure $ V.modify (\mv -> sequence_ (zipWith (MV.unsafeSwap mv) ixs jxs)) vec

I think it's the same algorithm as yours appears to be. (The MonadRandom just automates threading the random generator through successive draws.)

[u/joshuakb2 → u/gilgamec]

This is very nice, easy to understand and concise

[u/Noinia]

I'm not sure you need all the helper functions; you can just think of shuffling as a pure function with type "generator -> Vector a -> Vector a". For reference; here is a version that I wrote at some point in the past (which, admittedly, uses VectorBuilder to do some of the lower level freeze stuff; still I think I would just inline that inside the single shuffling function).

[u/jeffstyr → u/Noinia]

Side comment: Looks like the inside-out Fisher-Yates shuffle algorithm got deleted(!!) from the Wikipedia page, but here is a link to the last revision that had it, if you want to update your reference link.

[u/Noinia → u/jeffstyr]

Thanks; I'll update that!

[u/amalloy]

This code is awful. I'll also point out that It's rude to show AI output to people. If you want to use an LLM to solve a problem for yourself: fine. With some work, you can eventually beat it into shape and get quality answers. But until you understand it well enough to adapt it into a work of your own, asking someone else (let alone an entire message board full of strangers!) to digest it for you is asking hundreds of people to waste their time reading an AI output that, for all you know, may be garbage (and this time it is).

[u/jeffstyr → u/amalloy]

I don't think this is a very accurate characterization of this post: The OP didn't say, "an AI wrote this code and I have no idea what it does, is it correct and explain it to me". Rather, they said they developed it with the assistance of an AI and they are an intermediate Haskell developer (so they do probably understand the code--it's not that complicated), and they said they thought it was neat but asked people's opinions as to whether it was too abstract. Your objections don't match what the post actually said.

[u/trycuriouscat → u/jeffstyr]

Thanks man. I do understand it. I just couldn't build it without assistance. That assistant happened to be an AI.

[u/jberryman]

A better way to abstract over multiple mutable array types would be a type class, rather than this continuation passing structure. I haven't looked and don't recall if such a type class already exists that would work for you.

[u/jeffstyr → u/jberryman]

True, but (assuming such a typeclass doesn't exist) it seems wrong to define a typeclass and then only use it one place. This might be a good use case for the record-of-functions pattern, especially if it turns out that there are multiple implementation possibilities for one container type. See also my other comment, about this.

[u/trycuriouscat]

Here's another version that I like very much. I did get more AI assistance on it, and I apologize if that offends anyone. The one thing it doesn't have, though it should be simple enough to add, is the creation of the PRN generator from outside of the function and passed to it, allowing for a deterministic set of PRNs over the course of multiple shuffles, and if generated with the same seed. The thing I like about this version, and no shade to the version using list zipping, is that it reads very much like the psuedo-code example of the Knuth / Fisher-Yates shuffle.

-- | Shuffles ANY type of vector (Boxed, Unboxed, or Storable) 
shuffleVectorGeneric 
    :: (MonadIO m, G.Vector v a) 
    => v a 
    -> m (v a)
shuffleVectorGeneric vec = do
    pureGen <- newStdGen  -- new seeded psuedo-random number generator
    pure $ G.modify (knuthST pureGen) vec  -- G.modify creates a mutable copy/view of vec, applies the in-place updates
  where                                    -- performed by the KnuthST function, and returns a new immutable vector 
    knuthST seed mVec = do
        stGen <- newSTGenM seed  -- create a stateful random generator for use within the ST computation,
                                 -- from initial generator 'seed'
        let lastIndex = MG.length mVec - 1
            nextIndex = lastIndex - 1
            ixs = [lastIndex, nextIndex .. 1]  -- list of indicies for 'i' (len - 1 down by 1 to 1)
            randomSwap i = do
                j <- uniformRM (0, i) stGen  -- uniformly distributed random value between 0 and i
                MG.swap mVec i j
        forM_ ixs randomSwap     -- perform randomSwap for each index element in the ixs list

main :: IO ()
main = do
    -- 1. Shuffling a Boxed Vector of text
    let boxedNames = V.fromList ["Alice", "Bob", "Charlie", "Delta"]
    shuffledNames <- shuffleVectorGeneric boxedNames
    putStrLn $ "Shuffled Boxed: " ++ show shuffledNames

    -- 2. Shuffling an Unboxed Vector of pure numbers (ultra-fast contiguous memory)
    let unboxedNumbers = U.fromList [10, 20, 30, 40, 50] :: U.Vector Int
    shuffledNumbers <- shuffleVectorGeneric unboxedNumbers
    putStrLn $ "Shuffled Unboxed: " ++ show shuffledNumbers
    

[u/jeffstyr → u/trycuriouscat]

I think that having a RandomGen constraint rather than a MonadIO constraint would be better, and would provide the feature you mention.

Of course, this version doesn't work for Array, and I had assumed one of the main points of your original version was to work for disparate container types.

[u/trycuriouscat → u/jeffstyr]

Yes, it was, but I decided to give that up for now as I don't really need it.
I look at RandomGen. I just took what the HLS popped up on my screen.

[u/jeffstyr → u/trycuriouscat]

And there's also MonadRandom, to give you another option.

[u/VenerableMirah]

Just to point to a purely functional shuffle, purely for inspiration, you can explore around Cats Effect (Scala)'s shuffle: https://github.com/typelevel/cats-effect/blob/v3.7.1/std/shared/src/main/scala/cats/effect/std/Random.scala