tut9.hs

import Data.List

is_equiv :: (a -> a -> Bool) -> [a] -> Bool
is_equiv (~=) set = refl && sym && trans
  where
    infix 1 ==>
    x ==> y = not x || y

    every c = all c set

    refl  = every (\x -> x ~= x)
    sym   = every (\x -> every (\y -> x ~= y ==> y ~= x))
    trans = every (\x -> every (\y -> every (\z -> x ~= y && y ~= z ==> x ~= z)))

classes :: (a -> a -> Bool) -> [a] -> [[a]]
classes _    []     = []
classes (~=) (x:xs) = (x:ex):classes (~=) nex
  where
    (ex, nex) = partition (x ~=) xs

reflexive_closure :: (Eq a) => (a -> a -> Bool) -> (a -> a -> Bool)
reflexive_closure (~=) x y = x == y || x ~= y


import Data.Char
import Data.List

search :: [String] -> [String] -> [Int]
search grid = map (count . map toLower)
  where
    gridA = map (map toLower) grid
    gridB = transpose gridA

    line  s = length . filter (s `isPrefixOf`) . tails
    count s = sum [line s' l | g <- [gridA, gridB], l <- g, s' <- [s, reverse s]]

-- Nové datové typy se vytvářejí pomocí klíčového slova 'data'.
--
-- data <jméno> = <definice>
--
-- Jméno musí začínat velkým písmenem (typy, které začínají malým písmenem
-- jsou typové proměnné). Definice je pak výčet 'konstruktorů' - možných
-- hodnot datového typu - oddělený svislítkem '|'.
--
-- např. definice typu Bool by vypadala takto:
--
--   data Bool = False | True
--
-- Tohle jednoduše definuje Bool jako typ se dvěma konstantami - False a True.
--
-- Jednotlivé konstruktory mohou mít položky.

data Extended = PlusInfinity | MinusInfinity | Finite Integer

-- PlusInfinity a MinusInfinity jsou konstanty, Finite obsahuje jednu položku
-- typu Integer.
--
-- > :t Finite
-- Finite :: Integer -> Extended
--
-- > :t PlusInfinity
-- PlusInfinity :: Extended
--
-- Pokud dostaneme hodnotu typu Extended, můžeme ji rozebrat stejně jako
-- např. seznamy - pattern matching.

leq :: Extended -> Extended -> Bool
leq MinusInfinity _             = True
leq _             PlusInfinity  = True
leq (Finite x)    (Finite y)    = x <= y
leq _             _             = False

-- > PlusInfinity
-- <interactive>:2:1: error:
--     * No instance for (Show Extended) arising from a use of `print'
--     * In a stmt of an interactive GHCi command: print it
--
-- GHCi neví, jak zobrazit hodnotu PlusInfinity!
--
-- Potřebujeme implementovat Show pro typ Extended. Pro pár základních typových
-- tříd (Eq, Ord, Show, ...) to GHC umí udělat za nás.
--
-- data Extended = PlusInfinity | MinusInfinity | Finite Integer
--     deriving (Show)
--
-- data Point = Point Double Double
--   deriving (Show, Eq)  -- Ord nedává smysl
--
-- getX :: Point -> Double
-- getX (Point x _) = x
--
-- getY :: Point -> Double
-- getY (Point _ y) = y
--
-- Pokud máme datový typ, který má pouze jednen konstruktor, tak můžeme tyhle funkce
-- dostat zadarmo. Stačí tento typ definovat jako 'record'.

data Point = Point { getX :: Double, getY :: Double }
    deriving (Show, Eq)

-- > :t getX
-- getX :: Point -> Double
--
-- V předchozí definici jsme použili jméno Point dvakrát? Nedojde ke konfliktu?
-- Z kontextu se vždy dá jednoznačně určit, jestli se jedná o jméno typu
-- nebo o jméno konstruktoru.
--
-- Také můžeme definovat rekurzivní typy.

data IntTree = IntLeaf | IntNode Int IntTree IntTree
    deriving (Show, Eq)

insert :: Int -> IntTree -> IntTree
insert x IntLeaf = IntNode x IntLeaf IntLeaf
insert x (IntNode y l r)
    | x <  y    = IntNode y (insert x l) r
    | x == y    = IntNode x l r
    | otherwise = IntNode y l (insert x r)

-- Pokud definujeme strom takovýmto způsobem, budeme potřebovat kopii pro
-- každý datový typ. Řešení: datový typ parametrizujeme typovou proměnnou.

data Tree a = Leaf | Node a (Tree a) (Tree a)
    deriving (Show, Eq)

insert' :: (Ord a) => a -> Tree a -> Tree a
insert' x Leaf = Node x Leaf Leaf
insert' x (Node y l r)
    | x <  y    = Node y (insert' x l) r
    | x == y    = Node x l r
    | otherwise = Node y l (insert' x r)

-- Původní IntTree je tedy Tree Int (podobně jako [Int]).
--
-- > :t Leaf
-- Leaf :: Tree a
--
-- > :t Node
-- Node :: a -> Tree a -> Tree a -> Tree a
--
-- Všimněte si, že podobně jako [] vytváří Leaf strom, jehož prvky mají
-- libovolný typ.
--
-- Parametrů může být i více.
--
--   data Either a b = Left a | Right b
--
-- Either a b obsahuje buď hodnotu typu a nebo hodnotu typu b.
--
-- > :t Left
-- Left :: a -> Either a b
--
-- > :t Right
-- Right :: b -> Either a b
--
-- Kromě vlastních datových typů můžeme vytvářet synonyma pro již existující
-- typy. Jedná se pouze o syntaktickou zkratku, z hlediska kompilátoru jsou
-- synonymum a typ, který reprezentuje, shodné.
--
-- type String = [Char]

-- Skládání datových struktur.
--
-- Většina funkcí, které pracují nad seznamy, má podobnou strukturu.
-- Případ pro prádzný seznam, případ pro neprádzný seznam s rekurzivním
-- voláním na zbytek seznamu.
--
-- Můžeme tohle zobecnit?

foldRight :: (a -> b -> b) -> b -> [a] -> b
foldRight f z []     = z
foldRight f z (x:xs) = f x (foldRight f z xs)

-- Standardní knihovna: foldr

sum' :: (Num a) => [a] -> a
sum' = foldr (+) 0

product' :: (Num a) => [a] -> a
product' = foldr (*) 1

map' :: (a -> b) -> [a] -> [b]
map' f = foldr (\x r -> f x:r) []

elem' :: (Eq a) => a -> [a] -> Bool
elem' x = foldr (\y r -> x == y || r) False

-- Idea:
--
--   (:)                                 f
--   / \                                / \
--  1  (:)       == foldr f z =>       1   f
--     / \                                / \
--    2  (:)                             2   f
--       / \                                / \
--      3   []                             3   z
--
--
-- Skládání druhým směrem.

foldLeft :: (b -> a -> b) -> b -> [a] -> b
foldLeft f acc []     = acc
foldLeft f acc (x:xs) = foldLeft f (f acc x) xs

-- Standardní knihovna: foldl
--
-- Reprezentuje to, co známe z Prologu jako akumulátor.
--
--   (:)                                  f
--   / \                                 / \
--  1  (:)       == foldl f z =>        f   3
--     / \                             / \
--    2  (:)                          f   2
--       / \                         / \
--      3   []                      z   1

reverse' :: [a] -> [a]
reverse' = foldl (\acc x -> x:acc) []

-- foldr1 a foldl1 jsou verze foldr a foldl, které pracují pouze na neprázdných
-- seznamech, počáteční hodnotou je první prvek seznamu.

maximum' :: (Ord a) => [a] -> a
maximum' = foldr1 max

-- Definované výše:
--   fns = [(+2), (*3), max 2, (`div` 2)]
--
-- > foldr (.) id fns 7
-- 11
--
--
-- Občas v kódu najdete operátor $, který je definovaný takto:
--
-- ($) :: (a -> b) -> a -> b
-- f $ x = f x
--
-- Nedělá nic zajímavého, ale má nízkou prioritu, takže se dá použít
-- pro odbourávání závorek.
--
-- > (max 2 . (*2) . (^2)) 5
-- 50
--
-- > max 2 . (*2) . (^2) $ 5
-- 50
--
--
-- Líné vyhodnocování
--
-- Vraťme se zpět k funkci elem'.
--
--   elem' :: (Eq a) => a -> [a] -> Bool
--   elem' x = foldr (\y r -> x == y || r) False
--
-- > elem' 2 [1..]
-- True
--
-- Proč jsme dostali True a výpočet se nezacyklil?
--
--   (1 == 2) || ((2 == 2) || ((3 == 2) ... ))
--
-- Short-circuit pro ||. Tak jak to známe v tradičních jazycích.
-- Ale...

or' True _ = True
or' _    x = x

elem'' :: (Eq a) => a -> [a] -> Bool
elem'' x = foldr (\y r -> or' (x == y) r) False

-- > elem'' 2 [1..]
-- True
--
-- Náš or' také umí short-circuit, jakto? Haskell vyhodnocuje jen to, co je
-- pro výpočet nezbytně nutné. Pokud zjistíme, že prvním argumentem funkce or'
-- je True, tak rovnou vracíme True a na druhý argument se ani nepodíváme.
--
-- Místo toho, abychom funkce volali na nějaký nekončný výpočet (např.
-- let x = x in x) a pak sledovali, jestli se výpočet zastaví nebo ne, můžeme
-- použít hodnotu undefined, která "shodí" program, pokud se ji někdo pokusí
-- vyhodnotit.
--
-- > undefined
-- *** Exception: Prelude.undefined
--
-- > True || undefined
-- True
--
-- > undefined || True
-- *** Exception: Prelude.undefined
--
-- > length [undefined, undefined, undefined]
-- 3
--
-- > head (1:undefined)
-- 1
--
-- Pár zajímavých definic:

ones :: [Integer]
ones = 1:ones

nats :: [Integer]
nats = 0:map (+1) nats

fibs :: [Integer]
fibs = 0:1:zipWith (+) fibs (tail fibs)

-- Dokonce můžeme implementovat vlastní if, který skutečně vyhodnotí pouze
-- jednu větev.

if' :: Bool -> a -> a -> a
if' True  a _ = a
if' False _ b = b

-- > if' True 1 undefined
-- 1

-- Příklady na procvičení: test reflexivity, symetrie, tranzitivity
-- hledání tříd ekvivalence, reflexivní uzávěr, zobecněný kartézký součin,
-- skládání seznamu funkcí, hledání posloupnosti fcí maximalizujících výslednou
-- hodnotu