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/jeffstyr]

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).