{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
import Data1
import System.Random
isBST :: Ord a => BT a -> Bool
isBST Empty = True
isBST (Fork x l r) = allSmaller x l
&& allBigger x r
&& isBST l
&& isBST r
allSmaller :: Ord a => a -> BT a -> Bool
allSmaller x Empty = True
allSmaller x (Fork y l r) = y < x
&& allSmaller x l
&& allSmaller x r
allBigger :: Ord a => a -> BT a -> Bool
allBigger x Empty = True
allBigger x (Fork y l r) = y > x
&& allBigger x l
&& allBigger x r
isBST’ :: Ord a => BT a -> Bool
isBST’ t = isIncreasing(treeInOrder t)
isIncreasing :: Ord a => [a] -> Bool
isIncreasing [] = True
isIncreasing (x:[]) = True
isIncreasing (x:y:zs) = x < y && isIncreasing(y:zs)
occurs :: Ord a => a -> BT a -> Bool
occurs x Empty = False
occurs x (Fork y l r) = x == y
|| (x < y && occurs x l)
|| (x > y && occurs x r)
insert :: Ord a => a -> BT a -> BT a
insert x Empty = Fork x Empty Empty
insert x (Fork y l r) | x < y = Fork y (insert x l) r
| x > y = Fork y l (insert x r)
| otherwise = Fork y l r
insert’ :: Ord a => a -> BT a -> Maybe(BT a)
insert’ x Empty = Just(Fork x Empty Empty)
insert’ x (Fork y l r) | x < y = case insert' x l of
Nothing -> Nothing
Just l’ -> Just(Fork y l’ r)
| x > y = case insert’ x r of
Nothing -> Nothing
Just r’ -> Just(Fork y l r’)
| otherwise = Nothing
delete :: Ord a => a -> BT a -> BT a
delete x Empty = Empty — or you may prefer undefined (and even Nothing)
delete x (Fork y l r) | x < y = Fork y (delete x l) r
| x > y = Fork y l (delete x r)
| x == y && l == Empty = r
| x == y && r == Empty = l
| otherwise = Fork (largestOf l) (withoutLargest l) r
largestOf :: Ord a => BT a -> a
largestOf Empty = undefined
largestOf (Fork x l Empty) = x
largestOf (Fork x l r) = largestOf r
withoutLargest :: Ord a => BT a -> BT a
withoutLargest Empty = undefined
withoutLargest (Fork x l Empty) = l
withoutLargest (Fork x l r) = Fork x l (withoutLargest r)
randomInts :: [Int]
randomInts = randomRs (minBound,maxBound) (mkStdGen seed)
where seed = 42
inserts :: Ord a => [a] -> BT a -> BT a
inserts [] t = t
inserts (x:xs) t = inserts xs (insert x t)
aBigBST :: BT Int
aBigBST = inserts (take (10^6) randomInts) Empty
itsHeight = height aBigBST
itsSize = size aBigBST
itsBST = isBST aBigBST
itsBST’ = isBST’ aBigBST
deletes :: Ord a => [a] -> BT a -> BT a
deletes [] t = t
deletes (x:xs) t = deletes xs (delete x t)
aSmallerTree :: BT Int
aSmallerTree = deletes (take (5 * (10^5)) randomInts) aBigBST
evenBigger :: BT Int
evenBigger = inserts (take (10^7) randomInts) Empty
fullBST :: Integer -> Integer -> BT Integer
fullBST x y | x == y = Fork x Empty Empty
| x+1 == y = Fork y (Fork x Empty Empty) Empty
| x+1 < y = Fork m (fullBST x (m-1)) (fullBST (m+1) y)
| otherwise = undefined
where m = (x + y) `div` 2
bstsort :: Ord a => [a] -> [a]
bstsort xs = treeInOrder(inserts xs Empty)
qsort :: Ord a => [a] -> [a]
qsort [] = []
qsort (x:xs) = qsort [l | l <- xs, l < x]
++ [x]
++ qsort [r | r <- xs, r >= x]
merge :: Ord a => [a] -> [a] -> [a]
merge [] [] = []
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys)
| x <= y = x : merge xs (y:ys)
| otherwise = y : merge (x:xs) ys
eosplit :: [a] -> ([a],[a])
eosplit [] = ([],[])
eosplit [x] = ([x],[])
eosplit (e:o:xs) = case eosplit xs of
(es,os) -> (e:es, o:os)
msort :: Ord a => [a] -> [a]
msort xs | length xs <= 1 = xs
| otherwise = merge (msort es) (msort os)
where (es, os) = eosplit xs
bigList = take (10^5) randomInts
hugeList = take (10^6) randomInts
data Rose a = Branch a [Rose a]
rsize :: Rose a -> Integer
rsize (Branch _ ts) = 1 + sum [rsize t | t <- ts]
rsize' :: Rose a -> Integer
rsize’ (Branch _ ts) = 1 + sum (map rsize’ ts)
rheight :: Rose a -> Integer
rheight (Branch _ []) = 0
rheight (Branch _ ts) = 1 + maximum [rheight t | t <- ts]
data GameTree board move = Node board [(move, GameTree board move)] deriving (Show)
gameTree :: (board -> [(move,board)]) -> board -> GameTree board move
gameTree plays board = Node board [(m, gameTree plays b) | (m,b) <- plays board]
type NimBoard = [Integer]
data NimMove = Remove Int Integer deriving (Show,Eq)
nimPlays :: NimBoard -> [(NimMove,NimBoard)]
nimPlays heaps = [(Remove i k, (hs ++ h-k : hs’))
| i <- [0..length heaps-1],
let (hs, h:hs') = splitAt i heaps,
k <- [1..h]]
nim :: [Integer] -> GameTree NimBoard NimMove
nim = gameTree nimPlays
isWinning, isLosing :: Bool -> GameTree board move -> Bool
isWinning isMisere (Node b mgs)
| null mgs = isMisere
| otherwise = any (isLosing isMisere) [g | (m,g) <- mgs]
isLosing isMisere (Node b mgs)
| null mgs = not (isMisere)
| otherwise = all (isWinning isMisere) [g | (m,g) <- mgs]
data Tree a = EBranch [(a, Tree a)] deriving (Show)
fullPaths :: Tree a -> [[a]]
fullPaths (EBranch []) = [[]]
fullPaths (EBranch forest) = [x:p | (x,t) <- forest, p <- fullPaths t]
paths :: Tree a -> [[a]]
paths (EBranch forest) = [] : [x:p | (x,t) <- forest, p <- paths t]
permTree :: Eq a => [a] -> Tree a
permTree xs = EBranch [ (x, permTree(xs \\\ x)) | x <- xs]
where
(\\\) :: Eq a => [a] -> a -> [a]
[] \\\ _ = undefined
(x:xs) \\\ y
| x == y = xs
| otherwise = x : (xs \\\ y)
permutations :: Eq a => [a] -> [[a]]
permutations = fullPaths . permTree
factorial n = length(permutations [1..n])
removals, removals2 :: [a] -> [(a,[a])]
removals [] = []
removals (x:xs) = (x,xs) : map (\(y,ys) -> (y,x:ys)) (removals xs)
type DList a = [a] -> [a]
removals’ :: DList a -> [a] -> [(a,[a])]
removals’ f [] = []
removals’ f (x:xs) = (x, f xs) : removals’ (f.(x:)) xs
removals2 = removals’ (\xs -> xs)
permTree2 :: [a] -> Tree a
permTree2 xs = EBranch [(y, permTree2 ys) | (y,ys) <- removals2 xs]
permutations2 :: [a] -> [[a]]
permutations2 = fullPaths . permTree2
data Expr a = Value a
| FromInteger Integer
| Negate (Expr a)
| Abs (Expr a)
| SigNum (Expr a)
| Add (Expr a) (Expr a)
| Mul (Expr a) (Expr a)
eval :: Num a => Expr a -> a
eval (Value x) = x
eval (FromInteger n) = fromInteger n
eval (Negate e) = negate (eval e)
eval (Abs e) = abs(eval e)
eval (SigNum e) = signum(eval e)
eval (Add e e’) = eval e + eval e’
eval (Mul e e’) = eval e * eval e’
instance Show a => Show(Expr a) where
show (Value x) = show x
show (FromInteger n) = “fromInteger(” ++ show n ++ “)”
show (Negate e) = “negate(” ++ show e ++ “)”
show (Abs e) = “abs(” ++ show e ++ “)”
show (SigNum e) = “signum(” ++ show e ++ “)”
show (Add e e’) = “(” ++ show e ++ “+” ++ show e’ ++ “)”
show (Mul e e’) = “(” ++ show e ++ “*” ++ show e’ ++ “)”