-- Jednoduche ukony se seznamem suma :: [Int] -> Int suma [] = 0 suma (x:xs) = x + suma xs posledni :: [a] -> a posledni (x:[]) = x posledni (x:xs) = posledni xs prostredni :: [a] -> a prostredni (x:[]) = x prostredni (x:_:[]) = x prostredni (x:y:xs) = prostr (y:xs) xs prostr :: [a] -> [a] -> a prostr (x:_) (_:[]) = x prostr (x:_) (_:_:[]) = x prostr (_:xs) (_:_:ys) = prostr xs ys mymax :: (Ord a) => [a] -> a mymax (x:[]) = x mymax (x:y:xs) | (x > y) = mymax (x:xs) | otherwise = mymax (y:xs) mymin :: (Ord a) => [a] -> a mymin (x:[]) = x mymin (x:y:xs) | (x < y) = mymin (x:xs) | otherwise = mymin (y:xs) -- Sort quickSort :: (Ord a) => [a] -> [a] quickSort []= [] quickSort (x:xs) = quickSort ([y|y<-xs, y=x]) mergeSort :: (Ord a) => [a] -> [a] mergeSort [] = [] mergeSort (x:[]) = [x] mergeSort x = merge (mergeSort(fst pulky)) (mergeSort(snd pulky)) where pulky = naPulky x naPulky :: (Ord a) => [a] -> ([a],[a]) naPulky [] = ([], []) naPulky (x:[]) = ([x],[]) naPulky (x:y:xs) = ((x:(fst z)), (y:(snd z))) where z = naPulky xs merge :: (Ord a) => [a] -> [a] -> [a] merge x [] = x merge [] x = x merge (x:xs) (y:ys) | (x < y) = (x:(merge xs (y:ys))) | otherwise = (y:(merge (x:xs) ys)) -- Seznam prvociselnych delitelu seznamDelitelu :: (Integral a, Enum a) => a -> [a] seznamDelitelu 1 = [1] seznamDelitelu 2 = [1,2] seznamDelitelu x | odd x = [1] ++ (eratosthen [y|y<-[3,5..floor(sqrt (fromIntegral x))], (mod x y) == 0]) | otherwise = [1,2] ++ (eratosthen [y|y<-[3,5..floor(sqrt (fromIntegral x))], (mod x y) == 0]) eratosthen :: (Integral a) => [a] -> [a] eratosthen [] = [] eratosthen (x:xs) = (x:(eratosthen (vyskrtejNasobky x xs))) vyskrtejNasobky :: (Integral a) => a -> [a] -> [a] vyskrtejNasobky _ [] = [] vyskrtejNasobky x (y:ys) | ((mod y x) == 0) = vyskrtejNasobky x ys | otherwise = (y:(vyskrtejNasobky x ys)) -- Graf a prochazeni do sirky data Uzel = Uz ID String [ID] type ID = Int type Graf = [Uzel] vypis :: [(ID, Int)] -> String vypis [] = "" vypis ((x, y):[]) = ("("++(show x)++", "++(show y)++")") vypis ((x, y):xs) = ("("++(show x)++", "++(show y)++"), ")++(vypis xs) uz1::Uzel uz1 = (Uz 1 "" [2, 3, 4]) uz2::Uzel uz2 = (Uz 2 "" [1, 4]) uz3::Uzel uz3 = (Uz 3 "" [5]) uz4::Uzel uz4 = (Uz 4 "" [1, 2, 3]) uz5::Uzel uz5 = (Uz 5 "" [3]) myG::Graf myG = [uz1, uz2, uz3, uz4, uz5] projdiDoSirky :: Graf -> ID -> [(ID, Int)] projdiDoSirky [] _ = [] projdiDoSirky g i = prochazejDoSirky g [(i, 0)] [] prochazejDoSirky :: Graf -> [(ID, Int)] -> [ID] -> [(ID, Int)] prochazejDoSirky _ [] _ = [] prochazejDoSirky g ((i, vz):is) y | (prvek i y) = prochazejDoSirky g is y | otherwise = (((idUzlu x), vz)):(prochazejDoSirky g (is ++ nove) (i:y)) where x = najdiUzel g i nove = zip (sousediUzlu x) (repeat (vz + 1)) prvek :: (Eq a) => a -> [a] -> Bool prvek _ [] = False prvek y (x:xs) | (y == x) = True | otherwise = prvek y xs najdiUzel :: Graf -> ID -> Uzel najdiUzel (u:us) id | (id == idUzlu u) = u | otherwise = najdiUzel us id idUzlu :: Uzel -> ID idUzlu (Uz id _ _) = id sousediUzlu :: Uzel -> [ID] sousediUzlu (Uz _ _ s) = s -- Nasledujici permutace naslPerm :: Ord a => [a] -> [a] naslPerm [] = [] naslPerm x = reverse vysledek where (ros, zbyt) = rostouci (reverse x) nv = nejmensiVetsi ros (prvniVetsi ros (head zbyt)) (head zbyt) ros2 = prohod ros nv (head zbyt) vysledek = ros2++(nv:(tail zbyt)) rostouci :: Ord a => [a] -> ([a], [a]) rostouci [] = ([], []) rostouci (x:[]) = ([], [x]) rostouci (x:y:xs) | (x < y) = ((x:ros), zb) | (x > y) = ([x], (y:xs)) where (ros, zb) = rostouci (y:xs) prohod :: Eq a => [a] -> a -> a -> [a] prohod [] _ _ = error "Dalsi permutace neexistuje" prohod (x:xs) a b | (x == a) = b:xs | otherwise = x:(prohod xs a b) nejmensiVetsi :: Ord a => [a] -> a -> a -> a nejmensiVetsi [] m _ = m nejmensiVetsi (x:xs) mezi hod | ((x > hod) && (x < mezi)) = nejmensiVetsi xs x hod | otherwise = nejmensiVetsi xs mezi hod prvniVetsi :: Ord a => [a] -> a -> a prvniVetsi [] a = a prvniVetsi (x:xs) a | (x > a) = x | otherwise = prvniVetsi xs a -- Generator pascalova trojuhelniku pascal :: Num a => [[a]] pascal = generujPasc [[1]] generujPasc :: Num a => [[a]] -> [[a]] generujPasc (x:[]) = x:(generujPasc [generujDalsi (0:x)]) generujPasc (x:xs) = x:(generujPasc xs) generujDalsi :: Num a => [a] -> [a] generujDalsi (x:[]) = [x] generujDalsi (x:y:xs) = (x + y):(generujDalsi (y:xs)) -- BVS a ruzne vylomeniny data (Ord a, Eq a) => BVS a = Null | Bvs (BVS a) a (BVS a) deriving Show postavBVSpreOrder :: (Ord a, Eq a) => [a] -> BVS a postavBVSpreOrder [] = Null postavBVSpreOrder (x:xs) = (Bvs levy x pravy) where levy = postavBVSpreOrder [y | y <- xs, y <= x] pravy = postavBVSpreOrder [y | y <- xs, y > x] postavBVSinOrder :: (Ord a, Eq a) => [a] -> BVS a postavBVSinOrder [] = Null postavBVSinOrder x = (Bvs levy h pravy) where (l, (h:p)) = naPoloviny x x levy = postavBVSinOrder l pravy = postavBVSinOrder p naPoloviny :: [a] -> [a] -> ([a], [a]) naPoloviny [] [] = ([], []) naPoloviny (x:xs) [] = ([], (x:xs)) naPoloviny (x:xs) (y1:[]) = ([], (x:xs)) naPoloviny (x:xs) (_:_:ys) = ((x:(fst z)), (snd z)) where z = naPoloviny xs ys postavBVSpostOrder :: (Ord a, Eq a) => [a] -> BVS a postavBVSpostOrder x = postavBVSpreOrder (reverse x) vypustPrvekBVS :: (Ord a, Eq a) => BVS a -> a -> BVS a vypustPrvekBVS Null _ = Null vypustPrvekBVS (Bvs Null h Null) a | (a == h) = Null | otherwise = (Bvs Null h Null) vypustPrvekBVS (Bvs Null h pravy) a | (a == h) = pravy | otherwise = (Bvs Null h (vypustPrvekBVS pravy a)) vypustPrvekBVS (Bvs levy h Null) a | (a == h) = levy | otherwise = (Bvs (vypustPrvekBVS levy a) h Null) vypustPrvekBVS (Bvs levy h pravy) a | (a > h) = (Bvs levy h (vypustPrvekBVS pravy a)) | (a < h) = (Bvs (vypustPrvekBVS levy a) h pravy) | otherwise = (Bvs (vypustPrvekBVS levy x) x pravy) where x = nejvetsiPrvekBVS levy nejvetsiPrvekBVS :: (Ord a, Eq a) => BVS a -> a nejvetsiPrvekBVS Null = error "Chyba - nenalezen nejvetsi prvek." nejvetsiPrvekBVS (Bvs _ x Null) = x nejvetsiPrvekBVS (Bvs _ _ pravy) = nejvetsiPrvekBVS pravy vypustPrvkyBVS :: (Ord a, Eq a) => BVS a -> [a] -> BVS a vypustPrvkyBVS Null _ = Null vypustPrvkyBVS bvs [] = bvs vypustPrvkyBVS bvs (x:xs) = vypustPrvkyBVS (vypustPrvekBVS bvs x) xs vypisBVSpreOrder :: (Ord a, Eq a) => BVS a -> [a] vypisBVSpreOrder Null = [] vypisBVSpreOrder (Bvs levy h pravy) = (h:(vypisBVSpreOrder levy))++(vypisBVSpreOrder pravy) vypisBVSinOrder :: (Ord a, Eq a) => BVS a -> [a] vypisBVSinOrder Null = [] vypisBVSinOrder (Bvs levy h pravy) = (vypisBVSinOrder levy)++(h:(vypisBVSinOrder pravy)) vypisBVSpostOrder :: (Ord a, Eq a) => BVS a -> [a] vypisBVSpostOrder Null = [] vypisBVSpostOrder (Bvs levy h pravy) = (vypisBVSpostOrder levy)++(vypisBVSpostOrder pravy)++[h] -- Polynomy type Polynom = [(Koef, Exp)] type Koef = Float type Exp = Int --soucet soucetP :: Polynom -> Polynom -> Polynom soucetP p [] = p soucetP [] q = q soucetP (p:ps) q = pricti p q1 where q1 = soucetP ps q pricti :: (Koef, Exp) -> Polynom -> Polynom pricti x [] = [x] pricti x@(k1, e1) (p@(k2, e2):ps) | (e1 == e2) = if ((k1 + k2) == 0) then ps else ((k1 + k2), e1):ps | otherwise = p:(pricti x ps) --rozdil rozdilP :: Polynom -> Polynom -> Polynom rozdilP p q = soucetP p (vynasob (-1, 0) q) --nasobeni nasobeniP :: Polynom -> Polynom -> Polynom nasobeniP [] q = [] nasobeniP (p:ps) q = soucetP (vynasob p q) q1 where q1 = nasobeniP ps q vynasob :: (Koef, Exp) -> Polynom -> Polynom vynasob _ [] = [] vynasob x@(k1, e1) (p@(k2, e2):ps) | ((k1 * k2) == 0) = vynasob x ps | otherwise = ((k1 * k2), (e1 + e2)):(vynasob x ps) --deleni (bohuzel je tam chyba, viz. deleniP [(1, 2), (-5, 1), (7, 0)] [(1, 1), (2, 0)]) deleniP :: Polynom -> Polynom -> (Polynom, Polynom) --delenec -> delitel -> (podil, zbytek) deleniP p q = vydel (sortP p) (sortP q) sortP :: Polynom -> Polynom sortP [] = [] sortP (x:[]) = [x] sortP (p@(_, e):ps) = (sortP [(k, e1) | (k, e1) <- ps, e <= e1])++(p:(sortP [(k, e1) | (k, e1) <- ps, e > e1])) vydel :: Polynom -> Polynom -> (Polynom, Polynom) vydel [] _ = ([], []) vydel p@(x:_) q@(y:_) | (e < 0) = ([(0, 0)], p) | otherwise = ((pricti pod podil), zbytek) where pod@(_, e) = najdiPodil x y (podil, zbytek) = (vydel (sortP (rozdilP p (vynasob pod q))) q) najdiPodil :: (Koef, Exp) -> (Koef, Exp) -> (Koef, Exp) najdiPodil (k1, e1) (k2, e2) | (k2 == 0) = error "Deleni nulou" | otherwise = (k1 / k2, e1 - e2)