Implemented Queue Data Structure

DIRECTORY.md

@@ -19,6 +19,9 @@
     * [Binarytree](https://github.com/TheAlgorithms/Haskell/blob/master/src/BinaryTree/BinaryTree.hs)
   * Datastructures
     * [Maxheap](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/MaxHeap.hs)
+    * [Disjointsets](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/DisjointSets.hs)
+    * [Stack](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/Stack.hs)
+    * [Queue](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/Queue.hs)
   * Graph
     * [Dfs](https://github.com/TheAlgorithms/Haskell/blob/master/src/Graph/Dfs.hs)
     * [Directedgraph](https://github.com/TheAlgorithms/Haskell/blob/master/src/Graph/DirectedGraph.hs)

src/DataStructures/DisjointSets.hs

@@ -0,0 +1,64 @@
+import Data.Array.ST
+import Control.Monad.ST
+import Data.STRef
+
+-- Disjoint Set Node represented as an index in an array
+type Node = Int
+
+-- Union-Find structure
+type DisjointSet s = (STArray s Node Node, STArray s Node Int)
+
+-- Initialize the disjoint set with each node being its own parent and rank zero
+makeSet :: Int -> ST s (DisjointSet s)
+makeSet n = do
+    parentArray <- newListArray (0, n-1) [0..n-1]
+    rankArray <- newListArray (0, n-1) (replicate n 0)
+    return (parentArray, rankArray)
+
+-- Find with path compression
+findSet :: DisjointSet s -> Node -> ST s Node
+findSet (parentArray, rankArray) x = do
+    parent <- readArray parentArray x
+    if parent == x
+        then return x
+        else do
+            root <- findSet (parentArray, rankArray) parent
+            writeArray parentArray x root
+            return root
+
+-- Union by rank
+unionSet :: DisjointSet s -> Node -> Node -> ST s ()
+unionSet (parentArray, rankArray) x y = do
+    rootX <- findSet (parentArray, rankArray) x
+    rootY <- findSet (parentArray, rankArray) y
+    if rootX /= rootY
+        then do
+            rankX <- readArray rankArray rootX
+            rankY <- readArray rankArray rootY
+            if rankX > rankY
+                then writeArray parentArray rootY rootX
+                else if rankX < rankY
+                    then writeArray parentArray rootX rootY
+                    else do
+                        writeArray parentArray rootY rootX
+                        writeArray rankArray rootY (rankY + 1)
+        else return ()
+
+-- Example usage
+example :: Int -> [(Node, Node)] -> [Node] -> [Node]
+example n unions finds = runST $ do
+    ds <- makeSet n
+    mapM_ (uncurry $ unionSet ds) unions
+    mapM (findSet ds) finds
+
+-- Testing function
+test :: IO ()
+test = do
+    let n = 10
+    let unions = [(0, 1), (1, 2), (3, 4), (4, 5), (6, 7), (8, 9), (0, 5), (6, 9)]
+    let finds = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
+    let result = example n unions finds
+    print result
+
+main :: IO ()
+main = test

src/DataStructures/Queue.hs

@@ -0,0 +1,63 @@
+import Data.Array.ST
+import Control.Monad.ST
+import Data.STRef
+
+-- Queue data structure represented using two indices (front, rear) and an array
+data Queue s a = Queue {
+    front :: STRef s Int,
+    rear :: STRef s Int,
+    array :: STArray s Int (Maybe a)
+}
+
+-- Initialize a new queue with a given size
+newQueue :: Int -> ST s (Queue s a)
+newQueue size = do
+    front <- newSTRef 0
+    rear <- newSTRef 0
+    array <- newArray (0, size-1) Nothing
+    return $ Queue front rear array
+
+-- Enqueue an element
+enqueue :: Queue s a -> a -> ST s ()
+enqueue q x = do
+    r <- readSTRef (rear q)
+    writeArray (array q) r (Just x)
+    writeSTRef (rear q) (r + 1)
+
+-- Dequeue an element
+dequeue :: Queue s a -> ST s (Maybe a)
+dequeue q = do
+    f <- readSTRef (front q)
+    r <- readSTRef (rear q)
+    if f == r
+        then return Nothing -- Queue is empty
+        else do
+            x <- readArray (array q) f
+            writeSTRef (front q) (f + 1)
+            return x
+
+-- Check if the queue is empty
+isEmptyQueue :: Queue s a -> ST s Bool
+isEmptyQueue q = do
+    f <- readSTRef (front q)
+    r <- readSTRef (rear q)
+    return (f == r)
+
+-- Testing function
+testQueue :: [a] -> ([Maybe a], Bool, Bool)
+testQueue xs = runST $ do
+    queue <- newQueue (length xs)
+    mapM_ (enqueue queue) xs
+    emptyBefore <- isEmptyQueue queue
+    result <- mapM (\_ -> dequeue queue) xs
+    emptyAfter <- isEmptyQueue queue
+    return (result, emptyBefore, emptyAfter)
+
+-- Main function
+main :: IO ()
+main = do
+    let input = [1, 2, 3, 4, 5]
+    let (result, emptyBefore, emptyAfter) = testQueue input
+    print result          -- Expected output: [Just 1, Just 2, Just 3, Just 4, Just 5]
+    print emptyBefore     -- Expected output: False
+    print emptyAfter      -- Expected output: True

src/DataStructures/Stack.hs

@@ -0,0 +1,63 @@
+import Data.Array.ST
+import Control.Monad.ST
+import Data.STRef
+
+type Stack s a = (STArray s Int a, STRef s Int)
+
+-- Create a new stack
+newStack :: Int -> ST s (Stack s a)
+newStack size = do
+    arr <- newArray_ (0, size - 1)
+    topRef <- newSTRef (-1)
+    return (arr, topRef)
+
+-- Push an element onto the stack
+push :: Stack s a -> a -> ST s ()
+push (arr, topRef) x = do
+    top <- readSTRef topRef
+    let newTop = top + 1
+    writeArray arr newTop x
+    writeSTRef topRef newTop
+
+-- Pop an element from the stack
+pop :: Stack s a -> ST s (Maybe a)
+pop (arr, topRef) = do
+    top <- readSTRef topRef
+    if top < 0
+        then return Nothing
+        else do
+            x <- readArray arr top
+            writeSTRef topRef (top - 1)
+            return (Just x)
+
+-- Peek at the top element of the stack
+peek :: Stack s a -> ST s (Maybe a)
+peek (arr, topRef) = do
+    top <- readSTRef topRef
+    if top < 0
+        then return Nothing
+        else Just <$> readArray arr top
+
+-- Check if the stack is empty
+isEmpty :: Stack s a -> ST s Bool
+isEmpty (_, topRef) = do
+    top <- readSTRef topRef
+    return (top == -1)
+
+-- Example usage and testing function
+testStack :: [Int] -> ([Maybe Int], Bool, Bool)
+testStack xs = runST $ do
+    stack <- newStack (length xs)
+    mapM_ (push stack) xs
+    emptyBefore <- isEmpty stack
+    result <- mapM (\_ -> pop stack) xs
+    emptyAfter <- isEmpty stack
+    return (result, emptyBefore, emptyAfter)
+
+main :: IO ()
+main = do
+    let input = [1, 2, 3, 4, 5]
+    let (result, emptyBefore, emptyAfter) = testStack input
+    print result          -- Expected output: [Just 5, Just 4, Just 3, Just 2, Just 1]
+    print emptyBefore     -- Expected output: False
+    print emptyAfter      -- Expected output: True