diff --git a/DIRECTORY.md b/DIRECTORY.md index 3594d0f..a559f40 100644 --- a/DIRECTORY.md +++ b/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) diff --git a/README.md b/README.md index 2ce21d0..156ea68 100644 --- a/README.md +++ b/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. diff --git a/package.yaml b/package.yaml index 581948d..e9c2dce 100644 --- a/package.yaml +++ b/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 diff --git a/src/DataStructures/DisjointSets.hs b/src/DataStructures/DisjointSets.hs new file mode 100644 index 0000000..dfa1d26 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/src/DataStructures/DisjointSetsMain.hs b/src/DataStructures/DisjointSetsMain.hs new file mode 100644 index 0000000..dd62ddf --- /dev/null +++ b/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 diff --git a/src/DataStructures/Queue.hs b/src/DataStructures/Queue.hs new file mode 100644 index 0000000..0780d98 --- /dev/null +++ b/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) diff --git a/src/DataStructures/QueueMain.hs b/src/DataStructures/QueueMain.hs new file mode 100644 index 0000000..58a4ad4 --- /dev/null +++ b/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 diff --git a/src/DataStructures/Stack.hs b/src/DataStructures/Stack.hs new file mode 100644 index 0000000..6c8fb94 --- /dev/null +++ b/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) \ No newline at end of file diff --git a/src/DataStructures/StackMain.hs b/src/DataStructures/StackMain.hs new file mode 100644 index 0000000..bdb0727 --- /dev/null +++ b/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