Deprecated: The each() function is deprecated. This message will be suppressed on further calls in /home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php on line 456
-- standard list processing functions from Prelude.hs
{-
head :: [a] -> a
head (x:_) = x
last :: [a] -> a
last [x] = x
last (_:xs) = last xs
tail :: [a] -> [a]
tail (_:xs) = xs
init :: [a] -> [a]
init [x] = []
init (x:xs) = x : init xs
null :: [a] -> Bool
null [] = True
null (_:_) = False
(++) :: [a] -> [a] -> [a]
[] ++ ys = ys
(x:xs) ++ ys = x : (xs ++ ys)
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 ]
concat :: [[a]] -> [a]
concat = foldr (++) []
length :: [a] -> Int
length = foldl' (\n _ -> n + 1) 0
(!!) :: [a] -> Int -> a
(x:_) !! 0 = x
(_:xs) !! n | n>0 = xs !! (n-1)
(_:_) !! _ = error "Prelude.!!: negative index"
[] !! _ = error "Prelude.!!: index too large"
foldl :: (a -> b -> a) -> a -> [b] -> a
foldl f z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
foldl' :: (a -> b -> a) -> a -> [b] -> a
foldl' f a [] = a
foldl' f a (x:xs) = (foldl' f $! f a x) xs
foldl1 :: (a -> a -> a) -> [a] -> a
foldl1 f (x:xs) = foldl f x xs
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f q xs = q : (case xs of
[] -> []
x:xs -> scanl f (f q x) xs)
scanl1 :: (a -> a -> a) -> [a] -> [a]
scanl1 _ [] = []
scanl1 f (x:xs) = scanl f x xs
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr f z [] = z
foldr f z (x:xs) = f x (foldr f z xs)
foldr1 :: (a -> a -> a) -> [a] -> a
foldr1 f [x] = x
foldr1 f (x:xs) = f x (foldr1 f xs)
scanr :: (a -> b -> b) -> b -> [a] -> [b]
scanr f q0 [] = [q0]
scanr f q0 (x:xs) = f x q : qs
where qs@(q:_) = scanr f q0 xs
scanr1 :: (a -> a -> a) -> [a] -> [a]
scanr1 f [] = []
scanr1 f [x] = [x]
scanr1 f (x:xs) = f x q : qs
where qs@(q:_) = scanr1 f xs
iterate :: (a -> a) -> a -> [a]
iterate f x = x : iterate f (f x)
repeat :: a -> [a]
repeat x = xs where xs = x:xs
replicate :: Int -> a -> [a]
replicate n x = take n (repeat x)
cycle :: [a] -> [a]
cycle [] = error "Prelude.cycle: empty list"
cycle xs = xs' where xs'=xs++xs'
take :: Int -> [a] -> [a]
take n _ | n <= 0 = []
take _ [] = []
take n (x:xs) = x : take (n-1) xs
drop :: Int -> [a] -> [a]
drop n xs | n <= 0 = xs
drop _ [] = []
drop n (_:xs) = drop (n-1) xs
splitAt :: Int -> [a] -> ([a], [a])
splitAt n xs | n <= 0 = ([],xs)
splitAt _ [] = ([],[])
splitAt n (x:xs) = (x:xs',xs'') where (xs',xs'') = splitAt (n-1) xs
takeWhile :: (a -> Bool) -> [a] -> [a]
takeWhile p [] = []
takeWhile p (x:xs)
| p x = x : takeWhile p xs
| otherwise = []
dropWhile :: (a -> Bool) -> [a] -> [a]
dropWhile p [] = []
dropWhile p xs@(x:xs')
| p x = dropWhile p xs'
| otherwise = xs
-}
-- list functions from homework
pythagoreans :: Int -> [ (Int, Int, Int) ]
pythagoreans n = [ (x, y, z) | x <- [1..n],
y <- [1..n],
z <- [1..n], x ^ 2 + y ^ 2 == z ^ 2 ]
myLength :: [a] -> Int
myLength [] = 0
myLength (a : as) = 1 + myLength as
-- binary leaf-labelled trees
data LTree a = Leaf a | Bin (LTree a) (LTree a)
size (Leaf _) = 1
size (Bin l r) = size l + size r
height (Leaf _) = 0
height (Bin l r) = 1 + max (height l) (height r)
flatten :: LTree a -> [a]
flatten (Leaf a) = [a]
flatten (Bin l r) = flatten l ++ flatten r
-- binary node-labelled trees
data BTree a = Void | BBin a (BTree a) (BTree a)
-- finitely branching node-labelled trees
data Tree a = Node a [Tree a] deriving Show
flattenT :: Tree a -> [a]
flattenT (Node a ts) = a : [ a' | t <- ts, a' <- flattenT t ]
{-
flattenT (Node a ts) = a : concat (map flattenT ts)
-}
exampletree = Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]
-- sort algorithms
-- insertion sort
isort :: Ord a => [a] -> [a]
isort [] = []
isort (a : as) = insert a (isort as)
insert :: Ord a => a -> [a] -> [a]
insert e [] = [e]
insert e l@(a : as) | e <= a = e : l
| otherwise = a : insert e as
-- selection sort
ssort :: Ord a => [a] -> [a]
ssort [] = []
ssort as = let
(a', as') = extractmin as
in a' : ssort as'
extractmin :: Ord a => [a] -> (a, [a])
extractmin [a] = (a, [])
extractmin (a : as) = let
(a', as') = extractmin as
in if a <= a' then (a, as) else (a', a : as')
-- mergesort
msort :: Ord a => [a] -> [a]
msort [] = []
msort [a] = [a]
msort as = let
(as0, as1) = split as
in merge (msort as0) (msort as1)
split :: [a] -> ([a], [a])
{-
split [] = ([], [])
split [a] = ([a], [])
split (a0 : a1 : as) =
let
(as0, as1) = split as
in (a0 : as0, a1 : as1)
-}
split [] = ([], [])
split (a : as) =
let
(as0, as1) = split as
in (a : as1, as0)
merge :: Ord a => [a] -> [a] -> [a]
merge [] bs = bs
merge as [] = as
merge (a : as) (b : bs) | a <= b = a : merge as (b : bs)
| otherwise = b : merge (a : as) bs
-- higher order functions
-- examples of list processing functions written with foldr
yourLength :: [a] -> Int
yourLength = foldr (\ _ -> \ x -> 1 + x) 0
add :: [Int] -> Int
add = foldr (+) 0
myMap :: (a -> b) -> [a] -> [b]
myMap f = foldr (\ a -> \ bs -> f a : bs) []