Cvičení z Neprocedurálního programování - úkol 4

1-zadani.md

Úkol 4

Vaším úkolem je opravit neidiomatický kód v Haskellu.

K dispozici máte style guide (viz níže) a nástroje v Haskell Language Serveru, konkrétně ghci, hlint, nějaké formátítko se určitě hodí.

Neměňte názvy funkcí (aby to nerozbilo testování), ani její význam (testy by měly procházet). Testy se dají spustit napsáním main v GHCi, vytvořil jsem dole malý unit testový framework, abyste si mohli být jisti, že jste nic nerozbili...

Nesnažte se hledat hezké verze těchto funkcí na internetu, tak nějak to jde proti celému smyslu tohoto úkolu. Dále nepoužívejte žádné jiné moduly (žádný import...).

Do komentáře nad každou funkcí napište které zásady ze style guide jste použili (stačí číslo), popřípadě můžete použít i nějaký slovní popis. Pozor, že vám HLS/hlint může nabízet i věci, které vám nedávají smysl a nejsou ve style guide, v tom případě je ignorujte...

Deadline

Deadline je jako obvykle dva týdny od zadání, tedy do 6. 5. 08:59.

Style Guide

1. Kód musí jít zkompilovat pomocí GHC bez errorů či warningů.

2. Každá top-level funkce musí mít typovou deklaraci.

Místo:

secti x y = x + y

napište:

secti :: Int -> Int -> Int
secti x y = x + y

3. Používejte standardní Haskellové názvy:

• camelCase místo snake_case
• pattern match na seznamu je typicky (x:xs) či (y:ys)
• vnitřní rekurzivní funkce se často jmenuje go

4. Používejte rozumné názvy:

• top-level funkce by měly mít rozumný, popisný název
• lokální proměnné, které jsou dost obecné mohou být klidně pár znaků

Konkrétně pokud máte xs :: [a], tak je to lepší název než seznamAcek :: [a], pokud je to pro nějaké obecná a (třeba s obecným kvantifikátorem...)

5. Používejte konzistentní odsazení pomocí mezer (ne tabů)

• taby jsou dost špatné -- na každém počítači jsou jiné a mixování s mezerami je úplná tragédie
• vyberte si dvě/čtyři/osm mezer a je to :)

6. Vyvarujte se extrémně dlouhým řádkům (kolem 100 znaků už je to vopruz číst)
7. Používejte whitespace k odsazení, oddělení a zarovnání

• mezi top-level deklaracemi by měla být alespoň jedna prázdná mezera
• hezky zarovnané věci (např. v case) jsou fajn, ale není to nutné

8. Preferujte stráže (guards) před if

Například místo:

porovnej a b =
  if a > b then "Leva je vetsi"
           else if a == b then "Stejne"
                          else "Prava je vetsi"

použijte:

porovnej a b
  | a > b     = "Leva je vetsi"
  | a == b    = "Stejne"
  | otherwise = "Prava je vetsi"

9. Preferujte pattern matching před projekcemi (fst, snd, (!!))

Pattern matching je jednodušší a čistější! Tedy místo:

foo x = ...
  where
    a = fst x
    b = snd x

použijte:

foo (a, b) = ...

Podobně pokud procházíte seznam sekvenčně, tak raději používejte pattern matching na (x:xs) místo přístupů stylem xs !! 0, xs !! 1, xs !! 2... Nezapomeňte, že (!!) je worstcase O(N)!

10. Používejte pattern matching rovnou na parametry funkcí.

Například ten příklad výše pravděpodobně nikde nepotřebuje x jako takové, proto dává smysl jej rozbalit.

11. Vyvarujte se vnořených caseů.

Pokud máte v sobě vícero caseů, často je chcete spíše zkombinovat do jediného pomocí n-tice. Tedy místo:

data Barva = Cervena | Zelena | Modra

case a of
  Cervena -> case b of
                Cervena -> True
                Zelena  -> False
                Modra   -> False
  Zelena  -> case b of
                Cervena -> False
                Zelena  -> True
                Modra   -> False
  Modra   -> case b of
                Cervena -> False
                Zelena  -> False
                Modra   -> True

použijte následující:

case (a, b) of
  (Cervena, Cervena) -> True
  (Zelena , Zelena ) -> True
  (Modra  , Modra  ) -> True
  (_      , _      ) -> False

12. Nepoužívejte částečné funkce

Funkce jako head, tail, fromJust jsou takzvaně částečné -- při prázdném seznamu vyhodí error. To je ale dost nebezpečné a můžete se tím střelit do nohy.

Pokud je to možné, použijte raději pattern matching!

Tedy místo:

foo seznam = ...
  where 
    x  = head seznam
    xs = tail seznam

napište:

foo (x:xs) = ...

13. Nepoužívejte zbytečné ify.

Nepište ify, které jsou zbytečné! Například místo:

if b then False else True

použijte:

not b

Nebo místo:

if x then y else False

použijte:

x && y

a tak dále...

---

Tato style guide je specifická pro tento úkol, reálně by byla o něco obsáhlejší, detailnější a striktnější...

Pokud chcete "opravdovou" style guide, zkuste třeba tuto od Kowainik: https://kowainik.github.io/posts/2019-02-06-style-guide

2-vzor.hs

{-# OPTIONS_GHC -Wall #-}

module Ukol4 where

-----------------------------------------------------------------------------------
--                                   ZADÁNÍ                                       |
-----------------------------------------------------------------------------------
-- Upravte následující funkce: 'foo', 'otoc', 'spocitej' a 'zkombinuj' tak,
-- aby zůstal jejich význam (procházely testy), ale aby vyhovovaly style guide
-- v zadání na stránkách cvičení / výše.
-----------------------------------------------------------------------------------

-- Tuto funkci psal někdo, kdo nikdy neviděl Booleovskou logiku:
foo x y z = if x then 
                 if x then if y then True 
                                else if (x && z) then True else False 
                      else False
            else False

-- Tuto funkci psal někdo, kdo je zvyklý na Lisp/Scheme:
otoc l = otoc' l []
  where 
    otoc' l acc = 
      if null l 
        then acc 
        else otoc' (tail l) 
                   (head l : acc)

-- Tuto funkci psal někdo, kdo nikdy neviděl pattern matching,
-- nebo nějaké rozumné formátítko:
spocitej :: ((Int, Int), Int) -> ((Int,Int), Int) -> (Int, Int, Int)
spocitej x1 x2 =
  let x = fst (fst x1) in
  let y = snd (fst x1) in
  let z = snd x1 in
  let u = fst (fst x2) in
  let v = snd (fst x2) in
  let w = snd x2 
   in  
   ((((((y*w) - (z *v)),((z*u)    - 
     (x*w)),   ( (  x  *   v   ) 
     - ( y * 
     u))))))

-- Tuto funkci psal někdo, kdo nikdy neviděl rekurzi a má rád O(N^2) algoritmy:
zkombinuj xs ys = go 0 xs ys where
  go n xs ys = if n == length xs || n == length ys then [] else 
    (xs !! n, ys !! n) : go (n + 1) xs ys

-----------------------------------------------------------------------------------
--                                 UNIT TESTY                                     |
-----------------------------------------------------------------------------------
-- 
-- `actual === expected @@@ description` kontroluje, jestli je `expected` 
-- stejné jako `actual`, navíc tento test má popis `description`
--
-----------------------------------------------------------------------------------

fooTests :: [Test Bool]
fooTests =
  [ foo True False True  === True  @@@ "foo True False True === True"
  , foo True False False === False @@@ "foo True False False === False"
  , foo False True True  === False @@@ "foo False True True === False"
  ]

otocTests :: [Test [Int]]
otocTests =
  [ otoc [1, 2, 3] === [3, 2, 1] @@@ "otoc [1, 2, 3] === [3, 2, 1]"
  , otoc []        === []        @@@ "otoc [] === []"
  , otoc [1]       === [1]       @@@ "otoc [1] === [1]"
  ]

spocitejTests :: [Test (Int, Int, Int)]
spocitejTests =
  [ spocitej ((1, 2), 3) ((4, 5), 6) === (-3, 6, -3)
    @@@ "spocitej ((1, 2), 3) ((4, 5), 6) === (-3, 6, -3)"
  , spocitej ((0, 0), 0) ((0, 0), 0) === (0, 0, 0)
    @@@ "spocitej ((0, 0), 0) ((0, 0), 0) === (0, 0, 0)"
  , spocitej ((3, 2), 1) ((4, 5), 6) === (7, -14, 7)
    @@@ "spocitej ((3, 2), 1) ((4, 5), 6) === (7, -14, 7)"
  ]

zkombinujTests :: [Test [(Char, Int)]]
zkombinujTests =
  [ zkombinuj "abc" [1, 2, 3] === [('a', 1), ('b', 2), ('c', 3)]
    @@@ "zkombinuj \"abc\" [1, 2, 3] === [('a', 1), ('b', 2), ('c', 3)]"
  , zkombinuj "a"   [1, 2, 3] === [('a', 1)]
    @@@ "zkombinuj \"a\" [1, 2, 3] === [('a', 1)]"
  , zkombinuj "abc" [1] === [('a', 1)]
    @@@ "zkombinuj \"abc\" [1] === [('a', 1)]"
  , zkombinuj "abc" [] === [] @@@ "zkombinuj \"abc\" [] === []"
  , zkombinuj [] []    === [] @@@ "zkombinuj [] [] === []"
  ]

-----------------------------------------------------------------------------------
--                             HERE BE DRAGONS                                    |
-----------------------------------------------------------------------------------
--
-- Níže následuje malinkatý framework pro unit testy, který jsem napsal,
-- abyste si mohli otestovat svůj kód. :)
-- Zavolejte 'main' v GHCi a vypíše se vám hezký přehled.
--
-- Kód níže samozřejmě můžete zkoumat a upravovat, odevzdávat jej nemusíte... ;)
--
-----------------------------------------------------------------------------------

-- | A 'Test' is a pair of (expected value, actual value)
-- together with an optional description
data Test a = Test
  { expected    :: a
  , actual      :: a
  , description :: Maybe String
  }
  deriving (Show, Eq)

-- | A binary operator for creating a basic test without a description
--
-- Example:
-- >>> 2 + 8 === 10
(===) :: (Eq a, Show a) => a -> a -> Test a
actualValue === expectedValue = Test expectedValue actualValue Nothing

-- | A binary operator for annotating a test with a description
--
-- Example:
-- >>> 2 + 8 === 10 @@@ "Two plus eight should be ten!"
(@@@) :: Test a -> String -> Test a
test @@@ desc = test { description = Just desc }

-- | Gets a description of a 'Test'.
--
-- Returns @expected === actual@ if the given test has no description.
getTestDescription :: Show a => Test a -> String
getTestDescription t = case description t of
  Just someDescription -> someDescription
  Nothing              -> show (expected t) ++ " === " ++ show (actual t)

-- | A 'TestResult' is either 'OK' or 'Fail'
--
-- This type is different from 'Bool' to avoid boolean blindness...
-- See this article by Bob Harper: https://existentialtype.wordpress.com/2011/03/15/boolean-blindness/
data TestResult
  = OK
  | Fail
  deriving (Show, Eq)

-- | Takes a list of 'TestResult' and returns a pair of numbers,
-- where the first number is the number of 'OK's
-- and the second number is the number of 'Fail's
sumTestResults :: [TestResult] -> (Int, Int)
sumTestResults results = go results (0, 0)
 where
  go []          (oks, fails) = (oks, fails)
  go (OK   : rs) (oks, fails) = go rs (oks + 1, fails)
  go (Fail : rs) (oks, fails) = go rs (oks, fails + 1)

-- | Runs a test producing a 'TestResult'
runTest :: (Eq a, Show a) => Test a -> TestResult
runTest t | expected t == actual t = OK
          | otherwise              = Fail

-- | Takes a 'Test' and its 'TestResult' and produces a 'String'
-- with details about the test and its success/failure
describeTest :: Show a => Test a -> TestResult -> String
describeTest t OK   = getTestDescription t ++ " ... OK "
describeTest t Fail = unlines
  [ getTestDescription t ++ " ... FAIL"
  , "    " ++ "Expected: " ++ show (expected t)
  , "    " ++ "Actual:   " ++ show (actual t)
  ]

-- | Takes a list of 'Test a', runs it and returns a single 'String'
-- describing the result and a pair of two 'Int's -- number of 'OK' and number of 'Fail' resp.
runTests :: (Eq a, Show a) => [Test a] -> (String, (Int, Int))
runTests tests = (resultsString, resultsSum)
 where
  results       = map runTest tests
  resultsSum    = sumTestResults results
  resultsString = unlines
    $ map (\(test, result) -> describeTest test result) (zip tests results)

-- | The main entrypoint to a Haskell module
main :: IO ()
main = do
  putStrLn "Testing..."
  putStrLn ""

  runTestGroup "foo"       fooTests
  runTestGroup "otoc"      otocTests
  runTestGroup "spocitej"  spocitejTests
  runTestGroup "zkombinuj" zkombinujTests
 where
  -- | A helper function to run a group of tests 
  -- with a pretty name and a summary
  runTestGroup name tests = do
    putStrLn $ "=== " ++ name ++ " ==="
    let (str, (oks, fails)) = runTests tests
    let total               = oks + fails
    putStrLn str
    putStrLn
      $  show oks
      ++ "/"
      ++ show total
      ++ " ... OK, "
      ++ show fails
      ++ "/"
      ++ show total
      ++ " ... FAIL"
    putStrLn ""