Migrated project to stack

Author: Artur Parowicz

Haskell.cabal

@@ -0,0 +1,62 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 9bef5ebd7df69b30ebfe5fcb2aa3c8e73a2285caeebe8057db70cdfaf8471a5a
+
+name:           Haskell
+version:        0.0.1
+homepage:       https://github.com/TheAlgorithms/Haskell#readme
+bug-reports:    https://github.com/TheAlgorithms/Haskell/issues
+author:         TheAlgorithms
+maintainer:     TheAlgorithms
+license:        MIT
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    LICENSE
+    package.yaml
+    README.md
+    stack.yaml
+
+source-repository head
+  type: git
+  location: https://github.com/TheAlgorithms/Haskell
+
+library
+  exposed-modules:
+      BinaryTree.BinarySearchTree
+      BinaryTree.BinaryTree
+      HaskellAlgorithms
+      ProjectEuler.Problem1.Problem1
+      ProjectEuler.Problem2.Problem2
+      Robotics.ComplementaryFilter.CompFilt
+      Robotics.ComplementaryFilter.TestData
+      Sorts.BubbleSort
+      Sorts.MergeSort
+      Sorts.QuickSort
+  other-modules:
+      Paths_Haskell
+  hs-source-dirs:
+      src
+  ghc-options: -Wall
+  build-depends:
+      base
+  default-language: Haskell2010
+
+test-suite Haskell-test-suite
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      SortSpecs.BubbleSortSpec
+  hs-source-dirs:
+      specs
+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N
+  build-depends:
+      Haskell
+    , QuickCheck
+    , base
+    , hspec
+  default-language: Haskell2010

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

package.yaml

@@ -0,0 +1,36 @@
+# This YAML file describes your package. Stack will automatically generate a
+# Cabal file when you run `stack build`. See the hpack website for help with
+# this file: <https://github.com/sol/hpack>.
+name: Haskell
+version: '0.0.1'
+github: "TheAlgorithms/Haskell"
+license: MIT
+author: "TheAlgorithms"
+maintainer: "TheAlgorithms"
+
+extra-source-files:
+- LICENSE
+- package.yaml
+- README.md
+- stack.yaml
+
+ghc-options: -Wall
+
+library:
+  dependencies:
+  - base
+  source-dirs: src
+
+tests:
+  Haskell-test-suite:
+    source-dirs: specs
+    main: Spec.hs
+    dependencies:
+    - base
+    - Haskell
+    - hspec
+    - QuickCheck
+    ghc-options:
+    - -rtsopts
+    - -threaded
+    - -with-rtsopts=-N

specs/SortSpecs/BubbleSortSpec.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module SortSpecs.BubbleSortSpec where
+
+import Test.Hspec
+import Test.QuickCheck
+import Sorts.BubbleSort
+
+spec :: Spec
+spec = do
+    describe "bubbleSort" $ do
+        it "returns empty list when sorting empty list" $ property $
+            bubbleSort [] == ([] :: [Int])
+
+        it "returns same list if input was already sorted" $ property $
+            \(x :: [Int]) -> bubbleSort x == (bubbleSort . bubbleSort $ x)
+
+        it "returns list with smallest element at 0" $ property $ 
+            forAll (listOf1 arbitrary) $
+                \(x :: [Int]) -> let sortedList = bubbleSort x
+                        in head sortedList == minimum sortedList
+
+        it "returns list with largest element at the end" $ property $ 
+            forAll (listOf1 arbitrary) $
+                \(x :: [Int]) -> let sortedList = bubbleSort x
+                        in last sortedList == maximum sortedList
+
+        it "handle simple sorting of static value" $
+            let (unsortedList :: [Int]) = [4, 2, 1, 7, 3]
+                (sortedList :: [Int]) = [1, 2, 3, 4, 7]
+            in bubbleSort unsortedList == sortedList

specs/Spec.hs

@@ -0,0 +1,3 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+
+module Spec where

src/BinaryTree/BinarySearchTree.hs

@@ -0,0 +1,57 @@
+module BinaryTree.BinarySearchTree where
+
+data BTree a = Empty | Node a (BTree a) (BTree a) deriving (Show)
+data Side = LeftSide | RightSide deriving (Eq, Show)
+
+-- Function to get the data associated with the node.
+nodeKey :: BTree a -> Maybe a
+nodeKey Empty = Nothing
+nodeKey (Node x _ _) = Just x
+
+-- Perform inorder walk of the binary search tree.
+-- Cormen, Thomas H., et al. Introduction to algorithms.  pg. 288, MIT press, 2009.
+inorderWalk :: (Eq a, Ord a) => BTree a -> [a]
+inorderWalk Empty = []
+inorderWalk (Node x l r) = (inorderWalk l) ++ [x] ++ (inorderWalk r)
+
+-- Function to insert a value into the tree. Returns the new tree.
+-- Cormen, Thomas H., et al. Introduction to algorithms.  pg. 294, MIT press, 2009.
+bstInsert :: (Eq a, Ord a) => BTree a -> a -> BTree a
+bstInsert Empty z = Node z Empty Empty
+bstInsert (Node x l r) z
+    | z < x = Node x (bstInsert l z) r
+    | otherwise = Node x l (bstInsert r z)
+
+-- Function to find the maximum value in the BST.
+bstMax :: (Eq a, Ord a) => BTree a -> Maybe a
+bstMax Empty = Nothing
+bstMax (Node x Empty Empty) = Just x
+bstMax (Node x l Empty) = Just x
+bstMax (Node x l r) = bstMax r
+
+-- Function to find the minimum value in the BST.
+bstMin :: (Eq a, Ord a) => BTree a -> Maybe a
+bstMin Empty = Nothing
+bstMin (Node x Empty Empty) = Just x
+bstMin (Node x Empty r) = Just x
+bstMin (Node x l r) = bstMin l
+
+-- Function to build BST from a list of values using a fold.
+bstFromList :: (Eq a, Ord a) => [a] -> BTree a
+bstFromList [] = Empty
+bstFromList lst = foldl (\tree elem -> bstInsert tree elem) Empty lst
+
+sampleTree = bstFromList [10, 7, 3, 11, 12, 1, 3, 2]
+
+-- Function to check if a given tree is a Binary Search Tree.
+-- Property: 
+--     x is a node in the BST. If y is a node in the left subtree of x then 
+--     y.key <= x.key. If y is a node in the right subtree of x then
+--     y.key >= x.key.
+--     Cormen, Thomas H., et al. Introduction to algorithms. MIT press, 2009.
+isBST :: (Ord a, Eq a) => BTree a -> Bool
+isBST Empty = True
+isBST (Node x Empty Empty) = True
+isBST (Node x Empty r) = (x < (nkey r)) && (isBST r) where nkey = (\(Node n ll rr) -> n)
+isBST (Node x l Empty) = (x >= (nkey l)) && (isBST l) where nkey = (\(Node n ll rr) -> n)
+isBST (Node x l r) = (x >= (nkey l)) && (x < (nkey r)) && (isBST l) && (isBST r) where nkey = (\(Node n ll rr) -> n)

src/BinaryTree/BinaryTree.hs

@@ -0,0 +1,71 @@
+module BinaryTree.BinaryTree where
+
+import qualified Data.List as L
+
+data BTree a = Empty | Node a (BTree a) (BTree a) deriving (Show)
+data Side = LeftSide | RightSide deriving (Eq, Show)
+
+-- Get subtree on specified side
+getSubTree :: Side -> BTree a -> BTree a
+getSubTree _ Empty = Empty
+getSubTree s (Node _ l r) = if s == LeftSide then l else r
+
+-- Get Left Subtree
+getLeftTree :: BTree a -> BTree a
+getLeftTree Empty = Empty
+getLeftTree (Node _ l _) = l
+
+-- Get Right Subtree
+getRightTree :: BTree a -> BTree a
+getRightTree Empty = Empty
+getRightTree (Node _ _ r) = r
+
+-- Get string representation of node Data
+nodeShow :: (Show a) => BTree a -> String
+nodeShow Empty = ""
+nodeShow (Node val _ _) = show val
+
+-- Depth first traversal
+dfsList :: BTree a -> [a]
+dfsList Empty = []
+dfsList (Node n l r) = [n] ++ (dfsList l) ++ (dfsList r)
+
+-- Breadth first traversal.
+bfsList :: BTree a -> [a]
+bfsList Empty = []
+bfsList t = concat $ takeWhile (\l -> (length l) > 0) [getLevel i 0 t | i <- [0..]]
+
+-- Get all nodes from a single level in the tree.
+getLevel :: (Num b, Enum b, Eq b) => b -> b -> BTree a -> [a]
+getLevel _ _ Empty = []
+getLevel 0 _ (Node n l r) = [n]
+getLevel level i (Node n l r)
+    | i == level = [n]
+    | otherwise = (getLevel level (i+1) l) ++ (getLevel level (i+1) r)
+
+-- Get a list of lists of nodes in each level
+getLevels :: BTree a -> [[a]]
+getLevels t = takeWhile (\l -> (length l) > 0) [getLevel i 0 t | i <- [0..]]
+
+-- Get the depth of the tree
+getDepth :: BTree a -> Int
+getDepth t = length $ getLevels t
+
+-- Generate a Binary Tree from a list of values.
+-- Assume list is in breadth first order.
+fromList :: [a] -> BTree a
+fromList lst = fromListInt 0 lst
+-- Internal function to convert list to tree.
+fromListInt :: Int -> [a] -> BTree a
+fromListInt _ [] = Empty
+fromListInt i lst@(x:xs) = Node x (fromListInt (2*i + 1) (drop (i+1) lst)) 
+                                  (fromListInt (2*i + 2) (drop (i+2) lst))
+
+-- Count number of nodes in the tree.
+numNodes :: BTree a -> Int
+numNodes t = length $ bfsList t
+
+-- Pretty Print a Binary Tree
+simplePrint :: (Show a) => BTree a -> String
+simplePrint Empty = ""
+simplePrint t = (nodeShow t) ++ " " ++ (simplePrint $ getLeftTree t) ++ (simplePrint $ getRightTree t)

src/HaskellAlgorithms.hs

@@ -0,0 +1,6 @@
+module HaskellAlgorithms 
+(
+    module Sorts.BubbleSort
+) where
+
+import Sorts.BubbleSort

src/ProjectEuler/Problem1/Problem1.hs

@@ -0,0 +1,6 @@
+module ProjectEuler.Problem1.Problem1 where
+
+solList = filter (\n -> (rem n 5 == 0) || (rem n 3 == 0)) [1..999]
+
+main = do
+    print $ sum solList

src/ProjectEuler/Problem2/Problem2.hs

@@ -0,0 +1,11 @@
+module ProjectEuler.Problem2.Problem2 where
+
+fib :: Integer -> [Integer]
+fib n
+    | n < 0 = []
+    | n == 1 = [0]
+    | n == 2 = [0, 1]
+    | otherwise = reverse $ foldl (\acc n -> (sum (take 2 acc)):acc) [1, 0] [3..n]
+
+main = do
+    print $ sum $ filter even $ takeWhile (<=4000000) (fib 100)

src/Robotics/ComplementaryFilter/CompFilt.hs

@@ -0,0 +1,48 @@
+module Robotics.ComplementaryFilter.CompFilt where
+
+import Robotics.ComplementaryFilter.TestData
+
+-- Utility functions to extract X, Y, Z components from 3D vector.
+getX :: (a, a, a) -> a
+getX (x,_,_) = x
+
+getY :: (a, a, a) -> a
+getY (_,y,_) = y
+
+getZ :: (a, a, a) -> a
+getZ (_,_,z) = z
+
+-- Extract accel data from list of floats
+getAccel :: (RealFloat a) => [a] -> (a, a, a)
+getAccel [] = (0, 0, 0)
+getAccel s = if length s >= 6
+                then (s!!0, s!!1, s!!2)
+                else (0, 0, 0)
+
+-- Extract gyro data from a lsit of floats
+getGyro :: (RealFloat a) => [a] -> (a, a, a)
+getGyro s = if length s >= 6 
+               then (s!!3, s!!4, s!!5)
+               else (0, 0, 0)
+
+-- Function to calculate tilt angle from accelerometer reading.
+-- By default the tilt measurement is made around the Z axis.
+accelTiltAngle :: (RealFloat a) => (a, a, a) -> a
+accelTiltAngle (_, y, z) = (atan2 z y)*180.0/pi
+
+
+-- Complementary filter, uses the scanl pattern.
+compFilt :: (RealFloat a) => [a] -> [a] -> a -> a -> [a]
+compFilt ωs θ_accs α δt = scanl (\θ (ω, θ_acc) -> α*(θ + ω*δt) + (1-α)*θ_acc) 
+                                (head θ_accs)
+                                (zip ωs θ_accs)
+
+-- Calculate tilts
+calcTilt :: (RealFloat a) => [(a, a, a)] -> [(a, a, a)] -> a -> a -> [a]
+calcTilt accel gyro α δt = compFilt (map getX gyro) (map accelTiltAngle accel) α δt
+
+main = do
+    let accels = map getAccel testData
+    let gyros  = map getGyro testData
+    let tilts = calcTilt accels gyros 0.95 0.01
+    print tilts

src/Robotics/ComplementaryFilter/TestData.hs

@@ -0,0 +1,23 @@
+module Sorts.BubbleSort where
+
+listToSort :: [Int]
+listToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]
+
+
+-- The bubble sort function
+bubbleSort :: (Ord a) => [a] -> [a]
+bubbleSort lst = if bpassed == lst then lst
+                 else bubbleSort bpassed
+                 where bpassed = bubblePass lst
+
+-- A single pass of bubble sort
+bubblePass :: (Ord a) => [a] -> [a]
+bubblePass [] = [] -- Empty list is empty.
+bubblePass [x] = [x] -- Singleton list is always trivially sorted.
+bubblePass (x1:x2:xs) = if x1 > x2
+                        then [x2] ++ (bubblePass ([x1] ++ xs))
+                        else [x1] ++ (bubblePass ([x2] ++ xs))
+
+main = do
+    putStrLn $ "Unsorted: " ++ show listToSort
+    putStrLn $ "Sorted: " ++ show (bubbleSort listToSort)

src/Sorts/BubbleSort.hs

@@ -0,0 +1,24 @@
+module Sorts.MergeSort where
+
+listToSort = [13, 2, 3, 14, 17, 4, 1, 5, 16, 12, 9, 10, 15, 8, 7, 11, 18, 19, 6, 20]
+
+mergeSort :: (Ord a) => [a] -> [a]
+mergeSort [] = [] -- Empty list is empty
+mergeSort [x] = [x] -- Singleton lists are trivially sorted.
+mergeSort [x, y] = [(min x y), (max x y)]
+mergeSort lst = merge (mergeSort leftL) (mergeSort rightL)
+                where leftL = take splitPoint lst
+                      rightL = drop splitPoint lst
+                      splitPoint = (length lst) `div` 2
+
+-- Function to execute a merge of two sorted lists
+merge :: (Ord a) => [a] -> [a] -> [a]
+merge l1 [] = l1
+merge [] l2 = l2
+merge lst1@(x:xs) lst2@(y:ys) = if x < y 
+                                then x:(merge xs lst2)
+                                else y:(merge lst1 ys)
+
+main = do
+    putStrLn $ "Unsorted: " ++ show listToSort
+    putStrLn $ "Sorted: " ++ show (mergeSort listToSort)