利用OCaml实现一些数据结构和算法

这里记录一下最近用OCaml做一些简单的算法实现 持续更新。。。

1. `插入排序`

utop #
let rec insertion_sort_helper result_list input_list = match input_list with| [] -> result_list| h :: t -> insertion_sort_helper (insert result_list h) tand insert result_list e = match result_list with | [] -> [e]| [h] -> if e >= h then [h; e]else [e; h] | h0 :: h1 :: h2 ->  if e >= h0 && e <= h1 then h0 :: e :: h1 :: h2else h0 :: insert (h1 :: h2) elet insertion_sort = insertion_sort_helper []
;;val insertion_sort_helper : 'a list -> 'a list -> 'a list = <fun>
val insert : 'a list -> 'a -> 'a list = <fun>
val insertion_sort : '_weak3 list -> '_weak3 list = <fun>

测试

utop # insertion_sort [];;
- : '_weak3 list = []utop # insertion_sort [0];;
- : int list = [0]utop # insertion_sort [1; 0];;
- : int list = [0; 1]utop # insertion_sort [0; 10; 1; 2; 3; 5; 3; 6; 8; 9; 2; 4];;
- : int list = [0; 1; 2; 2; 3; 3; 4; 5; 6; 8; 9; 10]

其中insertion_sort函数类型为:

utop # let insertion_sort = insertion_sort_helper []
val insertion_sort : '_weak3 list -> '_weak3 list = <fun>

修改一下insertion_sort的定义:

utop # let insertion_sort input_list = insertion_sort_helper [] input_list;;
val insertion_sort : 'a list -> 'a list = <fun>

'_weak3 暂时还没弄清楚, 等想明白了再更新.

值得注意的是，算法导论里面对插入排序的描述是给定一个j索引，然后在索引j处从后往前遍历数组A[1…j-1]，并进行比较，然后插入A[j]元素到前缀数组中；这里我们实现时，相当于是从前往后插入A[j]到数组A[1…j-1]中；然而这两种插入方式，实际上是等效的。

在对函数式语言的代码进行算法复杂度分析时，用到master theorem.

2. `线性搜索`

输入数组 A, v；如果A中存在索引i使得A[i] = v, 返回i，如果不存在返回空

utop #
let rec linear_search_helper i v = function | [] -> None| h :: t -> if h = v then Some i else linear_search_helper (i + 1) v tlet linear_search list v = linear_search_helper 0 v list
;;
val linear_search_helper : int -> 'a -> 'a list -> int option = <fun>
val linear_search : 'a list -> 'a -> int option = <fun>

测试

utop # linear_search [] 4;;
- : int option = Noneutop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 4;;
- : int option = Noneutop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 0;;
- : int option = Some 0utop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 1;;
- : int option = Some 2utop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 2;;
- : int option = Some 4utop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 3;;
- : int option = Some 6utop # linear_search [0; 0; 1; 1; 2; 2; 3; 3] 4;;
- : int option = None

3. `选择排序`

utop #
let rec selection_sort_helper acc list = match list with| [] -> acc| h0 :: t0 ->let max_list = find_max_list t0 inmatch max_list with | [] -> selection_sort_helper (h0 :: acc) []| h1 :: t2 -> if h1 > h0 then selection_sort_helper (h1 :: acc) (h0 :: t2)else selection_sort_helper (h0 :: acc) (h1 :: t2)and find_max_list_helper acc list = match list with| [] -> acc| h :: t -> match acc with | [] -> find_max_list_helper [h] t| max :: tail -> if h > max then find_max_list_helper (h :: acc) telse find_max_list_helper (max :: h :: tail) t  and find_max_list list = find_max_list_helper [] listlet selection_sort list = selection_sort_helper [] list
;;
val selection_sort_helper : 'a list -> 'a list -> 'a list = <fun>
val find_max_list_helper : 'a list -> 'a list -> 'a list = <fun>
val find_max_list : 'a list -> 'a list = <fun>
val selection_sort : 'a list -> 'a list = <fun>

测试

utop # selection_sort [];;
- : 'a list = []utop # selection_sort [0];;
- : int list = [0]utop # selection_sort [1; 0];;
- : int list = [0; 1]utop # insertion_sort [0; 10; 1; 2; 3; 5; 3; 6; 8; 9; 2; 4];;
- : int list = [0; 1; 2; 2; 3; 3; 4; 5; 6; 8; 9; 10]

选择排序用可变数据结构实现起来非常简单，但是用纯函数式实现，可能需要想一下，不过也很容易…

find_max_list 函数作用于一个列表，将该列表最大值放在首部。

selection_sort_helper的思想就是将待排序的列表分为左右两截，左侧(acc, 表示accumulator)为排好序的，右侧(list)为未排序的，那么调用find_max_list找到右侧list的最大值并将其追加到acc的首部；

此时，左侧acc添加一个元素，右侧减少一个元素，再递归地执行，直到右侧list元素为空。那么此时acc就是整个排好序的列表。

4. `归并排序`

不可变List怎么去实现？我们知道归并是典型的分治算法，先将数组分为两半，然后对两半分别进行排序，然后把两个排好序的数组进行合并。

对于不可变数组，两个问题：

怎么将List分为两半 ?
怎么合并两个(已经有序的)List ?

对于第二个问题实现起来很直观: merge list1 list2, 对比头节点，然后拼接到结果List中，然后递归地对比拼接

第一个问题，怎么将List分成两半？快慢法
引入三个数组：list1, list2, list3，定义

list1为最终得到的折半List的前缀，初始为 []
list2为最终得到的折半List的后缀，初始为需要折半的List
list3用于折半分裂的工具List，初始为需要折半的List

我们不断执行下面的步骤：

list2去掉1个前缀元素，添加到list1中
list3去掉2个前缀元素

这样，保证：当list3为空时，list1, list2分别占有一半元素(列表元素数为奇数时，其中list1, list2元素差1)

下面是具体实现:

utop #
let rec merge_sort list = let l, r = split list in match l, r with | ([], _) -> r| (_, []) -> l| (_, _) -> merge (merge_sort l) (merge_sort r) and split list = split_helper [] list listand split_helper list1 list2 list3 = match list3 with | [] | [_] -> List.rev list1, list2| h1 :: h2 :: t -> match list2 with | hd :: tl -> split_helper (hd :: list1) tl tand merge list1 list2 = List.rev (merge_helper [] list1 list2)and merge_helper result list1 list2 = match (list1, list2) with | ([], []) -> result  | ([], h :: t) -> merge_helper (h :: result) [] t| (h :: t, []) -> merge_helper (h :: result) t []| (h1 :: t1), (h2 :: t2) -> if h1 <= h2 then merge_helper (h1 :: result) t1 list2else merge_helper (h2 :: result) list1 t2;;
Lines 14-15, characters 8-55:
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
[]
val merge_sort : 'a list -> 'a list = <fun>
val split : 'a list -> 'a list * 'a list = <fun>
val split_helper : 'a list -> 'a list -> 'a list -> 'a list * 'a list = <fun>
val merge : 'a list -> 'a list -> 'a list = <fun>
val merge_helper : 'a list -> 'a list -> 'a list -> 'a list = <fun>

测试

utop # merge_sort [];;
- : 'a list = []utop # merge_sort [0];;
- : int list = [0]utop # merge_sort [1; 0;];;
- : int list = [0; 1]utop # merge_sort [0; 10; 1; 2; 3; 5; 3; 6; 8; 9; 2; 4];;
- : int list = [0; 1; 2; 2; 3; 3; 4; 5; 6; 8; 9; 10]

5. `冒泡排序`

这里实现没有尾递归，后面有给一个尾递归版本。

utop #
let rec bubbo_sort list = bubbo_sort_helper0 [] list(* @param result: 当先已经排序好的数组@param list: 需要排序的数组@return 整个排序好的数组
*)
and bubbo_sort_helper0 result list = let l, r = bubbo_sort_helper result list inmatch r with| [] -> l| _ -> bubbo_sort_helper0 l r(*@param result: 当前已经排序好的数组@param list: 需要排序的数组@param (l, r): l: 排序好的数组; r: 仍然需要排序的数组
*)
and bubbo_sort_helper result list =match list with| [] -> result, []| [e] -> e :: result, []| h0 :: h1 :: t -> if h0 >= h1 then let l, r = bubbo_sort_helper result (h0 :: t) inl, h1 :: relse let l, r = bubbo_sort_helper result (h1 :: t) inl, h0 :: r;;
val bubbo_sort : 'a list -> 'a list = <fun>
val bubbo_sort_helper0 : 'a list -> 'a list -> 'a list = <fun>
val bubbo_sort_helper : 'a list -> 'a list -> 'a list * 'a list = <fun>

测试

utop # bubbo_sort [];;
- : 'a list = []utop # bubbo_sort [0];;
- : int list = [0]utop # bubbo_sort [1; 0];;
- : int list = [0; 1]utop # bubbo_sort [0; 10; 1; 2; 3; 5; 3; 6; 8; 9; 2; 4];;
- : int list = [0; 1; 2; 2; 3; 3; 4; 5; 6; 8; 9; 10]

另外一种，来自：https://codereview.stackexchange.com/questions/125571/recursive-bubble-sort-in-ocaml

utop # let rec bubbo_sort list =
let swap_adj = match list with| [] -> []| [e] -> [e]| h0 :: h1 :: t ->if h0 < h1 then h0 :: bubbo_sort (h1 :: t)else h1 :: bubbo_sort (h0 :: t)
in if list = swap_adj then swap_adjelse bubbo_sort swap_adj ;;

思想就是不断交换相邻的元素，直到达到稳定状态。

6. `逆序对的数量`

给定数组A[1, …, n], 存在 1 < i < j <= n使得A[i] > A[j] ，我们称(i, j)所组成的(A[i], A[j])为一个逆序对。求数组A存在多少个(i, j)所组成的逆序对。

利用归并的思想(分治)：

将数组分成左右两半AL, AR
求解AL逆序对数量为l, AR逆序对数量为r. (base情况为当n <= 1时，逆序对数量为0)
求解AL中大于AR中元素的数量 m (此时AL, AR分别有序，充分利用有序这个特点降低求解复杂度)
merge AL, AR使其有序
最终结果为 (有序的A, l+r+m)

时间复杂度分析: T(n) = 2T(n/2) + O(n), 参考Master theorem, 得到O(nlogn)

utop #
(* list: 待求解的列表*)let rec sum_inversions list = let _, inversion_nums = sum_inversions0 list in inversion_numsand sum_inversions0 = function| [] -> [], 0| [e] -> [e], 0| list -> let left, right = split list in  let (left, l), (right, r) = (sum_inversions0 left), (sum_inversions0 right) in let m = sum_merged_inversions left right in(merge left right), l+m+rand split list = let left, right = split_helper [] list list inList.rev left, right(*left: 每次增加一个元素right: 每次减少一个元素, 添加到left上list: 每次减少两个元素
*)
and split_helper left right list = match list with | [] | [_] -> left, right| h1 :: h2 :: t1 -> let rh :: rt = right in  split_helper (rh :: left) rt t1(*left: 左侧已经排好序的数组len: 当前left数组长度right: 右侧已经拍好序的数组
*)
and sum_merged_inversions left right = sum_merged_inversions0 left (List.length left) right(* left: 当前左侧子数组len: 整个左侧数组的长度right: 当前右侧子数组*)
and sum_merged_inversions0 left len right = match left, right with | _, [] | [], _ -> 0| h0 :: t0, h1 :: t1 -> if h0 > h1 then(* 左侧数组都与j成为逆序对 *) len + sum_merged_inversions0 left len t1else sum_merged_inversions0 t0 (len-1) rightand merge left right = match left, right with | [], _ -> right| _, [] -> left| h0 :: t0, h1 :: t1 -> if h0 > h1 then h1 :: (merge left t1) else h0 :: (merge t0 right);;

测试：

utop # sum_inversions [2; 3; 4; 5; 6; 1];;
- : int = 5utop # sum_inversions [2; 3; 8; 6; 1];;
- : int = 5utop # sum_inversions [3; 2];;
- : int = 1utop # sum_inversions [0];;
- : int = 0utop # sum_inversions [];;
- : int = 0

7. `二叉树`

定义数据结构；

树，要么结构是叶子结点(虚拟)，要么结构是有带有一个数据类型为’a，并且有两个子树的

type 'a tree = | Leaf| Node of 'a * 'a tree * 'a tree
;;type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree

其中，type 'a tree 叫做：Parameterized Variants

例子：

(*4/   \2     5/ \   /  \
1   3 6    7
*)
let t = Node (4, Node (2, Node (1, Leaf, Leaf),Node (3, Leaf, Leaf)),Node (5,Node (6, Leaf, Leaf),Node (7, Leaf, Leaf)))
;;val t : int tree =Node (4, Node (2, Node (1, Leaf, Leaf), Node (3, Leaf, Leaf)),Node (5, Node (6, Leaf, Leaf), Node (7, Leaf, Leaf)))

求节点的数量:

let rec size_of_tree = function| Leaf -> 0| Node (_, l, r) -> 1 + size_of_tree(l) + size_of_tree(r);;
val size_of_tree : 'a tree -> int = <fun>

测试:

utop #
size_of_tree t;;
- : int = 7

给定值v，求是否树中存在与该值的结点？

let rec value_in_tree v = function | Leaf -> false| Node (value, left, right) -> v = value|| value_in_tree v left || value_in_tree v right;;
val value_in_tree : 'a -> 'a tree -> bool = <fun>

先序遍历:

let rec pre_order tree = List.rev (pre_order0 [] tree)and pre_order0 acc = function | Leaf -> acc| Node (v, left, right) -> pre_order0 (pre_order0 (v :: acc) left) right
;;val pre_order : 'a tree -> 'a list = <fun>
val pre_order0 : 'a list -> 'a tree -> 'a list = <fun>

测试:

utop #
pre_order t;;
- : int list = [4; 2; 1; 3; 5; 6; 7]

这个更加优雅:

let preorder_lin t =let rec pre_acc acc = function| Leaf -> acc| Node {value; left; right} -> value :: (pre_acc (pre_acc acc right) left) in pre_acc [] t