------------------------------ Male ulohy Haskell ------------------------------

-- 1. RIDKE MATICE -------------------------------------------------------------

{-
 Ridka matice je reprezentovana jako trojice (m,n,s), kde m je pocet radek,
 n je pocet sloupcu a s je seznam trojic (i,j,a_ij) (kde i je cislo radky,
 j je cislo sloupce a a_ij je nenulova hodnota) usporadany vzestupne podle
 i a uvnitr radek podle j.

 Naprogramujte funkce, ktere v teto reprezentaci realizuji

 (a) transpozici matic
 (b) nasobeni matic
 (c) umocnovani matic (dobrovolne)
-}

-- datova struktura

-- (i,j,a_ij)
type RMVals = (Int,Int,Int)

-- (m,n,s)
type RM = (Int,Int,[RMVals])

-- sortovani trojic

sort3 :: [RMVals] -> [RMVals]
sort3 [] = []
sort3 (x:xs) = sort3 [a | a <- xs, a<x]
            ++ [x]
            ++ sort3 [a | a <- xs, a>=x]

-- transpozice

-- transpozice hodnot
transV :: [RMVals] -> [RMVals]
transV [] = []
transV ((a,b,c):xs) = (b,a,c):(transV xs)

-- transpozice matice 

trans :: RM -> RM
trans (m,n,s) = (n,m,sort3 (transV s))

-- nasobeni matic


del0 :: [RMVals] -> [RMVals]    -- vynechani nulovych prvku
del0 [] = []
del0 ((a,b,c):xs) | c==0 = del0 xs
                  | otherwise = (a,b,c):(del0 xs)

-- z matice, ktera muze obsahovat vicekrat jeden prvek udela normalni
-- souctem hodnot techto duplicitnich prvku
-- tedy secte hodnoty stejnych prvku za sebou
simpM :: [RMVals] -> [RMVals]
simpM [] = []
simpM [x] = [x]
simpM ((xa,xb,xc):(ya,yb,yc):xys)
        | xa==ya && xb==yb = simpM ((xa,xb,xc+yc):(xys))
        | otherwise = (xa,xb,xc):(simpM ((ya,yb,yc):xys))


-- vynasobi matice s tim, ze format matice muze obsahovat nulove prvky 
mulM :: [RMVals] -> [RMVals] -> [RMVals]
mulM xs ys = simpM (sort3 [(xa,yb,xc*yc) 
        | (xa,xb,xc) <- xs, (ya,yb,yc) <- ys, xb==ya])

-- samotne nasobeni
mul :: RM -> RM -> RM
mul (m1,n1,s1) (m2,n2,s2) | n1==m2 = (m1,n2,s3) 
                            where s3 = del0 (mulM s1 s2)

-- testovaci matice

t1 :: RM
t1 = (2,3,[(1,3,1),(2,1,2),(2,2,1)])

t2 :: RM
t2 = (3,4,[(1,1,6),(1,2,2),(2,1,1),(3,4,1)])

-- testy testovacich matic

r1 :: RM
r1 = trans t1

r2 :: RM
r2 = trans t2

r3 :: RM
r3 = t1 `mul` t2




-- 2. VYPOUSTENI Z BVS  --------------------------------------------------------

{-
 Definujte prirozenou reprezentaci binarniho stromu, v jehoz uzlech je ulozena 
 informace nejakeho typu (podtridy Ord).

 Naprogramujte funkci, ktera z binarniho vyhledavaciho stromu vypusti uzly 
 patrici do zadaneho intervalu (nejsou-li tam zadne takove, bude to identita).
-}


-- datova struktura 

data BVSTree a = Nil | BVS ((BVSTree a),a,(BVSTree a)) deriving (Show, Eq)

-- najde min/max v BVS
findMin :: (Ord a) => BVSTree a -> a
findMin (BVS (left,val,right)) 
        | left==Nil = val
        | otherwise = findMin left

findMax :: (Ord a) => BVSTree a -> a
findMax (BVS (left,val,right))
        | right==Nil = val
        | otherwise = findMax right

-- vypusti ze stromu vsechny uzly od m do n
remBVS :: (Ord a) => BVSTree a -> a -> a -> BVSTree a
remBVS Nil _ _ = Nil

remBVS (BVS (Nil,val,Nil)) m n
        | m <= val && val <= n = Nil
        | otherwise = BVS (Nil,val,Nil)

remBVS (BVS (left,val,right)) m n = 
        if m>n then Nil
        else if n<val then BVS (remLeft,val,right)
        else if val<m then BVS (left,val,remRight)
        else if not (remLeft==Nil) then BVS (remLeftMax,maxremLeft,remRight)
        else if not (remRight==Nil) then BVS (remLeft,minremRight,remRightMin)
        else Nil
                where remLeft = remBVS left m n
                      remRight = remBVS right m n
                      maxremLeft = findMax remLeft
                      minremRight = findMin remRight
                      remLeftMax = remBVS remLeft maxremLeft maxremLeft
                      remRightMin = remBVS remRight minremRight minremRight


-- testovaci stromy

tr1 :: BVSTree Int
tr1 = BVS (
        BVS
        (
          BVS (
            BVS (Nil,1,Nil),
            7,
            Nil
          ),
          50,
          BVS (
            BVS (Nil,54,Nil),
            68,
            BVS (Nil,70,Nil)
          )
        ),
        100,
        BVS (
          BVS (
            BVS (Nil,101,Nil),
            111,
            Nil
          ),
          120,
          BVS (Nil,122,Nil)
        )
      )
      
{-
 take se da zapsat jako

BVS (BVS (BVS (BVS (Nil,1,Nil),7,Nil),50,BVS (BVS (Nil,54,Nil),68,
BVS (Nil,70,Nil))),100,BVS (BVS (BVS (Nil,101,Nil),111,Nil),120,
BVS (Nil,122,Nil)))
-}

tr2 :: BVSTree Int
tr2 = BVS (
        BVS (Nil,12,Nil),
        123,
        BVS (Nil,234,Nil)
      )

-- testy testovacich stromu

ts1=remBVS tr2 123 123
ts2=remBVS tr2 100 300
ts3=remBVS tr2 200 300
ts4=remBVS tr1 50 150
ts5=remBVS tr1 0 150
ts6=remBVS tr1 90 102
ts7=remBVS tr1 100 100
ts8=remBVS tr1 55 119
ts9=remBVS tr1 69 199




-- 3. CHYBEJICI CISLA ----------------------------------------------------------

{-
Je dan seznam prirozenych cisel S a cislo K. Ukolem je vratit seznam  
K nejmensich cisel, jez nejsou obsazena v S. Muzeme predpokladat, ze cisla se 
v S neopakuji.
-}


-- not member vraci, zda prvek neni v seznamu
notMember :: (Eq a) => a -> [a] -> Bool
notMember _ [] = True
notMember y (x:xs)
        | y==x = False
        | otherwise = notMember y xs

-- resi danou ulohu
solve3 :: [Int] -> Int -> [Int]
solve3 xs k = take k [x | x <- [1..], x `notMember` xs]

-- testy
solve3_test1 = solve3 [8,25,4,7,12,2,1,23] 16
solve3_test2 = solve3 [1,2,3,4,5,6,8,9,10] 1
solve3_test3 = solve3 [] 12




-- 4. 1-2 STROMY ---------------------------------------------------------------

{-
Haskell: mam datovy typ reprezentujici 1-2 strom:

data T1 a = Nil | N1 a (T1 a) | N2 a (T1 a) (T1 a)

Ukolem je napsat funkci fold typu:

b -> (a -> b -> b) -> (a -> b -> b -> b) -> T1 a -> b

a funkci hodnota, ktera pomoci funkce fold projde zadany strom a vrati seznam 
hodnot z konstruktoru N2 v poradi preorder - tj. vsechny hodnoty z vrcholu, 
ktere maji dva potomky

Hint:
V tomto pripade byla fold definovana takto:

fold::b->(a->b->b)->(a->b->b->b)->T1 a->b

b nahradi vrcholy konstruovane Nil
na vrchol s konstruktorem N1 a (T1 a) zavola funkci (a->b->b)
a na N2 a (T1 a) (T1 a) zavola funkci (a->b->b->b) 
-}


data T1 a = NilX | N1 a (T1 a) | N2 a (T1 a) (T1 a) deriving (Show, Eq)

-- funkce fold (=svinovani)
fold :: b -> (a -> b -> b) -> (a -> b -> b -> b) -> (T1 a) -> b
fold fNil fN1 fN2 NilX = fNil
fold fNil fN1 fN2 (N1 val next) = fN1 val (fold fNil fN1 fN2 next)
fold fNil fN1 fN2 (N2 val left right) = fN2 val (fold fNil fN1 fN2 left) (fold fNil fN1 fN2 right)

-- funkce hodnota pomoci fold
hodnota :: (T1 a) -> [a]
hodnota = fold [] (\ _ xs -> xs) (\ x xs ys -> (x:xs)++ys)


-- pro lepsi pochopeni jeste funkce pro seznam hodnot ve VSECH vrcholech
hodnota_all :: (T1 a) -> [a]
hodnota_all = fold [] (\ x xs -> (x:xs)) (\ x xs ys -> (x:xs)++ys)

-- testovaci strom

t12_t1 :: (T1 Int)
t12_t1 = N1 20 
         (
           N2 13
           (
             N2 1
             (
               N2 21 
               (
                 N1 9 NilX
               )
               (
                 N1 11 
                 (
                   N1 8 NilX
                 )
               )
             )
             (
               N1 2 
               (
                 N1 5 NilX
               )
             )
           )
           (
             N1 4
             (
               N1 8
               (
                 N1 7 NilX
               ) 
             )
           )
         )

{-
 take se da zapsat jako

N1 20 (N2 13 (N2 1 (N2 21 (N1 9 NilX) (N1 11 (N1 8 NilX))) (N1 2 (N1 5 NilX))) 
(N1 4 (N1 8 (N1 7 NilX))))
-}

-- testy 
t12_test1 = hodnota t12_t1
        



-- 5. BATOH --------------------------------------------------------------------

{-
 Je dan seznam A cislo N. Napiste funkci, ktera zjisti, zda je mozne poscitat 
 (nektere) prvky seznamu, aby soucet vysel N.
-}

-- implementujeme funkci, ktera tento seznam vrati, dana uloha pak by byla 
-- pokud seznam neexistuje, vraci se []
batoh :: [Int] -> Int -> [Int]
batoh _ 0 = []
batoh [] _ = []
batoh (x:xs) n 
  | sum newBatoh1 == n = newBatoh1
  | sum newBatoh2 == n = newBatoh2
  | otherwise = []
        where newBatoh1 = x:(batoh xs (n-x))
              newBatoh2 = batoh xs n

-- testy
b1 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 34
b2 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 35
b3 = batoh [1,58,3,9,2,1,85,2,6,51,8,69,21] 60
b4 = batoh [2,4,8,16,32,64,128] 91
b5 = batoh [1,2,4,8,16,32,64,128] 91
b6 = batoh [1,5..] 91
b7 = batoh [1,1..] 654




-- 6. PERMUTACE USPORADANI -----------------------------------------------------

{-
 Je dan seznam A - seznam dvojic prvku, urcujici castecne usporadani. Vyrobte 
 seznam vsech permutaci puvodniho seznamu, ktere vyhovuji castecnemu 
 usporadani.
-}

-- vrati seznam bez jendoho prvku
without :: (Eq a) => [a] -> a -> [a]
without [] _ = []
without (x:xs) a 
  | a==x = xs `without` a 
  | otherwise = x:(xs `without` a)


-- not member vraci, zda prvek neni v seznamu
notMember1 :: (Eq a) => a -> [a] -> Bool
notMember1 _ [] = True
notMember1 y (x:xs)
        | y==x = False
        | otherwise = notMember1 y xs
 
-- ze seznamu prvku vylouci opakujici se prvky
uniq :: (Eq a) => [a] -> [a]
uniq [] = []
uniq (x:xs)
        | x `notMember1` xs = x:(uniq xs)
        | otherwise = uniq xs

-- vrati seznam prvku ze seznamu dvojic
tuplList :: (Eq a) => [(a,a)] -> [a]
tuplList [] = []
tuplList ((one,two):xs) = uniq (one:two:(tuplList xs))

-- vytvori seznam vsech permutaci prvku
perm :: (Eq a) => [a] -> [[a]]
perm [] = [[]]
perm xs = [one:others | one <- xs, others <- (perm (xs `without` one)) ]

-- vrati suffix seznamu od zadaneho prvku 
upto :: (Eq a) => [a] -> a -> [a]
upto [] _ = []
upto (x:xs) a
        | x==a = [x]
        | otherwise = x:(xs `upto` a)

-- overi, zda permutace splnuje podminky usporadani
validone :: (Eq a) => [a] -> (a,a) -> Bool
validone p (a,b) = b `notMember1` (p `upto` a)

valid :: (Eq a) => [a] -> [(a,a)] -> Bool
valid p [] = True
valid p (cond:conds) = validone p cond && valid p conds

-- vyresi ulohu tak, ze ze seznamu dvojic udela seznam prvku, z nej vytvori
-- vsechny permutace, ktere pak prefiltruje pres podminky usporadani
permus :: (Eq a) => [(a,a)] -> [[a]]
permus a = [p | p <- perm (tuplList a), valid p a]

-- testy
perm_test1 = permus [(1,2),(17,18),(16,17)]




-- 7. PREVOD N-ARNI -> BINARNI -------------------------------------------------

{-
 Sestavte funkci realizujici kanonickou reprezentaci obecneho stromu pomoci
 binarniho ("levy syn" = prvorozeny syn, "pravy syn" = mladsi bratr).
-}

-- datova struktura

data TreeN a = NodeN a [TreeN a] deriving (Eq, Show)
data TreeB a = NilB | NodeB a (TreeB a) (TreeB a) deriving (Eq, Show)


-- 
convNBs :: (Eq a) => [TreeN a] -> (TreeB a)
convNBs [] = NilB
convNBs [NodeN a []] = NodeB a NilB NilB 
convNBs [NodeN a [x]] = NodeB a NilB (convNB x)
convNBs [NodeN a xs] = NodeB a (convNBs xs) NilB
convNBs ((NodeN a xs):ts) = NodeB a (convNBs xs) (convNBs ts)

--
convNB :: (Eq a) => (TreeN a) -> (TreeB a)
convNB tree = convNBs [tree]

-- testovaci data

treeN1 :: TreeN Int
treeN1 = NodeN 10
         [
           NodeN 5
           [
             NodeN 2 [],
             NodeN 7 []
           ],
           NodeN 7
           [
             NodeN 10 []
           ],
           NodeN 12 [],
           NodeN 3
           [
             NodeN 18 [],
             NodeN 1 [],
             NodeN 40 []
           ]
         ]

{-
 take se da zapsat jako 

 NodeN 10 [NodeN 5 [NodeN 2 [],NodeN 7 []],NodeN 7 [NodeN 10 []],NodeN 12 [],
 NodeN 3 [NodeN 18 [],NodeN 1 [],NodeN 40 []]]
-}

treeN2 :: TreeN Int
treeN2 = NodeN 10
         [
           NodeN 5 
           [
             NodeN 4 [],
             NodeN 1 []
           ],
           NodeN 7 [],
           NodeN 2 []
         ]


-- testy

treeNB_t1 = convNB treeN1
treeNB_t2 = convNB treeN2




-- 8. PRUCHOD KANONICKOU REPREZENTACI ------------------------------------------

{-
 Naprogramujte funkci, ktera na zaklade kanonicke reprezentace obecneho stromu 
 pomoci binarniho stromu vyda seznam vznikly pruchodem puvodniho obecneho 
 stromu do sirky.
-}

-- datova struktura - shodna s predchozi ulohou
{-
data TreeN a = NodeN a [TreeN a] deriving (Eq, Show)
data TreeB a = NilB | NodeB a (TreeB a) (TreeB a) deriving (Eq, Show)
-}

-- vraci value X (hodnotu v uzlu)
getVal :: (TreeB a) -> a
getVal (NodeB a _ _) = a

-- vraci leveho syna 
getLeft :: (TreeB a) -> (TreeB a)
getLeft (NodeB _ left _) = left

-- vraci praveho syna 
getRight :: (TreeB a) -> (TreeB a)
getRight (NodeB _ _ right) = right

-- reseni ulohy podle schematu: 
-- 1) je-li fronta prazda -> konec, jinak odeber X prvek z fronty 
-- 2) jestlize X==NilB jdi na 1) jinak na 3)
-- 3) dej value X na vystup (hodnota v uzlu)
-- 4) vloz left X do fronty a pro X:=right X proved 2)
--    rekurze pro right X je trikova pomoci zarazeni right X na zacatek fronty
--    a zavolani 1) tudiz se vlastne provede 2) pro right X

tKBFSq :: (Eq a) => [TreeB a] -> [a]
tKBFSq [] = []
tKBFSq (x:xs)
        | x==NilB = tKBFSq xs
        | otherwise = [getVal x]++(tKBFSq ([getRight x] ++ xs ++ [getLeft x]))

-- zavola funkci s frontou o jednom prvku
tKBFS :: (Eq a) => (TreeB a) -> [a]
tKBFS tree = tKBFSq [tree]

-- testovaci data 
treeBK1 :: TreeB Int
treeBK1 = NodeB 10 
          (
            NodeB 5 
            (
              NodeB 2 
              NilB 
              (
                NodeB 7 NilB NilB
              )
            ) 
            (
              NodeB 7 
              (
                NodeB 10 NilB NilB
              ) 
              (
                NodeB 12 
                NilB 
                (
                  NodeB 3 
                  (
                    NodeB 18 
                    NilB 
                    (
                      NodeB 1 
                      NilB 
                      (
                        NodeB 40 NilB NilB
                      )
                    )
                  ) 
                  NilB
                )
              )
            )
          ) NilB

{-
 take se da napsat jako

 NodeB 10 (NodeB 5 (NodeB 2 NilB (NodeB 7 NilB NilB)) (NodeB 7 (NodeB 10 NilB 
 NilB) (NodeB 12 NilB (NodeB 3 (NodeB 18 NilB (NodeB 1 NilB (NodeB 40 NilB 
 NilB))) NilB)))) NilB

 nebo jako vysledek predchozi ulohy

treeNB_t1
-}

-- testy

tKBFS_t1 = tKBFS treeBK1
tKBFS_t2 = tKBFS treeNB_t1
tKBFS_t3 = tKBFS treeNB_t2




-- 9. OPERACE NAD FUNKCI APL ---------------------------------------------------

{-
 Definujte funkci apl se ctyrmi parametry:
   S ... seznam prvku nejakeho typu
   f ... unarni funkce aplikovatelna na prvky tohoto typu
   g ... binarni (vlevo asociativni) funkce aplikovatelna na prvky tohoto typu
   p ... pocatecni hodnota

 Funkce apl "provede funkci f na vsechny prvky seznamu S, za takto vznikly 
 seznam pripoji prvek p a spocita vysledek, ktery vznikne tim, ze do vsech 
 mezer noveho seznamu vlozime funkci g". (To neni navod k programovani, 
 ale popis funkce.)

 Na zaklade funkce apl vytvorte nasledujici funkce:
   a) minimum prvku z neprazdneho seznamu
   b) aritmeticky prumer z prvku neprazdneho seznamu
   c) geometricky prumer z prvku neprazdneho seznamu (n-ta odmocnina ze soucinu 
      jeho prvku - n je delka seznamu.)
   d) harmonicky prumer z prvku neprazdneho seznamu (druha odmocnina ze souctu 
      druhych mocnin jeho prvku)

 Navod: Maji funkce b) az d) neco spolecneho?
-}

{-
 zrejme tedy 

apl [1,2,3] (*3) (+) 100

udela seznam 

[3,6,9]

potom nasklada funkce g:

(((3 + 6) + 9) + 100)

a vysledek tedy bude 

118
-}

-- funkce apl je slozeni foldl a map
apl :: [a] -> (a -> a) -> (a -> a -> a) -> a -> a
apl s f g p = foldl g p (map f s)

-- minimum prvku z neprazdneho seznamu
aplMin :: (Ord a) => [a] -> a
aplMin (x:xs) = apl xs (\ x -> x) (min) x

-- aritmeticky prumer z prvku neprazdneho seznamu
aplAvA :: (Fractional a) => [a] -> a
aplAvA (x:xs) = apl xs (\ y -> y/lxs) (+) (x/lxs)
        where lxs = fromInt (length (x:xs))

-- geometricky prumer z prvku neprazdneho seznamu
aplAvG :: [Double] -> Double
aplAvG (x:xs) = apl xs (\ y -> y**(1/lxs)) (*) (x**(1/lxs))
        where lxs = fromInt (length (x:xs))

-- harmonicky prumer z prvku neprazdneho seznamu
aplAvH :: [Double] -> Double
aplAvH (x:xs) = sqrt (apl xs (\ y -> y**2) (+) (x**2))
        where lxs = fromInt (length (x:xs))

-- testy

apl_t1 = apl [1,2,3] (*3) (+) 100
apl_t2 = aplMin [4,1,3,6,5,-3,2,6,0]
apl_t3 = aplAvA [5,9,1,0,4,5]
apl_t4 = aplAvG [16,9,12]
apl_t5 = aplAvH [3,5,4,10]              -- = 12.24




-- 10. CETNOST SLOV ------------------------------------------------------------

{-
Typ string je definovan takto: type String = [Char]. Krome zapisu 
['a','n','n','a'] muzeme ekvivalentne psat i "anna". Naprogramujte funkci, 
ktera dostane jako vstup string Doc (ktery pro jednoduchost muze obsahovat 
jen mala pismena anglicke abecedy, znak \n a znak mezera) a cislo N a vyrobi 
z nej "abecedni index vyskytu slov delky alespon N na radcich" dokumentu Doc, 
tj. provede s nim nasledujici operace (budeme je demonstrovat na priklade):

Doc=="jak kul husar\nluk\nstal jak\n\nkul v plote\nuz jsem zase v tom"

N==3

  a) Rozdeli vstupni string doc na posloupnost radek (stringu) Lines
     (radky jsou oddeleny znakem \n)

     ["jak kul husar", "luk", "stal jak", [], "kul v plote",
      "uz jsem zase v tom"]


  b) Radky v seznamu Lines ocisluje - vystupem bude tedy seznam dvojic 
     (cisloradky, radka)

     [(1, "jak kul husar"), (2, "luk"), (3, "stal jak"), (4, ""),
      (5, "kul v plote"), (6, "uz jsem zase v tom")]


  c) Rozdeli kazdou radku na slova - vyda seznam dvojic (cisloradky, slovo)

     [(1, "jak"), (1, "kul"), (1, "husar"), (2, "luk"), (3, "stal"),
      (3, "jak"), (5, "kul"), (5, "v"), (5, "plote"), (6, "uz"),
      (6, "jsem"), (6, "zase"), (6, "v"), (6, "tom")]


  d) Usprada tento seznam podle druhe slozky - slova

     [(1, "husar"), (1, "jak"), (3, "jak"), (6, "jsem"), (1, "kul"), 
      (5, "kul"), (2, "luk"), (5, "plote"), (3, "stal"), (6, "tom")
      (6, "uz"), (5, "v"), (6, "v"), (6, "zase")]


  e) Prepracuje vstupni seznam na seznam dvojic
     (Slovo, SeznamCiselRadkuNaKterychSeTotoSlovoVyskytuje)

     [("husar", [1]), ("jak", [1,3]), ("jsem", [6]), ("kul", [1,5]),
      ("luk", [2]), ("plote", [5]), ("stal", [3]), ("tom", [6]),
      ("uz", [6]), ("v", [5,6]), ("zase", [6])]


  f) Vypusti slova kratsi nez vstupni parametr N (v priklade == 3)

     [("husar", [1]), ("jak", [1,3]), ("jsem", [6]), ("kul", [1,5]),
      ("luk", [2]), ("plote", [5]), ("stal", [3]), ("tom", [6]),
      ("zase", [6])]

-}

-- porovnani zacatku retezce s patternem
match :: String -> String -> Bool
match str pat = (take (length pat) str) == pat

-- ze stringu vybere string az do prvniho vyskytu patternu
upToStr :: String -> String -> String
upToStr "" _ = []
upToStr str@(x:xs) pat
        | str `match` pat = []
        | otherwise = x:(xs `upToStr` pat)

-- ze stringu vybere string po prvnim vyskytu patternu
fromStr :: String -> String -> String
fromStr str "" = str
fromStr "" _ = []
fromStr str@(x:xs) pat@(y:ys)
        | str `match` pat = xs `fromStr` ys
        | otherwise = (xs `fromStr` pat)


-- cast a)
makeLines :: String -> String -> [String]
makeLines [] _ = []
makeLines doc delim = [(doc `upToStr` delim)] ++ (makeLines (doc `fromStr` delim) delim)

-- cast b)
numberLines :: [String] -> [(Int,String)]
numberLines lines = numLines 1 lines

-- reseni b) s akumulatorem cisel
numLines :: Int -> [String] -> [(Int,String)]
numLines _ [] = []
numLines n (x:xs) = [(n,x)] ++ numLines (n+1) xs

-- cast c)
splitLines :: [(Int,String)] -> [(Int,String)]
splitLines [] = []
splitLines ((n,str):xs) = map ((,) n) (makeLines str " ") ++ splitLines xs

-- cast d)
sortPairs :: [(Int,String)] -> [(Int,String)]
sortPairs [] = []
sortPairs ((j,s):xs) = (sortPairs [(i,r) | (i,r) <- xs, r<s])
                    ++ [(j,s)] 
                    ++ (sortPairs [(k,t) | (k,t) <- xs, s<=t])

-- cast e) 
joinPairLists :: [(String,[Int])] -> [(String,[Int])]
joinPairLists [] = []
joinPairLists ((s,i):(t,j):xs)
        | s==t = joinPairLists ([(s,i ++ j)] ++ xs)
        | otherwise = [(s,i)] ++ joinPairLists ((t,j):xs)
joinPairLists xs = xs

joinPairs :: [(Int,String)] -> [(String,[Int])]
joinPairs xs = joinPairLists (map (\ (i,s) -> (s,[i])) xs)

-- cast f)
cutShorts :: [(String,[Int])] -> Int -> [(String,[Int])]
cutShorts [] _ = []
cutShorts ((s,i):xs) n
        | length(s) < n = cutShorts xs n
        | otherwise = [(s,i)] ++ (cutShorts xs n)

-- reseni je primocare zkombinovani vsech sesti casti
wordFreq :: String -> Int -> [(String,[Int])]
wordFreq doc n = cutShorts (joinPairs (sortPairs (splitLines (numberLines (makeLines doc "\n"))))) n

-- testovaci data
doc :: String
doc = "jak kul husar\nluk\nstal jak\n\nkul v plote\nuz jsem zase v tom"

-- testy
wF_t1 = makeLines doc "\n"
wF_t2 = numberLines wF_t1
wF_t3 = splitLines wF_t2
wF_t4 = sortPairs wF_t3
wF_t5 = joinPairs wF_t4
wF_t6 = cutShorts wF_t5 3
wF_t7 = wordFreq doc 3




-- 11. VYPOUSTENI BVS UZLU -----------------------------------------------------

{-
 Definujeme prirozenou reprezentaci binarniho stromu, v jehoz uzlech je
 ulozena informace nejakeho typu (podtridy Ord).
 Naprogramujte funkci, ktera z BVS vypusti uzel se zadanou hodnotou.
-}

-- jedna se o lehci variantu ulohy 2.


-- THE END ---------------------------------------------------------------------