[zz]用 Haskell 实现普通的算法

-- 插入排序
sort::Ord a=>[a]->[a]
sort [] = []
sort (x:xs) = insert x (sort xs)
insert x [] = [x]
insert x (y:ys) | x<=y = x:y:ys
                | x>y = y:insert x ys

-- 快速排序
quicksort::Ord a=>[a]->[a]
quicksort []=[]
quicksort (x:xs) = [y|y<-xs,y<x]++[x]++[y|y<-xs,y>=x]

-- 归并排序
mergeSort [] = []
mergeSort [x] = [x]
mergeSort xs | size > 0 =
        merge (mergeSort front) (mergeSort back)
        where        size = length xs `div` 2
                        front = take size xs
                        back = drop size xs

merge :: Ord a => [a] -> [a] -> [a]
merge (x : xs) (y : ys)
        | x <= y        = x : merge xs (y : ys)
        | x > y                = y : merge (x : xs) ys
merge [] ys                = ys
merge xs []                = xs

-- 堆排序
heapsort :: Ord a => [a] -> [a]
heapsort xs = decomposetree (composetree xs)

data Tree a = Leaf | Node (Tree a) a (Tree a)

composetree :: Ord a => [a] -> Tree a
composetree xs =
  case xs of
    [] -> Leaf
    y : ys -> insert y (composetree ys)

insert :: Ord a => a -> Tree a -> Tree a
insert x t =
  case t of
    Leaf -> Node Leaf x Leaf
    Node l e r -> if e <= x then Node (insert x r) e l
                            else Node (insert e r) x l

decomposetree :: Ord a => Tree a -> [a]
decomposetree t =
  case t of
    Leaf -> []
    Node l e r -> e : decomposetree (removemin (Node l e r))

removemin :: Ord a => Tree a -> Tree a
removemin t =
  case t of
    Leaf -> Leaf
    Node l e r ->
      case l of
        Leaf -> r
        Node l1 e1 r1 ->
          case r of
            Leaf -> Node l1 e1 r1
            Node l2 e2 r2 ->
              if e1 <= e2 then Node (removemin (Node l1 e1 r1)) e1 (Node l2 e2 r2)
                          else Node (Node l1 e1 r1) e2 (removemin (Node l2 e2 r2))

-- List 操作
my_init :: [a] -> [a]
my_init [x] = []
my_init (x : xs) = x : my_init xs

my_head :: [a] ->a
my_head [x] = x
my_head (x:xs) = x

my_tail :: [a]->[a]
my_tail [x] = []
my_tail (x:xs) = xs

my_sum [] = 0
my_sum (x:xs) = x + my_sum xs

my_length [] = 0
my_length (x:xs) = 1+my_length xs

my_elem x (y : ys) = x==y || my_elem x ys
my_elem x [] = False

my_reverse (x : xs) = my_reverse xs ++ [x]
my_reverse [] = []

my_zip (x : xs) (y : ys) = (x, y) : my_zip xs ys
my_zip [] ys = []
my_zip xs [] = []

my_take :: Int -> [a] -> [a]
my_take _ [] = []
my_take n (x : xs) | n > 0 = x : take (n-1) xs
                   | otherwise = []

-- comprehension
fibs = 1 : 1 : [ a + b | (a, b) <- zip fibs (tail fibs)]

my_concat :: [[a]]->[a]
my_concat xss = [x|xs<-xss,x<-xs]

-- BST（Binary Search Tree）的描述
-- （1）把bst的性质用最简短的语言抽象出来了，一看就记住啦；
-- （2）节点元素只要是可以进行比较的就可以。
data Ord a=>BST a = Nil | Node a (BST a) (BST a)
-- 查看元素key是否在树中存在
member key Nil = False
member key (Node x t s) | key < x  = member key t
                        | key > x  = member key s
                        | key == x = True

-- 插入一个元素
insert k Nil = Node k Nil Nil
insert k n@(Node x t s) | k<x = Node x (insert k t) s
                        | k>x = Node x t (insert k s)
                        | otherwise = n

-- 计算树的深度
depth Nil = 0
depth Node _ left right = 1+max (depth left) (depth right)

-- 前序遍历
preorder Nil            = []
preorder (Node x lf rt) = [x] ++ preorder lf ++ preorder rt

-- 中序遍历
inorder Nil            = []
inorder (Node x lf rt) = inorder lf ++ [x] ++ inorder rt

-- 后序遍历
postorder Nil            = []
postorder (Node x lf rt) = postorder lf ++ postorder rt ++ [x]

-- 红黑树的实现：
-- （1）当红黑树的条件被破坏之后，怎样调整，四种情况，一目了然；
-- （2）当调整之后的红黑树的根为红色时，必须改成黑色
-- （3）插入操作：先插入，再涂色
data Color = Red | Black

data RedBlackTree a = Leaf | Branch Color (RedBlackTree a) a (RedBlackTree a)

empty :: RedBlackTree a
empty = Leaf

insert :: Ord a => a -> (RedBlackTree a) -> (RedBlackTree a)
insert x Leaf = Branch Black Leaf x Leaf
insert x t = makerootblack (ins x t)

ins x Leaf = Branch Red Leaf x Leaf
ins x (Branch c t1 y t2)
    | x < y = balance (Branch c (ins x t1) y t2)
    | x > y = balance (Branch c t1 y (ins x t2))
    | otherwise = Branch c t1 y t2

makerootblack (Branch Red t1 x t2) = (Branch Black t1 x t2)
makerootblack t = t

balance (Branch Black (Branch Red (Branch Red t11 x1 t12) y t21) x2 t22) = Branch Red (Branch Black t11 x1 t12) y (Branch Black t21 x2 t22)
balance (Branch Black (Branch Red t11 x1 (Branch Red t12 y t21)) x2 t22) = Branch Red (Branch Black t11 x1 t12) y (Branch Black t21 x2 t22)
balance (Branch Black t11 x1 (Branch Red (Branch Red t12 y t21) x2 t22)) = Branch Red (Branch Black t11 x1 t12) y (Branch Black t21 x2 t22)
balance (Branch Black t11 x1 (Branch Red t12 y (Branch Red t21 x2 t22))) = Branch Red (Branch Black t11 x1 t12) y (Branch Black t21 x2 t22)
balance t = t

-- 全排列
perms [] = [[]]
perms xs = [x:p | x <- xs, p <- perms (removeFirst x xs)]
    where removeFirst x []                 = []
          removeFirst x (y:ys) | x == y    = ys
                               | otherwise = y : removeFirst x ys

-- 循环链表
data List a = Node a (List a) (List a)
            | Null

mkList :: [a] -> List a
mkList [] = Null
mkList xs = mkList' xs Null

mkList' :: [a]->List a->List a
mkList' [] prev = Null
mkList' (x:xs) prev = Node x prev (mkList' xs cur)

4 个解决方案

#1

-- 求素数 1
factors :: Int->[Int]
factors n = [x|x<-[1..n],n `mod` x == 0]

prime ::Int->Bool
prime n = factors n == [1,n]

primes :: Int->[Int]
primes n = [x|x<-[2..n],prime x]

-- 求素数 2
prime = sieve [2..]
where sieve (x:xs) = x : sieve (filter (\y ->y `rem` x /= 0) xs)

#2

-- 非确定性有限自动机的异种列表表达
-- Code snippet: constraint a heterogenous list by a deterministic finite automaton
-- http://www.nabble.com/Code-snippet%3A-constraint-a-heterogenous-list-by-a-deterministic-finite-automaton-t3659611.html
-- from Haskell mailing list
{-# OPTIONS -fglasgow-exts #-}

data HNil = HNil

data HCons a s b = Delta s b => HCons a s b

data One = One
data Two = Two
data Three = Three
data Four = Four

data A = A
data B = B
data C = C

class Delta st sy

-- you can use HaLeX to generate minimal DFA's from
-- regular expressions.
-- http://www.di.uminho.pt/~jas/Research/HaLeX/HaLeX.html

-- the minimal deterministic finite automaton for "AB?C"

instance Delta HNil One -- One is the start state

instance Delta One (HCons A Two n)
instance Delta Two (HCons B Three n)
instance Delta Two (HCons C Four n)
instance Delta Three (HCons C Four n)

instance Delta Four HNil -- Four is an end state

-- there are two valid full sequences
x = HCons HNil One $ HCons A Two $ HCons B Three $ HCons C Four HNil
y = HCons HNil One $ HCons A Two $ HCons C Four HNil

-- if you do not terminate and/or start with HNil, you can have
-- partitial matches
z = HCons B Three $ HCons C Four HNil

-- invalid sequences do not type-check
-- b = HCons HNil One $ HCons B Three $ HCons C Four HNil
-- b' = HCons A Two $ HCons B Three HNil

秒客网

[zz]用 Haskell 实现普通的算法

4 个解决方案

#1

#2

#3

#4

#1

#2

#3

#4

相关文章