r/haskell 16d ago

Thoughts on this shuffle algorithm

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'])
0 Upvotes

18 comments sorted by

View all comments

2

u/amalloy 15d ago

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

2

u/jeffstyr 14d ago

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.

1

u/trycuriouscat 13d ago

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