Implemented Disjoint Set, Stack and Queue Data Structures

DIRECTORY.md

@@ -18,7 +18,13 @@
     * [Binarysearchtree](https://github.com/TheAlgorithms/Haskell/blob/master/src/BinaryTree/BinarySearchTree.hs)
     * [Binarytree](https://github.com/TheAlgorithms/Haskell/blob/master/src/BinaryTree/BinaryTree.hs)
   * Datastructures
+    * [Disjointsets](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/DisjointSets.hs)
+    * [Disjointsetsmain](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/DisjointSetsMain.hs)
     * [Maxheap](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/MaxHeap.hs)
+    * [Queue](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/Queue.hs)
+    * [Queuemain](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/QueueMain.hs)
+    * [Stack](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/Stack.hs)
+    * [Stackmain](https://github.com/TheAlgorithms/Haskell/blob/master/src/DataStructures/StackMain.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)

README.md

@@ -1,4 +1,5 @@
-![CI (Stack)](https://github.com/TheAlgorithms/Haskell/workflows/CI%20(Stack)/badge.svg)
+[![CI (Stack)](https://github.com/Ramy-Badr-Ahmed/Haskell-DSA/actions/workflows/CI.yml/badge.svg)](https://github.com/Ramy-Badr-Ahmed/Haskell-DSA/actions/workflows/CI.yml)
+
 # The Algorithms - Haskell
 Haskell is a general-purpose, statically typed, purely functional programming language with type inference and lazy evaluation.
 

package.yaml

@@ -23,6 +23,7 @@ library:
   - containers
   - vector
   - vector-algorithms
+  - array
   source-dirs: src
 
 tests:
@@ -35,6 +36,7 @@ tests:
     - hspec
     - QuickCheck
     - containers
+    - array
     ghc-options:
     - -rtsopts
     - -threaded

src/DataStructures/DisjointSets.hs

@@ -0,0 +1,62 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.DisjointSets where
+
+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

src/DataStructures/DisjointSetsMain.hs

@@ -0,0 +1,19 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.DisjointSetsMain where
+
+import DataStructures.DisjointSets
+
+main :: IO ()
+main = 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

src/DataStructures/Queue.hs

@@ -0,0 +1,64 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.Queue where
+
+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)

src/DataStructures/QueueMain.hs

@@ -0,0 +1,19 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.QueueMain where
+
+import DataStructures.Queue
+
+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,65 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.Stack where
+
+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)

src/DataStructures/StackMain.hs

@@ -0,0 +1,19 @@
+{-|
+Created by: Ramy-Badr-Ahmed (https://github.com/Ramy-Badr-Ahmed) in Pull Request: #54
+https://github.com/TheAlgorithms/Haskell/pull/54
+
+Please mention me (@Ramy-Badr-Ahmed) in any issue or pull request addressing bugs/corrections to this file.
+Thank you!
+-}
+
+module DataStructures.StackMain where
+
+import DataStructures.Stack
+
+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