Begin to add other source code of this book

Chapter04/script.hs

@@ -0,0 +1,5 @@
+
+reverseSentence :: String -> String
+reverseSentence str = unwords (reverse (words str))
+
+

Chapter05/Newton.hs

@@ -1,7 +1,11 @@
+--n 控制迭代的次数
 squareroot :: Int -> Double -> Double
 squareroot 0 x = x 
 squareroot n x = (squareroot (n-1) x + x / squareroot (n-1) x )/2
 
+-- c 精度控制
+-- f x 步骤
+-- 如果精度满足条件，则得到结果；否则说明还要继续进行牛顿迭代(继续猜测的均值)
 fix c f x | c x  (f x)  = x
           | otherwise = fix c f (f x)
 
@@ -10,4 +14,4 @@ newton c t = (c/t + t) /2.0
 
 mysqrt :: Double -> Double
 mysqrt c = fix (\a b -> a - b < 0.000001) (newton c) c
-
+

Chapter05/decimal2rome.hs

@@ -0,0 +1,18 @@
+romeNotation :: [String]
+romeNotation = ["M", "CM", "D", "CD", "C", "XC", "L", "XL", "X", "IX", "V", "IV", "I"]
+
+romeAmount :: [Int]
+romeAmount = [1000, 900, 500, 400, 100, 90, 50, 40, 10, 9, 5, 4, 1]
+
+pair :: [(Int, String)]
+pair = zip romeAmount romeNotation 
+
+subtrahend :: Int -> (Int, String)
+subtrahend n = head (dropWhile (\(a,_) -> a > n) pair)
+
+convert :: Int -> (Int, String)
+convert 0 = (0, "")
+convert n = let (i,st) = subtrahend n in
+            let (i',st') = convert (n-i) in (i', st ++ st')
+
+

Chapter05/fibonacci.hs

@@ -0,0 +1,37 @@
+
+fibonacci :: Int -> Int
+fibonacci 0 = 1
+fibonacci 1 = 1
+fibonacci n = fibonacci (n-1) + fibonacci (n-2)
+
+fibStep :: (Int, Int) -> (Int, Int)
+fibStep (u,v) = (v, u+v)
+
+fibPair :: Int -> (Int, Int)
+fibPair 0 = (0, 1)
+fibPair n = fibStep (fibPair (n-1))
+
+fastFib n = fst (fibPair n)
+
+fibs n = map fastFib [1 .. n]
+
+fibs' n = take n (map fst (iterate fibStep (0,1)))
+
+{-
+golden :: Fractional a => Int -> [a]
+golden n = take n (map (\(x,y) -> x/y) (iterate fibStep (0,1))
+-}
+
+
+-- 得到连续的3项
+combine :: [(a,a)] -> [(a,a,a)]
+combine ((f1,f2):(f3,f4):fs) = (f1,f2,f4) : combine ((f3,f4):fs)
+combine _ = []
+
+fibPairs :: Int -> [(Int, Int)]
+fibPairs n = map fibPair [1 .. n]
+
+difference :: Int -> [Int]
+difference n = map (\(f1,f2,f3) -> f1 * f3 - f2 * f2) (combine $ fibPairs n)
+
+

Chapter05/halt.hs

@@ -0,0 +1,6 @@
+halt :: Integral a => a -> [a]
+halt 1 = [1]
+halt n | even n = let n' = div n 2 in n' : halt n'
+        | otherwise = let n' = 3*n + 1 in n' : halt n'
+
+

Chapter05/hanoi.hs

@@ -0,0 +1,14 @@
+
+type From = Int
+type To = Int
+type Via = Int
+
+move :: (Int, From, To, Via) -> [(From, To)]
+move (1, from, to, via) = [(from, to)]
+move (n, from, to, via) = move (n-1, from, via, to) ++ [(from, to)] ++
+                          move (n-1, via, to, from)
+
+hanoi n = move (n, 1, 2, 3)
+
+
+

Chapter05/script.hs

@@ -0,0 +1,52 @@
+factorial :: Integer -> Integer 
+factorial n = if n < 0 then error "n is less than 0"
+              else if n == 0 then 1
+              else n * factorial (n-1)
+
+mygcd :: Int -> Int -> Int
+mygcd x y = if y == 0 then x else mygcd y (mod x y)
+
+power :: Int -> Int -> Int
+power _ 0 = 1
+power x n = x * power x (n-1)
+
+power' :: Int -> Int -> Int
+power' _ 0 = 1
+power' x n 
+          | odd n = let p = power' x ((n-1) `div` 2) in x * p * p
+          | otherwise = let p = power' x (n `div` 2) in p * p
+
+
+snoc :: a -> [a] -> [a]
+snoc x [] = [x]
+snoc x (y:ys) = y : snoc x ys
+
+last' :: [a] -> a
+last' [] = error "empty list"
+last' [x] = x
+last' (_:xs) = last' xs
+
+elem' :: Eq a => a -> [a] -> Bool
+elem' _ [] = False
+elem' a (x:xs) = if a == x then True else elem' a xs
+
+{- 
+total :: [Int] -> Int
+total [] = 0
+total (x:xs) = x + total xs 
+-}
+
+
+total' :: [Int] -> Int -> Int 
+total' [] n  = n
+--total'(x:xs) n = total' xs (n+x)
+total'(x:xs) n = total' xs $! (n+x)
+
+total xs = total' xs 0
+
+mc :: Int -> Int
+mc n 
+    | n > 100 = n - 10
+    | otherwise = mc (mc (n+11))
+
+

Chapter05/search.hs

@@ -0,0 +1,7 @@
+search :: (Ord a) => a -> [a] -> Bool
+search a [] = False
+search a xs 
+        | a > m = search a behind
+        | a < m = search a front
+        | otherwise = True
+        where (front, m:behind) = splitAt (length xs `div` 2) xs

Chapter05/shorter.hs

@@ -0,0 +1,7 @@
+-- 对于无穷列表，求长度存在问题
+shorter :: [a] -> [a] -> [a]
+shorter xs ys | x < y = xs
+              | otherwise = ys
+              where x = length xs
+                    y = length ys
+

Chapter05/sort.hs

@@ -0,0 +1,97 @@
+-------
+--插入排序
+
+insert :: (Ord a) => a -> [a] -> [a]
+insert x [] = [x]
+insert x (y:ys) 
+            | x < y = x:y:ys
+            | otherwise = y: insert x ys
+
+
+-- 利用中间辅助列表，把要排序的列表元素逐渐插入到辅助list中， 尾递归
+insertionSort :: Ord a => [a] -> [a] -> [a]
+insertionSort xs [] = xs
+insertionSort xs (y:ys) = insertionSort (insert y xs) ys
+
+insertionSort' :: Ord a => [a] -> [a]
+insertionSort' [] = []
+insertionSort' (x:xs) = insert x (insertionSort' xs)
+
+------------
+--冒泡排序--
+swaps :: Ord a => [a] -> [a]
+swaps [] = []
+swaps [x] = [x]
+swaps (x1:x2:xs)
+            | x1 > x2 = x2 : swaps (x1:xs)
+            | otherwise = x1 : swaps (x2:xs)
+
+-- 定义一个不动点函数，一致调用swaps，知道列表不发生改变
+fix :: Eq a => (a -> a) -> a -> a
+fix f x = if x == x' then x else fix f x'
+          where x' = f x
+
+bubbleSort :: Ord a => [a] -> [a]
+bubbleSort xs = fix swaps xs
+
+-- assemble fix in the bubbleSort 
+bubbleSort' :: Ord a => [a] -> [a]
+bubbleSort' xs 
+            | swaps xs == xs = xs
+            | otherwise = bubbleSort' $ swaps xs
+
+
+-----------------
+--选择排序
+delete :: Eq a => a -> [a] -> [a]
+delete _ [] = []
+delete x (l:xs) | x == l = xs
+                | otherwise = l:delete x xs
+
+selectionSort :: [Int] -> [Int]
+selectionSort [] = []
+selectionSort xs = mini : selectionSort xs'
+                  where mini = minimum xs
+                        xs' = delete mini xs
+
+
+-----------------
+--Quick Sort
+quickSort :: Ord a => [a] -> [a]
+quickSort [] = []
+quickSort (x:xs) = quickSort smaller ++ [x] ++ quickSort larger
+              where smaller = filter (<x) xs
+                    larger = filter (>= x) xs
+
+filterSplit :: (a -> Bool) -> [a] -> ([a],[a])
+filterSplit _ [] = ([],[])
+filterSplit f (x:xs) 
+                      | f x = ((x:l),r)
+                      | otherwise = (l, (x:r))
+                      where (l,r) = filterSplit f xs
+
+quickSort' :: Ord a => [a] -> [a]
+quickSort' [] = []
+quickSort' [x] = [x]
+quickSort' (x:xs) = quickSort' l ++ [x] ++ quickSort' r
+  where (l,r) = filterSplit (<x) xs
+
+
+----------------
+--Merge Sort
+merge :: Ord a => [a] -> [a] -> [a]
+merge xs [] = xs
+merge [] ys = ys
+merge (x:xs) (y:ys)   | x > y = y:merge (x:xs) ys
+                      | otherwise = x:merge xs (y:ys)
+
+-- 注意where的各个子句要对齐，否则解析错误
+mergeSort :: Ord a => [a] -> [a]
+mergeSort [] = []
+mergeSort [x] = [x]
+mergeSort xs = merge (mergeSort x1) (mergeSort x2)
+  where (x1, x2) = halve xs
+        halve xs = (take l xs, drop l xs)
+        l = (length xs) `div` 2
+
+

Chapter06/Pi.hs

@@ -0,0 +1,9 @@
+
+--生成级数展开序列
+series :: Int -> [Double]
+series n = [1/(2 * (fromIntegral k) + 1) * (-1) ^ k | k <- [0 .. n]]
+
+mypi :: Int -> Double
+mypi n = 4 * (sum $ series n)
+
+

Chapter06/Prime.hs

@@ -0,0 +1,22 @@
+factors :: Integral a => a -> [a]
+factors n = [x | x <- [1 .. n], mod n x == 0]
+
+isPrime :: Integral a => a -> Bool
+isPrime n = factors n == [1,n]
+
+primes :: Integral a => a -> [a]
+primes n = [x | x <- [1 .. n], isPrime x]
+
+
+
+halfOdd :: Integral a => a -> [a]
+halfOdd p = takeWhile (\n -> n * n <= p) [3,5 ..]
+
+
+allNotFactorOf :: Integral a => [a] -> a -> Bool
+allNotFactorOf xs p = all (\n -> p `mod` n /= 0) xs
+
+
+isPrime' :: Integral a => a -> Bool
+isPrime' 2 = True
+isPrime' p = p > 1 && odd p && (all (\n -> p `mod` n /= 0) $ takeWhile (\n -> n * n <= p) [3,5 ..])

README.md

@@ -91,6 +91,8 @@ This is source code of my book.
 
 第95页  take 5 nature的结果应该为[0,1,2,3,4]而非[1,2,3,4,5]
 
+第100页 isPrime' 代码需要排除偶数的情况，看[Chapter06/Prime.hs](Chapter06/Prime.hs)
+
 第124页  第一行`某两个列表`应为`某个列表`。
 
 **第124页 该页的最后一段：理论上。。。以及下面的图7-1应该插入在125页练习2之后。