This repository has been archived on 2025-07-20. You can view files and clone it, but you cannot make any changes to it's state, such as pushing and creating new issues, pull requests or comments.
fp/test2/Test2.hs
2023-12-07 14:55:42 +00:00

96 lines
No EOL
3 KiB
Haskell

-- setting the "warn-incomplete-patterns" flag asks GHC to warn you
-- about possible missing cases in pattern-matching definitions
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
-- see https://wiki.haskell.org/Safe_Haskell
{-# LANGUAGE Safe #-}
module Test2 ( pentaFast
, statePenta
, deposit
, withdraw
, runAll
, circuit
, insert
, popMin
) where
import Types
import Control.Monad.State
{- QUESTION 1 -}
pentaFast :: Integer -> Integer
pentaFast n = a
where
((),(a,b,c,d,e)) = runState (statePenta n) (0,1,2,3,4)
statePenta :: Integer -> State (Integer,Integer,Integer,Integer,Integer) ()
statePenta 0 = pure ()
statePenta 1 = pure ()
statePenta 2 = pure ()
statePenta 3 = pure ()
statePenta 4 = pure ()
statePenta n = do modify (\(a, b, c, d, e) -> (a + b + 2*c - 3*d + 4*e - 5*n, c, d, e, n))
statePenta (n-1)
{- QUESTION 2 -}
-- modify fn needs to have signature: (Int, [Transaction])
deposit :: Int -> State BankAccount ()
deposit amount | amount < 0 = do modify (\(cb, trns) -> (cb, trns ++ [DepositFailed]))
pure ()
| otherwise = do modify (\(cb, trns) -> (cb+amount, trns ++ [Deposit]))
pure ()
withdraw :: Int -> State BankAccount ()
withdraw amount = do (bal, log) <- get
if amount < 0 || amount > bal then
do modify (\(cb, trns) -> (cb, trns ++ [WithdrawalFailed]))
pure ()
else do modify (\(cb, trns) -> (cb-amount, trns ++ [Withdrawal]))
pure ()
{- QUESTION 3 -}
runAll :: Monad m => Bin (m a) -> m (Bin a)
runAll t = undefined
{- QUESTION 4 -}
circuit :: Expr -> Circuit
circuit (Var char) = (Input char)
circuit (Not v) = let x = circuit v in (Nand x x)
circuit (And v w) = let x = (Nand (circuit v) (circuit w)) in (Nand x x)
circuit (Or v w) = circuit (Not (And (Not v) (Not w)))
circuit (Implies v w) = circuit (Or (Not v) w)
{- QUESTION 5 -}
insert :: Ord a => a -> Heap a -> Heap a
insert x Empty = (HeapNode x Empty Empty)
insert x (HeapNode v Empty Empty) = if x < v then
(HeapNode x (HeapNode v Empty Empty) Empty)
else
(HeapNode v (HeapNode x Empty Empty) Empty)
insert x (HeapNode v t y) = if x < v then
(HeapNode x (HeapNode v t Empty) y)
else if t == Empty then
(HeapNode v (HeapNode x Empty Empty) y)
else if y == Empty then
(HeapNode v t (HeapNode x Empty Empty))
else (HeapNode v (insert x t) y)
popMin :: Ord a => Heap a -> (Maybe a, Heap a)
popMin Empty = (Nothing, Empty)
popMin (HeapNode x Empty Empty) = (Just x, Empty)
popMin (HeapNode x y Empty) = (Just x, y)
popMin (HeapNode x Empty y) = (Just x, y)
popMin (HeapNode x (HeapNode y a b) (HeapNode z c d)) = if y < z then
let (_, res) = popMin (HeapNode y a b) in (Just x, (HeapNode y res (HeapNode z c d)))
else
let (_, res) = popMin (HeapNode z c d) in (Just x, (HeapNode z res (HeapNode y a b)))