Functional Programming Techniques in Haskell: A Practical Guide

Posted on Jul 1, 2024 in Computers

1. Merging Two Sorted Lists

Task

Merge two sorted lists into one sorted list.

Solution

Base cases handle empty lists; recursive case merges elements based on comparison.

merge :: [Integer] -> [Integer] -> [Integer]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
  | x <= y     = x : merge xs (y:ys)
  | otherwise = y : merge (x:xs) ys

2. Splitting a List

Task

Split a list into two approximately equal parts.

Solution

Use pattern matching and recursion to alternate elements into two lists.

split :: [a] -> ([a], [a])
split [] = ([], [])
split [x] = ([x], [])
split (x:y:xs) = (x:xs', y:ys')
  where (xs', ys') = split xs

3. Merge Sort

Task

Implement merge sort using custom split and merge functions.

Solution

Recursively split and merge lists.

mergeSort :: ([a] -> ([a], [a])) -> ([a] -> [a] -> [a]) -> [a] -> [a]
mergeSort _ _ [] = []
mergeSort _ _ [x] = [x]
mergeSort splitter merger xs = merger (mergeSort splitter merger left) (mergeSort splitter merger right)
  where (left, right) = splitter xs

4. Lazy Evaluation

Understanding

Explained lazy evaluation through examples (mySum, myor).

Example

mySum evaluated by creating thunks and postponing arithmetic.

mySum [] = 0
mySum (x:xs) = x + mySum xs

5. Nested Lists

Task

Implement nested lists in Haskell.

Solution

Use recursive data type and functions to handle flattening.

data NestedListItem a = Item a | List [NestedListItem a]
  deriving (Eq, Show)

flatten :: [NestedListItem a] -> [a]
flatten [] = []
flatten (x:xs) = flattenItem x ++ flatten xs

flattenItem :: NestedListItem a -> [a]
flattenItem (Item a) = [a]
flattenItem (List lst) = flatten lst

6. Semigroup and Monoid Instances

Task

Make BoolX an instance of Semigroup and Monoid.

Solution

Implement logical XOR (<>) and identity (mempty).

data BoolX = MkBoolX Bool deriving (Eq, Show)

instance Semigroup BoolX where
    (<>) (MkBoolX a) (MkBoolX b) = MkBoolX (a /= b)

instance Monoid BoolX where
    mempty = MkBoolX False

7. Evaluating Expressions

Task

Evaluate head ( ( (1:[]) ++ (2:[]) ) ++ (3:[]) ).

Solution

Expand the list concatenations step-by-step.

head ( ( (1:[]) ++ (2:[]) ) ++ (3:[]) )
= head ( [1] ++ [2] ++ [3] )
= head ( 1 : ([2] ++ [3]) )
= head ( 1 : 2 : [3] )
= 1

8. Structural Induction

Task

Prove properties about w function using structural induction.

Solution

Base case and induction step for lists.

w [] (N _ a _ ) = [a]
w (O:bt) (N lt a rt) = a : w bt lt
w (I:bt) (N lt a rt) = a : w bt rt

9. Monoid for Summation

Task

Define S as a Monoid to compute sum, sum of squares, and count.

Solution

Implement Semigroup and Monoid instances.

data S = MkS Double Double Int

instance Semigroup S where
    MkS s1 s1_sq n1 <> MkS s2 s2_sq n2 = MkS (s1 + s2) (s1_sq + s2_sq) (n1 + n2)

instance Monoid S where
    mempty = MkS 0 0 0

10. Handling UNIX PATH Environment Variable

Task

Split a string by colons and delete a specific string from a list.

Solution

Implement splitOnce, split, delete, and glue functions.

splitOnce :: String -> (String, String)
splitOnce "" = ("", "")
splitOnce (':' : rest) = ("", rest)
splitOnce str = splitHelper str ""

splitHelper :: String -> String -> (String, String)
splitHelper "" acc = (reverse acc, "")
splitHelper (':' : rest) acc = (reverse acc, rest)
splitHelper (x : xs) acc = splitHelper xs (x : acc)

split :: String -> [String]
split "" = []
split str =
    let (first, rest) = splitOnce str
    in first : split rest

delete :: String -> [String] -> [String]
delete s = filter (/= s)

import Data.List (intercalate)

glue :: [String] -> String
glue = intercalate ":"

11. AVL Tree Insertions

Task

Implement insertion for an AVL tree and ensure it remains balanced.

Solution

Define helper functions for rotations, balancing, and updating node heights.

module AVL(insert) where

import AVLDef

-- Helper Functions for Rotations and Balancing
updateHeight :: AVL k -> AVL k
updateHeight Empty = Empty
updateHeight node@(Node { avlLeft = l, avlRight = r }) =
    node { avlHeight = 1 + max (height l) (height r) }

-- Left Rotation
rotateLeft :: AVL k -> AVL k
rotateLeft Node{avlLeft, avlKey, avlRight = Node{avlLeft = b, avlKey = y, avlRight = c, avlHeight = _}, avlHeight = _} =
    let newLeft = updateHeight (Node avlLeft avlKey b 0) -- Construct new left child and update its height
        newRoot = updateHeight (Node newLeft y c 0)     -- Construct new root and update its height
    in newRoot
rotateLeft n = n

-- Right Rotation
rotateRight :: AVL k -> AVL k
rotateRight Node{avlLeft = Node{avlLeft = a, avlKey = x, avlRight = b, avlHeight = _}, avlKey, avlRight, avlHeight = _} =
    let newRight = updateHeight (Node b avlKey avlRight 0) -- Construct new right child and update its height
        newRoot = updateHeight (Node a x newRight 0)      -- Construct new root and update its height
    in newRoot
rotateRight n = n

-- Balance the tree at a node
balance :: AVL k -> AVL k
balance node@(Node { avlLeft = l, avlRight = r, avlHeight = _ })
  | balanceFactor node > 1 && balanceFactor l >= 0 = rotateRight node
  | balanceFactor node > 1 && balanceFactor l < 0  = rotateRight $ node { avlLeft = rotateLeft l }
  | balanceFactor node < -1 && balanceFactor r <= 0 = rotateLeft node
  | balanceFactor node < -1 && balanceFactor r > 0  = rotateLeft $ node { avlRight = rotateRight r }
  | otherwise = updateHeight node
balance node = node

-- Insert Function
insert :: Ord k => k -> AVL k -> AVL k
insert key Empty = singleton key
insert key node@(Node { avlLeft = l, avlKey = k, avlRight = r })
  | key < k = balance $ node { avlLeft = insert key l }
  | key > k = balance $ node { avlRight = insert key r }
  | otherwise = node  -- No duplicates allowed