|
|
| Line 1: |
Line 1: |
| | <syntaxhighlight lang="Haskell"> | | <syntaxhighlight lang="Haskell"> |
| − | import Data.Char
| |
| − |
| |
| | fact1 :: Int -> Int | | fact1 :: Int -> Int |
| | fact1 0 = 1 | | fact1 0 = 1 |
| | fact1 n = n * fact1 (n-1) | | fact1 n = n * fact1 (n-1) |
| | | | |
| − | fact2 :: Int -> Int
| |
| − | fact2 n | n==0 = 1
| |
| − | | otherwise = n * fact2 (n-1)
| |
| − |
| |
| − | fact3 :: Int -> Int
| |
| − | fact3 n = if n==0 then 1 else n * fact3 (n-1)
| |
| − |
| |
| − | fib :: Int -> Int
| |
| − | fib 0 = 0
| |
| − | fib 1 = 1
| |
| − | fib n = tmp n 0 1 where
| |
| − | tmp 1 _ b = b
| |
| − | tmp x a b = tmp (x-1) b (a+b)
| |
| − |
| |
| − | gcd' :: Int -> Int -> Int
| |
| − | gcd' a b | a > b = gcd' (a-b) b
| |
| − | | a < b = gcd' a (b-a)
| |
| − | | a==b = a
| |
| − |
| |
| − | gcd2 :: Int -> Int -> Int
| |
| − | gcd2 a 0 = a
| |
| − | gcd2 a b = gcd2 b (a `mod` b)
| |
| − |
| |
| − | isPrime :: Int -> Bool
| |
| − | isPrime 1 = False
| |
| − | isPrime y = isPrimeTest y (ceiling (sqrt (fromIntegral y)::Double))
| |
| − | where
| |
| − | isPrimeTest _ 1 = True
| |
| − | isPrimeTest n x | n `mod` x ==0 = False
| |
| − | | otherwise = isPrimeTest n (x-1)
| |
| − |
| |
| − | length' :: [a] -> Int
| |
| − | length' [] = 0
| |
| − | length' (_:xs) = 1 + length' xs
| |
| − |
| |
| − | sumIt :: [Int] -> Int
| |
| − | sumIt [] = 0
| |
| − | sumIt (x:xs) = x + sumIt xs
| |
| − |
| |
| − | getHead :: [a] -> a
| |
| − | getHead (x:_) = x
| |
| − |
| |
| − | getLast :: [a] -> a
| |
| − | getLast (x:xs) | length xs == 0 = x
| |
| − | | otherwise = getLast xs
| |
| − |
| |
| − | isElement :: Eq a => a -> [a] -> Bool
| |
| − | isElement _ [] = False
| |
| − | isElement a (x:xs) | a == x = True
| |
| − | | otherwise = isElement a xs
| |
| − |
| |
| − | getTail :: [a] -> [a]
| |
| − | getTail (_:xs) = xs
| |
| − |
| |
| − | getInit :: [a] -> [a]
| |
| − | getInit [_] = []
| |
| − | getInit (x:xs) = x : getInit xs
| |
| − |
| |
| − | combine :: [a] -> [a] -> [a]
| |
| − | combine [] y = y
| |
| − | combine (x:xs) y = x : combine xs y
| |
| − |
| |
| − | max' :: [Int] -> Int
| |
| − | max' [x] = x
| |
| − | max' (x:y:z) | x > y = max' (x:z)
| |
| − | | otherwise = max' (y:z)
| |
| − |
| |
| − | max2 :: [Int] -> Int
| |
| − | max2 (y:ys) = tmp y ys where
| |
| − | tmp a [] = a
| |
| − | tmp a (x:xs) | x > a = tmp x xs
| |
| − | |otherwise = tmp a xs
| |
| − |
| |
| − | reverse' :: [a] -> [a]
| |
| − | reverse' [] = []
| |
| − | reverse' (x:xs) = (reverse' xs) ++ [x]
| |
| − |
| |
| − | reverse'' :: [a] -> [a]
| |
| − | reverse'' n = tmp n []
| |
| − | where tmp [] ys = ys
| |
| − | tmp (x:xs) ys = tmp xs (x:ys)
| |
| − |
| |
| − | take' :: Int -> [a] -> [a]
| |
| − | take' 0 _ = []
| |
| − | take' _ [] = []
| |
| − | take' n (x:xs) = x: take' (n-1) xs
| |
| − |
| |
| − | drop' :: Int -> [a] -> [a]
| |
| − | drop' 0 x = x
| |
| − | drop' _ [] = []
| |
| − | drop' n (_:xs) = drop' (n-1) xs
| |
| − |
| |
| − | minimum' :: Ord a => [a] -> a -- Is this right?
| |
| − | minimum' [x] = x
| |
| − | minimum' (x:y:z) | x < y = minimum' (x:z)
| |
| − | | otherwise = minimum' (y:z)
| |
| − |
| |
| − | divisors :: Int -> [Int]
| |
| − | divisors n = tmp n where
| |
| − | tmp 0 = []
| |
| − | tmp x | n `mod` x == 0 = x: tmp (x-1)
| |
| − | | otherwise = tmp (x-1)
| |
| − |
| |
| − | divisors' :: Int -> [Int]
| |
| − | divisors' n = filter (\x -> n `mod` x == 0) [1..n]
| |
| − |
| |
| − | divisors'' :: Int -> [Int]
| |
| − | divisors'' n = [x | x<-[1..n], n `mod` x == 0]
| |
| − |
| |
| − | zipThem:: [a] -> [b] -> [(a,b)]
| |
| − | zipThem (x:xs) (y:ys) = (x,y) : zipThem xs ys
| |
| − | zipThem _ _ = []
| |
| − |
| |
| − | dotProduct :: [a] -> [b] -> [(a,b)]
| |
| − | dotProduct [] _ = []
| |
| − | dotProduct (x:xs) ys = tmp ys ++ dotProduct xs ys where
| |
| − | tmp [] = []
| |
| − | tmp (b:bs) = (x,b) : tmp bs
| |
| − |
| |
| − | dotProduct' :: [a] -> [b] -> [(a,b)]
| |
| − | dotProduct' xs ys = [(x,y)|x<-xs, y<-ys]
| |
| − |
| |
| − | dotProduct'' :: [a] -> [b] -> [(a,b)]
| |
| − | dotProduct'' x y =
| |
| − | zip (concat (map (replicate (length y)) x))
| |
| − | (concat (replicate (length x) y))
| |
| − |
| |
| − |
| |
| − | fibonacci :: Int -> Int
| |
| − | fibonacci n = fst (tmp n) where
| |
| − | fibStep (a,b) = (b,a+b)
| |
| − | tmp 0 = (0,1)
| |
| − | tmp x = fibStep (tmp (x-1))
| |
| − |
| |
| − | allToUpper :: String -> String
| |
| − | allToUpper xs = [toUpper x |x<-xs]
| |
| − |
| |
| − | allToUpper' :: String -> String
| |
| − | allToUpper' xs = map toUpper xs
| |
| − |
| |
| − | quicksort :: (Ord a) => [a] -> [a]
| |
| − | quicksort (x:xs) = let lp = filter (< x) xs
| |
| − | rp = filter (>= x) xs
| |
| − | in quicksort lp ++ [x] ++ quicksort rp
| |
| − |
| |
| − | oddList :: Int -> Int -> [Int]
| |
| − | oddList a b = [ x |x<-[a..b], odd x]
| |
| − |
| |
| − | removeAllUpper :: String -> String
| |
| − | removeAllUpper xs = [ x |x<-xs, not (isUpper x)]
| |
| − |
| |
| − | union :: Eq a => [a] -> [a] -> [a]
| |
| − | union xs ys = xs ++ [y| y<-ys, not (elem y xs)]
| |
| − |
| |
| − | intersection :: Eq a => [a] -> [a] -> [a]
| |
| − | intersection xs ys = [y| y<-ys, elem y xs]
| |
| − |
| |
| − | unique :: String -> String
| |
| − | unique n = reverse(tmp n "") where
| |
| − | tmp [] store = store
| |
| − | tmp (x:xs) store | x `elem` store = tmp xs store
| |
| − | | otherwise = tmp xs (x:store)
| |
| − |
| |
| − | unique' :: String -> String
| |
| − | unique' [] = []
| |
| − | unique' (x:xs) = x: unique' (filter (/=x)xs)
| |
| − |
| |
| − | countThem :: String -> [(Char, Int)]
| |
| − | countThem xs = let u = unique xs
| |
| − | in [(x, length (filter (==x) xs)) |x<-u]
| |
| − |
| |
| − | isPrime :: Int -> Bool
| |
| − | isPrime n = null [x |x<-[2..ceiling (sqrt (fromIntegral n)::Double)], n `mod` x == 0]
| |
| − |
| |
| − | goldbach :: Int-> [(Int, Int)]
| |
| − | goldbach n = let primes = [x |x<-[2..(n `div` 2)+1], isPrime x]
| |
| − | in [(x,n-x) |x<-primes, isPrime (n-x)]
| |
| − |
| |
| − | goldbachList :: Int -> Int-> Int -> [(Int, Int)]
| |
| − | goldbachList a b limit = filter (\(x,_)-> x>limit) [head (goldbach x) | x<-[a..b], even x]
| |
| − |
| |
| − | combinations :: Int -> String -> [String]
| |
| − | combinations 1 xs = [[x]| x<-xs]
| |
| − | combinations n (x:xs) | n == length (x:xs) = [(x:xs)]
| |
| − | |otherwise = [[x] ++ y |y<-combinations (n-1) xs ]
| |
| − | ++ (combinations n xs)
| |
| − |
| |
| − | not' :: Bool -> Bool
| |
| − | not' True = False
| |
| − | not' False = True
| |
| − | infixl 5 `not'`
| |
| − |
| |
| − | and' :: Bool -> Bool -> Bool
| |
| − | and' True True = True
| |
| − | and' _ _ = False
| |
| − | infixl 4 `and'`
| |
| − |
| |
| − | or' :: Bool -> Bool -> Bool
| |
| − | or' False False = False
| |
| − | or' _ _ = True
| |
| − | infixl 3 `or'`
| |
| − |
| |
| − | nand' :: Bool -> Bool -> Bool
| |
| − | nand' x y = not' (and' x y)
| |
| − | infixl 4 `nand'`
| |
| − |
| |
| − | xor' :: Bool -> Bool -> Bool
| |
| − | xor' x y = x/=y
| |
| − | infixl 3 `xor'`
| |
| − |
| |
| − | impl' :: Bool -> Bool -> Bool
| |
| − | impl' True False = False
| |
| − | impl' _ _ = True
| |
| − | infixl 2 `impl'`
| |
| − |
| |
| − | equ' :: Bool -> Bool -> Bool
| |
| − | equ' x y = x == y
| |
| − | infixl 7 `equ'`
| |
| − |
| |
| − | tablen :: Int -> ([Bool] -> Bool) -> IO ()
| |
| − | tablen n f = putStr(concat [show x ++ " -> " ++ show(f x) ++ "\n" |x<-allValues n]) where
| |
| − | allValues 1 = [[True], [False]]
| |
| − | allValues n = [x:y| x<-[True,False], y<-allValues (n-1)]
| |
| − |
| |
| − | huffman :: [(Char, Int)] -> [(Char, String)]
| |
| − | huffman input = let
| |
| − | prep = [ (y, [(x,"")] ) | (x,y)<-input]
| |
| − | in sortBy (\ (x,_) (y,_) -> compare x y) (step prep) where
| |
| − | step :: [(Int, [(Char, String)])] -> [(Char, String)]
| |
| − | step [(_, result) ] = result
| |
| − | step list = let ((a1, as2):(b1,bs2):rest) = sortBy (\ (x,_) (y,_) -> compare x y) list
| |
| − | in step ((a1+b1, [(x,'0':a2)|(x,a2)<-as2]++[(x,'1':b2)|(x,b2)<-bs2]) : rest)
| |
| − |
| |
| − | type Pic = [String]
| |
| − |
| |
| − | pic :: Pic
| |
| − | pic = [ "....#....",
| |
| − | "...###...",
| |
| − | "..#.#.#..",
| |
| − | ".#..#..#.",
| |
| − | "....#....",
| |
| − | "....#....",
| |
| − | "....#####"]
| |
| − |
| |
| − | pp :: Pic -> IO ()
| |
| − | pp x = putStr (concat (map (++"\n") x))
| |
| − |
| |
| − | flipV :: Pic -> Pic
| |
| − | flipV = map reverse
| |
| − |
| |
| − | flipV' :: Pic -> Pic
| |
| − | flipV' xs = [reverse x|x<-xs]
| |
| − |
| |
| − | flipH :: Pic -> Pic
| |
| − | flipH = reverse
| |
| − |
| |
| − | above :: Pic -> Pic -> Pic
| |
| − | above x y = x ++ y
| |
| − |
| |
| − | sideBySide :: Pic -> Pic -> Pic
| |
| − | sideBySide xs ys = map (\(x,y) -> x ++ y)(zip xs ys)
| |
| − |
| |
| − | sideBySide':: Pic -> Pic -> Pic
| |
| − | sideBySide' (x:xs) (y:ys) = (x ++ y) : sideBySide' xs ys
| |
| − | sideBySide' _ _ = []
| |
| − |
| |
| − | sideBySide'' :: Pic -> Pic -> Pic
| |
| − | sideBySide'' = zipWith (++)
| |
| − |
| |
| − | toRow :: String -> Pic
| |
| − | toRow xs = map (\x -> [x]) xs -- [[x]|x<-xs]
| |
| − |
| |
| − | rotateR :: Pic -> Pic
| |
| − | rotateR [x] = toRow x
| |
| − | rotateR (x:xs) = (rotateR xs) `sideBySide` (toRow x)
| |
| − |
| |
| − | rotateR' :: Pic -> Pic
| |
| − | rotateR' x = foldl1 sideBySide (reverse (map toRow x))
| |
| − |
| |
| − |
| |
| − | rotateL :: Pic -> Pic
| |
| − | rotateL [x] = reverse(toRow x)
| |
| − | rotateL (x:xs) = reverse(toRow x) `sideBySide` (rotateL xs)
| |
| − |
| |
| − | rotateL' :: Pic -> Pic
| |
| − | rotateL' x = foldl1 sideBySide (map (reverse.toRow) x)
| |
| − |
| |
| − | zoom :: Int -> Pic -> Pic
| |
| − | zoom n xs = [concat(map (replicate n) x)|x<-concat (map (replicate n) xs)]
| |
| − |
| |
| − | data Expr = Num Int
| |
| − | | Add Expr Expr
| |
| − | | Sub Expr Expr
| |
| − | | Mul Expr Expr
| |
| − | | Div Expr Expr
| |
| − | | Var Char
| |
| − | deriving (Eq)
| |
| − |
| |
| − | testExpr1 :: Expr
| |
| − | testExpr1 = Sub (Num 1) (Add (Num 2) (Num 3))
| |
| − |
| |
| − | testExpr2 :: Expr
| |
| − | testExpr2 = Add (Mul (Add (Num 1) (Num 2)) (Add (Num 4) (Var 'x')))
| |
| − | (Mul (Num 1) (Var 'x'))
| |
| − |
| |
| − | eval :: Expr -> Int
| |
| − | eval (Num x) = x
| |
| − | eval (Add l r) = (eval l) + (eval r)
| |
| − | eval (Sub l r) = (eval l) - (eval r)
| |
| − | eval (Mul l r) = (eval l) * (eval r)
| |
| − | eval (Div l r) = (eval l) `div` (eval r)
| |
| − |
| |
| − | showExpr :: Expr -> String
| |
| − | showExpr expr = showExpr' expr NoOp
| |
| − |
| |
| − | data Operation = Hi | HiDiv | Lo | LoSub | NoOp deriving (Eq)
| |
| − |
| |
| − | showExpr' :: Expr -> Operation -> String
| |
| − | showExpr' (Num x) _ = show x
| |
| − | showExpr' (Var x) _ = [x]
| |
| − | showExpr' (Add l r) op = let
| |
| − | x = showExpr' l Lo ++"+"++showExpr' r Lo
| |
| − | in if op == Hi || op == HiDiv || op==LoSub
| |
| − | then "(" ++ x ++")"
| |
| − | else x
| |
| − | showExpr' (Sub l r) op = let
| |
| − | x = showExpr' l Lo ++"-"++showExpr' r LoSub
| |
| − | in if op == Hi || op == HiDiv || op==LoSub
| |
| − | then "(" ++ x ++")"
| |
| − | else x
| |
| − | showExpr' (Mul l r) op = let
| |
| − | x = showExpr' l Hi ++"*"++showExpr' r Hi
| |
| − | in if op == HiDiv
| |
| − | then "(" ++ x ++")"
| |
| − | else x
| |
| − | showExpr' (Div l r) _ = showExpr' l Hi ++"/"++showExpr' r HiDiv
| |
| − |
| |
| − | instance (Show Expr) where
| |
| − | show = showExpr
| |
| − |
| |
| − | deriv :: Expr-> Char -> Expr
| |
| − |
| |
| − | deriv (Num _) _ = (Num 0)
| |
| − | deriv (Var x) y | x==y = (Num 1)
| |
| − | | otherwise = (Num 0)
| |
| − | deriv (Add l r) x = Add (deriv l x) (deriv r x)
| |
| − | deriv (Sub l r) x = Sub (deriv l x) (deriv r x)
| |
| − | deriv (Mul l r) x = Add (Mul (deriv l x) r) (Mul l (deriv r x))
| |
| − | deriv (Div l r) x =
| |
| − | Div
| |
| − | (Sub (Mul (deriv l x) r) (Mul l (deriv r x)))
| |
| − | (Mul r r)
| |
| − |
| |
| − | data Tree a = Leaf a
| |
| − | | Branch a (Tree a) (Tree a) deriving (Show)
| |
| − |
| |
| − | testTree1 :: Tree Int
| |
| − | testTree1 = Branch 123 (Branch 234 (Leaf 34) (Leaf 4)) (Leaf 5555)
| |
| − |
| |
| − | testTree2 :: Tree Char
| |
| − | testTree2 = Branch 'a' (Branch 'b' (Leaf 'c') (Leaf 'd')) (Leaf 'e')
| |
| − |
| |
| − | sum' :: Tree Int -> Int
| |
| − | sum' (Leaf x) = x
| |
| − | sum' (Branch x l r) = sum' l + x + sum' r
| |
| − |
| |
| − | toList :: Tree a -> [a]
| |
| − | toList (Leaf x) = [x]
| |
| − | toList (Branch x l r) = toList l ++ [x] ++ toList r
| |
| − |
| |
| − | toString :: Show a => Tree a -> String
| |
| − | toString (Leaf x) = show x
| |
| − | toString (Branch x l r) = show x ++ "(" ++ (toString l) ++ "," ++ (toString r) ++ ")"
| |
| − |
| |
| − | fromString :: Read a => String -> Tree a
| |
| − | fromString inp = fst (fromString' inp)
| |
| − |
| |
| − | fromString' :: Read a => String -> (Tree a,String)
| |
| − | fromString' inp =
| |
| − | let
| |
| − | before = takeWhile (\x -> x /='(' && x /=',' && x/=')') inp
| |
| − | after = dropWhile (\x -> x /='(' && x /=',' && x/=')') inp
| |
| − | value = read before
| |
| − | in if null after || head after /= '(' then (Leaf value, after) else
| |
| − | let
| |
| − | (l,after') = fromString' (tail after)
| |
| − | (r,after'') = fromString' (tail after')
| |
| − | in (Branch value l r, tail after'')
| |
| | </syntaxhighlight> | | </syntaxhighlight> |
