Při mém studiu programovacích jazyků a programování obecně jsem se často setkával s problémem, že jsem neměl k dispozici příklady, které by byly "těžké tak akorát". Proto jsem se vlastně rozhodl vytvořit tyhle stránky. Příklady, které sem budu postupně dávat jsou převážně moje přípravy na písemky. Jsou obtížností takové, aby Šli snadno pochopit, a zároveň aby nebyly zcela triviální (teda alespoň pro mě :-). Užijte si to.
erostatenes::[Int]
erostatenes = 2:sito[3,5..]
sito (a:x) = (a:sito[y| y<-x,(y `mod` a >0) ])
-- fibonaciho cisla
fib2 = 1:1:zipWith (+) fib2 (tail fib2)
-- pomocne predikaty by vypadali nejak takhle...
tail_::[a]->[a]
tail_ (x:xs) = xs
tail_ [] = error "empty list"
zipWithM::(a->b->c)->[a]->[b]->[c]
zipWithM _ [] _ = []
zipWithM _ _ [] = []
zipWithM f (x:xs) (y:ys) = (f x y) : zipWith f xs ys
n_ty::Int->[a]->a
n_ty 1 [] = error "unexpected end of list"
n_ty 1 (x:_) = x
n_ty m [] = error "unexpected end of list"
n_ty m (x:xs) = n_ty (m-1) xs
test::Int
test = n_ty 10 fib2
------------------------------------------------------------------------------------------
--operace s maticemi
--minus r [] = r
--minus []
--divide::[(a,a)]->[(a,a)]->[(a,a)]
--67
--mk_line::[[a]]->[a]
mk_line [] = []
mk_line ((x:zb) : xs) = (mk_line xs) ++ [x]
--cut_first::[[a]]->[[a]]
cut_first r = map tail r
rotate::[[a]]->[[a]]
rotate ([]:_) = []
rotate mat = mk_line mat : (rotate (cut_first mat))
--79
rev::[a]-> [a]
rev [] = []
rev (x:xs) = rev xs ++[x]
dvojrot::[[a]]->[[a]] -- transponuje namici
dvojrot mat = rev ( map rev mat)
--mk_line::[[a]]->[a]
mk_line2 [] = []
mk_line2 ((x:zb) : xs) = x:(mk_line2 xs)
transp ([]:_) = []
transp mat = (mk_line2 mat) : transp (cut_first mat)
---------------------------------------------------------------------------------------
--tautologie
-- Pomocny predikat na nelezeni vsech promennych ve formuli
vars :: Formula -> [String]
vars (PVar name) = [name]
vars (And p1 p2) = (vars p1 ++ vars p2)
vars (Or p1 p2) = (vars p1 ++ vars p2)
vars (Not p) = vars p
-- Vypocet hodnoty formule
truthValue :: Formula -> [(String, Bool)] -> Bool
truthValue (PVar name) env = my_lookup name env
truthValue (And p1 p2) env = truthValue p1 env && truthValue p2 env
truthValue (Or p1 p2) env = truthValue p1 env || truthValue p2 env
truthValue (Not p) env = not $ truthValue p env
-- Checks if a Formulaosition always is true
tautology :: Formula -> Bool
tautology p = and $ map (truthValue p) envs
where
envs = allEnvs $ vars p
allEnvs :: [String] -> [[(String, Bool)]]
allEnvs [] = [[]]
allEnvs (v:vs) = map ((v, True):) env' ++
map ((v, False):) env'
where
env' = allEnvs vs
my_lookup::(Eq a)=> a->[(a,b)]->b
my_lookup _ [] = error "not found in list!"
my_lookpu x ((a,b):xs)
| x==a = b
|otherwise = my_lookup x xs
---------------------------------------------------------------------------------------------------
--pascaluv trojuhelnik
--Tvori nekoncecny seznam seznamu.
--Jeho cleny jsou radky pascalova trojuhelnika
type Radek = [Int]
pascal::[Radek]
pascal =[1]: [zipWithM (+) x (0:x) ++[1] |x<-pascal ]
zipWithM::(a->b->c)->[a]->[b]->[c]
zipWithM _ [] _ = []
zipWithM _ _ [] = []
zipWithM f (x:xs) (y:ys) = (f x y) : zipWith f xs ys
----------------------------------------------------------------------------------------------------
--prevod stromu na kanonickou reprezentaci
--srandicky se stromy
-- obecny strom
data Tree a = Nil| Node a [Tree a] -- je tvoren hodnotou a Hromadou nasledovniku
data BTree a =BNil|Bnode a (BTree a) (BTree a)
-- z obecneho stromu vyrabi strom v kanonicke reprezentaci
zkanonizuj:: (Tree a)->(BTree a)
zkanonizuj a = kanon a []
kanon::(Tree a)-> [(Tree a)]->BTree a
kanon (Node a (x:xs)) (b:brothers) = Bnode a (kanon x xs) (kanon b brothers)
kanon (Node a []) (b:brothers) = Bnode a BNil (kanon b brothers)
kanon (Node a (x:xs)) [] = (Bnode a (kanon x xs) BNil)
kanon (Node a []) [] = (Bnode a BNil BNil)
---------------------------------------------------------------------------------------------------
--srandicky s ridkymi polynomy..
--definice typu
type Clen = (Float,Int)
type Polynom = [Clen]
expon::Float->Int->Float
expon _ 0 = 1.0
expon bod e = bod * expon bod (e-1)
hodnota::Float-> Polynom->Float
hodnota _ [] = 0
hodnota bod ((b,e):xs) = b*expon bod e + hodnota bod xs
--unarni minus
minus::Polynom->Polynom
minus [] = []
minus ((a,b):xs) = ((-a,b):minus xs)
odecteni::Polynom->Polynom->Polynom
nasobeni::Polynom->Clen->Polynom --clen je ruzdny od nuly
nasobeni [] _ = []
nasobeni ((a,b):xs ) (x,y) = (a*x,b+y):nasobeni xs (x,y)
--pouze pro ucely deleni...
odecteni x [] = x --prazdny seznam toho, co odecitame...
odecteni((a,b):xs) ((c,d):ys)
|b==d && a /=c = ((a-c, b): odecteni xs ys)
|b==d && a ==c = odecteni xs ys
|b>d = ((a, b): odecteni xs ((c,d):ys))
|b<d = ((-c, d): odecteni ((a,b):xs) ys)
odstran_prvni::Polynom->Polynom->Polynom -- odpovida jednomu zruseni prvniho clenu, delence, kdyz si to pisete normalne na papir...
odstran_prvni ((a,b):xs) ((x,y):ys) = odecteni ((a,b):xs) ( ((x,y):ys)`nasobeni` (a/x,b-y) )
-- deleni se zbytkem... nechodi tak jak ma, ale myslenka si myslim jde okoukat
d_z::Polynom->Polynom ->(Polynom,Polynom)
d_z [] x = ([],[])
d_z ((a,b):xs) ((c,d):ys)
| b < d = ( [],((a,b):ys) )
| b >= d = ([((a/c),(b-d))] ++ x,zbytek)
where new_poly = odstran_prvni ((a,b):xs) ((c,d):ys)
(x,zbytek) = d_z new_poly ((c,d):ys)
----------------------------------------------------------------------------------------------------
--stromy a operace s nimi...
--Definice Binarniho Vyhledavaciho Stromu
data BTree a = BNil | BNode a (BTree a) (BTree a)
--procedura vypust vypousti prvky z binarniho vyhledavaciho stromu v danem intervalu
vypust::Ord a=> (BTree a)->a->a->BTree a
vypust BNil _ _ = BNil
vypust (BNode x l p) a b
|x<a = (BNode x l (vypust p a b))
|x>b = (BNode x (vypust p a b) p)
|otherwise = smaz_koren (BNode x (vypust l a b) (vypust p a b))
--smaz koren vymaze vrchol ktery je v koreni stromu
smaz_koren::(BTree a )->(BTree a)
smaz_koren BNil = BNil
smaz_koren (BNode x BNil BNil) = BNil
smaz_koren (BNode x l BNil ) = l
smaz_koren (BNode x BNil r ) = r
smaz_koren (BNode x l r) --ma oba potomky
= (BNode a l r1)
where (a,r1) = nejlevejsi_z_praveho r
nejlevejsi_z_praveho (BNode x BNil p) = (x, p)
nejlevejsi_z_praveho (BNode x l p) = (a, (BNode x l1 p))
where (a,l1) = nejlevejsi_z_praveho l
--vrat_strom::BTree
--vrat_strom (BNode 10 (BNode 5 (BNode 2 BNil BNil) BNil) (BNode 15 (BNode 12 BNil BNil) BNil))
---------------------------------------------------------------------------------------------------
getWord::(Eq a)=>[a]->a->([a], [a])
getWord [] _ = ([], [])
getWord (x:xs) od
|x == od = ([], xs)
|otherwise = ((x:a), b)
where (a, b) = getWord xs od
parse::(Eq a)=>[a]->a->[[a]]
parse [] _ = []
parse r od = a:(parse c od)
where (a, c) = getWord r od
--ocisluj::(Eq a)=> [a]-> [(b,[a])]
ocisluj vstup = zip [1..] (parse vstup '\n')
--rozdel::(b,[a]) ->[(b,[a])]
rozdel (_ , []) = []
rozdel (r, line) = (r,b) : rozdel (r, c)
where (b, c) = getWord line ' '
ulohaC text = foldl (++) [] ( map rozdel (ocisluj text))
pokus::String->String->String
pokus s r
|s>r = s
|s < r = r
my_sort:: (Ord b) => [(a,b)]->[(a, b)]
my_sort [] = [];
my_sort ((nr,wd):xs) = my_sort[(a,b)| (a,b)<- xs, b<wd ] ++ [(nr, wd)] ++ my_sort[(a,b)| (a,b)<- xs, b>=wd ]
dokud_stejne::(Eq a)=>[(b,a)]-> ([(b,a)], [(b,a)])
dokud_stejne [] = ([], [])
dokud_stejne (m:[]) = ([m],[])
dokud_stejne ((x, y):((xs,ys):xss))
|y /= ys = ([(x,y)], ((xs,ys):xss))
|otherwise = ( (x,y): a, b)
where (a, b) = dokud_stejne ((xs,ys):xss)
del_na_seznamy::(Eq a)=>[(b,a)]-> [[(b,a)]]
del_na_seznamy [] = []
del_na_seznamy r = a: del_na_seznamy b
where (a,b) = dokud_stejne r
--slij_seznam [(b,a)] ->(a,[b])
slij_seznam ((ln,wd):[]) = (wd, [ln])
slij_seznam ((ln,wd):xs) = (a, ln:b)
where (a, b)= slij_seznam xs
--slij::(Eq a)=>[(b,a)]-> [(a,[b])]
slij r = map slij_seznam (del_na_seznamy r)
--vypust_kratka::[(String,[b])]-> [(a,[b]]
vypust_kratka n [] = []
vypust_kratka n ((a,b):xs)
|length a >=n = (a,b):(vypust_kratka n xs)
|otherwise = vypust_kratka n xs