├── .gitignore
├── LICENSE
├── README.md
├── ch1
    ├── ch1.erl
    ├── ch1.hs
    ├── ch1.md
    ├── ch1.rkt
    └── pfad_util.erl
├── ch10
    └── ch10.md
├── ch11
    └── ch11.md
├── ch12
    └── ch12.md
├── ch13
    └── ch13.md
├── ch14
    └── ch14.md
├── ch2
    ├── ch2.erl
    ├── ch2.hs
    └── ch2.md
├── ch3
    ├── ch3.erl
    ├── ch3.hs
    └── ch3.md
├── ch4
    ├── ch4.erl
    ├── ch4.hs
    └── ch4.md
├── ch5
    ├── ch5.erl
    └── ch5.md
├── ch6
    ├── ch6.erl
    ├── ch6.hs
    └── ch6.md
├── ch7
    └── ch7.erl
├── ch8
    └── ch8.erl
└── ch9
    └── ch9.md


/.gitignore:
--------------------------------------------------------------------------------
 1 | #Logs
 2 | application/logs/*.php
 3 | 
 4 | # Content types
 5 | /application/xml/types/*.xml
 6 | 
 7 | # Custom builds and generated php files
 8 | /core/documentation/build
 9 | /core/views/admin/content/translations.php
10 | 
11 | # Attachs and cache files #
12 | *.tmp
13 | /attach/cache/
14 | /attach/
15 | /application/cache/_bancha/*.css
16 | /application/cache/_bancha/*.js
17 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | The MIT License (MIT)
 2 | 
 3 | Copyright (c) 2014 Jack Yao
 4 | 
 5 | Permission is hereby granted, free of charge, to any person obtaining a copy
 6 | of this software and associated documentation files (the "Software"), to deal
 7 | in the Software without restriction, including without limitation the rights
 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 9 | copies of the Software, and to permit persons to whom the Software is
10 | furnished to do so, subject to the following conditions:
11 | 
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 | 
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21 | SOFTWARE.


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | PFAD
 2 | ====
 3 | 
 4 | *Pearls of Functional Algorithm Design*的讨论、代码、笔记。欢迎提交代码（不限语言）或在Issue中参与讨论（代码也可贴在Issue里）。
 5 | 
 6 | 原书：www.cambridge.org/9780521513388
 7 | 
 8 | 
 9 | <img src="http://fpalgo.readthedocs.org/en/latest/_images/cover.jpg"/>
10 | 
11 | 
12 | 
13 | 
14 | ####前半部分
15 | + [01-The Smallest Free number](https://github.com/Loveice/PFAD/blob/master/ch1/ch1.md)      [Discuss](https://github.com/Loveice/PFAD/issues/1)
16 | + [02-A surpassing problem](https://github.com/Loveice/PFAD/blob/master/ch2/ch2.md) [Discuss](https://github.com/Loveice/PFAD/issues/2)
17 | + [03-Improving on saddleback search](https://github.com/Loveice/PFAD/blob/master/ch3/ch3.md) [Discuss](https://github.com/Loveice/PFAD/issues/3)
18 | + [04-A selection problem](https://github.com/Loveice/PFAD/blob/master/ch4/ch4.md) [Discuss](https://github.com/Loveice/PFAD/issues/4)
19 | + [05- Sorting pairwise sums](https://github.com/Loveice/PFAD/blob/master/ch5/ch5.md) [Discuss](https://github.com/Loveice/PFAD/issues/5)
20 | + [06-Making a century](https://github.com/Loveice/PFAD/blob/master/ch6/ch6.md) [Discuss](https://github.com/Loveice/PFAD/issues/6)
21 | + [07-Building a tree with minunum height](https://github.com/Loveice/PFAD/blob/master/ch7/ch7.md) [Discuss](https://github.com/Loveice/PFAD/issues/7)
22 | + [08-Unravelling greedy algorithms](https://github.com/Loveice/PFAD/blob/master/ch8/ch8.md)                   [Discuss](https://github.com/Loveice/PFAD/issues/8)
23 | + 09-Finding celebrities [Discuss](https://github.com/Loveice/PFAD/issues/9)
24 | + 10-Removing duplicates [Discuss](https://github.com/Loveice/PFAD/issues/10)
25 | + 11-Not the maximun segment sum [Discuss](https://github.com/Loveice/PFAD/issues/11)
26 | + 12-Ranking suffixes [Discuss](https://github.com/Loveice/PFAD/issues/12)
27 | + 13-Burrows-Wheeler transfor [Discuss](https://github.com/Loveice/PFAD/issues/13)
28 | + 14-The last tail [Discuss](https://github.com/Loveice/PFAD/issues/14)
29 | + 15-All the common prefixes [Discuss](https://github.com/Loveice/PFAD/issues/15)
30 | 
31 | 


--------------------------------------------------------------------------------
/ch1/ch1.erl:
--------------------------------------------------------------------------------
 1 | -module(ch1).
 2 | 
 3 | -export([
 4 |          minfree/1,
 5 |          devide_and_conquer_minfree/1
 6 |         ]).
 7 | 
 8 | %% @doc O(N^2): N=length(Numbers)
 9 | -spec minfree([non_neg_integer()]) -> non_neg_integer().
10 | minfree(Numbers) ->
11 |     hd(lists:dropwhile(fun (X) -> lists:member(X, Numbers) end, lists:seq(0, length(Numbers)))).
12 | 
13 | 
14 | %% @doc O(N): N=length(Numbers)
15 | -spec devide_and_conquer_minfree([non_neg_integer()]) -> non_neg_integer().
16 | devide_and_conquer_minfree([])      -> 0;
17 | devide_and_conquer_minfree(Numbers) ->
18 |     Half  = (length(Numbers) + 1) div 2,
19 |     {Left, Right} = lists:partition(fun (X) -> X < Half end, Numbers),
20 |     case length(Left) < Half of
21 |         true  -> devide_and_conquer_minfree(Left);
22 |         false -> Half + devide_and_conquer_minfree([X - Half || X <- Right])
23 |     end.


--------------------------------------------------------------------------------
/ch1/ch1.hs:
--------------------------------------------------------------------------------
 1 | import Data.List
 2 | import Data.Array
 3 | import qualified Data.Vector as V
 4 | import Test.QuickCheck
 5 | 
 6 | 
 7 | -- simple, nice but O(n^2)
 8 | minfree :: [Int] -> Int
 9 | minfree xs = head ([0..] \\ xs)
10 | 
11 | search :: Array Int Bool -> Int
12 | search = length . takeWhile id . elems
13 | 
14 | vsearch :: V.Vector Bool -> Int
15 | vsearch = V.length . V.takeWhile id
16 | 
17 | -- pure functional
18 | checklist :: [Int] -> Array Int Bool
19 | checklist xs = accumArray (||) False (0, n) $ zip (filter ( <= n) xs) (repeat True)
20 |     where n = length xs
21 | 
22 | vchecklist :: [Int] -> V.Vector Bool
23 | vchecklist xs = V.accum (||) (V.replicate (n+1) False) $ zip (filter ( <= n) xs) (repeat True)
24 |     where n = length xs
25 | 
26 | -- O(n) using array
27 | minfree' = search . checklist
28 | -- O(n) using Vector
29 | vminfree = vsearch . vchecklist
30 | 
31 | -- just another example for using array
32 | countlist :: [Int] -> Int -> Array Int Int
33 | countlist xs n = accumArray (+) 0 (0, n) $ zip xs (repeat 1)
34 | 
35 | countsort xs n = concat [ replicate k x | (x, k) <-  assocs . countlist xs $ n ]
36 | 
37 | -- divide & conquer: numbers in xs must be distinct
38 | minfree'' xs = minfrom 0 (length xs, xs)
39 | minfrom a (n, xs) | n == 0 = a
40 |                   | m == b - a = minfrom b (n - m, vs)
41 |                   | otherwise = minfrom a (m, us)
42 |                   where (us, vs) = partition (< b) xs
43 |                         b = a + 1 + n `div` 2
44 |                         m = length us
45 | 
46 | -- tests
47 | limit = 2^10
48 | nats = listOf . choose $ (0, limit)
49 | ok xs = all (== head xs) xs
50 | prop = forAll nats $ \x -> ok (map ($x) [minfree, minfree', vminfree])
51 | 
52 | -- minfree'' assumes distinct input
53 | prop2 = forAll (fmap nub nats) $ \x -> ok (map ($x) [minfree, minfree', minfree'', vminfree])
54 | 
55 | main = do
56 |     print $ f [0..10]
57 |     print $ f [2,4,6,8,5,0,3,5,1,2]
58 |     quickCheck prop
59 |     quickCheck prop2
60 |     quickCheck (forAll nats $ \xs -> sort xs == countsort xs limit)
61 |     where f xs = (minfree xs, minfree' xs)
62 | 


--------------------------------------------------------------------------------
/ch1/ch1.md:
--------------------------------------------------------------------------------
 1 | #1  The smallest free number 
 2 | 
 3 | ##简介
 4 | 
 5 | 给定有限个自然数组成的集合X，求不在X中的最小自然数。如果X是有序的，只需要逐个检查。如果X无序，比如：
 6 | 
 7 | [08,23,09,00,12,11,01,10,13,07,41,04,14,21,05,17,03,19,02,06]
 8 | 
 9 | 是否有线性时间的解法？列表的排序不能在线性时间完成（故作排序预处理不是个好想法）。尽管如此，是存在线性复杂度解法的：一个基于Haskell的数组，一个使用分治法
10 | 
11 | 
12 | ##基于数组的解法
13 | 根据题意，有个很直接的解法
14 | ~~~~
15 | minfree :: [a] -> a 
16 | minfree xs = head ([0..] \\ xs) 
17 | ~~~~
18 | 
19 | "\\\"接受两个列表参数xs，ys，结果是：移除在ys在出现过的元素后，xs剩下的元素。
20 | 
21 | minfree的复杂度是O(n^2),
22 | 


--------------------------------------------------------------------------------
/ch1/ch1.rkt:
--------------------------------------------------------------------------------
 1 | #lang racket
 2 | 
 3 | ;; Problem : Find the smallest free number
 4 | 
 5 | 
 6 | ;; simple approch
 7 | (define (minfree xs)
 8 |   (stream-first 
 9 |    (stream-filter 
10 |     (λ (x) (not (member x xs)))
11 |     (in-naturals))))
12 | 
13 | (define (minform a n xs)
14 |   (if (zero? n)
15 |       a
16 |       (let ([b (+ 1 a (quotient n 2))])
17 |         (let-values ([(us vs) (partition (λ (x) (< x b)) xs)])
18 |           (let ([m (length us)])
19 |             (if (= m (- b a))
20 |                 (minform b (- n m) vs)
21 |                 (minform a m us)))))))
22 | 
23 | (define (minfree2 xs)
24 |   (minform 0 (length xs) xs))
25 | 
26 | ;; test 
27 | (define xs (map string->number (string-split "08,23,09,00,12,11,01,10,13,07,41,04,14,21,05,17,03,19,02,06" ",")))
28 | (minfree xs)
29 | (minfree2 xs)
30 | 
31 | ;; need more tests
32 | 
33 | 


--------------------------------------------------------------------------------
/ch1/pfad_util.erl:
--------------------------------------------------------------------------------
 1 | %% @doc utility functions
 2 | -module(pfad_util).
 3 | 
 4 | -export([
 5 |          count_if/2,
 6 |          map_tail/2,
 7 |          min_by/2,
 8 |          fork/2,
 9 |          id/1,
10 |          tails/1
11 |         ]).
12 | 
13 | -spec map_tail(Fun, [Element]) -> [Result] when
14 |       Fun     :: fun ((Element, Tail) -> Result),
15 |       Element :: term(),
16 |       Result  :: term(),
17 |       Tail    :: [Element].
18 | map_tail(Fun, List) ->
19 |     {Results, _} =
20 |         lists:mapfoldl(
21 |           fun (Element, PrevTail) ->
22 |                   Tail = tl(PrevTail),
23 |                   Result = Fun(Element, Tail),
24 |                   {Result, Tail}
25 |           end,
26 |           List,
27 |           List),
28 |     Results.
29 | 
30 | -spec count_if(Fun, [term()]) -> non_neg_integer() when
31 |       Fun :: fun ((term()) -> boolean()).
32 | count_if(Fun, List) ->
33 |     lists:foldl(fun (X, Count) -> boolean_to_integer(Fun(X)) + Count end,
34 |                 0,
35 |                 List).
36 | 
37 | -spec boolean_to_integer(boolean()) -> 0|1.
38 | boolean_to_integer(true)  -> 1;
39 | boolean_to_integer(false) -> 0.
40 | 
41 | -spec min_by(Fun, [X]) -> X when
42 |       Fun :: fun ((X) -> Cost::term()),
43 |       X   :: term().
44 | min_by(Fun, [Head | Tail]) ->
45 |     {_, Min} =
46 |         lists:foldl(
47 |           fun (X, {MinCost, MinX}) ->
48 |                   case Fun(X) of
49 |                       Cost when Cost < MinCost -> {Cost, X};
50 |                       _                        -> {MinCost, MinX}
51 |                   end
52 |           end,
53 |           {Fun(Head), Head},
54 |           Tail),
55 |     Min.
56 | 
57 | -spec id(term()) -> term().
58 | id(X) -> X.
59 | 
60 | -spec fork({Fun, Fun}, term()) -> {term(), term()} when
61 |       Fun :: fun ((term()) -> term()).
62 | fork({Fun1, Fun2}, X) ->
63 |     {Fun1(X), Fun2(X)}.
64 | 
65 | -spec tails([term()]) -> [[term()]].
66 | tails([]) -> [];
67 | tails(Xs) -> [Xs | tails(tl(Xs))].


--------------------------------------------------------------------------------
/ch10/ch10.md:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 | 
 5 | 
 6 | 
 7 | 
 8 | 
 9 | 
10 | $x + y = z$
11 | 


--------------------------------------------------------------------------------
/ch11/ch11.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch12/ch12.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch13/ch13.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch14/ch14.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch2/ch2.erl:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | %% @doc Chapter 2: A surpassing problem
 4 | -module(ch2).
 5 | 
 6 | -export([
 7 |          msc/1,
 8 |          devide_and_conquer_msc/1
 9 |         ]).
10 | 
11 | %% @doc O(N ^ 2): N = length(List)
12 | -spec msc([Element]) -> MaximumSurpasserCount::non_neg_integer() when
13 |       Element :: term().
14 | msc([_|_] = List) ->
15 |     lists:max(pfad_util:map_tail(fun count_surpassers/2, List)).
16 | 
17 | %% @doc O(N * log(N)): N = length(List)
18 | -spec devide_and_conquer_msc([Element]) -> MaximumSurpasserCount::non_neg_integer() when
19 |       Element :: term().
20 | devide_and_conquer_msc([_|_] = List) ->
21 |     lists:max([Count || {_, Count} <- table(List)]).
22 | 
23 | -spec table([Element]) -> [{Element, SupasserCount::non_neg_integer()}] when
24 |       Element :: term().
25 | table([X])  -> [{X, 0}];
26 | table(List) -> 
27 |     Size = length(List),
28 |     Half = Size div 2,
29 |     {Left, Right} = lists:split(Half, List),
30 |     join(Size - Half, table(Left), table(Right)).
31 | 
32 | -spec join(RightSize::non_neg_integer(), Table, Table) -> Table when
33 |       Table :: [{Element::term(), SupasserCount::non_neg_integer()}].
34 | join(_, Left, [])            -> Left;  
35 | join(_, [], Right)           -> Right;
36 | join(RightSize, Left, Right) ->
37 |     [{LeftElement, LeftCount}   | LeftTail]  = Left,
38 |     [{RightElement, RightCount} | RightTail] = Right,
39 |     case LeftElement < RightElement of
40 |         true  -> [{LeftElement, LeftCount + RightSize} | join(RightSize, LeftTail, Right)];
41 |         false -> [{RightElement, RightCount}           | join(RightSize - 1, Left, RightTail)]
42 |     end.
43 | 
44 | -spec count_surpassers(Element, [Element]) -> non_neg_integer() when
45 |       Element :: term().
46 | count_surpassers(Element, List) ->
47 |     pfad_util:count_if(fun (X) -> X > Element end, List).


--------------------------------------------------------------------------------
/ch2/ch2.hs:
--------------------------------------------------------------------------------
 1 | import Data.List
 2 | import Test.QuickCheck
 3 | 
 4 | -- straightforward O(n^2)
 5 | msc :: Ord a => [a] -> Int
 6 | msc xs = maximum [scount z zs | z : zs <- tails xs]
 7 | 
 8 | {-  
 9 |    tails是Data.List的库函数，复杂度为O(n)，生成列表的所有后缀。可以这样实现
10 |    tails :: [a] -> [[a]]
11 |    tails [] = []
12 |    tails (x : xs) = (x : xs) : tail xs
13 | -}
14 | 
15 | scount x xs = length (filter (x <) xs)
16 | 
17 | 
18 | 
19 | -- 分治 O(nlogn)
20 | msc' :: Ord a => [a] -> Int
21 | msc' = maximum . map snd . table
22 | 
23 | table [x] = [(x, 0)]
24 | table xs = join (m-n) (table ys) (table zs)
25 |     where m = length xs
26 |           n = m `div` 2
27 |           (ys, zs) = splitAt n xs
28 | 
29 | join _ txs [] = txs
30 | join _ [] tys = tys
31 | join n txs@((x,c):txs') tys@((y,d):tys')
32 |     | x < y = (x, c+n) : join n txs' tys
33 |     | otherwise = (y,d): join (n-1) txs tys'
34 | 
35 | ints :: Gen [Int]
36 | ints = listOf arbitrary
37 | 
38 | nstr :: Gen [String]
39 | nstr = listOf1 arbitrary
40 | 
41 | main = do
42 |     print (msc as, msc' as)
43 |     print (msc bs, msc' bs)
44 |     print (msc cs, msc' cs)
45 |     print (msc ds, msc' ds)
46 | 
47 |     quickCheck . forAll ints $ \xs -> (not . null) xs ==> msc xs == msc' xs
48 |     quickCheck . forAll nstr $ \xs -> msc xs == msc' xs
49 | 
50 |     where as = "GENERATING"
51 |           bs = [1,3,4,6,2,0,8,9,3,6,5,1,100,99,0,3,7,1,2]
52 |           cs = [1..1000]
53 |           ds = [1000,999..1]
54 | 


--------------------------------------------------------------------------------
/ch2/ch2.md:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 | ###简介
 5 | 
 6 | 我们将解决一个最早由Martin Rem提出的问题。Rem的算法用了二分查找，我们使用另一种基于分治的方法，复杂度是O(nlogn)。
 7 | 
 8 | 定义：如果i < j且x[i] < x[j]，则x[j]为x[i]的“超越数”。统计字符串GENERATING的每个字母的超越数个数
 9 | 
10 |     G   E   N   E   R   A   T   I   N   G 
11 |     5   6   2   5   1   4   0   1   0   0  
12 |     
13 | ”超越数“个数最多的是第二个E，它的“超越数”包括N，R，T，I，N，和G。
14 | 
15 | 给定长为n的数组，每个元素都有0到n-1个“超越数”，求“超越数”个数的最大值
16 | 
17 | 
18 | ###说明
19 | 
20 | 假设给定的输入是列表（Haskell的基础数据结构）而非数组。这个问题的解法可以很直观地表达
21 | 
22 |     msc :: Ord a => [a] -> Int 
23 |     msc  xs  = maximum [scount z zs | z : zs <- tails xs] 
24 |     
25 |     -- scount作用为计算元素x的“超越数”个数
26 |     scount x xs   = length (filter (x <) xs)  
27 |     
28 | 
29 | tails是Data.List标准库的函数，作用为返回列表的所有后缀。复杂度为O(n)，也可以自己实习
30 | 
31 |     tails :: [a] -> [[a]] 
32 |     tails [] = []
33 |     tails (x : xs) = (x : xs) : tail xs 
34 |     
35 | msc先计算列表每一个元素的“超越数”个数，再求其中的最大值。 
36 | 
37 | 算法的复杂度：tails函数O(n)，scount求第一个元素的“超越数”个数要n-1次，第二个n-2次...总共复杂度为O(n^2）。
38 | 最后maximum也是O(n)，故总复杂度为O(n^2)。
39 | 
40 | 这个算法其实是暴力破解。
41 | 
42 | 
43 | ###分治法
44 | 我们的目标是O(nlogn)的算法，自然想到了分治。如果可以找到函数join，使得：
45 | 
46 |     msc (xs ++ ys)  =  join (msc xs) (msc ys) 
47 |     
48 | 并且join是线性复杂度的，那么整体复杂度T(n)就可以表示成
49 | 
50 |     T(n) = 2T(n/2) + O(n)， 结果T(n) = O(nlogn) 
51 | 
52 | 
53 | 
54 | 
55 | 
56 | 
57 |     msc' :: Ord a => [a] -> Int 
58 |     msc' = maximum . map snd . table 
59 |     
60 |     table [x] = [(x, 0)]
61 |     table xs = join (m-n) (table ys) (table zs)
62 |         where m = length xs
63 |             n = m `div` 2
64 |             (ys, zs) = splitAt n xs
65 | 
66 |     join _ txs [] = txs
67 |     join _ [] tys = tys
68 |     join n txs@((x,c):txs') tys@((y,d):tys')
69 |         | x < y = (x, c+n) : join n txs' tys
70 |         | otherwise = (y,d): join (n-1) txs tys'
71 | 


--------------------------------------------------------------------------------
/ch3/ch3.erl:
--------------------------------------------------------------------------------
  1 | 
  2 | 
  3 | -module(ch3).
  4 | 
  5 | -export([
  6 |          invert_p12_1/2,
  7 |          invert_p12_2/2,
  8 |          invert_p13_1/2,
  9 |          invert_p13_2/2,
 10 |          invert_p14_1/2,
 11 |          invert_p15_1/2
 12 |         ]).
 13 | 
 14 | -export_type([
 15 |               binary_fun/0,
 16 |               argument_pair/0
 17 |              ]).
 18 | 
 19 | -type binary_fun() :: fun ((non_neg_integer(), non_neg_integer()) -> non_neg_integer()).
 20 | -type argument_pair() :: {non_neg_integer(), non_neg_integer()}.
 21 | 
 22 | %% @doc (N) ^ 2 = O(N^2): N = Z + 1
 23 | -spec invert_p12_1(binary_fun(), non_neg_integer()) -> [argument_pair()].
 24 | invert_p12_1(Fun, Z) ->
 25 |     [{X, Y} || X <- lists:seq(0, Z), Y <- lists:seq(0, Z), Fun(X, Y) =:= Z].
 26 | 
 27 | %% @doc (N * (N+1)) / 2 = O(N^2): N = Z + 1
 28 | -spec invert_p12_2(binary_fun(), non_neg_integer()) -> [argument_pair()].
 29 | invert_p12_2(Fun, Z) ->
 30 |     [{X, Y} || X <- lists:seq(0, Z), Y <- lists:seq(0, Z - X), Fun(X, Y) =:= Z].
 31 | 
 32 | %% @doc (N) ^ 2 = O(N^2): N = Z + 1
 33 | -spec invert_p13_1(binary_fun(), non_neg_integer()) -> [argument_pair()].
 34 | invert_p13_1(Fun, Z) ->
 35 |     find_p13_1({0, Z}, Fun, Z).
 36 | 
 37 | -spec find_p13_1(argument_pair(), binary_fun(), non_neg_integer()) -> [argument_pair()].
 38 | find_p13_1({FirstX, LastY}, Fun, Z) ->
 39 |     [{X, Y} || X <- lists:seq(FirstX, Z), Y <- lists:seq(0, LastY), Fun(X, Y) =:= Z].
 40 | 
 41 | %% @doc O(N): N = Z + 1
 42 | -spec invert_p13_2(binary_fun(), non_neg_integer()) -> [argument_pair()].
 43 | invert_p13_2(Fun, Z) ->
 44 |     find_p13_2({0, Z}, Fun, Z).
 45 |  
 46 | -spec find_p13_2(argument_pair(), binary_fun(), non_neg_integer()) -> [argument_pair()].
 47 | find_p13_2({X, Y}, _, Z) when X > Z; Y < 0 ->
 48 |     [];
 49 | find_p13_2({X, Y}, Fun, Z) ->
 50 |     Result = Fun(X, Y),
 51 |     if
 52 |         Result  <  Z -> find_p13_2({X + 1, Y}, Fun, Z);
 53 |         Result =:= Z -> [{X, Y} | find_p13_2({X + 1, Y - 1}, Fun, Z)];
 54 |         Result  >  Z -> find_p13_2({X, Y - 1}, Fun, Z)
 55 |     end.
 56 | 
 57 | %% @doc [WORST] 2 * log(Z) + M + N, [BEST] 2 * log(Z) + min(M, N)
 58 | -spec invert_p14_1(binary_fun(), non_neg_integer()) -> [argument_pair()].
 59 | invert_p14_1(Fun, Z) -> 
 60 |     M = bsearch(fun (Y) -> Fun(0, Y) end, -1, Z + 1, Z),
 61 |     N = bsearch(fun (X) -> Fun(X, 0) end, -1, Z + 1, Z),
 62 |     find_p14_1({0, M}, {N, 0}, Fun, Z).
 63 | 
 64 | -spec bsearch(Fun, integer(), non_neg_integer(), non_neg_integer()) -> non_neg_integer() when
 65 |       Fun :: fun ((integer()) -> non_neg_integer()).
 66 | bsearch(_Fun, -1, 0, _Z) -> 0;
 67 | bsearch(_Fun, 0, -1, _Z) -> 0;
 68 | bsearch(_Fun, Low, High, _) when Low + 1 =:= High -> Low;
 69 | bsearch(Fun, Low, High, Z) ->
 70 |     M = (Low + High) div 2, 
 71 |     case Fun(M) =< Z of
 72 |         true  -> bsearch(Fun, M, High, Z);
 73 |         false -> bsearch(Fun, Low, M, Z)
 74 |     end.
 75 | 
 76 | -spec find_p14_1(argument_pair(), argument_pair(), binary_fun(), non_neg_integer()) -> [argument_pair()].
 77 | find_p14_1({Top, Left}, {Bottom, Right}, _, _) when Top > Bottom; Left < Right ->
 78 |     [];
 79 | find_p14_1({X, Y}, Edge, Fun, Z) ->
 80 |     Result = Fun(X, Y),
 81 |     if
 82 |         Result  <  Z -> find_p14_1({X + 1, Y}, Edge, Fun, Z);
 83 |         Result =:= Z -> [{X, Y} | find_p14_1({X + 1, Y - 1}, Edge, Fun, Z)];
 84 |         Result  >  Z -> find_p14_1({X, Y - 1}, Edge, Fun, Z)
 85 |     end.
 86 | 
 87 | %% @doc O(M * log(N/M))
 88 | -spec invert_p15_1(binary_fun(), non_neg_integer()) -> [argument_pair()].
 89 | invert_p15_1(Fun, Z) ->
 90 |     M = bsearch(fun (Y) -> Fun(0, Y) end, -1, Z + 1, Z),
 91 |     N = bsearch(fun (X) -> Fun(X, 0) end, -1, Z + 1, Z),
 92 |     find_p15_1({0, M}, {N, 0}, Fun, Z).
 93 | 
 94 | -spec find_p15_1(argument_pair(), argument_pair(), binary_fun(), non_neg_integer()) -> [argument_pair()].
 95 | find_p15_1({Top, Left}, {Bottom, Right}, _, _) when Top > Bottom; Left < Right ->
 96 |     [];
 97 | find_p15_1({Top, Left}, {Bottom, Right}, Fun, Z) when (Left - Right) =< (Bottom - Top) ->
 98 |     Q = (Left + Right) div 2,
 99 |     P = bsearch(fun (X) -> Fun(X, Q) end, Top - 1, Bottom + 1, Z),
100 |     case Fun(P, Q) =:= Z of
101 |         true  -> [{P, Q} | find_p15_1({Top, Left}, {P - 1, Q + 1}, Fun, Z)];
102 |         false -> find_p15_1({Top, Left}, {P, Q + 1}, Fun, Z)
103 |     end ++ 
104 |     find_p15_1({P + 1, Q - 1}, {Bottom, Right}, Fun, Z);
105 | find_p15_1({Top, Left}, {Bottom, Right}, Fun, Z) ->
106 |     P = (Left + Right) div 2,
107 |     Q = bsearch(fun (Y) -> Fun(P, Y) end, Right - 1, Left + 1, Z),
108 |     find_p15_1({Top, Left}, {P - 1, Q + 1}, Fun, Z) ++
109 |     case Fun(P, Q) =:= Z of
110 |         true  -> [{P, Q} | find_p15_1({P + 1, Q - 1}, {Bottom, Right}, Fun, Z)];
111 |         false -> find_p15_1({P + 1, Q}, {Bottom, Right}, Fun, Z)
112 |     end.
113 | 


--------------------------------------------------------------------------------
/ch3/ch3.hs:
--------------------------------------------------------------------------------
  1 | -- assuming f (x,y) is O(1) (though sometimes it's not -- maybe expensive),
  2 | -- we mainly analyze the complexity of counts of the f(x,y) evaluations
  3 | --
  4 | -- note that, we take `f' as unknown black box. if you know and can inspect
  5 | -- `f' in advance, you can use some specific optimizing techniques
  6 | --
  7 | -- in ghci, you can :set +s to see the running time of different versions
  8 | --
  9 | 
 10 | import Data.List (sort)
 11 | import Test.QuickCheck
 12 | import Control.Monad (liftM, liftM3)
 13 | import Data.Ord (comparing)
 14 | 
 15 | -- as always, the first is no-brainer brute. O(z^2)
 16 | invert0 f z = [(x,y) | x <- [0..z], y <- [0..z], f (x,y) == z]
 17 | 
 18 | -- elegant saddleback O(z)
 19 | invert1 f z = find (0,z) f z z
 20 | find (u,v) f z n
 21 |     | u > n || v < 0 = []
 22 |     | z' < z = find (u+1, v) f z n
 23 |     | z' > z = find (u, v-1) f z n
 24 |     | otherwise = (u,v) : find (u+1, v-1) f z n
 25 |     where z' = f (u,v)
 26 | 
 27 | -- like invert1, but first get domain range.  O(logz + m + n)
 28 | invert2 f z = find (0,m) f z n
 29 |     where m = bsearch (\y -> f (0,y)) (-1,z+1) z
 30 |           n = bsearch (\x -> f (x,0)) (-1,z+1) z
 31 | 
 32 | -- biggest x in [a,b) s.t. g x <= z < g (x+1)
 33 | bsearch g (a,b) z
 34 |     | a+1 == b = a
 35 |     | g m <= z = bsearch g (m,b) z
 36 |     | otherwise = bsearch g (a,m) z
 37 |     where m = (a+b) `div` 2
 38 | 
 39 | -- like invert2, but just enumerate to get the range. O(m+n)
 40 | invert2' f z = find (0,m) f z n
 41 |     where m = head $ dropWhile (\y -> f(0, y) < z) [0..]
 42 |           n = head $ dropWhile (\x -> f(x, 0) < z) [0..]
 43 | 
 44 | -- divide & conquer take 1: split into three rectangles.
 45 | -- O(logz + m^1.59*log(2n/m)) m = min(m,n), n = max(m, n)
 46 | invert3 f z = find3 (0,m) (n,0) f z
 47 |     where m = bsearch (\y -> f (0,y)) (-1,z+1) z
 48 |           n = bsearch (\x -> f (x,0)) (-1,z+1) z
 49 | 
 50 | find3 (u,v) (r,s) f z
 51 |     | u > r || v < s = []
 52 |     | z' < z = find (u,v) (p,q+1) ++ find (p+1,q-1) (r,s) ++ find (p+1,v) (r,q)
 53 |     | z' > z = find (u,v) (p-1,q) ++ find (p+1,q-1) (r,s) ++ find (u,q-1) (p,s)
 54 |     | otherwise = (p, q) : find (p+1,q-1) (r,s) ++ find (u,v) (p-1,q+1)
 55 |     where p = (u + r) `div` 2
 56 |           q = (v + s) `div` 2
 57 |           z' = f (p, q)
 58 |           find a b = find3 a b f z
 59 | 
 60 | -- like invert3, but just enumerate to get the range.
 61 | -- O(m + n + m^1.59*log(2n/m)) m = min(m,n), n = max(m, n)
 62 | invert3' f z = find3 (0,m) (n,0) f z
 63 |     where m = head $ dropWhile (\y -> f(0, y) < z) [0..]
 64 |           n = head $ dropWhile (\x -> f(x, 0) < z) [0..]
 65 | 
 66 | -- faster divide & conquer: binary search on a *fixed* row/col
 67 | -- split into two-rectangles
 68 | -- O(logz + mlog(n/m)) m = min(m,n), n = max(m, n)
 69 | invert4 f z = find4 (0,m) (n,0) f z
 70 |     where m = bsearch (\y -> f (0,y)) (-1,z+1) z
 71 |           n = bsearch (\x -> f (x,0)) (-1,z+1) z
 72 | 
 73 | find4 (u,v) (r,s) f z
 74 |     | u > r || v < s = []
 75 |     | v - s <= r - u = rfind (bsearch (\x -> f(x,q)) (u-1,r+1) z)
 76 |     | otherwise = cfind (bsearch (\y -> f(p,y)) (s-1,v+1) z)
 77 |     where p = (u + r) `div` 2
 78 |           q = (v + s) `div` 2
 79 |           rfind p = (if f (p,q) == z then (p,q):find4 (u,v) (p-1,q+1) f z
 80 |                     else find4 (u,v) (p, q+1) f z) ++
 81 |                     find4 (p+1, q-1) (r,s) f z
 82 |           cfind q = find4 (u,v) (p-1,q+1) f z ++
 83 |                     (if f (p,q) == z then (p,q):find4 (p+1,q-1) (r,s) f z
 84 |                     else find4 (p+1, q) (r,s) f z)
 85 | 
 86 | 
 87 | -- tests
 88 | nat = choose (0::Integer, 100)
 89 | 
 90 | f0 (x,y) = 2^y * (2*x+1) - 1
 91 | f1 (x,y) = x*2^x + y*2^y + 2*x + y
 92 | f2 (x,y) = 3*x + 37*y + y^2
 93 | f3 (x,y) = x^2 + y^2 + x + y
 94 | f4 (x,y) = x + 2^y + y - 1
 95 | 
 96 | same xs = all (== head xs) xs
 97 | 
 98 | invs = [invert0, invert1, invert2, invert2', invert3, invert3', invert4]
 99 | fs = [f0, f1, f2, f3, f4]
100 | 
101 | results z f = map (r z f) invs
102 |     where r z f i = sort $ i f z
103 | 
104 | prop f = forAll nat $ \z -> same $ results z f
105 | check = quickCheck . prop
106 | checkall = quickCheck . conjoin $ map prop fs
107 | 
108 | -- Lets generate random functions
109 | data Expr = Bin Op Expr Expr
110 |           | Const Integer
111 |           | Var String deriving (Eq)
112 | 
113 | data Op = Add | Mul | Pow deriving (Eq, Enum)
114 | 
115 | instance Show Op where
116 |     show Add = "+"
117 |     show Mul = "*"
118 |     show Pow = "^"
119 | 
120 | instance Show Expr where
121 |     show (Const x) = show x
122 |     show (Var v) = v
123 |     show (Bin o e1 e2) = "(" ++ show e1 ++ show o ++ show e2 ++ ")"
124 | 
125 | instance Arbitrary Op where
126 |     arbitrary = frequency [(64, return Add), (32, return Mul), (1, return Pow)]
127 | 
128 | instance Arbitrary Expr where
129 |     arbitrary =
130 |         oneof [ liftM Const (elements [0..10])
131 |               , liftM Var (elements ["x", "y"])
132 |               , liftM3 Bin arbitrary arbitrary arbitrary
133 |               ]
134 | 
135 | eval (Const x) _ = x
136 | eval (Var "x") (x,_) = x
137 | eval (Var "y") (_,y) = y
138 | eval (Bin o e1 e2) p = f o (eval e1 p) (eval e2 p)
139 |     where f Add = (+)
140 |           f Mul = (*)
141 |           f Pow = (^)
142 | 
143 | -- f(x,y) must be strictly increasing
144 | xplusy = Bin Add (Var "x") (Var "y")
145 | func = liftM (Bin Add xplusy) arbitrary
146 | prop' = forAll func $ \f -> prop (eval f)
147 | 
148 | instance Ord Expr where
149 |     compare = comparing (length . show)
150 | 
151 | main = do
152 |     check f0
153 |     check f3
154 |     verboseCheck . prop $ f2
155 |     checkall
156 | 
157 |     f <- liftM maximum $ sample' func
158 |     putStrLn $ "find " ++ show f ++ " == 123:"
159 |     mapM_ print $ results 123 (eval f)
160 | 
161 |     verboseCheck prop'
162 | 


--------------------------------------------------------------------------------
/ch3/ch3.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch4/ch4.erl:
--------------------------------------------------------------------------------
 1 | 
 2 | 
 3 | 
 4 | %% @doc Chapter 4: A selection problem
 5 | -module(ch4).
 6 | 
 7 | -export([
 8 |          smallest/3,
 9 |          devide_and_conquer_smallest/3
10 |         ]).
11 | 
12 | %% @doc O(|Xs| + |Ys|)
13 | -spec smallest(non_neg_integer(), ordsets:ordset(term()), ordsets:ordset(term())) -> term().
14 | smallest(Nth, Xs, Ys) -> 
15 |     lists:nth(Nth + 1, ordsets:union(Xs, Ys)).
16 | 
17 | %% @doc O(log(|Xs| + |Ys|))
18 | -spec devide_and_conquer_smallest(non_neg_integer(), tuple(), tuple()) -> term().
19 | devide_and_conquer_smallest(Nth, Xs, Ys) ->
20 |     search(Nth, Xs, 0, size(Xs), Ys, 0, size(Ys)).
21 | 
22 | -spec search(non_neg_integer(), tuple(), non_neg_integer(), non_neg_integer(), tuple(), non_neg_integer(), non_neg_integer()) -> term().
23 | search(Nth, _, Xl, Xr, Ys, _, _) when Xl =:= Xr -> at(Nth - Xl, Ys);
24 | search(Nth, Xs, _, _, _, Yl, Yr) when Yl =:= Yr -> at(Nth - Yl, Xs); 
25 | search(Nth, Xs, Xl, Xr, Ys, Yl, Yr) ->
26 |     Xm = (Xl + Xr) div 2,
27 |     Ym = (Yl + Yr) div 2,
28 |     case {at(Xm, Xs) < at(Ym, Ys), Nth =< Xm + Ym} of
29 |         {false, _} -> search(Nth, Ys, Yl, Yr, Xs, Xl, Xr);
30 |         {_, true}  -> search(Nth, Xs, Xl, Xr, Ys, Yl, Ym);
31 |         {_, false} -> search(Nth, Xs, Xm + 1, Xr, Ys, Yl, Yr)
32 |     end.
33 | 
34 | -spec at(non_neg_integer(), tuple()) -> term().
35 | at(Nth, Tuple) -> element(Nth + 1, Tuple).
36 | 


--------------------------------------------------------------------------------
/ch4/ch4.hs:
--------------------------------------------------------------------------------
  1 | -- Selection Problem:
  2 | --
  3 | -- Given two *sorted* *disjoint* set X and Y
  4 | -- find the kth number of union(X,Y)
  5 | 
  6 | import Data.List
  7 | import Data.Array
  8 | import Control.Monad
  9 | import Test.QuickCheck
 10 | import Data.Ord
 11 | 
 12 | -- striaghtforward O(|X| + |Y|), or O(k)
 13 | smallest k (xs, ys) = union (xs, ys) !! k
 14 |     where union ([], ys) = ys
 15 |           union (xs, []) = xs
 16 |           union (xs'@(x:xs), ys'@(y:ys))
 17 |             | x < y = x : union (xs, ys')
 18 |             | y < x = y : union (xs', ys)
 19 | 
 20 | -- d&c on lists: still linear
 21 | smallest1 k ([], ws) = ws !! k
 22 | smallest1 k (zs, []) = zs !! k
 23 | smallest1 k (zs, ws) =
 24 |     case (a < b, k <= p + q) of
 25 |          (True, True) -> smallest1 k (zs, us)
 26 |          (True, False) -> smallest1 (k-p-1) (ys, ws)
 27 |          (False, True) -> smallest1 k (xs, ws)
 28 |          (False, False) -> smallest1 (k-q-1) (zs, vs)
 29 |     where p = length zs `div` 2
 30 |           q = length ws `div` 2
 31 |           (xs, a : ys) = splitAt p zs
 32 |           (us, b : vs) = splitAt q ws
 33 | 
 34 | -- d&c on array: O(log|X| + log|Y|)
 35 | smallest2 k (xa, ya) = search k (0, m+1) (0, n+1)
 36 |     where (0, m) = bounds xa
 37 |           (0, n) = bounds ya
 38 |           search k (lx, rx) (ly, ry)
 39 |             | lx == rx = ya ! (ly+k)
 40 |             | ly == ry = xa ! (lx+k)
 41 |             | otherwise = case (xa ! mx < ya ! my, k <= p + q) of
 42 |                              (True, True) -> search k (lx, rx) (ly, my)
 43 |                              (True, False) -> search (k-p-1) (mx+1,rx) (ly,ry)
 44 |                              (False,True) -> search k (lx, mx) (ly, ry)
 45 |                              (False,False) -> search (k-q-1) (lx,rx) (my+1,ry)
 46 |                           where mx = (lx + rx) `div` 2
 47 |                                 my = (ly + ry) `div` 2
 48 |                                 p = mx - lx
 49 |                                 q = my - ly
 50 | 
 51 | -- dumb but obviously correct
 52 | dumb k (xs, ys) = sort (xs ++ ys) !! k
 53 | 
 54 | -- test
 55 | fromList xs = listArray (0, length xs - 1) xs
 56 | 
 57 | same xs = all (== head xs) xs
 58 | 
 59 | run xs ys k f = f k (xs, ys)
 60 | 
 61 | vals xs ys k = map (run xs ys k) [dumb, smallest, smallest1, smallest2']
 62 |     where smallest2' k (xs, ys) = smallest2 k (fromList xs, fromList ys)
 63 | 
 64 | evens n = [0,2..n]
 65 | odds n = [1,3..n]
 66 | 
 67 | ok1 n k = same $ k : vals (odds n) (evens n) k
 68 | 
 69 | prop1 = forAll (choose (1, 12345)) $ \n -> forAll (choose (0, n)) $ \k -> ok1 n k
 70 | 
 71 | arg :: Gen ([Integer], [Integer], Int)
 72 | arg = do
 73 |     zs <- liftM f $ oneof [listOf1 arbitrary, vector 6789]
 74 |     xs <- liftM f $ listOf (elements zs)
 75 |     let ys = zs \\ xs
 76 |     k <- choose (0, length zs - 1)
 77 |     return (xs, ys, k)
 78 |     where f = sort . nub
 79 | 
 80 | prop2 = forAll arg $ \(xs, ys, k) -> same $ vals xs ys k
 81 | 
 82 | maxlen = maximumBy (comparing f)
 83 |     where f (xs,ys,_) = length $ xs ++ ys
 84 | 
 85 | doit (xs, ys, k) = do
 86 |     putStrLn ""
 87 |     putStr "X " >> print xs
 88 |     putStr "Y " >> print ys
 89 |     putStr "k " >> print k
 90 |     putStr "result " >> print (vals xs ys k)
 91 |     putStrLn ""
 92 | 
 93 | main = do
 94 |     quickCheck prop1
 95 | 
 96 |     doit ([0..10], [11..20], 12)
 97 |     doit ([1,8,100,1000], [-3, 101, 102, 10000], 5)
 98 |     doit . maxlen =<< sample' arg
 99 | 
100 |     quickCheck prop2
101 | 


--------------------------------------------------------------------------------
/ch4/ch4.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch5/ch5.erl:
--------------------------------------------------------------------------------
 1 | 
 2 | %% @doc Chapter 5: Sorting pairwize sums
 3 | -module(ch5).
 4 | 
 5 | -export([
 6 |          sortsums/2,
 7 |          lambert_sortsums/2
 8 |         ]).
 9 | 
10 | %% @doc O(N^2 * log(N)): N = length(Xs) = length(Ys)
11 | -spec sortsums([term()], [term()]) -> [term()].
12 | sortsums(Xs, Ys) ->
13 |    lists:sort([sum(X, Y) || X <- Xs, Y <- Ys]).
14 | 
15 | -spec lambert_sortsums([term()], [term()]) -> [term()].
16 | lambert_sortsums(Xs, Ys) ->
17 |     [V || {V, _} <- sortsubs(Xs, lists:map(fun negate/1, Ys))].
18 | 
19 | -spec sortsubs([term()]) -> [{term(), {integer(), integer()}}].
20 | sortsubs([])  -> [];
21 | sortsubs([W]) -> [{W - W, {0, 0}}];
22 | sortsubs(Ws)  ->
23 |     M = length(Ws) div 2,
24 |     {Xs, Ys} = lists:split(M, Ws),
25 |     Xxs = sortsubs(Xs),
26 |     Xys = sortsubs(Xs, Ys),
27 |     Yxs = lists:map(fun ({X, {I, J}}) -> {-X, {J, I}} end, lists:reverse(Xys)),
28 |     Yys = sortsubs(Ys),
29 | 
30 |     Incl = fun ({X, {I, J}}) -> {X, {M + I, J}} end,
31 |     Incr = fun ({X, {I, J}}) -> {X, {I, M + J}} end,
32 |     Incb = fun ({X, {I, J}}) -> {X, {M + I, M + J}} end,
33 |     
34 |     lists:foldr(fun lists:merge/2, [], [Xxs, lists:map(Incl, Xys), lists:map(Incr, Yxs), lists:map(Incb, Yys)]).
35 | 
36 | -spec sortsubs([term()], [term()]) -> [{term(), {integer(), integer()}}].
37 | sortsubs(Xs, Ys) ->
38 |     Table0 = table(Xs, Ys),
39 |     XsLen = length(Xs),
40 |     YsLen = length(Ys),
41 |     ToIndex = fun ({A, B, C}) -> A * XsLen * YsLen + B * YsLen + C end,
42 |     Table = list_to_tuple([Rank || {_, Rank} <- lists:sort(lists:zip(lists:map(ToIndex, Table0), lists:seq(1,length(Table0))))]),
43 |     GetRank = fun ({A, B, C}) -> element(ToIndex({A, B, C}) + 1, Table) end,
44 |     lists:sort(fun ({_X, {I, J}}, {_Y, {K, L}}) -> GetRank({0, I, J}) < GetRank({1, K, L}) end,
45 |                subs(Xs, Ys)).
46 | 
47 | -spec subs([term()], [term()]) -> [{term(), {integer(), integer()}}].
48 | subs(Xs, Ys) ->
49 |     [{sub(X, Y), {I, J}} || {X, I} <- lists:zip(Xs, lists:seq(0, length(Xs) - 1)),
50 |                             {Y, J} <- lists:zip(Ys, lists:seq(0, length(Ys) - 1))].
51 | 
52 | -spec table([term()], [term()]) -> [{integer(), integer(), integer()}].
53 | table(Xs, Ys) ->
54 |     Xxs = sortsubs(Xs),
55 |     Yys = sortsubs(Ys),
56 |     Tag = fun (I) -> fun ({X, {J, K}}) -> {X, {I, J, K}} end end,
57 |     [Index || {_, Index} <- lists:merge(lists:map(Tag(0), Xxs), lists:map(Tag(1), Yys))].
58 | 
59 | -spec sum(number(), number()) -> number().
60 | sum(X, Y) -> X + Y.
61 | 
62 | -spec sub(number(), number()) -> number().
63 | sub(X, Y) -> X - Y.
64 | 
65 | -spec negate(number()) -> number().
66 | negate(X) -> -X.


--------------------------------------------------------------------------------
/ch5/ch5.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch6/ch6.erl:
--------------------------------------------------------------------------------
 1 | 
 2 | %% @doc Chapter6: Making a century
 3 | -module(ch6).
 4 | 
 5 | -export([
 6 |          solutions/1,
 7 |          improved_solutions/1
 8 |         ]).
 9 | 
10 | -type expression() :: [pfad_term()].
11 | -type pfad_term()  :: [factor()].
12 | -type factor()     :: [digit()].
13 | -type digit()      :: integer().
14 | 
15 | -spec solutions([digit()]) -> [expression()].
16 | solutions(Digits) ->
17 |     lists:filter(fun (E) -> good(val_expr(E)) end, expressions(Digits)).
18 | 
19 | -spec val_expr(expression()) -> integer().
20 | val_expr(Exp) ->
21 |     lists:sum(lists:map(fun val_term/1, Exp)).
22 | 
23 | -spec val_term(pfad_term()) -> integer().
24 | val_term(Term) ->
25 |     lists:foldl(fun erlang:'*'/2, 1, lists:map(fun val_fact/1, Term)).
26 | 
27 | -spec val_fact(factor()) -> integer().
28 | val_fact(Factor) ->
29 |     lists:foldl(fun (D, N) -> 10 * N + D end, 0, Factor).
30 | 
31 | -spec partitions([term()]) -> [[[term()]]].
32 | partitions([])            -> [[]];
33 | partitions([Head | Tail]) ->
34 |     TailResult = partitions(Tail),
35 |     [[[Head] | Rest] || Rest <- TailResult] ++
36 |     [[[Head | RestHead] | RestTail] || [RestHead | RestTail] <- TailResult].
37 | 
38 | -spec expressions([digit()]) -> [expression()].
39 | expressions(Digits) ->
40 |     lists:flatmap(fun partitions/1, partitions(Digits)).
41 | 
42 | -spec good(integer()) -> boolean().
43 | good(100) -> true;
44 | good(_)   -> false.
45 |  
46 | -spec improved_solutions([digit()]) -> [expression()].
47 | improved_solutions(Digits) ->
48 |     C = 100,
49 |     Candidates = lists:foldr(fun (X, Acc) -> expand(C, X, Acc) end, [], Digits),
50 |     [Fst || {Fst, _} <- lists:filter(fun ({_, Snd}) -> good(C, Snd) end, Candidates)].
51 | 
52 | -type value() :: {integer(), integer(), integer(), integer()}.
53 | 
54 | %% -spec modify(integer(), value()) -> [value()].
55 | %% modify(X, {K, F, T, E}) ->
56 | %%     [{10 * K, K * X + F, T, E},
57 | %%      {10, X, F * T, E},
58 | %%      {10, X, 1, F * T + E}].
59 | 
60 | -spec good(integer(), value()) -> boolean().
61 | good(C, {_K, F, T, E}) ->
62 |     (F * T + E =:= C).
63 | 
64 | -spec ok(integer(), value()) -> boolean().
65 | ok(C, {_K, F, T, E}) ->
66 |     (F * T + E =< C).
67 | 
68 | -spec expand(integer(), integer(), [{expression(), value()}]) -> [{expression(), value()}].
69 | expand(_, X, [])  -> [{[[[X]]], {10, X, 1, 0}}];
70 | expand(C, X, Evs) ->
71 |     lists:append(
72 |       lists:map(fun ({E, V}) ->
73 |                         lists:filter(fun ({_, Snd}) -> ok(C, Snd) end, glue(X, {E, V}))
74 |                 end,
75 |                 Evs)).
76 | 
77 | -spec glue(integer(), {expression(), value()}) -> [{expression(), value()}].
78 | glue(X, {[[Xs | Xss] | Xsss], {K, F, T, E}}) ->
79 |     [
80 |      {[[[X | Xs] | Xss] | Xsss],  {10 * K, K * X + F, T, E}},
81 |      {[[[X], Xs | Xss] | Xsss],   {10, X, F * T, E}},
82 |      {[[[X]], [Xs | Xss] | Xsss], {10, X, 1, F * T + E}}
83 |     ].


--------------------------------------------------------------------------------
/ch6/ch6.hs:
--------------------------------------------------------------------------------
  1 | import Text.Parsec
  2 | import Text.Parsec.Token
  3 | import Text.Parsec.Expr
  4 | import Text.Parsec.Language
  5 | import Data.Char
  6 | import Data.List
  7 | import Test.QuickCheck
  8 | import Control.Monad
  9 | 
 10 | -- this is my quick & dirty version
 11 | -- get all arrangments -> parsec -> filter
 12 | make :: [Integer] -> [String]
 13 | make [] = []
 14 | make [x] = [show x]
 15 | make (x:xs) = concat [ [s ++ y, s ++ " + " ++ y, s ++ "*" ++ y] | y <- make xs ]
 16 |     where s = show x
 17 | 
 18 | get :: String -> Integer
 19 | get s = case parse expr "" s of
 20 |              Right i -> i
 21 | 
 22 | solutions :: Integer -> [Integer] -> [String]
 23 | solutions ans = filter ((==ans) . get . strip) . make
 24 |     where strip = filter (/= ' ')
 25 | 
 26 | -- parser
 27 | lexer = makeTokenParser emptyDef
 28 | expr = buildExpressionParser table (decimal lexer)
 29 | table = [[op "*" (*) AssocLeft], [op "+" (+) AssocLeft]]
 30 |     where op s f = Infix (do {string s; return f})
 31 | 
 32 | -- print helper
 33 | doit sol ans digits = do
 34 |     putStrLn $ "get " ++ s ++ " from " ++ show digits ++ ":\n"
 35 |     mapM_ (putStrLn . f) $ sol ans digits
 36 |     putStrLn ""
 37 |     where s = show ans
 38 |           f x = s ++ " = " ++ x
 39 | 
 40 | -- this is actually like a top-down parsing
 41 | -- list is such a (universally) convenient data structure
 42 | type Expr = [Term]
 43 | type Term = [Factor]
 44 | type Factor = [Integer]
 45 | 
 46 | valExpr :: Expr -> Integer
 47 | valExpr = sum . map valTerm
 48 | 
 49 | valTerm :: Term -> Integer
 50 | valTerm = product . map valFact
 51 | 
 52 | valFact :: Factor -> Integer
 53 | valFact = foldl1 (\x d -> x * 10 + d)
 54 | 
 55 | showExpr :: Expr -> String
 56 | showExpr = intercalate " + " . map showTerm
 57 | 
 58 | showTerm :: Term -> String
 59 | showTerm = intercalate "*" . map showFact
 60 | 
 61 | showFact :: Factor -> String
 62 | showFact = map (intToDigit . fromIntegral)
 63 | 
 64 | good c = (== c)
 65 | solutions1 c = map showExpr . filter (good c . valExpr) . exprs
 66 | 
 67 | exprs :: [Integer] -> [Expr]
 68 | exprs = foldr extend []
 69 | 
 70 | extend :: Integer -> [Expr] -> [Expr]
 71 | extend x [] = [[[[x]]]]
 72 | extend x es = concatMap (glue x) es
 73 | 
 74 | glue :: Integer -> Expr -> [Expr]
 75 | glue x ((xs:xss):xsss) =
 76 |     [ ((x:xs) : xss) : xsss
 77 |     , ([x] : xs : xss) : xsss
 78 |     , [[x]] : (xs:xss) : xsss ]
 79 | 
 80 | -- fatest; shortest
 81 | -- foldr fusion works like a pruning dfs
 82 | good2 c (k,f,t,e) = f*t+e == c
 83 | ok2 c (k,f,t,e) = f*t+e <= c
 84 | solutions2 c = map (showExpr . fst) . filter (good2 c . snd) . foldr (expand c) [([],(0,0,0,0))]
 85 | expand c x [] = []
 86 | expand c x [([],_)] = [([[[x]]], (10,x,1,0))]
 87 | expand c x es = concatMap (filter (ok2 c . snd) . glue2 x) es
 88 | glue2 x ((xs:xss):xsss, (k,f,t,e)) =
 89 |     [ (((x:xs) : xss) : xsss, (10*k, k*x + f, t, e))
 90 |     , (([x] : xs : xss) : xsss, (10, x, f*t, e))
 91 |     , ([[x]] : (xs:xss) : xsss, (10, x, 1, f*t + e))]
 92 | 
 93 | -- tests
 94 | digits = liftM (take 9) . listOf $ elements [1..9]
 95 | dst = choose (1,1000)
 96 | same xs = all (== head xs) xs
 97 | run c ds = map (\s -> sort $ s c ds) [solutions, solutions1, solutions2]
 98 | prop = forAll (liftM2 (,) digits dst) $ \(ds, c) -> same $ run c ds
 99 | 
100 | -- some examples
101 | main = do
102 |     doit solutions 100 [1..9]
103 |     doit solutions1 1234 $ map (fromIntegral . digitToInt) $ take 12 . drop 2 $ show pi
104 |     doit solutions2 9876 $ map (fromIntegral . digitToInt) $ take 20 . drop 2 $ show (exp 1)
105 |     verboseCheck prop
106 | 


--------------------------------------------------------------------------------
/ch6/ch6.md:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch7/ch7.erl:
--------------------------------------------------------------------------------
 1 | %% @doc Chapter7: Building a tree with minimum height
 2 | -module(ch7).
 3 | 
 4 | -export([
 5 |          mincost_tree/1,
 6 |          linear_time_mincost_tree/1,
 7 |          trees/1,
 8 |          cost/1
 9 |         ]).
10 | 
11 | -type tree() :: {leaf, integer()} | {fork, tree(), tree()}.
12 | 
13 | -type forest() :: [tree()].
14 | 
15 | -type tree_with_cost() :: {integer(), tree()}.
16 | 
17 | -spec cost(tree()) -> integer().
18 | cost({leaf, X})    -> X;
19 | cost({fork, U, V}) -> 1 + max(cost(U), cost(V)).
20 | 
21 | -spec mincost_tree([integer()]) -> tree().
22 | mincost_tree(Fringes) ->
23 |     pfad_util:min_by(fun cost/1, trees(Fringes)).
24 | 
25 | -spec trees([integer()]) -> [tree()].
26 | trees([X])      -> [{leaf, X}];
27 | trees([X | Xs]) -> lists:flatmap(prefixes(X), trees(Xs)).
28 | 
29 | -spec prefixes(integer()) -> fun ((tree()) -> [tree()]).
30 | prefixes(X) ->
31 |     fun (Tree) ->
32 |             [{fork, {leaf, X}, Tree}] ++
33 |             case Tree of
34 |                 {leaf, _}    -> [];
35 |                 {fork, U, V} -> [{fork, U2, V} || U2 <- (prefixes(X))(U)]
36 |             end
37 |     end.
38 | 
39 | %% @doc foldr version of trees/1
40 | %% -spec trees([integer()]) -> [tree()].
41 | %% trees(Fringes) ->
42 | %%     [Head | Tail] = lists:reverse(Fringes),
43 | %%     Fun = fun (X, Trees) -> lists:flatmap(prefixes(X), Trees) end,
44 | %%     lists:foldl(Fun, [{leaf, Head}], Tail).
45 | 
46 | %% @doc forest version of trees/1
47 | %% -spec trees([integer()]) -> [tree()].
48 | %% trees(Fringes) ->
49 | %%     lists:map(fun rollup/1, forests(Fringes)).
50 | 
51 | %% -spec forests([integer()]) -> [forest()].
52 | %% forests(Fringes) ->
53 | %%     [Head | Tail] = lists:reverse(Fringes),
54 | %%     Fun = fun (X, Forests) -> lists:flatmap(prefixes(X), Forests) end,
55 | %%     lists:foldl(Fun, [[{leaf, Head}]], Tail).
56 | 
57 | %% -spec prefixes(integer()) -> fun ((forest()) -> [forest()]).
58 | %% prefixes(X) ->
59 | %%     fun (Forest) ->
60 | %%             [begin
61 | %%                  {Front, Rear} = lists:split(K, Forest),
62 | %%                  [{leaf, X}, rollup(Front) | Rear]
63 | %%              end || K <- lists:seq(1, length(Forest))]
64 | %%     end.
65 | 
66 | -spec rollup(forest()) -> tree().
67 | rollup([Head | Tail]) ->
68 |     lists:foldl(fun (Tree1, Tree2) -> {fork, Tree2, Tree1} end, Head, Tail).
69 | 
70 | -spec linear_time_mincost_tree([integer()]) -> tree().
71 | linear_time_mincost_tree(Fringes) ->
72 |     [Head | Tail] = lists:reverse(Fringes),
73 |     rollup([Tree || {_, Tree} <- lists:foldl(fun insert/2, [leaf(Head)], Tail)]).
74 | 
75 | -spec leaf(integer()) -> tree_with_cost().
76 | leaf(X) -> {X, {leaf, X}}.
77 | 
78 | -spec fork(tree_with_cost(), tree_with_cost()) -> tree_with_cost().
79 | fork({Cost1, Tree1}, {Cost2, Tree2}) ->
80 |     {1 + max(Cost1, Cost2), {fork, Tree1, Tree2}}.
81 | 
82 | -spec insert(integer(), [tree_with_cost()]) -> [tree_with_cost()].
83 | insert(X, Ts) ->
84 |     [leaf(X) | split(X, Ts)].
85 |                     
86 | -spec split(integer(), [tree_with_cost()]) -> [tree_with_cost()].
87 | split(_, Ts = [_])                                         -> Ts;
88 | split(X, Ts = [{UC, _}, {VC, _} | _]) when X < VC, UC < VC -> Ts;
89 | split(X, [U, V | Ts])                                      -> split(X, [fork(U, V) | Ts]).


--------------------------------------------------------------------------------
/ch8/ch8.erl:
--------------------------------------------------------------------------------
1 | 
2 | 


--------------------------------------------------------------------------------
/ch9/ch9.md:
--------------------------------------------------------------------------------
1 | c
2 | 


--------------------------------------------------------------------------------