Cvičení z Neprocedurálního programování - úkol 4.1 a 4.2

1-zadani1.md

Úkol 4 má dvě části: úkol 4.1 a úkol 4.2, dohromady za 18 bodů.

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

---

Úkol 4.1 [ 6 bodů ]

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...

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-zadani2.md

Úkol 4.2 [ 12 bodů ]

Vaším úkolem je popsat situaci v obchůdku pomocí datových typů a napsat pár funkcí, které s nimi pracují.

Popis obchůdku

Obchůdek na rohu nabízí následující jídla: pizzu, salát a bagetu.

Pizza

Každá pizza je dostupná ve dvou velikostech: malá a velká. Každá pizza má omáčku: rajčatovou, smetanovou, nebo pesto. Rajčatová a smetanová omáčka jsou základní omáčky, ale pesto je prémiové -- za příplatek.

Malá základní pizza bez dalších přísad je za 220 korun, velká základní pizza bez dalších přísad je za 270 korun. Pesto na malé pizze stojí 30 korun a na velké pizze 40 korun.

Obchod nabízí pět následujících přísad: salám, šunku, cibuli, ananas a kuřecí maso. Kuřecí maso stojí 60 korun na malé pizze a 75 na velké pizze. Všechny ostatní přísady stojí 30 korun na malé pizze a 50 na velké pizze.

Přísady nemusí být unikátní -- jedna pizza na sobě může mít dvojitou šunku.

Salát

Dále obchod nabízí generický salát s možností nejvýše jednoho vlastního dresinku. Každý salát stojí 135 korun a obsahuje dresink v ceně.

Dresink je buď Caesar, olivový olej, dijonský, jogurtový, nebo žádný.

Bageta

Bageta je dostupná ve dvou velikostech: malá a velká. Každá bageta má v ceně nejvýše jeden dresink (stejný výběr jako u salátových).

Malá bageta stojí 90 korun a velká bageta stojí 120 korun.

Zadání úkolu

Reprezentujme Jidlo jako datový typ v Haskellu dle zadání výše.

data Jidlo = Pizza Velikost Omacka [Prisada]
           | Salat Dresink
           | Bageta Velikost Dresink
           deriving (Show)

1. Dopište definice pro datové typy Velikost, Omacka, Prisada a Dresink dle zadání výše. Ke každému datovému typu dopište deriving (Show) jako v příkladu výše. Vaše typy explicitně nemají instanci pro Eq (nepřidávejte si ji), takže nemůžete používat == ani /= v následujících úkolech. Místo toho používejte pattern matching!

2. Napište funkci cenaPrisady :: Velikost -> Prisada -> Int, která vrátí cenu přísady v závislosti na zvolené přísadě a velikosti pizzy. Nepište desetiřádkovou funkci -- rozmyslete si jak budete pattern-matchovat.

3. Napište funkci cenaOmacky :: Velikost -> Omacka -> Int, která vrátí cenu omáčky v závislosti na zvolené omáčce a velikosti pizzy.

4. Napište funkci hladoveji :: Jidlo -> Jidlo, která vrátí větší variantu zadaného jídla. Pokud jídlo už zvětšit nejde, tak zůstane takové jaké je. Nic dalšího (přísady / omáčky / dresinky) se na jídle nemění.

5. Napište funkci zdraveji :: Jidlo -> Jidlo, která vrátí zdravější variantu zadaného jídla. Zdravější varianta odstraňuje dresink a každá uzenina (šunka, salám) je nahrazena kuřecím masem.

6. Napište funkci cenaJidla :: Jidlo -> Int, které vrátí cenu zvoleného jídla.

7. Napište funkci nejvicePrisad :: [Jidlo] -> Int, která dostane objednávku (seznam jídel) a vrátí počet přísad, které měla ta pizza v objednávce, která měla nejvíce přísad.

Pokud v objednávce byla pizza s pěti přísadami, pizza s jednou přísadou a bageta, pak funkce vrátí 5.

8. Napište funkci sunkovitost :: [Jidlo] -> Int, která dostane objednávku (seznam jídel) a vrátí počet pizz v objednávce, které obsahují šunku.

3-vzor1.hs

{-# OPTIONS_GHC -Wall #-}

module Ukol41 where

-----------------------------------------------------------------------------------
--                            ZADÁNÍ ÚKOLU 4.1                                    |
-----------------------------------------------------------------------------------
-- 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 ""