Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- module Main where
- import Lib
- import Data.Char
- import Prelude
- import Text.Printf
- main :: IO ()
- main = someFunc
- qsort [] = []
- qsort (x:xs) = qsort smaller ++ [x] ++ qsort larger
- where
- smaller = [a | a <- xs, a <= x]
- larger = [b | b <- xs, b > x]
- --qsort [3,5,1,4,2]
- seqn :: [IO a] -> IO [a]
- seqn [] = return []
- seqn (act:acts) = do x <- act
- xs <- seqn acts
- return (x:xs)
- factorial n = product [1..n]
- average ns = sum ns `div` length ns
- add x y = x + y
- -- Pattern matching
- --(&&) :: Bool -> Bool -> Bool
- --True && True = True
- --_ && _ = False
- -- lambda expressions
- a = \ x -> x + x
- addL :: Int -> (Int -> Int)
- addL = \ x -> \ y -> x + y
- add2 = addL 2
- -- function declaration is right associative
- -- function application is left associative
- -- luhn algorithm
- luhnDouble :: Int -> Int
- luhnDouble x = y - (if y > 9 then 9 else 0) where y = x * 2
- --luhn :: Int -> Int -> Int -> Int -> Bool
- --luhn a b c d = sum (map luhnDouble [a,c]) `mod` 10 == 0
- -- guards
- --find :: Eq a => a -> [(a,b)] -> [b]
- --find k t = [v | (k', v) <- t, k == k']
- -- zip
- pairs :: [a] -> [(a,a)]
- pairs xs = zip xs (tail xs)
- sorted :: Ord a => [a] -> Bool
- sorted xs = and [x <= y | (x,y) <- pairs xs]
- positions :: Eq a => a -> [a] -> [Int]
- positions x xs = [i | (x', i) <- zip xs [0..], x == x']
- -- Caesar Cipher
- let2int :: Char -> Int
- let2int c = ord c - ord 'a'
- int2let :: Int -> Char
- int2let n = chr (ord 'a' + n)
- shift :: Int -> Char -> Char
- shift n c | isLower c = int2let ((let2int c + n) `mod` 26)
- | otherwise = c
- --encode :: Int -> String -> String
- --encode n xs = [shift n x | x <- xs]
- percent :: Int -> Int -> Float
- percent n m = (fromIntegral n / fromIntegral m) * 100
- count :: Eq a => a -> [a] -> Int
- count x xs = sum [1 | x' <- xs, x == x']
- lowers :: String -> Int
- lowers xs = length [x | x <- xs, isAsciiLower x]
- freqs :: String -> [Float]
- freqs xs = [percent (count x xs) n | x <- ['a'..'z']]
- where
- n = lowers xs
- -------------
- -- Recursion
- -- Some of the implementations are commented because they are
- -- overriding the existing definitions in scope
- -------------
- fac :: Int -> Int
- fac 0 = 1
- fac n = n * fac(n-1)
- --product :: Num a => [a] -> a
- --product [] = 1
- --product (n:ns) = n * product ns
- --length :: [a] -> Int
- --length [] = 0
- --length (_:xs) = 1 + length xs
- --reverse :: [a] -> [a]
- --reverse [] = []
- --reverse (x:xs) = reverse(xs) ++ [x]
- -- commented because above qsort code is using system ++
- --(++) :: [a] -> [a] -> [a]
- --[] ++ ys = ys
- --(x:xs) ++ ys = x : (xs :: ys)
- insert :: Ord a => a -> [a] -> [a]
- insert x [] = [x]
- insert x (y:ys) | x <= y = x : y : ys
- | otherwise = y : insert x ys
- isort :: Ord a => [a] -> [a]
- isort [] = []
- isort (x:xs) = insert x (isort xs)
- -- multiple arguments
- --zip :: [a] -> [b] -> [(a,b)]
- --zip [] _ = []
- --zip _ [] = []
- --zip (x:xs) (y:ys) = (x,y) : zip xs ys
- --drop :: Int -> [a] -> [a]
- --drop 0 xs = xs
- --drop _ [] = []
- --drop n (_:xs) = drop (n-1) xs
- fib :: Int -> Int
- fib 0 = 0
- fib 1 = 1
- fib n = fib (n-2) + fib(n-1)
- -- mutual recursion
- --even :: Int -> Bool
- --even 0 = True
- --even n = odd (n-1)
- --
- --odd :: Int -> Bool
- --odd = False
- --odd n = even (n + 1)
- evens :: [a] -> [a]
- evens [] = []
- evens (x:xs) = x : odds xs
- odds :: [a] -> [a]
- odds [] = []
- odds (x:xs) = evens xs
- -------------------------
- -- Higher order functions
- -------------------------
- twice :: (a -> a) -> a -> a
- twice f x = f (f x)
- --map :: (a -> b) -> [a] -> b
- --map f xs = [f x | x <- xs]
- --filter :: (a -> Bool) -> [a] -> [a]
- --filter p xs = [x | x <- xs, p x]
- -- filter using recursion
- --filter p [] = []
- --filter p (x:xs) | p x = x : filter p xs
- -- | otherwise filter p xs
- --foldr :: (a -> b -> b) -> b -> [a] -> b
- --foldr f v [] = v
- --foldr f v (x:xs) = f x (foldr f v xs)
- --foldl :: (a -> b -> a) -> a -> [b] -> a
- --foldl f v [] = v
- --foldl f v (x:xs) = foldl f (f v x) xs
- --sum :: Num a => [a] -> a
- --sum = sum' 0
- -- where
- -- sum' v [] = v
- -- sum' v (x:xs) = sum' (v+x) xs
- --(.) :: (b -> c) -> (a -> b) -> (a -> c)
- --f . g = \x -> f (g x)
- type Bit = Int
- bin2int :: [Bit] -> Int
- bin2int bits = sum [w*b | (w,b) <- zip weights bits]
- where weights = iterate (*2) 1
- int2bin :: Int -> [Bit]
- int2bin 0 = []
- int2bin n = n `mod` 2 : int2bin(n `div` 2)
- make8 :: [Bit] -> [Bit]
- make8 bits = take 8 (bits ++ repeat 0)
- encode :: String -> [Bit]
- encode = concatMap (make8 . int2bin . ord)
- chop8 :: [Bit] -> [[Bit]]
- chop8 [] = []
- chop8 bits = take 8 bits : chop8 (drop 8 bits)
- decode :: [Bit] -> String
- decode = map (chr . bin2int) . chop8
- ------------------------------
- -- Declaring types and classes
- ------------------------------
- type Pair a = (a,a)
- type Assoc k v = [(k,v)]
- find :: Eq k => k -> Assoc k v -> v
- find k t = head [v | (k', v) <- t, k == k']
- data Move = North | South | East | West
- type Pos = (Int, Int)
- move :: Move -> Pos -> Pos
- move North (x,y) = (x, y+1)
- move South (x,y) = (x, y-1)
- move East (x,y) = (x+1, y)
- move West (x,y) = (x-1, y)
- data Shape = Circle Float | Rect Float Float
- area :: Shape -> Float
- area (Circle r) = pi * r^2
- area (Rect l b) = l * b
- safediv :: Int -> Int -> Maybe Int
- safediv _ 0 = Nothing
- safediv m n = Just (m `div` n)
- -- Natural Numbers
- data Nat = Zero | Succ Nat
- instance Show Nat where
- show Zero = "Zero"
- show (Succ m) = printf "Succ (%s)" (show m)
- nat2int :: Nat -> Int
- nat2int Zero = 0
- nat2int (Succ n) = 1 + nat2int n
- int2nat :: Int -> Nat
- int2nat 0 = Zero
- int2nat n = Succ (int2nat (n-1))
- add' :: Nat -> Nat -> Nat
- add' Zero n = n
- add' (Succ m) n = Succ (add' m n)
- addNat :: Nat -> Nat -> Nat
- addNat m n = int2nat (nat2int m + nat2int n)
- -- List
- data List' a = Nil | Cons a (List' a)
- len :: List' a -> Int
- len Nil = 0
- len (Cons _ xs) = 1 + len xs
- -- Tree
- data Tree a = Leaf a | Node (Tree a) a (Tree a)
- t :: Tree Int
- t = Node (Node (Leaf 1) 3 (Leaf 4))
- 5
- (Node (Leaf 6) 7 (Leaf 9))
- occurs :: Eq a => a -> Tree a -> Bool
- occurs x (Leaf y) = x == y
- occurs x (Node l y r) = (x == y) || occurs x l || occurs x r
- flatten :: Tree a -> [a]
- flatten (Leaf x) = [x]
- flatten (Node l x r) = flatten l ++ [x] ++ flatten r
- occurs' :: Ord a => a -> Tree a -> Bool
- occurs' x (Leaf y) = x == y
- occurs' x (Node l y r) | x == y = True
- | x < y = occurs x l
- | otherwise = occurs x r
- -- class
- class Bird a where
- eat, walk, fly :: () -> a
- -- Tautology checker
- data Prop = Const Bool
- | Var Char
- | Not Prop
- | And Prop Prop
- | Imply Prop Prop
- p1 :: Prop
- p1 = And (Var 'A') (Not (Var 'A'))
- p2 :: Prop
- p2 = Imply (And (Var 'A') (Var 'B')) (Var 'A')
- p3 :: Prop
- p3 = Imply (Var 'A') (And (Var 'A') (Var 'B'))
- p4 :: Prop
- p4 = Imply (And (Var 'A') (Imply (Var 'A') (Var 'B'))) (Var 'B')
- type Subst = Assoc Char Bool
- eval :: Subst -> Prop -> Bool
- eval _ (Const b) = b
- eval s (Var x) = find x s
- eval s (Not p) = not (eval s p)
- eval s (And p q) = eval s p && eval s q
- eval s (Imply p q) = eval s p <= eval s q
- vars :: Prop -> [Char]
- vars (Const _) = []
- vars (Var x) = [x]
- vars (Not p) = vars p
- vars (And p q) = vars p ++ vars q
- vars (Imply p q) = vars p ++ vars q
- bools :: Int -> [[Bool]]
- bools n = map (reverse . map conv . make n . int2bin) range
- where
- range = [0..(2^n)-1]
- make n bs = take n (bs ++ repeat 0)
- conv 0 = False
- conv 1 = True
- rmdups :: Eq a => [a] -> [a]
- rmdups [] = []
- rmdups (x:xs) = x : filter (/= x) (rmdups xs)
- substs :: Prop -> [Subst]
- substs p = map (zip vs) (bools (length vs))
- where vs = rmdups (vars p)
- isTaut :: Prop -> Bool
- isTaut p = and [eval s p | s <- substs p]
- -- Abstract Machine
- data Expr = Val Int | Add Expr Expr
- value :: Expr -> Int
- value (Val n) = n
- value (Add x y) = value x + value y
- type Cont = [Op]
- data Op = EVAL Expr | ADD Int
- eval' :: Expr -> Cont -> Int
- eval' (Val n) c = exec c n
- eval' (Add x y) c = eval' x (EVAL y : c)
- exec :: Cont -> Int -> Int
- exec [] n = n
- exec (EVAL y : c) n = eval' y (ADD n : c)
- exec (ADD n : c) m = exec c (n+m)
- value :: Expr -> Int
- value e = eval e []
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement