├── .gitignore ├── CLAUDE.md ├── Makefile ├── README.md ├── archive ├── array_utils.ml ├── avl.ml ├── bst.ml ├── btree.ml ├── continuation.ml ├── counting.ml ├── dijkstra.ml ├── distance.ml ├── fib.ml ├── graph.ml ├── heap.ml ├── heaps.ml ├── leftist_tree.ml ├── merge.ml ├── multi_tree.ml ├── pqueue.ml ├── python │ ├── avl_tree.py │ ├── binary_heap.py │ ├── dijkstra.py │ ├── graph.py │ └── graph2.py ├── queue.ml ├── quick.ml ├── random_shuffle.ml ├── red_black_tree.ml ├── search.ml ├── set.ml ├── shuffle.ml ├── sort.ml ├── sorting.ml ├── splay_tree.ml └── utils │ ├── benchmark.ml │ ├── list_utils.ml │ └── utils.ml ├── dune-project ├── ods.opam ├── src ├── .merlin ├── dune ├── ods.ml ├── sorting.ml ├── sorting │ ├── bubble_sort.ml │ ├── counting_sort.ml │ ├── dune │ ├── heap_sort.ml │ ├── insertion_sort.ml │ ├── merge_sort.ml │ ├── quick_sort.ml │ ├── radix_sort.ml │ ├── selection_sort.ml │ └── sorting.ml └── trees │ ├── avl_tree.ml │ ├── binary_search_tree.ml │ ├── btree.ml │ ├── dune │ ├── fenwick_tree.ml │ ├── red_black_tree.ml │ ├── segment_tree.ml │ ├── splay_tree.ml │ ├── suffix_tree.ml │ ├── treap.ml │ ├── trees.ml │ ├── trie.ml │ └── union_find.ml └── test ├── .merlin ├── dune ├── test_sort.ml └── test_trees.ml /.gitignore: -------------------------------------------------------------------------------- 1 | *.annot 2 | *.cmo 3 | *.cma 4 | *.cmi 5 | *.a 6 | *.o 7 | *.cmx 8 | *.cmxs 9 | *.cmxa 10 | *.mldylib 11 | *.mllib 12 | *.META 13 | 14 | # ocamlbuild working directory 15 | _build/ 16 | _tags 17 | configure 18 | 19 | # ocamlbuild targets 20 | *.byte 21 | *.native 22 | 23 | # oasis generated files 24 | setup.data 25 | setup.log 26 | 27 | myocamlbuild.ml 28 | setup.ml 29 | -------------------------------------------------------------------------------- /CLAUDE.md: -------------------------------------------------------------------------------- 1 | # CLAUDE.md 2 | 3 | This file provides guidance to Claude Code (claude.ai/code) when working with code in this repository. 4 | 5 | ## Project Overview 6 | 7 | This repository contains OCaml implementations of common data structures and algorithms (ODS) for educational purposes. It includes implementations of: 8 | 9 | - Binary Search Trees 10 | - Red-Black Trees 11 | - Sorting Algorithms 12 | 13 | The archive directory contains additional implementations that may be referenced or integrated into the main library. 14 | 15 | ## Build Commands 16 | 17 | - `make build` - Clean and build the project 18 | - `make clean` - Clean build artifacts 19 | - `make test` - Run tests 20 | - `make utop` - Start OCaml REPL with the library loaded 21 | 22 | ## Development Workflow 23 | 24 | 1. The project uses Dune as the build system 25 | 2. Main source files are in the `src/` directory 26 | 3. Tests are in the `test/` directory using OUnit framework 27 | 4. Archive contains older implementations for reference 28 | 29 | ## Code Architecture 30 | 31 | - The code uses OCaml's module system and functors for abstraction 32 | - Data structures are typically implemented as algebraic data types 33 | - Heavy use of pattern matching for algorithm implementation 34 | - Tree-based data structures follow recursive functional implementation patterns 35 | - Self-balancing trees include appropriate rebalancing operations 36 | 37 | ## Running Tests 38 | 39 | Tests are written using the OUnit framework: 40 | 41 | - Run all tests: `make test` 42 | - Run a specific test: `dune exec test/test_sort.exe` 43 | 44 | ## Environment Setup 45 | 46 | Before development, ensure OCaml environment is properly set up: 47 | ``` 48 | eval $(opam env) 49 | dune build 50 | ``` -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: build 2 | 3 | .PHONY: clean 4 | clean: 5 | @dune clean 6 | 7 | .PHONY: build 8 | build: clean 9 | @dune build 10 | 11 | .PHONY: utop 12 | utop: 13 | @dune utop lib 14 | 15 | .PHONY: test 16 | test: clean 17 | @dune runtest 18 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # OCaml Data Structures and Algorithms 2 | 3 | A comprehensive library of data structures and algorithms implemented in OCaml. This library is designed for educational purposes to demonstrate how common data structures and algorithms can be implemented in a functional programming language. 4 | 5 | ## Data Structures 6 | 7 | ### Tree-based Data Structures 8 | - Binary Search Tree 9 | - AVL Tree (Self-balancing) 10 | - Red-Black Tree (Self-balancing) 11 | - Splay Tree (Self-adjusting) 12 | - Treap (Randomized BST) 13 | - B-Tree (Multi-way search tree) 14 | - Trie (Prefix tree) 15 | - Segment Tree (Range queries) 16 | - Fenwick Tree / Binary Indexed Tree (Prefix sums) 17 | - Suffix Tree (Pattern matching) 18 | - Union-Find / Disjoint Set (Connectivity) 19 | 20 | ### Sorting Algorithms 21 | - Bubble Sort 22 | - Selection Sort 23 | - Insertion Sort 24 | - Merge Sort 25 | - Quick Sort 26 | - Heap Sort 27 | - Counting Sort 28 | - Radix Sort 29 | 30 | ## Building 31 | 32 | ```bash 33 | # Setup OPAM environment 34 | eval $(opam env) 35 | 36 | # Build the project 37 | make build 38 | 39 | # Run tests 40 | make test 41 | 42 | # Start OCaml REPL with library loaded 43 | make utop 44 | ``` 45 | 46 | ## Usage 47 | 48 | ```ocaml 49 | # Using sorting algorithms 50 | open Ods 51 | 52 | (* Using basic sorting *) 53 | let sorted_list = Sorting.Bubble.sort [5; 2; 1; 4; 3];; 54 | let sorted_array = Sorting.Quick.sort_array [|5; 2; 1; 4; 3|];; 55 | 56 | (* Using automatic algorithm selection *) 57 | let optimal_sort = Sorting.sort_list [5; 2; 1; 4; 3];; 58 | 59 | # Using tree data structures 60 | open Ods 61 | 62 | (* Create and use an AVL tree *) 63 | let avl = Trees.AVL.build [5; 3; 8; 1; 4; 7; 10];; 64 | let has_value = Trees.AVL.member 5 avl;; 65 | let values = Trees.AVL.inorder avl;; 66 | ``` 67 | 68 | ## Project Structure 69 | 70 | ``` 71 | /src 72 | /sorting - Sorting algorithm implementations 73 | /trees - Tree data structure implementations 74 | ods.ml - Main library module 75 | /test - Test suite 76 | ``` 77 | 78 | ## License 79 | 80 | Apache License 2.0 -------------------------------------------------------------------------------- /archive/array_utils.ml: -------------------------------------------------------------------------------- 1 | module ArrayUtil = struct 2 | let swap i j arr = 3 | let temp = xs.(j) in 4 | xs.(j) <- xs.(i) 5 | xs.(i) <- temp 6 | end 7 | -------------------------------------------------------------------------------- /archive/avl.ml: -------------------------------------------------------------------------------- 1 | (* OCaml AVL Trees *) 2 | 3 | type 'a tree = Node of 'a * 'a tree * 'a tree | Leaf 4 | 5 | let rec insert x = function 6 | Leaf -> Node (x, Leaf, Leaf) 7 | | Node (y, l, r) as t -> 8 | if x = y then t 9 | else if x > y then Node (y, l, (insert x r)) 10 | else Node (y, (insert x l), r) 11 | 12 | let rec contains x = function 13 | Leaf -> false 14 | | Node (y, l, r) -> 15 | if x = y then true 16 | else if (x < y) then contains x l 17 | else contains x r 18 | 19 | let insert_many = List.fold_left (fun acc x -> insert x acc) Leaf 20 | -------------------------------------------------------------------------------- /archive/bst.ml: -------------------------------------------------------------------------------- 1 | (* OCaml Binary Search Trees *) 2 | 3 | type comparison = Less 4 | | Equal 5 | | Greater 6 | 7 | module type ORDERED_TYPE = 8 | sig 9 | type t 10 | val cmp: t -> t -> comparison 11 | end 12 | 13 | module BinarySearchTree = 14 | functor (Elt: ORDERED_TYPE) -> 15 | struct 16 | type t = Elt.t 17 | type bst = Empty 18 | | Node of t * bst * bst 19 | let empty() = Empty 20 | let is_empty = function 21 | Empty -> true 22 | | Node (_, _, _) -> false 23 | let rec insert item = function 24 | Empty -> Node (item, Empty, Empty) 25 | | Node (m, left, right) -> 26 | match Elt.cmp item m with 27 | Equal -> Node (m, left, right) 28 | | Less -> Node (m, (insert item left), right) 29 | | Greater -> Node (m, left, (insert item right)) 30 | let rec min = function 31 | Empty -> None 32 | | Node (_, left, _) -> 33 | match left with 34 | Empty -> None 35 | | Node(v, Empty, Empty) -> Some(v) 36 | | Node(_, l, _) -> min(l) 37 | end 38 | 39 | module OrderedIntType = 40 | struct 41 | type t = int 42 | let cmp x y = if x = y then Equal 43 | else if x < y then Less 44 | else Greater 45 | end 46 | 47 | module IntBst = BinarySearchTree(OrderedIntType) 48 | -------------------------------------------------------------------------------- /archive/btree.ml: -------------------------------------------------------------------------------- 1 | type 'a tree = 2 | | Leaf 3 | | Node of 'a tree * 'a * 'a tree 4 | 5 | module type BTree = sig 6 | val insert : 'a -> 'a tree -> 'a tree 7 | val member : 'a -> 'a tree -> bool 8 | val size : 'a tree -> int 9 | end 10 | 11 | type order = Lt | Eq | Gt 12 | 13 | module Int = 14 | struct 15 | type t = int 16 | let comp (x,y) = 17 | if x > y then Gt 18 | else if x < y then Lt 19 | else Eq 20 | end 21 | 22 | let rec insert v = function 23 | | Leaf -> Node(Leaf, v, Leaf) 24 | | Node(l,item,r) 25 | (* Insertion on the left subtree *) 26 | -> if v < item then Node((insert v l), item, r) 27 | (* Insertion on the right subtree *) 28 | else if v > item then Node(l, item, (insert v r)) 29 | else Node(l, item, r) 30 | 31 | exception EmptyTree (* fail if calling delete on empty tree *) 32 | 33 | let rec delete_max = function 34 | | Leaf -> raise EmptyTree 35 | | Node(l,v,Leaf) -> (v, l) 36 | | Node(l,v,r) -> 37 | let (max, r') = delete_max r in (max, Node(l,v,r')) 38 | 39 | let rec delete x = function 40 | | Leaf -> Leaf 41 | | Node(l,v,Leaf) when v=x -> l 42 | | Node(Leaf,v,r) when v=x -> r 43 | | Node(l,v,r) -> 44 | if x=v then let (pred, l') = delete_max l in Node(l', pred, r) 45 | else if x < v then Node(delete x l, v, r) 46 | else Node(l,v, delete x r) 47 | 48 | let rec contains value = function 49 | | Leaf -> false 50 | | Node(l,v,r) -> 51 | if value=v then true 52 | else if value < v then contains value l 53 | else contains value r 54 | 55 | let rec member x = function 56 | | Leaf -> false 57 | | Node(l,v,r) -> 58 | if x=v then true 59 | else if x < v then member x l 60 | else member x r 61 | 62 | type direction = Left | Right 63 | 64 | let height tree = 65 | let rec aux d = function 66 | | Leaf -> 0 67 | | Node(l,_,r) -> 68 | match d with 69 | | Left -> 1 + (aux Left l) 70 | | Right -> 1 + (aux Right r) 71 | in 72 | let height_left = aux Left tree 73 | and height_right = aux Right tree 74 | in max height_left height_right 75 | 76 | (* Build a tree from a list *) 77 | let make_tree = 78 | List.fold_left 79 | (fun acc v -> insert v acc) Leaf 80 | 81 | let root_node = function 82 | | Leaf -> None 83 | | Node(_,v,_) -> Some(v) 84 | 85 | let rec left_sub_tree = function 86 | | Leaf -> [] 87 | | Node(l,v,_) -> v :: left_sub_tree l 88 | 89 | let rec right_sub_tree = function 90 | | Leaf -> [] 91 | | Node(_,v,r) -> v :: right_sub_tree r 92 | 93 | let sample_tree = make_tree [7;1;0;3;2;5;4;6;9;8;10];; 94 | 95 | let rec preorder = function 96 | Leaf -> [] 97 | | Node(l,v,r) -> [v] @ (preorder l) @ (preorder r) 98 | and rec inorder = function 99 | Leaf -> [] 100 | | Node(l,v,r) -> 101 | (inorder l) @ [v] @ (inorder r) 102 | and rec postorder = function 103 | Leaf -> [] 104 | | Node(l,v,r) -> postorder l @ postorder r @ [v] 105 | 106 | (* Functions to map a function f over a tree structure *) 107 | let rec pre_map ~f = function 108 | | Leaf -> [] 109 | | Node(l,v,r) -> 110 | let x = f v in 111 | [x] @ (pre_map f l) @ (pre_map f r) 112 | 113 | let rec inorder_map ~f = function 114 | | Leaf -> [] 115 | | Node(l,v,r) -> 116 | let x = f v in 117 | (inorder_map f l) @ [x] @ (inorder_map f r) 118 | 119 | let rec post_map ~f = function 120 | | Leaf -> [] 121 | | Node(l,v,r) -> 122 | let x = f v in 123 | post_map f l @ post_map f r @ [x] 124 | 125 | (* String Tree *) 126 | let t = ['A';'B';'C';'D';'E';'F';'G';'H';'I'];; 127 | -------------------------------------------------------------------------------- /archive/continuation.ml: -------------------------------------------------------------------------------- 1 | (************************** 2 | 3 | Programming continuations 4 | 5 | Worth looking at scheme for this stuff 6 | 7 | **************************) 8 | 9 | let rec sum_recur = function | [] -> 0 | x::xs -> x + sum_recur xs 10 | (* no deferred operations on any recursive call *) 11 | let sum_tail_recur s = 12 | let rec aux' s a = 13 | match s with 14 | | [] -> a 15 | | x::xs -> aux' xs (a + x) in 16 | aux' s 0 17 | 18 | (* create a function that packages up deferred operations, 19 | then passes it down in the recursive call for somebody else to perform *) 20 | let sum_continutation s = 21 | let rec sum' s k = 22 | match s with 23 | | [] -> k 0 24 | | x::xs -> sum' xs (fun a -> k (x + a)) in 25 | sum' s (fun x -> x) 26 | 27 | (* Implementing a fold using continuations *) 28 | let rec fold_right_recur (f : 'a -> 'b -> 'b) (s : 'a list) (b : 'b) : 'b = 29 | match s with 30 | | [] -> b 31 | | x::xs -> f x (fold_right_recur f xs b) 32 | 33 | (* using continuations *) 34 | let fold_right_continuation (f : 'a -> 'b -> 'b) (s : 'a list) (b : 'b) : 'b = 35 | let identity = (fun x -> x) in (* the identity function *) 36 | let rec fold_right' s k = 37 | match s with 38 | | [] -> k b 39 | | x::xs -> fold_right' xs (fun y -> k (f x y)) in 40 | fold_right' s identity 41 | -------------------------------------------------------------------------------- /archive/counting.ml: -------------------------------------------------------------------------------- 1 | (* Counting sort *) 2 | 3 | let arr = [|2;1;4;5;1|] 4 | 5 | let arrayf f arr = 6 | if Array.length arr <> 0 then 7 | let result = Array.fold_left (fun r v -> f r v) arr.(0) arr 8 | in Some(result) 9 | else None 10 | 11 | let array_min arr = arrayf min arr 12 | let array_max arr = arrayf max arr 13 | 14 | let unsafe_aget = function 15 | | Some(x) -> x 16 | | None -> failwith "Empty array" 17 | 18 | let counting_sort arr = 19 | let hi = unsafe_aget (array_min arr) and 20 | low = unsafe_aget (array_max arr) in 21 | let count = Array.make (hi-(low+1)) 0 in 22 | Array.iter (fun i -> count.(i-low) <- count.(i-low) + 1) arr; 23 | let result = (Array.to_list (Array.mapi (fun i x -> Array.make x (low+i)) count)) 24 | in Array.concat result 25 | -------------------------------------------------------------------------------- /archive/dijkstra.ml: -------------------------------------------------------------------------------- 1 | module Dijkstra = struct 2 | type cost = Nan | Cost of float 3 | 4 | type adj_mat = cost array array 5 | 6 | type 'a graph = { mutable ind : int; 7 | size : int; 8 | nodes : 'a array; 9 | m : adj_mat } 10 | let create_graph n s = 11 | { ind = 0; size = s; nodes = Array.make s n; 12 | m = Array.make_matrix s s Nan } 13 | let belongs_to n g = 14 | let rec aux i = 15 | (i < g.size) && ((g.nodes.(i) = n) || (aux (i+1))) 16 | in aux 0 17 | let add_node n g = 18 | if g.ind = g.size then failwith "Graph full" 19 | else if belongs_to n g then failwith "Node exists" 20 | else (g.nodes.(g.ind) <- n; g.ind <- g.ind + 1) 21 | let index n g = 22 | let rec aux i = 23 | if i >= g.size then raise Not_found 24 | else if g.nodes.(i) = n then i 25 | else aux (i+1) 26 | in aux 0 27 | let add_edge e1 e2 c g = 28 | try 29 | let x = index e1 g and y = index e2 g in 30 | g.m.(x).(y) <- Cost c 31 | with Not_found -> failwith "node does not exist" 32 | let gr = create_graph 0 10;; 33 | let test_graph () = 34 | let g = create_graph "nothing" 5 in 35 | List.iter (fun x -> add_node x g) ["A"; "B"; "C"; "D"; "E"]; 36 | List.iter (fun (a,b,c) -> add_edge a b c g) 37 | ["A", "B", 10.; 38 | "A", "D", 30.; 39 | "A", "E", 100.0; 40 | "B", "C", 50.; 41 | "C", "E", 10.; 42 | "D", "C", 20.; 43 | "D", "E", 60.]; 44 | for i=0 to g.ind -1 do g.m.(i).(i) <- Cost 0.0 done; 45 | g;; 46 | end 47 | -------------------------------------------------------------------------------- /archive/distance.ml: -------------------------------------------------------------------------------- 1 | (* OCaml distance metrics *) 2 | 3 | class point_type x_pos y_pos = object 4 | val mutable x: float = x_pos 5 | val mutable y: float = y_pos 6 | method x = x 7 | method y = y 8 | end 9 | 10 | module Distance = struct 11 | 12 | type point = Point of float * float 13 | 14 | let as_tuple p = match p with Point(x,y) -> (x,y) 15 | 16 | let px point = match point with 17 | | Point(x, _) -> Some(x) 18 | | _ -> None 19 | 20 | let py point = match point with 21 | | Point(_, y) -> Some(y) 22 | | _ -> None 23 | 24 | (* This is also known as chessboard distance *) 25 | let chebyshev (x1,y1) (x2,y2) = 26 | let a = abs_float (x1 -. x2) 27 | and b = abs_float (y1 -. y2) in 28 | max a b 29 | 30 | (* The euclidean distance for a two points is simply 31 | euclidean distance = ((x, y), (a, b)) = sqrt (x - a)2 + (y - b)2 *) 32 | let euclidean (x1,y1) (x2,y2) = 33 | let v1 = (x1 -. x2) 34 | and v2 = (y1 -. y2) 35 | in let sq = (fun x -> x *. x) 36 | in sqrt ((sq v1) +. (sq v2)) 37 | 38 | let manhattan (x1,y1) (x2,y2) = () 39 | end 40 | 41 | let test x1 y1 x2 y2 = 42 | let p1 = Distance.Point(x1,y1) 43 | and p2 = Distance.Point(x2,y2) in 44 | Distance.chebyshev p1 p2 45 | -------------------------------------------------------------------------------- /archive/fib.ml: -------------------------------------------------------------------------------- 1 | (* Improving fibs *) 2 | 3 | let rec naive_fib i = if i <= 1 4 | then i 5 | else naive_fib (i - 1) + naive_fib(i - 2) 6 | -------------------------------------------------------------------------------- /archive/graph.ml: -------------------------------------------------------------------------------- 1 | (* Graph Algorithms *) 2 | 3 | (* Set would be a better choice here for when I get some time *) 4 | module DiGraph = struct 5 | exception VertexDoesNotExist 6 | exception Cyclic of string 7 | (* TODO parameterize this module *) 8 | type t = string 9 | type vertex = V of t * (t list ref) 10 | type graph = vertex list ref 11 | let create() = ref [] 12 | let ident v = let V (x, _) = v in x 13 | let vertices g = List.map ident !g 14 | let has_vertex g v = List.mem v (vertices g) 15 | let add_vertex g v = 16 | if has_vertex g v then g 17 | else 18 | let new_vertex = V (v, ref []) in 19 | g := new_vertex :: !g; 20 | g 21 | let get_vertex g v = 22 | let rec aux vert_list vertex = 23 | match vert_list with 24 | | [] -> None 25 | | x::xs -> if (ident x) = vertex then Some(x) else aux xs vertex 26 | in aux !g v 27 | (* Adds a ONE-WAY connection. For undirected the operation needs to be done 28 | in both directions *) 29 | let add_edge g src dest = 30 | add_vertex g src; 31 | add_vertex g dest; 32 | match (get_vertex g src) with 33 | | Some(v) -> let V (_, adjList) = v in adjList := dest :: !adjList 34 | (* Todo in theory we can't reach this case *) 35 | | _ -> failwith "Source vertex does not exist" 36 | let successors g v = 37 | let vtx = get_vertex g v in 38 | match vtx with 39 | | Some(vertex) -> let V (_, adjList) = vertex in !adjList 40 | | None -> raise VertexDoesNotExist 41 | (* Builds a directed graph from a list of edge pairs i.e [(1,2);(2,3)] etc *) 42 | let build_directed_graph pairs = 43 | let g = create() in 44 | List.map (fun (src, dest) -> add_edge g src dest) pairs; 45 | g 46 | 47 | let sample_graph = 48 | let edges = [ 49 | ("a", "b"); ("a", "c"); 50 | ("a", "d"); ("b", "e"); 51 | ("c", "f"); ("d", "e"); 52 | ("e", "f"); ("e", "g") ] 53 | in build_directed_graph edges 54 | 55 | let dfs graph start_state = 56 | let rec depth_first_search graph visited = function 57 | [] -> List.rev visited 58 | | x::xs -> 59 | if List.mem x visited then 60 | dfs graph visited xs 61 | else 62 | let frontier = (successors graph x) @ xs 63 | in dfs graph (x::visited) frontier 64 | in depth_first_search graph [] (start_state::[]) 65 | end 66 | 67 | let edges = [ 68 | ("a", "b"); ("a", "c"); 69 | ("a", "d"); ("b", "e"); 70 | ("c", "f"); ("d", "e"); 71 | ("e", "f"); ("e", "g") ] 72 | 73 | let successors n edges = 74 | let matching (s,_) = s = n in 75 | List.map snd (List.filter matching edges) 76 | 77 | let rec dfs edges visited = function 78 | [] -> List.rev visited 79 | | n::nodes -> 80 | if List.mem n visited then 81 | dfs edges visited nodes 82 | else dfs edges (n::visited) ((successors n edges) @ nodes) 83 | 84 | exception Cyclic of string 85 | let topological_sort edges seed = 86 | let rec sort path visited = function 87 | [] -> visited 88 | | n::nodes -> 89 | if List.mem n path then raise (Cyclic n) else 90 | let v' = if List.mem n visited then visited else 91 | n :: sort (n::path) visited (successors n edges) 92 | in sort path v' nodes 93 | in sort [] [] [seed] 94 | 95 | module type ADJ = 96 | sig 97 | type t 98 | (* A graph represented as a mutable list of vertices *) 99 | type graph 100 | (* A graph vertex in the form (v, incoming, outgoing) *) 101 | type vertex 102 | (* An edge in the form source -> dest -> weight *) 103 | type edge 104 | val create : unit -> graph 105 | val vertices : graph -> int list 106 | val is_empty : graph -> bool 107 | val add_vertex : graph -> int -> graph 108 | val find_vertex : graph -> int -> vertex option 109 | end 110 | 111 | module Graph = struct 112 | exception VertexDoesNotExist 113 | type t = int 114 | type vertex = V of int * (int list ref) * (int list ref) 115 | type edge = vertex * vertex * int 116 | type graph = vertex list ref 117 | let create () = ref [] 118 | let vertices g = 119 | List.map (fun (v) -> let V (x,_,_) = v in x) !g 120 | (* TODO Duplication of logic *) 121 | let out_func v = let V (_,x,_) = v in !x 122 | let in_func v = let V (_,_,x) = v in !x 123 | let flatten_edges g f = 124 | let edges = List.map f !g in 125 | edges |> List.flatten 126 | let outgoing_edges g = flatten_edges g out_func 127 | let incoming_edges g = flatten_edges g in_func 128 | let is_empty g = 129 | match !g with 130 | | [] -> true 131 | | _ -> false 132 | (* In the following two functions vertex refers to the value not the type *) 133 | let find_vertex graph vertex = 134 | let rec find g v = 135 | match g with 136 | | [] -> None 137 | | V (x,_,_) as vtx :: xs -> if v = x then Some(vtx) else find xs v 138 | in find !graph vertex 139 | (* Core operations *) 140 | let add_vertex graph v = 141 | let new_vertex = V (v, ref [], ref []) 142 | in graph := new_vertex :: !graph; 143 | graph 144 | 145 | (* Consider cost implications here as it's going to be a bit crappy *) 146 | let add_incoming_edge graph src dest = 147 | let vtx = find_vertex graph src in 148 | match vtx with 149 | | Some(v) -> let V (_,i,_) = v in i := dest :: !i; v 150 | | None -> failwith "No matching vertex" 151 | 152 | let add_outgoing_edge graph src dest = 153 | let vtx = find_vertex graph src in 154 | match vtx with 155 | | Some(v) -> let V (_, _, o) = v in o := dest :: !o; v 156 | | None -> failwith "No matching vertex" 157 | 158 | let add_undirected_edge graph src dest = 159 | add_incoming_edge graph src dest; 160 | add_outgoing_edge graph src dest; 161 | graph; 162 | end 163 | -------------------------------------------------------------------------------- /archive/heap.ml: -------------------------------------------------------------------------------- 1 | (* Heap sort *) 2 | -------------------------------------------------------------------------------- /archive/heaps.ml: -------------------------------------------------------------------------------- 1 | (* An list/array based binary heap structure *) 2 | 3 | module type HEAP = sig 4 | val create: 'a list 5 | end 6 | 7 | module ListHeap : HEAP = struct 8 | let create() = [0] 9 | (* Parent of node at k is at k/2. *) 10 | let parent_index heap k = 11 | List.nth heap (k/2) 12 | 13 | let left_child_index heap k = 14 | List.nth heap (k*2) 15 | 16 | let right_child_index heap k = 17 | let i = k * 2 in 18 | List.nth heap (i + 1) 19 | 20 | (* Children of node at k are at 2k and 2k+1 *) 21 | let children heap k = 22 | let l_index = ListHeap.left_child_index(heap,k) 23 | and r_index = ListHeap.right_child_index(heap,k) 24 | in [l_index;r_index] 25 | end 26 | 27 | let h = ['';'T';'S';'R';'P';'N';'O';'A';'E';'I';'H';'G'] 28 | -------------------------------------------------------------------------------- /archive/leftist_tree.ml: -------------------------------------------------------------------------------- 1 | (* Leftist Trees *) 2 | 3 | type 'a leftist = 4 | | Leaf 5 | | Node of 'a leftist * 'a * 'a leftist * int 6 | 7 | let singleton k = Node (Leaf, k, Leaf, 1) 8 | 9 | let rank tree = 10 | match tree with 11 | | Leaf -> 0 12 | | Node (_, _, _, n) -> n 13 | 14 | let rec merge t1 t2 = 15 | match t1, t2 with 16 | | Leaf, t -> t | t, Leaf -> t 17 | | Node (l, k1, r, _), Node (_, k2, _, _) -> 18 | if k1 > k2 then merge t2 t1 19 | else 20 | let merged = merge r t2 in 21 | let rank_left = rank l 22 | and rank_right = rank merged in 23 | if rank_left >= rank_right then 24 | Node(l, k1, merged, rank_right+1) 25 | else 26 | Node(merged, k1, l, rank_left+1) 27 | 28 | let insert x t = merge (singleton x) t 29 | 30 | let get_min = function 31 | | Leaf -> None 32 | | Node (_, k, _, _) -> Some(k) 33 | 34 | let delete_min = function 35 | | Leaf -> failwith "empty" 36 | | Node (l, _, r, _) -> merge l r 37 | -------------------------------------------------------------------------------- /archive/merge.ml: -------------------------------------------------------------------------------- 1 | (* Merge sort *) 2 | 3 | module MergeSort = struct 4 | 5 | let rec split_at n xs = 6 | match n, xs with 7 | 0, xs -> [], xs 8 | | n, x::xs when n > 0 -> 9 | let y, z = split_at (n-1) xs in 10 | x::y, z 11 | | _, _ -> failwith "Negative index" 12 | 13 | (* Divide a list into two parts *) 14 | let divide xs = split_at (List.length xs / 2) xs 15 | 16 | let rec sort cmp = function 17 | [] -> [] 18 | | [x] -> [x] 19 | | xs -> 20 | let xs, ys = divide xs in 21 | List.merge cmp (merge_sort cmp xs) (merge_sort cmp ys) 22 | 23 | end 24 | 25 | let eg = MergeSort.sort compare [8;6;4;2;1;3;5;7;9] 26 | -------------------------------------------------------------------------------- /archive/multi_tree.ml: -------------------------------------------------------------------------------- 1 | (* Multiway trees *) 2 | 3 | module MultiwayTree = struct 4 | 5 | end 6 | 7 | type 'a mult_tree = T of 'a * 'a mult_tree list 8 | 9 | (* TODO *) 10 | let make_tree xs = xs 11 | 12 | let t = T('a', 13 | [T('f', 14 | [T('g',[])]); T('c',[]); T('b', 15 | [T('d',[]); T('e',[])])]) 16 | 17 | let rec count_tree_nodes (T(_, sub)) = 18 | List.fold_left (fun n t -> n + count_tree_nodes t) 1 sub 19 | 20 | 21 | -------------------------------------------------------------------------------- /archive/pqueue.ml: -------------------------------------------------------------------------------- 1 | (* Priority Queue *) 2 | 3 | module type PRIOQUEUE = 4 | sig 5 | type priority = int 6 | type 'a queue 7 | val empty : 'a queue 8 | val insert : 'a queue -> int -> 'a -> 'a queue 9 | val extract : 'a queue -> int * 'a * 'a queue 10 | exception Queue_is_empty 11 | end 12 | 13 | module type PQ_TYPE = 14 | sig 15 | type t 16 | end 17 | 18 | module PrioQueue = functor (Elt: PQ_TYPE) -> 19 | struct 20 | type priority = Elt.t 21 | type 'a queue = Empty | Node of priority * 'a * 'a queue * 'a queue 22 | let empty = Empty 23 | 24 | let rec insert queue prio elt = 25 | match queue with 26 | Empty -> Node(prio, elt, Empty, Empty) 27 | | Node(p, e, left, right) -> 28 | if prio <= p 29 | then Node(prio, elt, insert right p e, left) 30 | else Node(p, e, insert right prio elt, left) 31 | 32 | exception Queue_is_empty 33 | 34 | let rec remove_top = function 35 | Empty -> raise Queue_is_empty 36 | | Node(prio, elt, left, Empty) -> left 37 | | Node(prio, elt, Empty, right) -> right 38 | | Node(prio, elt, (Node(lprio, lelt, _, _) as left), 39 | (Node(rprio, relt, _, _) as right)) -> 40 | if lprio <= rprio 41 | then Node(lprio, lelt, remove_top left, right) 42 | else Node(rprio, relt, left, remove_top right) 43 | let extract = function 44 | Empty -> raise Queue_is_empty 45 | | Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue) 46 | end 47 | 48 | module IPQ : PQ_TYPE= struct 49 | type t = int 50 | end 51 | 52 | module IntPriorityQueue = PrioQueue(IPQ) 53 | -------------------------------------------------------------------------------- /archive/python/avl_tree.py: -------------------------------------------------------------------------------- 1 | from __future__ import print_function 2 | 3 | class BinaryHeap: 4 | def __init__(self): 5 | # to make the maths easier array is indexed from 1 not 0 6 | self.heap = [0] 7 | self.current_size = 0 8 | 9 | def __repr__(self): return str(self.heap) 10 | 11 | def increment_size(self): 12 | self.current_size += 1 13 | 14 | def last_item(self): 15 | """ Returns the last item in the heap since current size 16 | is a reference to the largest index """ 17 | return self.heap[self.current_size] 18 | 19 | def last_item_index(self): return self.current_size 20 | 21 | def parent_index(self, i): 22 | """Parent node can always be found with integer division""" 23 | return i // 2 24 | 25 | def left_child_index(self, i): 26 | """Returns the index of the left child node for a given node""" 27 | return i * 2 28 | 29 | def right_child_index(self, i): 30 | """Returns the index of the left child node for a given node""" 31 | return (i * 2) + 1 32 | 33 | def swim(self,i): 34 | """Swims an item up the heap to it's correct position so that it does not violate 35 | heap invariant""" 36 | while self.parent_index(i) > 0: 37 | parent_index = self.parent_index(i) 38 | node_value = self.heap[i] 39 | parent_node_value = self.heap[parent_index] 40 | # if the current node is g 41 | if node_value < parent_node_value: 42 | # swap parent for current node value 43 | self.heap[parent_index] = node_value 44 | # swap current node value with previous parent value 45 | self.heap[i] = parent_node_value 46 | i = parent_index 47 | return self.heap 48 | 49 | def sink(self, i): 50 | while self.left_child_index(i) <= self.current_size: 51 | min_child = self.min_child(i) 52 | if self.heap[i] > self.heap[min_child]: 53 | # Swap 54 | cache = self.heap[i] 55 | self.heap[i] = self.heap[min_child] 56 | self.heap[min_child] = cache 57 | i = min_child 58 | 59 | def insert(self, value): 60 | self.heap.append(value) 61 | self.increment_size() 62 | self.heap = self.swim(self.last_item_index()) 63 | return self.heap 64 | 65 | def min_child(self,i): 66 | left_child = self.left_child_index(i) 67 | right_child = self.right_child_index(i) 68 | if right_child > self.current_size: 69 | return left_child 70 | else: 71 | if self.heap[left_child] < self.heap[right_child]: 72 | return left_child 73 | else: 74 | return right_child 75 | 76 | def delete_min(self): 77 | """ Remove the smallest element from the heap """ 78 | min_item = self.heap[1] # The smallest item will be the root 79 | self.heap[1] = self.last_item() 80 | self.sink(1) 81 | self.current_size = self.current_size - 1 82 | self.heap.pop() 83 | return self.heap 84 | 85 | class BSTNode(object): 86 | """ A simple BST node object """ 87 | def __init__(self, t): 88 | self.key = t 89 | self.dissoc() 90 | 91 | def dissoc(self): 92 | self.left = None 93 | self.right = None 94 | self.parent = None 95 | 96 | def is_leaf(self): 97 | return self.key is None 98 | 99 | def __repr__(self): 100 | return "Node: < %s >" % self.key 101 | 102 | class BST(object): 103 | """ A basic Binary Search Tree """ 104 | def __init__(self, values=[]): 105 | self.root = None 106 | if any(values): 107 | self.insert_many(values) 108 | 109 | def insert(self, k): 110 | """Insert a key k into the tree""" 111 | new = BSTNode(k) 112 | if self.root is None: 113 | self.root = new 114 | else: 115 | node = self.root 116 | while True: 117 | # Go left 118 | if k < node.key: 119 | if node.left is None: # if left is none insert it here 120 | node.left = new 121 | new.parent = node 122 | break 123 | node = node.left # carry on down 124 | else: 125 | if node.right is None: 126 | node.right = new 127 | new.parent = node 128 | break 129 | node = node.right 130 | return new 131 | 132 | def insert_many(self, values=[]): 133 | return [self.insert(value) for value in values] 134 | 135 | def find(self, v): 136 | node = self.root 137 | while node is not None: 138 | if v == node.key: 139 | return node 140 | elif v < node.key: 141 | node = node.left 142 | else: node = node.right 143 | return None 144 | 145 | def contains(self, v): 146 | return self.find(v) is not None 147 | 148 | def delete_min(self): 149 | if self.root is None: 150 | return None 151 | else: # smallest item will be in the left sub tree so walk it 152 | node = self.root 153 | while node.left is not None: 154 | node = node.left 155 | if node.parent is not None: 156 | node.parent.left = node.right 157 | else: self.root = node.right 158 | if node.right is not None: 159 | node.right.parent = node.parent 160 | parent = node.parent 161 | node.dissoc() 162 | return node, parent 163 | 164 | def height(self, node): 165 | if node is None: 166 | return 0 167 | else: 168 | return 1 + max(self.height(node.left), self.height(node.right)) 169 | 170 | # Traversals 171 | def print_func (self, x): 172 | print(x) # wrong version of python to pass as a lambda 173 | 174 | def inorder_traversal(self, f, node): 175 | if node is not None: 176 | self.inorder_traversal(f, node.left) 177 | f(node.key) 178 | self.inorder_traversal(f, node.right) 179 | 180 | def print_tree_in_order(self): 181 | self.inorder_traversal(self.print_func, self.root) 182 | 183 | def preorder_traversal(self, f, node): 184 | if node is not None: 185 | f(node.key) 186 | self.preorder_traversal(f, node.left) 187 | self.preorder_traversal(f, node.right) 188 | 189 | def print_tree_in_preorder(self): 190 | self.preorder_traversal(self.print_func, self.root) 191 | 192 | def postorder_traversal(self, f, node): 193 | if node is not None: 194 | self.postorder_traversal(f, node.left) 195 | self.postorder_traversal(f, node.right) 196 | f(node.key) 197 | 198 | def print_tree_in_postorder(self): 199 | self.postorder_traversal(self.print_func, self.root) 200 | 201 | class AVLTree(BST): 202 | def __init__(self): 203 | pass 204 | -------------------------------------------------------------------------------- /archive/python/binary_heap.py: -------------------------------------------------------------------------------- 1 | # =================================================== 2 | # 3 | # Python Binary Heap 4 | # 5 | # =================================================== 6 | class BinaryHeap: 7 | def __init__(self): 8 | # to make the maths easier array is indexed from 1 not 0 9 | self.heap = [0] 10 | self.current_size = 0 11 | 12 | def __repr__(self): return str(self.heap) 13 | 14 | def increment_size(self): 15 | self.current_size += 1 16 | 17 | def last_item(self): 18 | """ Returns the last item in the heap since current size 19 | is a reference to the largest index """ 20 | return self.heap[self.current_size] 21 | 22 | def last_item_index(self): return self.current_size 23 | 24 | def parent_index(self, i): 25 | """Parent node can always be found with integer division""" 26 | return i // 2 27 | 28 | def left_child_index(self, i): 29 | """Returns the index of the left child node for a given node""" 30 | return i * 2 31 | 32 | def right_child_index(self, i): 33 | """Returns the index of the left child node for a given node""" 34 | return (i * 2) + 1 35 | 36 | # Swim UP the heap 37 | def swim(self,i): 38 | """Swims an item up the heap to it's correct position so that it does not violate 39 | heap invariant""" 40 | while self.parent_index(i) > 0: 41 | parent_index = self.parent_index(i) 42 | node_value = self.heap[i] 43 | parent_node_value = self.heap[parent_index] 44 | # if the current node is g 45 | if node_value < parent_node_value: 46 | # swap parent for current node value 47 | self.heap[parent_index] = node_value 48 | # swap current node value with previous parent value 49 | self.heap[i] = parent_node_value 50 | i = parent_index 51 | return self.heap 52 | 53 | def sink(self, i): 54 | while self.left_child_index(i) <= self.current_size: 55 | min_child = self.min_child(i) 56 | if self.heap[i] > self.heap[min_child]: 57 | # Swap 58 | cache = self.heap[i] 59 | self.heap[i] = self.heap[min_child] 60 | self.heap[min_child] = cache 61 | i = min_child 62 | 63 | def insert(self, value): 64 | self.heap.append(value) 65 | self.increment_size() 66 | self.heap = self.swim(self.last_item_index()) 67 | return self.heap 68 | 69 | def min_child(self,i): 70 | left_child = self.left_child_index(i) 71 | right_child = self.right_child_index(i) 72 | if right_child > self.current_size: 73 | return left_child 74 | else: 75 | if self.heap[left_child] < self.heap[right_child]: 76 | return left_child 77 | else: 78 | return right_child 79 | 80 | def delete_min(self): 81 | """ Remove the smallest element from the heap """ 82 | min_item = self.heap[1] # The smallest item will be the root 83 | self.heap[1] = self.last_item() 84 | self.sink(1) 85 | self.current_size = self.current_size - 1 86 | self.heap.pop() 87 | return self.heap 88 | -------------------------------------------------------------------------------- /archive/python/dijkstra.py: -------------------------------------------------------------------------------- 1 | # Dijkstra's Algorithm for shortest paths 2 | # 3 | class UndirectedGraph(object): 4 | """ 5 | A simple undirected, weighted graph 6 | """ 7 | def __init__(self): 8 | self.nodes = set() 9 | self.edges = {} 10 | self.distances = {} 11 | 12 | def add_node(self, value): 13 | self.nodes.add(value) 14 | 15 | def add_edge(self, from_node, to_node, distance): 16 | self._add_edge(from_node, to_node, distance) 17 | self._add_edge(to_node, from_node, distance) 18 | 19 | def _add_edge(self, from_node, to_node, distance): 20 | self.edges.setdefault(from_node, []) 21 | self.edges[from_node].append(to_node) 22 | self.distances[(from_node, to_node)] = distance 23 | 24 | def dijkstra(graph, initial_node): 25 | visited = {initial_node: 0} 26 | current_node = initial_node 27 | path = {} 28 | 29 | nodes = set(graph.nodes) 30 | 31 | while nodes: 32 | min_node = None 33 | for node in nodes: 34 | if node in visited: 35 | if min_node is None: 36 | min_node = node 37 | elif visited[node] < visited[min_node]: 38 | min_node = node 39 | 40 | if min_node is None: 41 | break 42 | 43 | nodes.remove(min_node) 44 | cur_wt = visited[min_node] 45 | 46 | for edge in graph.edges[min_node]: 47 | wt = cur_wt + graph.distances[(min_node, edge)] 48 | if edge not in visited or wt < visited[edge]: 49 | visited[edge] = wt 50 | path[edge] = min_node 51 | 52 | return visited, path 53 | 54 | def shortest_path(graph, initial_node, goal_node): 55 | distances, paths = dijkstra(graph, initial_node) 56 | route = [goal_node] 57 | while goal_node != initial_node: 58 | route.append(paths[goal_node]) 59 | goal_node = paths[goal_node] 60 | route.reverse() 61 | return route 62 | 63 | def main(): 64 | g = UndirectedGraph() 65 | g.nodes = set(range(1, 7)) 66 | g.add_edge(1, 2, 7) 67 | g.add_edge(1, 3, 9) 68 | g.add_edge(1, 6, 14) 69 | g.add_edge(2, 3, 10) 70 | g.add_edge(2, 4, 15) 71 | g.add_edge(3, 4, 11) 72 | g.add_edge(3, 6, 2) 73 | g.add_edge(4, 5, 6) 74 | g.add_edge(5, 6, 9) 75 | assert shortest_path(g, 1, 5) == [1, 3, 6, 5] 76 | assert shortest_path(g, 5, 1) == [5, 6, 3, 1] 77 | assert shortest_path(g, 2, 5) == [2, 3, 6, 5] 78 | assert shortest_path(g, 1, 4) == [1, 3, 4] 79 | 80 | if __name__ == '__main__': 81 | main() 82 | -------------------------------------------------------------------------------- /archive/python/graph.py: -------------------------------------------------------------------------------- 1 | # An undirected weighted graph 2 | # 3 | class UndirectedGraph(object): 4 | """ A simple undirected graph representation 5 | for shortest path problems """ 6 | def __init__(self): 7 | self.vertices = set() 8 | self.edges = {} 9 | self.weights = {} 10 | 11 | def add_vertex(self, value): 12 | """ Add a vertex to the graph """ 13 | self.vertices.add(value) 14 | 15 | def add_edge(self, from_node, to_node, weight): 16 | """ Since this graph is undirected connections go both ways """ 17 | self._add_edge(from_node, to_node, weight) 18 | self._add_edge(to_node, from_node, weight) 19 | 20 | def _add_edge(self, from_node, to_node, weight): 21 | """ Add a weighted edge between two vertices """ 22 | self.edges.setdefault(from_node, set()) 23 | self.edges[from_node].add(to_node) 24 | self.weights[(from_node, to_node)] = weight 25 | 26 | def weight(self, from_node, to_node): 27 | """ Returns the weight between two vertices """ 28 | return self.weights[(from_node, to_node)] 29 | 30 | def main(): 31 | g = UndirectedGraph() 32 | g.nodes = set(range(1, 7)) 33 | g.add_edge(1, 2, 7) 34 | g.add_edge(1, 3, 9) 35 | return g 36 | -------------------------------------------------------------------------------- /archive/python/graph2.py: -------------------------------------------------------------------------------- 1 | # Weighted directed graph 2 | 3 | class Edge(object): 4 | """ A directed weighted graph edge """ 5 | def __init__(self, start, end, cost): 6 | self.start = start 7 | self.end = end 8 | self.cost = cost 9 | 10 | def __repr__(self): 11 | return '%s - (%s) -> %s' % ( self.start, self.cost, self.end ) 12 | 13 | class Graph(): 14 | """ A directed weighted graph """ 15 | def __init__(self, edges): 16 | self.edges = [Edge(*edge) for edge in edges] 17 | self.vertices = set(sum(([e.start, e.end] for e in self.edges), [])) 18 | 19 | graph = Graph([("a", "b", 7), ("a", "c", 9), ("a", "f", 14), ("b", "c", 10), 20 | ("b", "d", 15), ("c", "d", 11), ("c", "f", 2), ("d", "e", 6), 21 | ("e", "f", 9)]) 22 | -------------------------------------------------------------------------------- /archive/queue.ml: -------------------------------------------------------------------------------- 1 | module type QUEUE = sig 2 | exception EmptyQueue 3 | 4 | type 'a queue 5 | 6 | val empty : unit -> 'a queue 7 | (* Adds an item to the back of the queue *) 8 | val enqueue : 'a -> 'a queue -> 'a queue 9 | (* Take from the front and returns new queue *) 10 | val dequeue : 'a queue -> 'a queue 11 | val is_empty : 'a queue -> bool 12 | val dequeue: 'a queue -> 'a queue 13 | (* Peek *) 14 | val front : 'a queue -> 'a 15 | end 16 | 17 | module AppendListQueue : QUEUE = struct 18 | 19 | exception EmptyQueue 20 | 21 | type 'a queue = 'a list 22 | 23 | let empty() = [] 24 | let enqueue v q = q @ [v] 25 | let deq = function 26 | | [] -> raise EmptyQueue 27 | | x::xs -> (x,xs) 28 | let dequeue q = snd (deq q) 29 | let is_empty = function 30 | | [] -> true 31 | | _ -> false 32 | 33 | let front q = fst (deq q) 34 | end 35 | 36 | (* (\** Need to implement module sig **\) 37 | * module MutableQueue = struct 38 | * 39 | * exception EmptyQueue 40 | * 41 | * type 'a queue = 'a ref 42 | * 43 | * let q = ref [] 44 | * let empty() = q 45 | * let enqueue v q = q := !q @ [v] 46 | * let deq = function 47 | * | [] -> raise EmptyQueue 48 | * | x::xs -> (x,xs) 49 | * let dequeue() = q := snd (deq !q) 50 | * let front() = fst (deq !q) 51 | * 52 | * let is_empty = function 53 | * | [] -> true 54 | * | _ -> false 55 | * end *) 56 | -------------------------------------------------------------------------------- /archive/quick.ml: -------------------------------------------------------------------------------- 1 | (* Quick sort *) 2 | module type QUICK = 3 | sig 4 | val quick_sort : 'a list -> 'a list 5 | end 6 | 7 | module Sorting : QUICK = struct 8 | let rec quick_sort = function 9 | | [] -> [] 10 | | x::xs -> let smaller, larger = List.partition (fun y -> y < x) xs 11 | in let x = (quick_sort smaller) 12 | and y = (x::quick_sort larger) 13 | in x @ y 14 | end 15 | -------------------------------------------------------------------------------- /archive/random_shuffle.ml: -------------------------------------------------------------------------------- 1 | (* Random array shuffle *) 2 | 3 | let random_shuffle arr = 4 | let swap i j a = 5 | let temp = xs.(j) in 6 | xs.(j) <- xs.(i) 7 | xs.(i) <- temp 8 | in arr 9 | -------------------------------------------------------------------------------- /archive/red_black_tree.ml: -------------------------------------------------------------------------------- 1 | (* Red Black Trees *) 2 | 3 | (* ****************************************************** 4 | * 5 | * Bz Bz Bx Bx 6 | * / \ / \ / \ / \ 7 | * Ry d Rx d a Rz a Ry 8 | * / \ / \ / \ / \ 9 | * Rx c a Ry Ry d b Rz 10 | * / \ / \ / \ / \ 11 | * a b b c b c c d 12 | * 13 | * ****************************************************************** *) 14 | 15 | module RedBlackTree = struct 16 | exception Insert_error of string 17 | 18 | type color = Red | Black 19 | 20 | type 'a tree = 21 | | Leaf 22 | | Node of color * 'a * 'a tree * 'a tree 23 | 24 | let rec member x = function 25 | Leaf -> false 26 | | Node (_, value, left, right) -> 27 | if x == value then true 28 | else if x < value then member x left 29 | else member x right 30 | 31 | let balance = function 32 | Black, z, Node (Red, y, Node (Red, x, a, b), c), d 33 | | Black, z, Node (Red, x, a, Node (Red, y, b, c)), d 34 | | Black, x, a, Node (Red, z, Node (Red, y, b, c), d) 35 | | Black, x, a, Node (Red, y, b, Node (Red, z, c, d)) -> 36 | Node (Red, y, Node (Black, x, a, b), Node (Black, z, c, d)) 37 | | a, b, c, d -> 38 | Node (a, b, c, d) 39 | 40 | let insert x s = 41 | let rec ins = function 42 | Leaf -> Node (Red, x, Leaf, Leaf) 43 | | Node (color, y, a, b) as s -> 44 | if x < y then balance (color, y, ins a, b) 45 | else if x > y then balance (color, y, a, ins b) 46 | else s 47 | in 48 | match ins s with 49 | Node (_, y, a, b) -> 50 | Node (Black, y, a, b) 51 | | Leaf -> (* guaranteed to be nonempty *) 52 | raise (Insert_error "RBT insert failed with ins returning leaf") 53 | end 54 | -------------------------------------------------------------------------------- /archive/search.ml: -------------------------------------------------------------------------------- 1 | module type SEARCHALG = sig 2 | val linear : 'a -> 'a list -> 'a option 3 | val binary : 'a -> 'a list -> 'a option 4 | end 5 | 6 | module Search = struct 7 | let rec linear ~element:v = function 8 | | [] -> None 9 | | x::xs -> if x = v then Some(x) else linear v xs 10 | 11 | let binary ~element:v xs = 12 | let rec aux element xs min max = 13 | (* Base clause *) 14 | if min = max 15 | then None 16 | else (* Inductive *) 17 | let t = (min + max) in 18 | let mid = t / 2 19 | in Some(t) 20 | in match xs with 21 | | [] -> None 22 | | x::xs as lst -> 23 | aux v lst 0 (List.length xs) 24 | end 25 | -------------------------------------------------------------------------------- /archive/set.ml: -------------------------------------------------------------------------------- 1 | (* OCaml Set *) 2 | 3 | type compare_to = Lt | Eq | Gt 4 | 5 | module type ORDERED_TYPE = 6 | sig 7 | type t 8 | val cmp: t -> t -> compare_to 9 | end 10 | 11 | module type SET_TYPE = sig 12 | end 13 | 14 | module OrderedString = 15 | struct 16 | type t = string 17 | let cmp x y = 18 | if x = y 19 | then Eq 20 | else if x < y then Lt 21 | else Gt 22 | end 23 | 24 | module OrderedInt = 25 | struct 26 | type t = int 27 | let cmp x y = if x = y then Eq 28 | else if x < y then Lt 29 | else Gt 30 | end 31 | 32 | module OSet = functor (Elt: ORDERED_TYPE) -> 33 | struct 34 | type elem = Elt.t 35 | type set = elem list 36 | let empty = [] 37 | (* Invariant :- keep ordering of elements at all times *) 38 | let rec add x oset = 39 | match oset with 40 | [] -> [x] 41 | | y::ys -> 42 | (* Compare x = y *) 43 | match Elt.cmp x y with 44 | Eq -> oset (* Element already exists so just return the existing set *) 45 | | Lt -> x :: oset (* Insert the element at hd position *) 46 | | Gt -> y :: add x ys (* shuffle up and insert in the correct place *) 47 | let rec contains_element x = function 48 | [] -> false 49 | | y::ys -> 50 | (* Compare x = y *) 51 | match Elt.cmp x y with 52 | Eq -> true 53 | | _ -> contains_element x ys 54 | let rec member x = function 55 | [] -> false 56 | | y::ys -> 57 | (* Compare x = y *) 58 | match Elt.cmp x y with 59 | Eq -> true 60 | | Lt -> false (* invariant x can't be less than s@(y::ys) so does not exist *) 61 | | Gt -> member x ys (* recur *) 62 | end 63 | 64 | module OStringSet = OSet(OrderedString) 65 | module OIntSet = OSet(OrderedInt) 66 | -------------------------------------------------------------------------------- /archive/shuffle.ml: -------------------------------------------------------------------------------- 1 | (* Fisher Yates Shuffle *) 2 | 3 | module type ShuffleAlgos = sig 4 | val fisher_yates_shuffle : 'a array -> 'a array 5 | end 6 | 7 | module Shuffle : ShuffleAlgos = struct 8 | 9 | (* Knuth Fisher Yates Shuffle *) 10 | 11 | let fisher_yates_shuffle arr = 12 | let swap arr i j = 13 | let temp = arr.(i) in 14 | arr.(i) <- arr.(j); arr.(j) <- temp 15 | and len = Array.length arr in 16 | for i = (len-1) downto 1 do 17 | (* Random shuffle *) 18 | let r = Random.int (i+1) in 19 | swap arr i r; 20 | done; 21 | arr 22 | end 23 | -------------------------------------------------------------------------------- /archive/sort.ml: -------------------------------------------------------------------------------- 1 | module type SORTING = 2 | sig 3 | val sort : 'a list -> 'a list 4 | end 5 | 6 | module SelectionSort : SORTING = 7 | struct 8 | let rec sort = function 9 | | [] -> [] 10 | | h::t -> 11 | let rec aux y ys = function 12 | | [] -> y :: sort ys 13 | | x::xs when x < y -> aux x (y::ys) xs 14 | | x::xs -> aux y (x::ys) xs 15 | in aux h [] t 16 | end 17 | 18 | module Sort = struct 19 | let selection = SelectionSort.sort 20 | end 21 | -------------------------------------------------------------------------------- /archive/sorting.ml: -------------------------------------------------------------------------------- 1 | (* Sorting algorithms functional and imp *) 2 | 3 | open Utils 4 | 5 | module type SORTSIG = 6 | sig 7 | val quicksort : 'a list -> 'a list 8 | val selection_sort : 'a list -> 'a list 9 | val insertion_sort : 'a list -> 'a list 10 | val bubble_sort : 'a list -> 'a list 11 | end 12 | 13 | module SortAlgorithms : SORTSIG = struct 14 | let rec quicksort = function 15 | | [] -> [] 16 | | x::xs -> let smaller, larger = List.partition (fun y -> y < x) xs 17 | in let x = (quicksort smaller) 18 | and y = (x::quicksort larger) 19 | in x @ y 20 | let rec selection_sort = function 21 | | [] -> [] 22 | | h::t -> 23 | let rec aux y ys = function 24 | [] -> y :: selection_sort ys 25 | | x::xs when x < y -> aux x (y::ys) xs 26 | | x::xs -> aux y (x::ys) xs 27 | in 28 | aux h [] t 29 | (* Insertion sort using an auxilary insertion helper *) 30 | let rec insertion_sort lst = 31 | let rec insert v = function 32 | | [] -> [v] 33 | | x::xs as l -> if v < x 34 | then v :: l 35 | else x :: (insert v xs) 36 | in 37 | match lst with 38 | | [] -> [] 39 | | [x] -> [x] 40 | | x::xs -> insert x (insertion_sort xs) 41 | let rec bubble_sort lst = 42 | let rec aux = function 43 | | [] -> [] 44 | | x::y::xs -> 45 | if x > y then y::aux(x::xs) 46 | else x::aux(y::xs) 47 | | x::xs -> x :: aux xs 48 | in let p = aux lst in 49 | if lst <> p then bubble_sort p 50 | else lst 51 | end 52 | 53 | (** Utils **) 54 | let rec swap (l, n) = 55 | let rec loop xs count acc = 56 | match xs with 57 | | _ when count = n -> xs @ List.rev acc 58 | | [] -> List.rev acc 59 | | h::t -> loop t (count+1) (h::acc) 60 | in loop l 0 [] 61 | 62 | (* Mutable state for array swap *) 63 | let array_swap xs i j = 64 | let temp = xs.(i) in 65 | xs.(i) <- xs.(j); 66 | xs.(j) <- temp 67 | 68 | let selection_sort_array_mutable xs = 69 | let swap a i j = 70 | let temp = a.(i) in 71 | a.(i) <- a.(j); a.(j) <- temp 72 | and find_min arr i = 73 | let m = ref i in 74 | for j=i+1 to Array.length arr -1 do 75 | let mval = !m in 76 | if xs.(j) < xs.(mval) then m := j 77 | done; 78 | !m 79 | in 80 | let r = ref [] in 81 | for i = 0 to Array.length xs - 2 do 82 | let min = find_min xs i in 83 | swap xs i min 84 | done; 85 | xs 86 | 87 | (* Tests *) 88 | (************************************) 89 | 90 | let time f x = 91 | let t = Sys.time() in 92 | let fx = f x in 93 | Printf.printf "Execution time: %fs\n" (Sys.time() -. t) 94 | 95 | let tests = [ 96 | SortAlgorithms.quicksort; 97 | SortAlgorithms.selection_sort; 98 | SortAlgorithms.insertion_sort; 99 | SortAlgorithms.bubble_sort; 100 | ] 101 | 102 | let run tests = 103 | let generic_sort = 104 | List.sort (fun x y -> if x > y then 1 else 0) in 105 | let passed = ref 0 106 | and failed = ref 0 in 107 | let unsorted = Utils.random_list 1000 1000 in 108 | List.map (fun f -> if (f unsorted <> generic_sort unsorted) 109 | then incr failed 110 | else incr passed) tests; 111 | Printf.printf "\n\nPassed %d Failed %d\n\n" !passed !failed 112 | 113 | let main() = run tests;; 114 | 115 | let time_all() = 116 | let unsorted = Utils.random_list 5000 5000 in 117 | Printf.printf "Selection sort -> "; 118 | time SortAlgorithms.selection_sort unsorted; 119 | Printf.printf "Insertion sort -> "; 120 | time SortAlgorithms.insertion_sort unsorted; 121 | Printf.printf "Bubble sort -> "; 122 | time SortAlgorithms.bubble_sort unsorted 123 | -------------------------------------------------------------------------------- /archive/splay_tree.ml: -------------------------------------------------------------------------------- 1 | (* OCaml Splay Tree *) 2 | 3 | module type ORDERED_SET = sig 4 | type elem 5 | end 6 | 7 | module SplayTree = 8 | struct 9 | type elem = int 10 | type t = Leaf | Node of t * elem * t 11 | type tree = t ref 12 | 13 | let empty () = ref Leaf 14 | 15 | let isEmpty t = 16 | match !t with 17 | Leaf -> true 18 | | _ -> false 19 | end 20 | -------------------------------------------------------------------------------- /archive/utils/benchmark.ml: -------------------------------------------------------------------------------- 1 | module Benchmark = struct 2 | let time ~func:f ~value:x = 3 | let t = Sys.time() in 4 | let _ = f x in 5 | Printf.printf "Execution time: %fs\n" (Sys.time() -. t); 6 | Sys.time() -. t 7 | end 8 | 9 | (* Time.time (fun x -> x * 1000) 10;; *) 10 | (* Execution time: 0.000002s 11 | - : float = 2.00000000001e-05 *) 12 | -------------------------------------------------------------------------------- /archive/utils/list_utils.ml: -------------------------------------------------------------------------------- 1 | (* General list utils *) 2 | 3 | module ListUtils = struct 4 | let safe_head = function 5 | | [] -> None 6 | | x::xs -> Some(x) 7 | 8 | let repeat x n = 9 | let rec aux curr bound result = 10 | if curr < bound then 11 | let next_generation = List.hd result :: result 12 | in aux (curr+1) bound next_generation 13 | else result 14 | in aux 1 n [x] 15 | 16 | let rec replicate n xs = 17 | let (|>) v f = f v in 18 | let rec aux n = function 19 | | [] -> [] 20 | | x::xs -> let y = repeat x n 21 | in y :: replicate n xs 22 | in 23 | let result = aux n xs in 24 | result |> List.fold_left (fun a b -> b :: a) [] 25 | end 26 | -------------------------------------------------------------------------------- /archive/utils/utils.ml: -------------------------------------------------------------------------------- 1 | (* General utils *) 2 | 3 | open Core.Std 4 | 5 | module type U = sig 6 | val range : int -> int -> int list 7 | val random_list : int -> int -> int list 8 | end 9 | 10 | module Function = 11 | struct 12 | let ($) x y z = x (y z) 13 | end 14 | 15 | let range x y = 16 | let rec aux l item = 17 | let increment n = n+1 in 18 | if (item < y) then aux (l @ [item]) (increment item) 19 | else l 20 | in aux [] x 21 | 22 | let map_with_index ~f l = 23 | let rec aux i fn lst r = match lst with 24 | | [] -> List.rev r 25 | | x::xs -> aux (i+1) fn xs ((i, fn(x)) :: r) 26 | in aux 0 f l [] 27 | 28 | (* An int array of random size in range r *) 29 | let random_array size r = Array.init size (fun _ -> Random.int r) 30 | 31 | let random_list size r = 32 | let l = ref [] in 33 | for i = 0 to size do 34 | l := Random.int r :: !l 35 | done; 36 | !l 37 | 38 | module Utils : U = 39 | struct 40 | let range = range 41 | let random_list = random_list 42 | end 43 | 44 | let rec sum_recur = function 45 | | [] -> 0 46 | | x::xs -> x + sum_recur xs 47 | 48 | (* no deferred operations on any recursive call *) 49 | let sum lst = 50 | let rec aux' s a = 51 | match s with 52 | [] -> a 53 | | x::xs -> aux' xs (a+x) in 54 | aux' lst 0 55 | 56 | let take_while ~f l = 57 | let rec aux ls = function 58 | | [] -> ls 59 | | x::xs -> if f x then aux (x::ls) xs else ls 60 | in 61 | List.rev (aux [] (* [(|>)] is the forward pipe operator *) 62 | 63 | let (|>) x f = f x 64 | 65 | (* Haskells compose . operator *) 66 | 67 | let (>>) f g x = g (f x) 68 | 69 | let flat_map f = List.concat >> List.map f 70 | 71 | let print = print_string 72 | let println = print_endline 73 | 74 | (* File reading utilty function *) 75 | let read filename = 76 | let file_in = open_in filename in 77 | let rec aux acc = 78 | try aux (input_line file_in :: acc) with End_of_file -> close_in file_in; acc 79 | in 80 | aux [] |> List.filter ((<>) "") |> List.rev 81 | 82 | let count_lines filename = filename |> read |> List.length 83 | 84 | (* Take n lines from a given file *) 85 | let take_lines n filename = 86 | let file_in = open_in filename in 87 | let rec aux acc count = 88 | if count = n then acc 89 | else 90 | try let l = (input_line file_in :: acc) 91 | in aux l (count+1) 92 | with End_of_file -> close_in file_in; acc 93 | in aux [] 0 |> List.rev 94 | 95 | (* Apply a function to each line in a channel *) 96 | (* e.g each_line (open_in "README.md") print_endline *) 97 | let rec do_each_line channel f = 98 | try 99 | let line = input_line channel in 100 | f line; 101 | do_each_line channel f 102 | with 103 | | End_of_file -> close_in channel 104 | | _ -> failwith "Exception raised while processing file" 105 | 106 | let map_lines file f = 107 | do_each_line (open_in file) f 108 | 109 | let sum_squares xs = 110 | xs 111 | |> List.fold_left (fun acc v -> (v*v)::acc) [] 112 | |> sum 113 | 114 | let rec zip v1 v2 = 115 | match (v1, v2) with 116 | | [], _ -> [] 117 | | _, [] -> [] 118 | | (x::xs), (y::ys) -> (x,y)::zip xs ys 119 | 120 | let dot_product v1 v2 = 121 | let zipped = zip v1 v2 in 122 | List.map (fun (x,y) -> x * y) zipped |> sum 123 | 124 | type 'a point = Point of 'a * 'a 125 | 126 | (* Euclidean distance for two points *) 127 | let euclidean p1 p2 = 128 | match (p1,p2) with 129 | | P(x1,x2), P(y1,y2) -> 130 | let a = x1-y1 in 131 | let b = x2-y2 in 132 | let c = (a*a) + (b*b) in sqrt (float_of_int c) 133 | | _ -> failwith "Arguments p1 and p2 be of type P(x,y)" 134 | 135 | (* List Utils *) 136 | 137 | let map_squares = 138 | List.map ~f:(fun x -> x * x) 139 | 140 | let rec forall p l = 141 | match l with 142 | [] -> true 143 | | h::t -> p(h) & forall p t 144 | 145 | let list_empty = function 146 | | [] -> true 147 | | _ -> false 148 | 149 | let rec filter p = function 150 | | [] -> [] 151 | | x::xs -> if p x then x :: filter p xs 152 | else filter p xs 153 | 154 | let multiple_of n x = x mod n = 0 155 | 156 | let remove_multiples_of n = 157 | in filter (fun v -> v mod n <> 0) 158 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1.1) 2 | -------------------------------------------------------------------------------- /ods.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | version: "1.0" 3 | maintainer: "owain@owainlewis.com" 4 | authors: ["owainlewis"] 5 | homepage: "https://github.com/owainlewis/ods" 6 | license: "Apache-2.0" 7 | build: [ 8 | ["dune" "build" "-p" name "-j" jobs] 9 | ] 10 | -------------------------------------------------------------------------------- /src/.merlin: -------------------------------------------------------------------------------- 1 | EXCLUDE_QUERY_DIR 2 | B ../_build/default/src/.ods.objs/byte 3 | S . 4 | FLG -open Ods -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs 5 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ods) 3 | (public_name ods) 4 | (libraries sorting trees)) 5 | -------------------------------------------------------------------------------- /src/ods.ml: -------------------------------------------------------------------------------- 1 | (* ODS - OCaml Data Structures and Algorithms 2 | * Main module that exposes all the implemented data structures and algorithms 3 | *) 4 | 5 | module Sorting = Sorting.Sorting 6 | module Trees = Trees.Trees -------------------------------------------------------------------------------- /src/sorting.ml: -------------------------------------------------------------------------------- 1 | module Algorithms = 2 | struct 3 | let rec bubble: 'a list -> 'a list = fun xs -> 4 | let rec aux ys = match ys with 5 | | [] -> [] 6 | | x::[] -> [x] 7 | | x::y::xs when x > y -> y::aux(x::xs) 8 | | x::y::xs -> x :: aux(y::xs) 9 | in 10 | let sweep = aux xs in 11 | if sweep = xs 12 | then sweep 13 | else bubble sweep 14 | 15 | let rec selection_sort = function 16 | | [] -> [] 17 | | h::t -> 18 | let rec aux y ys = function 19 | | [] -> y :: selection_sort ys 20 | | x::xs when x < y -> aux x (y::ys) xs 21 | | x::xs -> aux y (x::ys) xs 22 | in aux h [] t 23 | 24 | let rec insertion xs = 25 | let rec aux v ys = 26 | match ys with 27 | | [] -> [v] 28 | | z::zs as l -> 29 | if v < z 30 | then v :: l 31 | else z :: (aux v zs) 32 | in match xs with 33 | | [] -> [] 34 | | [x] -> [x] 35 | | v::vs -> aux v (insertion vs) 36 | 37 | let rec quick_sort: 'a list -> 'a list = function 38 | | [] -> [] 39 | | x::xs -> let smaller, larger = List.partition (fun y -> y < x) xs 40 | in let x = (quick_sort smaller) 41 | and y = (x::quick_sort larger) 42 | in x @ y 43 | end 44 | -------------------------------------------------------------------------------- /src/sorting/bubble_sort.ml: -------------------------------------------------------------------------------- 1 | (* Bubble Sort Implementation *) 2 | 3 | (* Bubble sort for lists *) 4 | let rec sort = function 5 | | [] -> [] 6 | | lst -> 7 | let rec bubble = function 8 | | [] -> [] 9 | | [x] -> [x] 10 | | x::y::rest -> 11 | if x > y then 12 | y :: bubble (x :: rest) 13 | else 14 | x :: bubble (y :: rest) 15 | in 16 | let pass = bubble lst in 17 | if pass = lst then 18 | pass 19 | else 20 | sort pass 21 | 22 | (* Bubble sort for arrays (in-place) *) 23 | let sort_array arr = 24 | let n = Array.length arr in 25 | 26 | for i = 0 to n - 1 do 27 | let swapped = ref false in 28 | 29 | for j = 0 to n - i - 2 do 30 | if arr.(j) > arr.(j + 1) then ( 31 | let temp = arr.(j) in 32 | arr.(j) <- arr.(j + 1); 33 | arr.(j + 1) <- temp; 34 | swapped := true 35 | ) 36 | done; 37 | 38 | (* If no swapping occurred in this pass, array is sorted *) 39 | if not !swapped then 40 | i <- n 41 | done; 42 | 43 | arr -------------------------------------------------------------------------------- /src/sorting/counting_sort.ml: -------------------------------------------------------------------------------- 1 | (* Counting Sort Implementation *) 2 | 3 | (* Counting sort for array of non-negative integers *) 4 | let sort_non_negative arr = 5 | if Array.length arr = 0 then arr 6 | else 7 | (* Find maximum element to determine count array size *) 8 | let max_val = Array.fold_left max 0 arr in 9 | 10 | (* Create a count array to store count of each value *) 11 | let count = Array.make (max_val + 1) 0 in 12 | 13 | (* Count occurrences of each element *) 14 | Array.iter (fun x -> count.(x) <- count.(x) + 1) arr; 15 | 16 | (* Update count array to contain actual positions *) 17 | for i = 1 to max_val do 18 | count.(i) <- count.(i) + count.(i - 1) 19 | done; 20 | 21 | (* Build output array *) 22 | let output = Array.make (Array.length arr) 0 in 23 | for i = Array.length arr - 1 downto 0 do 24 | output.(count.(arr.(i)) - 1) <- arr.(i); 25 | count.(arr.(i)) <- count.(arr.(i)) - 1 26 | done; 27 | 28 | (* Copy output array to original array *) 29 | Array.blit output 0 arr 0 (Array.length arr); 30 | arr 31 | 32 | (* Counting sort for array of integers (can handle negative values) *) 33 | let sort arr = 34 | if Array.length arr = 0 then arr 35 | else 36 | (* Find minimum and maximum elements *) 37 | let min_val = Array.fold_left min Int.max_int arr in 38 | let max_val = Array.fold_left max Int.min_int arr in 39 | 40 | (* Shift all values to be non-negative *) 41 | let shifted = Array.map (fun x -> x - min_val) arr in 42 | 43 | (* Apply counting sort on shifted array *) 44 | let _ = sort_non_negative shifted in 45 | 46 | (* Shift back to original values *) 47 | Array.map (fun x -> x + min_val) shifted 48 | 49 | (* Counting sort for list of integers *) 50 | let sort_list lst = 51 | let arr = Array.of_list lst in 52 | let sorted = sort arr in 53 | Array.to_list sorted -------------------------------------------------------------------------------- /src/sorting/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name sorting) 3 | (public_name ods.sorting)) -------------------------------------------------------------------------------- /src/sorting/heap_sort.ml: -------------------------------------------------------------------------------- 1 | (* Heap Sort Implementation *) 2 | 3 | (* Heapify a subtree rooted at index i, maintaining max-heap property *) 4 | let heapify arr size i = 5 | let largest = ref i in 6 | let left = 2 * i + 1 in 7 | let right = 2 * i + 2 in 8 | 9 | (* If left child is larger than root *) 10 | if left < size && arr.(left) > arr.(!largest) then 11 | largest := left; 12 | 13 | (* If right child is larger than largest so far *) 14 | if right < size && arr.(right) > arr.(!largest) then 15 | largest := right; 16 | 17 | (* If largest is not root *) 18 | if !largest <> i then ( 19 | let temp = arr.(i) in 20 | arr.(i) <- arr.(!largest); 21 | arr.(!largest) <- temp; 22 | 23 | (* Recursively heapify the affected sub-tree *) 24 | heapify arr size !largest 25 | ) 26 | 27 | (* Build a max heap *) 28 | let build_heap arr = 29 | let n = Array.length arr in 30 | 31 | (* Start from the last non-leaf node and heapify all nodes *) 32 | for i = (n / 2) - 1 downto 0 do 33 | heapify arr n i 34 | done 35 | 36 | (* Heap sort implementation for arrays (in-place) *) 37 | let sort arr = 38 | let n = Array.length arr in 39 | 40 | (* Build max heap *) 41 | build_heap arr; 42 | 43 | (* Extract elements one by one from heap *) 44 | for i = n - 1 downto 1 do 45 | (* Move current root to end *) 46 | let temp = arr.(0) in 47 | arr.(0) <- arr.(i); 48 | arr.(i) <- temp; 49 | 50 | (* Heapify the reduced heap *) 51 | heapify arr i 0 52 | done; 53 | 54 | arr 55 | 56 | (* Heap sort implementation for lists *) 57 | let sort_list lst = 58 | let arr = Array.of_list lst in 59 | let sorted = sort arr in 60 | Array.to_list sorted -------------------------------------------------------------------------------- /src/sorting/insertion_sort.ml: -------------------------------------------------------------------------------- 1 | (* Insertion Sort Implementation *) 2 | 3 | (* Insertion sort for lists *) 4 | let rec sort = function 5 | | [] -> [] 6 | | x::xs -> insert x (sort xs) 7 | 8 | and insert x = function 9 | | [] -> [x] 10 | | y::ys as l -> 11 | if x <= y then x :: l 12 | else y :: insert x ys 13 | 14 | (* Insertion sort for arrays (in-place) *) 15 | let sort_array arr = 16 | let n = Array.length arr in 17 | 18 | for i = 1 to n - 1 do 19 | let key = arr.(i) in 20 | let j = ref (i - 1) in 21 | 22 | while !j >= 0 && arr.(!j) > key do 23 | arr.(!j + 1) <- arr.(!j); 24 | decr j 25 | done; 26 | 27 | arr.(!j + 1) <- key 28 | done; 29 | 30 | arr -------------------------------------------------------------------------------- /src/sorting/merge_sort.ml: -------------------------------------------------------------------------------- 1 | (* Merge Sort Implementation *) 2 | 3 | (* Merge two sorted lists into a single sorted list *) 4 | let rec merge left right = 5 | match left, right with 6 | | [], right -> right 7 | | left, [] -> left 8 | | x::xs, y::ys -> 9 | if x <= y then 10 | x :: merge xs right 11 | else 12 | y :: merge left ys 13 | 14 | (* Split a list into two roughly equal parts *) 15 | let split list = 16 | let rec aux left right = function 17 | | [] -> (List.rev left, right) 18 | | [x] -> (List.rev (x::left), right) 19 | | x::y::rest -> aux (x::left) (y::right) rest 20 | in 21 | aux [] [] list 22 | 23 | (* Merge sort on lists *) 24 | let rec sort = function 25 | | [] -> [] 26 | | [x] -> [x] 27 | | xs -> 28 | let (left, right) = split xs in 29 | merge (sort left) (sort right) 30 | 31 | (* Merge sort on arrays (in-place) *) 32 | let sort_array arr = 33 | let len = Array.length arr in 34 | let aux = Array.make len arr.(0) in 35 | 36 | let rec merge_arrays src dest start mid ending = 37 | let i = ref start in 38 | let j = ref mid in 39 | let k = ref start in 40 | 41 | while !k < ending do 42 | if !i >= mid then ( 43 | dest.(!k) <- src.(!j); 44 | incr j 45 | ) else if !j >= ending then ( 46 | dest.(!k) <- src.(!i); 47 | incr i 48 | ) else if src.(!i) <= src.(!j) then ( 49 | dest.(!k) <- src.(!i); 50 | incr i 51 | ) else ( 52 | dest.(!k) <- src.(!j); 53 | incr j 54 | ); 55 | incr k 56 | done 57 | in 58 | 59 | let rec split_merge src dest start ending = 60 | if ending - start <= 1 then () 61 | else 62 | let mid = start + ((ending - start) / 2) in 63 | split_merge dest src start mid; 64 | split_merge dest src mid ending; 65 | merge_arrays src dest start mid ending 66 | in 67 | 68 | if len <= 1 then arr 69 | else ( 70 | Array.blit arr 0 aux 0 len; 71 | split_merge aux arr 0 len; 72 | arr 73 | ) -------------------------------------------------------------------------------- /src/sorting/quick_sort.ml: -------------------------------------------------------------------------------- 1 | (* Quick Sort Implementation *) 2 | 3 | (* Partition a list based on a pivot element *) 4 | let partition pivot = 5 | let rec aux left right = function 6 | | [] -> (left, right) 7 | | x::xs -> 8 | if x <= pivot then 9 | aux (x::left) right xs 10 | else 11 | aux left (x::right) xs 12 | in 13 | aux [] [] 14 | 15 | (* Quick sort for lists *) 16 | let rec sort = function 17 | | [] -> [] 18 | | pivot::rest -> 19 | let (left, right) = partition pivot rest in 20 | sort left @ [pivot] @ sort right 21 | 22 | (* Quick sort for arrays (in-place) *) 23 | let sort_array arr = 24 | (* Swap elements in array *) 25 | let swap i j = 26 | let temp = arr.(i) in 27 | arr.(i) <- arr.(j); 28 | arr.(j) <- temp 29 | in 30 | 31 | (* Partition function - Lomuto partition scheme *) 32 | let partition low high = 33 | let pivot = arr.(high) in 34 | let i = ref (low - 1) in 35 | 36 | for j = low to high - 1 do 37 | if arr.(j) <= pivot then ( 38 | incr i; 39 | swap !i j 40 | ) 41 | done; 42 | 43 | let pivot_pos = !i + 1 in 44 | swap pivot_pos high; 45 | pivot_pos 46 | in 47 | 48 | (* Quick sort function *) 49 | let rec quick_sort low high = 50 | if low < high then 51 | let pivot_pos = partition low high in 52 | quick_sort low (pivot_pos - 1); 53 | quick_sort (pivot_pos + 1) high 54 | in 55 | 56 | let len = Array.length arr in 57 | if len > 1 then 58 | quick_sort 0 (len - 1); 59 | arr 60 | 61 | (* Random Pivot Quick sort - better performance on almost sorted data *) 62 | let sort_random_pivot arr = 63 | let len = Array.length arr in 64 | 65 | (* Swap elements in array *) 66 | let swap i j = 67 | let temp = arr.(i) in 68 | arr.(i) <- arr.(j); 69 | arr.(j) <- temp 70 | in 71 | 72 | (* Random partition - choose a random pivot for better average performance *) 73 | let partition low high = 74 | let rand_idx = low + Random.int (high - low + 1) in 75 | swap rand_idx high; (* Move random element to end *) 76 | 77 | let pivot = arr.(high) in 78 | let i = ref (low - 1) in 79 | 80 | for j = low to high - 1 do 81 | if arr.(j) <= pivot then ( 82 | incr i; 83 | swap !i j 84 | ) 85 | done; 86 | 87 | let pivot_pos = !i + 1 in 88 | swap pivot_pos high; 89 | pivot_pos 90 | in 91 | 92 | (* Quick sort function *) 93 | let rec quick_sort low high = 94 | if low < high then 95 | let pivot_pos = partition low high in 96 | quick_sort low (pivot_pos - 1); 97 | quick_sort (pivot_pos + 1) high 98 | in 99 | 100 | if len > 1 then ( 101 | Random.self_init(); 102 | quick_sort 0 (len - 1) 103 | ); 104 | arr -------------------------------------------------------------------------------- /src/sorting/radix_sort.ml: -------------------------------------------------------------------------------- 1 | (* Radix Sort Implementation *) 2 | 3 | (* Helper function to get the digit at a specific position *) 4 | let get_digit num position = 5 | (num / (int_of_float (10. ** float_of_int position))) mod 10 6 | 7 | (* Count sort implementation for radix sort *) 8 | let count_sort arr position = 9 | let n = Array.length arr in 10 | let output = Array.make n 0 in 11 | let count = Array.make 10 0 in 12 | 13 | (* Count occurrences of each digit *) 14 | for i = 0 to n - 1 do 15 | let digit = get_digit arr.(i) position in 16 | count.(digit) <- count.(digit) + 1 17 | done; 18 | 19 | (* Update count array to contain positions *) 20 | for i = 1 to 9 do 21 | count.(i) <- count.(i) + count.(i - 1) 22 | done; 23 | 24 | (* Build output array *) 25 | for i = n - 1 downto 0 do 26 | let digit = get_digit arr.(i) position in 27 | output.(count.(digit) - 1) <- arr.(i); 28 | count.(digit) <- count.(digit) - 1 29 | done; 30 | 31 | (* Copy output to original array *) 32 | Array.blit output 0 arr 0 n 33 | 34 | (* Radix sort for non-negative integers *) 35 | let sort_non_negative arr = 36 | if Array.length arr = 0 then arr 37 | else 38 | (* Find the maximum number to know number of digits *) 39 | let max_val = Array.fold_left max 0 arr in 40 | 41 | (* Apply counting sort for each digit position *) 42 | let rec sort_digits position = 43 | if max_val / (int_of_float (10. ** float_of_int position)) > 0 then ( 44 | count_sort arr position; 45 | sort_digits (position + 1) 46 | ) 47 | in 48 | 49 | sort_digits 0; 50 | arr 51 | 52 | (* Radix sort for any integers (handles negative values) *) 53 | let sort arr = 54 | if Array.length arr = 0 then arr 55 | else 56 | (* Split into negative and non-negative arrays *) 57 | let neg, non_neg = Array.to_list arr |> List.partition (fun x -> x < 0) in 58 | 59 | (* Sort absolute values of negative numbers *) 60 | let neg_abs = List.map abs neg |> Array.of_list in 61 | let _ = sort_non_negative neg_abs in 62 | 63 | (* Reverse and negate to get sorted negative numbers *) 64 | let sorted_neg = Array.to_list neg_abs 65 | |> List.rev 66 | |> List.map (fun x -> -x) in 67 | 68 | (* Sort non-negative numbers *) 69 | let non_neg_arr = Array.of_list non_neg in 70 | let _ = sort_non_negative non_neg_arr in 71 | 72 | (* Combine the two sorted arrays *) 73 | sorted_neg @ (Array.to_list non_neg_arr) 74 | |> Array.of_list 75 | 76 | (* Radix sort for list of integers *) 77 | let sort_list lst = 78 | let arr = Array.of_list lst in 79 | let sorted = sort arr in 80 | Array.to_list sorted -------------------------------------------------------------------------------- /src/sorting/selection_sort.ml: -------------------------------------------------------------------------------- 1 | (* Selection Sort Implementation *) 2 | 3 | (* Selection sort for lists *) 4 | let rec sort = function 5 | | [] -> [] 6 | | lst -> 7 | let rec select_min min rest = function 8 | | [] -> min :: sort rest 9 | | x::xs -> 10 | if x < min then 11 | select_min x (min::rest) xs 12 | else 13 | select_min min (x::rest) xs 14 | in 15 | match lst with 16 | | [] -> [] 17 | | x::xs -> select_min x [] xs 18 | 19 | (* Selection sort for arrays (in-place) *) 20 | let sort_array arr = 21 | let n = Array.length arr in 22 | 23 | for i = 0 to n - 2 do 24 | let min_idx = ref i in 25 | 26 | for j = i + 1 to n - 1 do 27 | if arr.(j) < arr.(!min_idx) then 28 | min_idx := j 29 | done; 30 | 31 | if !min_idx <> i then ( 32 | let temp = arr.(i) in 33 | arr.(i) <- arr.(!min_idx); 34 | arr.(!min_idx) <- temp 35 | ) 36 | done; 37 | 38 | arr -------------------------------------------------------------------------------- /src/sorting/sorting.ml: -------------------------------------------------------------------------------- 1 | (* Sorting Module - Entry point for all sorting algorithms *) 2 | 3 | module Bubble = struct 4 | let sort = Bubble_sort.sort 5 | let sort_array = Bubble_sort.sort_array 6 | end 7 | 8 | module Insertion = struct 9 | let sort = Insertion_sort.sort 10 | let sort_array = Insertion_sort.sort_array 11 | end 12 | 13 | module Selection = struct 14 | let sort = Selection_sort.sort 15 | let sort_array = Selection_sort.sort_array 16 | end 17 | 18 | module Quick = struct 19 | let sort = Quick_sort.sort 20 | let sort_array = Quick_sort.sort_array 21 | let sort_random_pivot = Quick_sort.sort_random_pivot 22 | end 23 | 24 | module Merge = struct 25 | let sort = Merge_sort.sort 26 | let sort_array = Merge_sort.sort_array 27 | end 28 | 29 | module Heap = struct 30 | let sort = Heap_sort.sort 31 | let sort_list = Heap_sort.sort_list 32 | end 33 | 34 | module Counting = struct 35 | let sort = Counting_sort.sort 36 | let sort_list = Counting_sort.sort_list 37 | let sort_non_negative = Counting_sort.sort_non_negative 38 | end 39 | 40 | module Radix = struct 41 | let sort = Radix_sort.sort 42 | let sort_list = Radix_sort.sort_list 43 | let sort_non_negative = Radix_sort.sort_non_negative 44 | end 45 | 46 | (* Helper functions *) 47 | 48 | (* Sort a list using the most appropriate algorithm based on data characteristics *) 49 | let sort_list lst = 50 | match lst with 51 | | [] | [_] -> lst (* Empty or single element list *) 52 | | _ -> 53 | (* For small lists, use insertion sort *) 54 | if List.length lst < 20 then 55 | Insertion.sort lst 56 | (* For larger lists, use merge sort as a general-purpose algorithm *) 57 | else 58 | Merge.sort lst 59 | 60 | (* Sort an array using the most appropriate algorithm based on data characteristics *) 61 | let sort_array arr = 62 | let len = Array.length arr in 63 | match len with 64 | | 0 | 1 -> arr (* Empty or single element array *) 65 | | _ -> 66 | (* For small arrays, use insertion sort *) 67 | if len < 20 then 68 | Insertion.sort_array arr 69 | (* For medium arrays, use quick sort *) 70 | else if len < 1000 then 71 | Quick.sort_random_pivot arr 72 | (* For larger arrays, use heap sort as it guarantees O(n log n) worst case *) 73 | else 74 | Heap.sort arr -------------------------------------------------------------------------------- /src/trees/avl_tree.ml: -------------------------------------------------------------------------------- 1 | (* AVL Tree Implementation *) 2 | 3 | type 'a tree = 4 | | Empty 5 | | Node of 'a * 'a tree * 'a tree * int (* value, left, right, height *) 6 | 7 | (* Get height of a tree *) 8 | let height = function 9 | | Empty -> 0 10 | | Node(_, _, _, h) -> h 11 | 12 | (* Create a new node with proper height *) 13 | let make_node value left right = 14 | let h = 1 + max (height left) (height right) in 15 | Node(value, left, right, h) 16 | 17 | (* Get balance factor of a node *) 18 | let balance_factor = function 19 | | Empty -> 0 20 | | Node(_, left, right, _) -> height left - height right 21 | 22 | (* Rotate right *) 23 | let rotate_right = function 24 | | Node(k2, Node(k1, a, b, _), c, _) -> 25 | make_node k1 a (make_node k2 b c) 26 | | _ -> failwith "Cannot rotate right" 27 | 28 | (* Rotate left *) 29 | let rotate_left = function 30 | | Node(k1, a, Node(k2, b, c, _), _) -> 31 | make_node k2 (make_node k1 a b) c 32 | | _ -> failwith "Cannot rotate left" 33 | 34 | (* Balance a node *) 35 | let balance node = 36 | match node with 37 | | Empty -> Empty 38 | | Node(value, left, right, _) as n -> 39 | let bf = balance_factor n in 40 | if bf > 1 then 41 | (* Left heavy *) 42 | if balance_factor left >= 0 then 43 | (* Left-Left case *) 44 | rotate_right n 45 | else 46 | (* Left-Right case *) 47 | let left' = rotate_left left in 48 | rotate_right (make_node value left' right) 49 | else if bf < -1 then 50 | (* Right heavy *) 51 | if balance_factor right <= 0 then 52 | (* Right-Right case *) 53 | rotate_left n 54 | else 55 | (* Right-Left case *) 56 | let right' = rotate_right right in 57 | rotate_left (make_node value left right') 58 | else 59 | (* Already balanced *) 60 | make_node value left right 61 | 62 | (* Insert a value into the AVL tree *) 63 | let rec insert value = function 64 | | Empty -> Node(value, Empty, Empty, 1) 65 | | Node(v, left, right, _) as node -> 66 | if value < v then 67 | balance (make_node v (insert value left) right) 68 | else if value > v then 69 | balance (make_node v left (insert value right)) 70 | else 71 | (* Duplicate keys not allowed *) 72 | node 73 | 74 | (* Find minimum value in a tree *) 75 | let rec find_min = function 76 | | Empty -> failwith "Empty tree has no minimum" 77 | | Node(value, Empty, _, _) -> value 78 | | Node(_, left, _, _) -> find_min left 79 | 80 | (* Delete a value from the AVL tree *) 81 | let rec delete value = function 82 | | Empty -> Empty 83 | | Node(v, left, right, _) -> 84 | if value < v then 85 | balance (make_node v (delete value left) right) 86 | else if value > v then 87 | balance (make_node v left (delete value right)) 88 | else 89 | (* Node to delete found *) 90 | match left, right with 91 | | Empty, Empty -> Empty 92 | | Empty, _ -> right 93 | | _, Empty -> left 94 | | _, _ -> 95 | (* Node with two children *) 96 | let min_val = find_min right in 97 | balance (make_node min_val left (delete min_val right)) 98 | 99 | (* Check if a value exists in the tree *) 100 | let rec member value = function 101 | | Empty -> false 102 | | Node(v, left, right, _) -> 103 | if value = v then true 104 | else if value < v then member value left 105 | else member value right 106 | 107 | (* Tree traversals *) 108 | let rec inorder = function 109 | | Empty -> [] 110 | | Node(value, left, right, _) -> 111 | inorder left @ [value] @ inorder right 112 | 113 | let rec preorder = function 114 | | Empty -> [] 115 | | Node(value, left, right, _) -> 116 | [value] @ preorder left @ preorder right 117 | 118 | let rec postorder = function 119 | | Empty -> [] 120 | | Node(value, left, right, _) -> 121 | postorder left @ postorder right @ [value] 122 | 123 | (* Build tree from a list *) 124 | let build xs = 125 | List.fold_left (fun tree x -> insert x tree) Empty xs 126 | 127 | (* Visualize tree structure (for debugging) *) 128 | let rec to_string_indented ?(indent=0) = function 129 | | Empty -> String.make indent ' ' ^ ".\n" 130 | | Node(value, left, right, h) -> 131 | let s = String.make indent ' ' ^ 132 | Printf.sprintf "%d (h=%d, bf=%d)\n" 133 | value h (balance_factor (Node(value, left, right, h))) in 134 | s ^ to_string_indented ~indent:(indent+2) left ^ 135 | to_string_indented ~indent:(indent+2) right -------------------------------------------------------------------------------- /src/trees/binary_search_tree.ml: -------------------------------------------------------------------------------- 1 | exception Unknown 2 | 3 | type comparison = Lt 4 | | Eq 5 | | Gt 6 | 7 | module type ORDERED_TYPE = 8 | sig 9 | type t 10 | val cmp: t -> t -> comparison 11 | end 12 | 13 | module BinarySearchTree = functor (Elt: ORDERED_TYPE) -> struct 14 | type t = Elt.t 15 | type bst = Empty 16 | | Node of t * bst * bst 17 | end 18 | 19 | type 'a tree = 20 | | Leaf 21 | | Node of 'a tree * 'a * 'a tree 22 | 23 | let leaf = Leaf 24 | let node x = Node(leaf, x, leaf) 25 | 26 | let rec min_value tree = 27 | match tree with 28 | | Leaf -> 0 29 | | Node(l,x,_) -> if l = Leaf then x else min_value l 30 | 31 | let rec max_value tree = 32 | match tree with 33 | | Leaf -> raise Unknown 34 | | Node(_,x,r) -> 35 | if r = Leaf then x else max_value r 36 | 37 | let rec insert value tree = 38 | match tree with 39 | | Leaf -> Node(Leaf, value, Leaf) 40 | | Node(l,x,r) as t -> 41 | if value < x then Node((insert value l), x, r) 42 | else if value > x then Node(l, x, (insert value r)) 43 | (* Do nothing, duplicate key *) 44 | else t 45 | 46 | (* Deletion in a binary search tree has three cases 47 | * 1.) node to be deleted is a leaf 48 | * 2.) node to be deleted has only one child 49 | * 3.) node to be deleted has two children 50 | *) 51 | let rec delete value tree = 52 | match tree with 53 | | Leaf -> tree 54 | | Node(l,x,r) -> 55 | if value = x then 56 | (* node to be deleted is a leaf *) 57 | if l = Leaf && r = Leaf then Leaf 58 | (* node to be deleted has only one child *) 59 | else if l = Leaf then r 60 | else if r = Leaf then l 61 | else 62 | (* find a minimum value in the right subtree *) 63 | (* replace value of the node to be removed with found minimum. Now, right subtree contains a duplicate! *) 64 | (* apply remove to the right subtree to remove a duplicate. *) 65 | let m = min_value r in 66 | let n = delete m r in Node(l,m,n) 67 | else if value < x then 68 | let lhs = delete value l in Node(lhs,x,r) 69 | else 70 | let rhs = delete value r in Node(l,x,rhs) 71 | 72 | let rec member v tree = 73 | match tree with 74 | | Leaf -> false 75 | | Node(l,x,r) -> 76 | if v = x then true 77 | else 78 | if v < x then member v l 79 | else member v r 80 | 81 | let rec height = function 82 | | Leaf -> 1 83 | | Node(l,_,r) -> max (1 + height l) (1 + height r) 84 | 85 | (** Advanced traversals **) 86 | let rec fold f acc tree = 87 | match tree with 88 | | Leaf -> acc 89 | | Node(l,x,r) -> f x (fold f acc l) (fold f acc r) 90 | 91 | (** Construct a new tree from a list of values **) 92 | let build xs = 93 | List.fold_left (fun x y -> insert y x) Leaf xs 94 | -------------------------------------------------------------------------------- /src/trees/btree.ml: -------------------------------------------------------------------------------- 1 | (* B-Tree Implementation *) 2 | 3 | (* B-tree of order m has: 4 | - Each node can have at most m children 5 | - Each node (except root) has at least ceil(m/2) children 6 | - Root has at least 2 children unless it's a leaf 7 | - All leaves are at the same level 8 | - A non-leaf node with k children contains k-1 keys 9 | *) 10 | 11 | (* We'll implement a B-tree of order m where: 12 | - Each node has at most m-1 keys 13 | - Each node (except root) has at least ceil(m/2)-1 keys 14 | - The keys in each node are sorted 15 | *) 16 | 17 | type 'a entry = { 18 | key: 'a; 19 | value: 'a; (* For simplicity, key and value have same type *) 20 | } 21 | 22 | type 'a node = { 23 | entries: 'a entry array; (* Sorted array of entries *) 24 | mutable n_entries: int; (* Number of entries currently in the node *) 25 | mutable children: 'a btree array option; (* None for leaf nodes *) 26 | } 27 | 28 | and 'a btree = 'a node option 29 | 30 | (* B-tree with its order (m) *) 31 | type 'a t = { 32 | order: int; 33 | mutable root: 'a btree; 34 | } 35 | 36 | (* Create a new empty B-tree of order m *) 37 | let create order = 38 | if order < 3 then 39 | failwith "B-tree order must be at least 3"; 40 | { 41 | order; 42 | root = None; 43 | } 44 | 45 | (* Create a new empty node *) 46 | let create_node order is_leaf = 47 | let node = { 48 | entries = Array.make (order - 1) {key = Obj.magic 0; value = Obj.magic 0}; 49 | n_entries = 0; 50 | children = if is_leaf then None else Some(Array.make order None); 51 | } in 52 | Some(node) 53 | 54 | (* Search for a key in the B-tree *) 55 | let rec search btree key = 56 | let rec search_node = function 57 | | None -> None 58 | | Some node -> 59 | let i = ref 0 in 60 | (* Find the first entry with key >= the search key *) 61 | while !i < node.n_entries && key > node.entries.(!i).key do 62 | incr i 63 | done; 64 | 65 | if !i < node.n_entries && key = node.entries.(!i).key then 66 | (* Found the key *) 67 | Some node.entries.(!i).value 68 | else 69 | (* Not found in this node, check children if they exist *) 70 | match node.children with 71 | | None -> None (* Leaf node, key not found *) 72 | | Some children -> search_node children.(!i) 73 | in 74 | search_node btree.root 75 | 76 | (* Split a child node when it's full *) 77 | let split_child parent_node i = 78 | match parent_node.children with 79 | | None -> failwith "Cannot split child of a leaf node" 80 | | Some children -> 81 | match children.(i) with 82 | | None -> failwith "Child node is None" 83 | | Some child_node -> 84 | let order = Array.length children in 85 | let t = order / 2 in 86 | 87 | (* Create new node for the right half *) 88 | let new_node = match create_node order (child_node.children = None) with 89 | | None -> failwith "Failed to create node" 90 | | Some n -> n 91 | in 92 | 93 | (* Copy the right half entries to the new node *) 94 | for j = 0 to t - 2 do 95 | new_node.entries.(j) <- child_node.entries.(j + t); 96 | new_node.n_entries <- new_node.n_entries + 1; 97 | done; 98 | 99 | (* Copy child pointers if not a leaf *) 100 | (match child_node.children, new_node.children with 101 | | Some child_children, Some new_children -> 102 | for j = 0 to t - 1 do 103 | new_children.(j) <- child_children.(j + t); 104 | done; 105 | | _, _ -> ()); 106 | 107 | (* Move the middle key to the parent *) 108 | for j = parent_node.n_entries downto i + 1 do 109 | parent_node.entries.(j) <- parent_node.entries.(j - 1); 110 | done; 111 | parent_node.entries.(i) <- child_node.entries.(t - 1); 112 | parent_node.n_entries <- parent_node.n_entries + 1; 113 | 114 | (* Update parent's children array *) 115 | for j = parent_node.n_entries downto i + 2 do 116 | children.(j) <- children.(j - 1); 117 | done; 118 | children.(i + 1) <- Some new_node; 119 | 120 | (* Adjust the original child node *) 121 | child_node.n_entries <- t - 1 122 | 123 | (* Insert a key-value pair into a non-full node *) 124 | let rec insert_non_full btree node key value = 125 | let i = ref (node.n_entries - 1) in 126 | 127 | match node.children with 128 | | None -> 129 | (* Leaf node, insert the key here *) 130 | while !i >= 0 && key < node.entries.(!i).key do 131 | node.entries.(!i + 1) <- node.entries.(!i); 132 | decr i; 133 | done; 134 | node.entries.(!i + 1) <- {key; value}; 135 | node.n_entries <- node.n_entries + 1 136 | | Some children -> 137 | (* Find the child where the key should be inserted *) 138 | while !i >= 0 && key < node.entries.(!i).key do 139 | decr i; 140 | done; 141 | let child_idx = !i + 1 in 142 | 143 | match children.(child_idx) with 144 | | None -> failwith "Child node is None" 145 | | Some child -> 146 | (* Check if the child is full *) 147 | if child.n_entries = Array.length child.entries then ( 148 | split_child node child_idx; 149 | (* After splitting, decide which child to go to *) 150 | if key > node.entries.(child_idx).key then 151 | incr child_idx 152 | ); 153 | 154 | (* Recursively insert into the child *) 155 | match children.(child_idx) with 156 | | None -> failwith "Child node is None after split" 157 | | Some child -> insert_non_full btree child key value 158 | 159 | (* Insert a key-value pair into the B-tree *) 160 | let insert btree key value = 161 | match btree.root with 162 | | None -> 163 | (* Empty tree, create a root node *) 164 | let new_root = match create_node btree.order true with 165 | | None -> failwith "Failed to create root node" 166 | | Some n -> n 167 | in 168 | new_root.entries.(0) <- {key; value}; 169 | new_root.n_entries <- 1; 170 | btree.root <- Some new_root 171 | | Some root -> 172 | if root.n_entries = btree.order - 1 then ( 173 | (* Root is full, split it *) 174 | let new_root = match create_node btree.order false with 175 | | None -> failwith "Failed to create new root" 176 | | Some n -> n 177 | in 178 | 179 | match new_root.children with 180 | | None -> failwith "New root should have children array" 181 | | Some children -> 182 | children.(0) <- Some root; 183 | btree.root <- Some new_root; 184 | split_child new_root 0; 185 | 186 | (* Insert into the new root *) 187 | insert_non_full btree new_root key value 188 | ) else ( 189 | (* Root is not full, insert directly *) 190 | insert_non_full btree root key value 191 | ) 192 | 193 | (* In-order traversal of the B-tree *) 194 | let traverse btree = 195 | let result = ref [] in 196 | 197 | let rec traverse_node = function 198 | | None -> () 199 | | Some node -> 200 | match node.children with 201 | | None -> 202 | (* Leaf node, just print the keys *) 203 | for i = 0 to node.n_entries - 1 do 204 | result := node.entries.(i) :: !result 205 | done 206 | | Some children -> 207 | (* Non-leaf node, traverse in-order *) 208 | for i = 0 to node.n_entries - 1 do 209 | traverse_node children.(i); 210 | result := node.entries.(i) :: !result 211 | done; 212 | traverse_node children.(node.n_entries) 213 | in 214 | 215 | traverse_node btree.root; 216 | List.rev !result -------------------------------------------------------------------------------- /src/trees/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name trees) 3 | (public_name ods.trees)) -------------------------------------------------------------------------------- /src/trees/fenwick_tree.ml: -------------------------------------------------------------------------------- 1 | (* Fenwick Tree (Binary Indexed Tree) Implementation *) 2 | 3 | (* A Fenwick Tree or Binary Indexed Tree is a data structure that can efficiently 4 | update elements and calculate prefix sums in a table of numbers. *) 5 | 6 | type t = { 7 | tree: int array; (* 1-based indexing *) 8 | size: int; (* Size of the original array *) 9 | } 10 | 11 | (* Create a new Fenwick tree from an array *) 12 | let create arr = 13 | let n = Array.length arr in 14 | let tree = Array.make (n + 1) 0 in 15 | 16 | (* Build the tree *) 17 | for i = 0 to n - 1 do 18 | (* 1-based indexing *) 19 | let idx = i + 1 in 20 | tree.(idx) <- arr.(i); 21 | 22 | (* Update all responsible ancestors *) 23 | let parent = idx + (idx land (-idx)) in 24 | if parent <= n then 25 | tree.(parent) <- tree.(parent) + tree.(idx) 26 | done; 27 | 28 | { tree; size = n } 29 | 30 | (* Create an empty Fenwick tree of given size *) 31 | let create_empty size = 32 | { tree = Array.make (size + 1) 0; size } 33 | 34 | (* Get the sum of the first i elements (0-based index) *) 35 | let prefix_sum ft i = 36 | if i < 0 || i >= ft.size then 37 | failwith "Index out of bounds"; 38 | 39 | let i = i + 1 in (* Convert to 1-based *) 40 | let rec sum idx acc = 41 | if idx = 0 then acc 42 | else sum (idx - (idx land (-idx))) (acc + ft.tree.(idx)) 43 | in 44 | sum i 0 45 | 46 | (* Get the sum of elements in range [start, end] (inclusive, 0-based) *) 47 | let range_sum ft start_idx end_idx = 48 | if start_idx < 0 || end_idx >= ft.size || start_idx > end_idx then 49 | failwith "Invalid range"; 50 | 51 | if start_idx = 0 then 52 | prefix_sum ft end_idx 53 | else 54 | prefix_sum ft end_idx - prefix_sum ft (start_idx - 1) 55 | 56 | (* Update the value at index i by adding delta (0-based index) *) 57 | let update ft i delta = 58 | if i < 0 || i >= ft.size then 59 | failwith "Index out of bounds"; 60 | 61 | let i = i + 1 in (* Convert to 1-based *) 62 | let rec update_aux idx = 63 | if idx <= ft.size then ( 64 | ft.tree.(idx) <- ft.tree.(idx) + delta; 65 | update_aux (idx + (idx land (-idx))) 66 | ) 67 | in 68 | update_aux i 69 | 70 | (* Set the value at index i to val (0-based index) *) 71 | let set ft i new_val = 72 | if i < 0 || i >= ft.size then 73 | failwith "Index out of bounds"; 74 | 75 | let current = 76 | if i = 0 then prefix_sum ft 0 77 | else prefix_sum ft i - prefix_sum ft (i - 1) 78 | in 79 | update ft i (new_val - current) 80 | 81 | (* Get the value at index i (0-based index) *) 82 | let get ft i = 83 | if i < 0 || i >= ft.size then 84 | failwith "Index out of bounds"; 85 | 86 | if i = 0 then 87 | prefix_sum ft 0 88 | else 89 | prefix_sum ft i - prefix_sum ft (i - 1) 90 | 91 | (* Create a Fenwick tree from a list *) 92 | let of_list lst = 93 | create (Array.of_list lst) 94 | 95 | (* Convert a Fenwick tree to a list of original values *) 96 | let to_list ft = 97 | let result = Array.make ft.size 0 in 98 | for i = 0 to ft.size - 1 do 99 | result.(i) <- get ft i 100 | done; 101 | Array.to_list result 102 | 103 | (* Find the largest index with prefix sum less than or equal to target *) 104 | let find_largest_with_sum_leq ft target = 105 | let rec binary_search left right = 106 | if left > right then 107 | if left > 0 then left - 1 else -1 108 | else 109 | let mid = left + (right - left) / 2 in 110 | let sum = prefix_sum ft mid in 111 | if sum <= target then 112 | binary_search (mid + 1) right 113 | else 114 | binary_search left (mid - 1) 115 | in 116 | binary_search 0 (ft.size - 1) -------------------------------------------------------------------------------- /src/trees/red_black_tree.ml: -------------------------------------------------------------------------------- 1 | (* Red Black Trees *) 2 | 3 | (* ****************************************************** 4 | * 5 | * Bz Bz Bx Bx 6 | * / \ / \ / \ / \ 7 | * Ry d Rx d a Rz a Ry 8 | * / \ / \ / \ / \ 9 | * Rx c a Ry Ry d b Rz 10 | * / \ / \ / \ / \ 11 | * a b b c b c c d 12 | * 13 | * ****************************************************************** *) 14 | 15 | exception Insert of string 16 | 17 | type color = Red | Black 18 | 19 | type 'a tree = 20 | | Leaf 21 | | Node of color * 'a * 'a tree * 'a tree 22 | 23 | let rec member x tree = 24 | match tree with 25 | | Leaf -> false 26 | | Node (_, value, left, right) -> 27 | if x == value then true 28 | else if x < value then member x left 29 | else member x right 30 | 31 | let balance = function 32 | Black, z, Node (Red, y, Node (Red, x, a, b), c), d 33 | | Black, z, Node (Red, x, a, Node (Red, y, b, c)), d 34 | | Black, x, a, Node (Red, z, Node (Red, y, b, c), d) 35 | | Black, x, a, Node (Red, y, b, Node (Red, z, c, d)) -> 36 | Node (Red, y, Node (Black, x, a, b), Node (Black, z, c, d)) 37 | | a, b, c, d -> 38 | Node (a, b, c, d) 39 | 40 | let insert x s = 41 | let rec ins = function 42 | Leaf -> Node (Red, x, Leaf, Leaf) 43 | | Node (color, y, a, b) as s -> 44 | if x < y then balance (color, y, ins a, b) 45 | else if x > y then balance (color, y, a, ins b) 46 | else s 47 | in 48 | match ins s with 49 | Node (_, y, a, b) -> 50 | Node (Black, y, a, b) 51 | | Leaf -> (* guaranteed to be nonempty *) 52 | raise (Insert "Red Black Tree insertion failed with `ins` returning leaf") 53 | -------------------------------------------------------------------------------- /src/trees/segment_tree.ml: -------------------------------------------------------------------------------- 1 | (* Segment Tree Implementation *) 2 | 3 | (* A segment tree for range queries and updates *) 4 | type 'a t = { 5 | size: int; (* Size of the original array *) 6 | tree: 'a array; (* The actual tree storage *) 7 | combine: 'a -> 'a -> 'a; (* Function to combine values *) 8 | default: 'a; (* Default/identity value *) 9 | } 10 | 11 | (* Calculate the size needed for the tree array *) 12 | let calc_size n = 13 | let rec next_pow2 x = 14 | if x >= n then x else next_pow2 (x * 2) 15 | in 16 | 2 * next_pow2 1 - 1 17 | 18 | (* Build a segment tree from an array *) 19 | let build arr combine default = 20 | let n = Array.length arr in 21 | if n = 0 then 22 | { size = 0; tree = [||]; combine; default } 23 | else 24 | let tree_size = calc_size n in 25 | let tree = Array.make tree_size default in 26 | 27 | (* Recursive build function *) 28 | let rec build_rec arr_idx left right tree_idx = 29 | if left = right then 30 | (* Leaf node *) 31 | tree.(tree_idx) <- arr.(left) 32 | else 33 | (* Internal node *) 34 | let mid = left + (right - left) / 2 in 35 | let left_child = 2 * tree_idx + 1 in 36 | let right_child = 2 * tree_idx + 2 in 37 | 38 | build_rec arr_idx left mid left_child; 39 | build_rec arr_idx (mid + 1) right right_child; 40 | 41 | tree.(tree_idx) <- combine tree.(left_child) tree.(right_child) 42 | in 43 | 44 | build_rec arr 0 (n - 1) 0; 45 | { size = n; tree; combine; default } 46 | 47 | (* Query a range [start, end] *) 48 | let query seg_tree query_start query_end = 49 | if query_start < 0 || query_end >= seg_tree.size || query_start > query_end then 50 | failwith "Invalid query range"; 51 | 52 | let rec query_rec left right tree_idx = 53 | (* Complete overlap *) 54 | if query_start <= left && query_end >= right then 55 | seg_tree.tree.(tree_idx) 56 | (* No overlap *) 57 | else if query_start > right || query_end < left then 58 | seg_tree.default 59 | (* Partial overlap - recurse on children *) 60 | else 61 | let mid = left + (right - left) / 2 in 62 | let left_child = 2 * tree_idx + 1 in 63 | let right_child = 2 * tree_idx + 2 in 64 | 65 | let left_result = query_rec left mid left_child in 66 | let right_result = query_rec (mid + 1) right right_child in 67 | 68 | seg_tree.combine left_result right_result 69 | in 70 | 71 | query_rec 0 (seg_tree.size - 1) 0 72 | 73 | (* Update a value at a specific index *) 74 | let update seg_tree idx new_value = 75 | if idx < 0 || idx >= seg_tree.size then 76 | failwith "Index out of bounds"; 77 | 78 | let rec update_rec left right tree_idx = 79 | if left = right then 80 | (* Leaf node - update it *) 81 | seg_tree.tree.(tree_idx) <- new_value 82 | else 83 | (* Internal node - recurse on appropriate child *) 84 | let mid = left + (right - left) / 2 in 85 | let left_child = 2 * tree_idx + 1 in 86 | let right_child = 2 * tree_idx + 2 in 87 | 88 | if idx <= mid then 89 | update_rec left mid left_child 90 | else 91 | update_rec (mid + 1) right right_child; 92 | 93 | (* Recompute this node's value *) 94 | seg_tree.tree.(tree_idx) <- seg_tree.combine 95 | seg_tree.tree.(left_child) 96 | seg_tree.tree.(right_child) 97 | in 98 | 99 | update_rec 0 (seg_tree.size - 1) 0; 100 | seg_tree 101 | 102 | (* Create a segment tree for range sum queries *) 103 | let sum_segment_tree arr = 104 | build arr (+) 0 105 | 106 | (* Create a segment tree for range minimum queries *) 107 | let min_segment_tree arr = 108 | build arr min max_int 109 | 110 | (* Create a segment tree for range maximum queries *) 111 | let max_segment_tree arr = 112 | build arr max min_int 113 | 114 | (* Create a segment tree for range GCD queries *) 115 | let gcd_segment_tree arr = 116 | let rec gcd a b = 117 | if b = 0 then abs a else gcd b (a mod b) 118 | in 119 | build arr gcd 0 120 | 121 | (* Create a segment tree for range product queries *) 122 | let product_segment_tree arr = 123 | build arr ( * ) 1 -------------------------------------------------------------------------------- /src/trees/splay_tree.ml: -------------------------------------------------------------------------------- 1 | (* Splay Tree Implementation *) 2 | 3 | (* A splay tree is a self-adjusting binary search tree with the 4 | property that recently accessed elements are quick to access again *) 5 | 6 | type 'a tree = 7 | | Empty 8 | | Node of 'a tree * 'a * 'a tree 9 | 10 | (* Right rotation *) 11 | let right_rotate = function 12 | | Node(Node(a, x, b), y, c) -> Node(a, x, Node(b, y, c)) 13 | | t -> t 14 | 15 | (* Left rotation *) 16 | let left_rotate = function 17 | | Node(a, x, Node(b, y, c)) -> Node(Node(a, x, b), y, c) 18 | | t -> t 19 | 20 | (* Splay operation - brings the target key to the root *) 21 | let rec splay key = function 22 | | Empty -> Empty 23 | | Node(l, k, r) as t -> 24 | if key = k then 25 | (* Found the key, return the tree *) 26 | t 27 | else if key < k then 28 | match l with 29 | | Empty -> t (* Key not in tree *) 30 | | Node(ll, lk, lr) -> 31 | if key = lk then 32 | (* Zig: key is in left child, rotate right *) 33 | right_rotate t 34 | else if key < lk then 35 | (* Zig-Zig: key is in left-left grandchild *) 36 | match splay key ll with 37 | | Empty -> t 38 | | splayed -> right_rotate (right_rotate (Node(splayed, lk, lr))) 39 | else 40 | (* Zig-Zag: key is in left-right grandchild *) 41 | match splay key lr with 42 | | Empty -> t 43 | | splayed -> right_rotate (Node(ll, lk, Node(splayed, k, r))) 44 | else 45 | match r with 46 | | Empty -> t (* Key not in tree *) 47 | | Node(rl, rk, rr) -> 48 | if key = rk then 49 | (* Zig: key is in right child, rotate left *) 50 | left_rotate t 51 | else if key > rk then 52 | (* Zig-Zig: key is in right-right grandchild *) 53 | match splay key rr with 54 | | Empty -> t 55 | | splayed -> left_rotate (left_rotate (Node(l, k, Node(rl, rk, splayed)))) 56 | else 57 | (* Zig-Zag: key is in right-left grandchild *) 58 | match splay key rl with 59 | | Empty -> t 60 | | splayed -> left_rotate (Node(Node(l, k, splayed), rk, rr)) 61 | 62 | (* Insert a key into the splay tree *) 63 | let insert key tree = 64 | let rec insert_bst k = function 65 | | Empty -> Node(Empty, k, Empty) 66 | | Node(l, k', r) as t -> 67 | if k = k' then t 68 | else if k < k' then Node(insert_bst k l, k', r) 69 | else Node(l, k', insert_bst k r) 70 | in 71 | 72 | let inserted = insert_bst key tree in 73 | splay key inserted 74 | 75 | (* Find a key in the splay tree *) 76 | let find key tree = 77 | let splayed = splay key tree in 78 | match splayed with 79 | | Empty -> (false, splayed) 80 | | Node(_, k, _) -> (k = key, splayed) 81 | 82 | (* Delete a key from the splay tree *) 83 | let delete key tree = 84 | let splayed = splay key tree in 85 | match splayed with 86 | | Empty -> Empty 87 | | Node(l, k, r) -> 88 | if k <> key then splayed 89 | else 90 | match l, r with 91 | | Empty, _ -> r 92 | | _, Empty -> l 93 | | _, _ -> 94 | (* Find the largest in the left subtree *) 95 | let max_l = splay max_int l in 96 | match max_l with 97 | | Empty -> failwith "Impossible: max_l is Empty" 98 | | Node(l', max_key, Empty) -> 99 | Node(l', max_key, r) 100 | | Node(l', max_key, r') -> 101 | failwith "Impossible: max_l has a right child" 102 | 103 | (* Check if a key exists in the tree *) 104 | let member key tree = 105 | let found, _ = find key tree in 106 | found 107 | 108 | (* Build a splay tree from a list *) 109 | let build xs = 110 | List.fold_left (fun t x -> insert x t) Empty xs 111 | 112 | (* In-order traversal *) 113 | let rec inorder = function 114 | | Empty -> [] 115 | | Node(l, k, r) -> inorder l @ [k] @ inorder r 116 | 117 | (* Visualization for debugging *) 118 | let rec to_string_indented ?(indent=0) = function 119 | | Empty -> String.make indent ' ' ^ ".\n" 120 | | Node(l, k, r) -> 121 | let s = String.make indent ' ' ^ string_of_int k ^ "\n" in 122 | s ^ to_string_indented ~indent:(indent+2) l ^ 123 | to_string_indented ~indent:(indent+2) r -------------------------------------------------------------------------------- /src/trees/suffix_tree.ml: -------------------------------------------------------------------------------- 1 | (* Suffix Tree Implementation - Ukkonen's Algorithm *) 2 | 3 | module CharMap = Map.Make(Char) 4 | 5 | type node = { 6 | mutable suffix_link: node option; 7 | mutable children: edge CharMap.t; 8 | id: int; 9 | } 10 | 11 | and edge = { 12 | start: int; 13 | mutable end_pos: int ref; 14 | target: node; 15 | } 16 | 17 | type t = { 18 | text: string; 19 | root: node; 20 | mutable node_count: int; 21 | } 22 | 23 | (* Create a new node *) 24 | let create_node ~suffix_link ~id = { 25 | suffix_link; 26 | children = CharMap.empty; 27 | id; 28 | } 29 | 30 | (* Create a new suffix tree *) 31 | let create text = 32 | let root = create_node ~suffix_link:None ~id:0 in 33 | let tree = { text; root; node_count = 1 } in 34 | 35 | let global_end = ref (-1) in 36 | 37 | (* Helper function to get character at position *) 38 | let char_at pos = text.[pos] in 39 | 40 | (* Helper function to add a new edge *) 41 | let add_edge parent_node start_pos end_pos target_node = 42 | let c = char_at start_pos in 43 | let edge = { start = start_pos; end_pos; target = target_node } in 44 | parent_node.children <- CharMap.add c edge parent_node.children 45 | in 46 | 47 | (* Traverse from a node following the given substring *) 48 | let rec traverse node str_pos end_pos = 49 | if str_pos > end_pos then 50 | (node, str_pos) (* Reached the end of the string *) 51 | else 52 | let c = char_at str_pos in 53 | match CharMap.find_opt c node.children with 54 | | None -> (node, str_pos) (* No path to follow *) 55 | | Some edge -> 56 | let edge_len = !(edge.end_pos) - edge.start + 1 in 57 | let str_len = end_pos - str_pos + 1 in 58 | 59 | if str_len < edge_len then 60 | (* String ends within this edge *) 61 | (node, str_pos) 62 | else 63 | (* Continue traversal from the target node *) 64 | traverse edge.target (str_pos + edge_len) end_pos 65 | in 66 | 67 | (* Find the end of the matching prefix on an edge *) 68 | let find_match_end edge_start str_pos str_end = 69 | let rec match_chars i j = 70 | if i > str_end || j > !(global_end) then 71 | i - str_pos (* Length of match *) 72 | else if char_at i = char_at j then 73 | match_chars (i + 1) (j + 1) 74 | else 75 | i - str_pos (* Length of match before mismatch *) 76 | in 77 | match_chars str_pos edge_start 78 | in 79 | 80 | (* Split an edge at the given position *) 81 | let split_edge parent edge split_pos = 82 | let new_node = create_node ~suffix_link:None ~id:(tree.node_count) in 83 | tree.node_count <- tree.node_count + 1; 84 | 85 | let new_edge_start = edge.start + split_pos in 86 | 87 | (* Update parent's child pointer *) 88 | let c = char_at edge.start in 89 | let new_parent_edge = { 90 | start = edge.start; 91 | end_pos = ref (new_edge_start - 1); 92 | target = new_node 93 | } in 94 | parent.children <- CharMap.add c new_parent_edge parent.children; 95 | 96 | (* Add edge from new node to old target *) 97 | let c = char_at new_edge_start in 98 | let new_child_edge = { 99 | start = new_edge_start; 100 | end_pos = edge.end_pos; 101 | target = edge.target 102 | } in 103 | new_node.children <- CharMap.add c new_child_edge CharMap.empty; 104 | 105 | new_node 106 | in 107 | 108 | (* Phase i: add all suffixes of text[0..i] *) 109 | let rec phase i = 110 | global_end := i; 111 | 112 | let rec extend_phase j = 113 | if j > i then () 114 | else 115 | let (origin, start_pos) = traverse tree.root j i in 116 | 117 | if start_pos > i then 118 | (* This suffix is already in the tree *) 119 | extend_phase (j + 1) 120 | else 121 | (* Need to add this suffix *) 122 | if start_pos = j then 123 | (* Suffix starts at root *) 124 | let new_leaf = create_node ~suffix_link:None ~id:(tree.node_count) in 125 | tree.node_count <- tree.node_count + 1; 126 | add_edge origin start_pos (ref i) new_leaf; 127 | extend_phase (j + 1) 128 | else 129 | (* Suffix starts on an edge *) 130 | let c = char_at start_pos in 131 | let edge = CharMap.find c origin.children in 132 | let match_len = find_match_end edge.start start_pos i in 133 | 134 | if match_len = i - start_pos + 1 then 135 | (* Suffix is already in the tree *) 136 | extend_phase (j + 1) 137 | else 138 | (* Split the edge and add a new leaf *) 139 | let split_node = split_edge origin edge match_len in 140 | let new_leaf = create_node ~suffix_link:None ~id:(tree.node_count) in 141 | tree.node_count <- tree.node_count + 1; 142 | add_edge split_node (start_pos + match_len) (ref i) new_leaf; 143 | extend_phase (j + 1) 144 | in 145 | 146 | extend_phase 0; 147 | if i + 1 < String.length text then 148 | phase (i + 1) 149 | in 150 | 151 | (* Start building the tree *) 152 | if String.length text > 0 then 153 | phase 0; 154 | 155 | tree 156 | 157 | (* Check if a pattern exists in the text *) 158 | let contains tree pattern = 159 | let rec traverse node pattern_pos = 160 | if pattern_pos >= String.length pattern then 161 | true 162 | else 163 | let c = pattern.[pattern_pos] in 164 | match CharMap.find_opt c node.children with 165 | | None -> false 166 | | Some edge -> 167 | let edge_len = !(edge.end_pos) - edge.start + 1 in 168 | let remaining_len = String.length pattern - pattern_pos in 169 | 170 | if remaining_len <= edge_len then 171 | (* Pattern ends on this edge, check if it matches *) 172 | let rec check_match i j count = 173 | if count = 0 then true 174 | else if i >= String.length tree.text || j >= String.length pattern then 175 | false 176 | else if tree.text.[i] = pattern.[j] then 177 | check_match (i + 1) (j + 1) (count - 1) 178 | else 179 | false 180 | in 181 | check_match edge.start pattern_pos remaining_len 182 | else 183 | (* Follow the edge and continue matching *) 184 | let rec check_edge i j count = 185 | if count = 0 then 186 | traverse edge.target (pattern_pos + edge_len) 187 | else if tree.text.[i] <> pattern.[j] then 188 | false 189 | else 190 | check_edge (i + 1) (j + 1) (count - 1) 191 | in 192 | check_edge edge.start pattern_pos edge_len 193 | in 194 | 195 | traverse tree.root 0 196 | 197 | (* Find all occurrences of a pattern in the text *) 198 | let find_all tree pattern = 199 | let rec traverse node pattern_pos path_start = 200 | if pattern_pos >= String.length pattern then 201 | (* Found a match, collect all leaf positions below this node *) 202 | let rec collect_leaves node acc = 203 | if CharMap.is_empty node.children then 204 | (* This is a leaf, add its position *) 205 | (path_start - pattern_pos) :: acc 206 | else 207 | (* Collect leaves from all children *) 208 | CharMap.fold 209 | (fun _ edge acc -> collect_leaves edge.target acc) 210 | node.children 211 | acc 212 | in 213 | collect_leaves node [] 214 | else 215 | (* Continue matching the pattern *) 216 | let c = pattern.[pattern_pos] in 217 | match CharMap.find_opt c node.children with 218 | | None -> [] 219 | | Some edge -> 220 | let edge_len = !(edge.end_pos) - edge.start + 1 in 221 | let remaining_len = String.length pattern - pattern_pos in 222 | 223 | if remaining_len <= edge_len then 224 | (* Pattern ends on this edge, check if it matches *) 225 | let matches = ref true in 226 | for i = 0 to remaining_len - 1 do 227 | if pattern.[pattern_pos + i] <> tree.text.[edge.start + i] then 228 | matches := false 229 | done; 230 | 231 | if !matches then 232 | (* Continue to collect all leaves *) 233 | let new_node = 234 | if remaining_len = edge_len then edge.target 235 | else node 236 | in 237 | traverse new_node (pattern_pos + remaining_len) (path_start + remaining_len) 238 | else 239 | [] 240 | else 241 | (* Need to match the entire edge first *) 242 | let matches = ref true in 243 | for i = 0 to edge_len - 1 do 244 | if pattern.[pattern_pos + i] <> tree.text.[edge.start + i] then 245 | matches := false 246 | done; 247 | 248 | if !matches then 249 | traverse edge.target (pattern_pos + edge_len) (path_start + edge_len) 250 | else 251 | [] 252 | in 253 | 254 | traverse tree.root 0 0 255 | 256 | (* Visualize the suffix tree (for debugging) *) 257 | let visualize tree = 258 | let rec visualize_node node depth = 259 | let indent = String.make (depth * 2) ' ' in 260 | Printf.printf "%sNode %d\n" indent node.id; 261 | 262 | CharMap.iter (fun c edge -> 263 | let edge_str = String.sub tree.text edge.start (!(edge.end_pos) - edge.start + 1) in 264 | Printf.printf "%s %c -> \"%s\" (pos: %d-%d)\n" 265 | indent c edge_str edge.start !(edge.end_pos); 266 | visualize_node edge.target (depth + 1) 267 | ) node.children 268 | in 269 | 270 | visualize_node tree.root 0 -------------------------------------------------------------------------------- /src/trees/treap.ml: -------------------------------------------------------------------------------- 1 | (* Treap Implementation *) 2 | 3 | (* A Treap is a randomized binary search tree where each node has both 4 | a key and a priority (randomly assigned). It maintains the BST property 5 | for keys and the heap property for priorities. *) 6 | 7 | (* Random number generation for priorities *) 8 | let rng = Random.State.make_self_init () 9 | 10 | type 'a treap = 11 | | Empty 12 | | Node of 'a * int * 'a treap * 'a treap (* key, priority, left, right *) 13 | 14 | (* Create a new node with a random priority *) 15 | let make_node key left right = 16 | let priority = Random.State.int rng 100000 in 17 | Node(key, priority, left, right) 18 | 19 | (* Create a node with a specified priority (for testing) *) 20 | let make_node_with_priority key priority left right = 21 | Node(key, priority, left, right) 22 | 23 | (* Right rotation *) 24 | let rotate_right = function 25 | | Node(k2, p2, Node(k1, p1, a, b), c) -> 26 | Node(k1, p1, a, Node(k2, p2, b, c)) 27 | | t -> t 28 | 29 | (* Left rotation *) 30 | let rotate_left = function 31 | | Node(k1, p1, a, Node(k2, p2, b, c)) -> 32 | Node(k2, p2, Node(k1, p1, a, b), c) 33 | | t -> t 34 | 35 | (* Insert a key into the treap *) 36 | let rec insert key = function 37 | | Empty -> make_node key Empty Empty 38 | | Node(k, p, left, right) as node -> 39 | if key < k then 40 | let new_left = insert key left in 41 | match new_left with 42 | | Node(k', p', _, _) when p' > p -> 43 | (* New node has higher priority, rotate right *) 44 | rotate_right (Node(k, p, new_left, right)) 45 | | _ -> 46 | Node(k, p, new_left, right) 47 | else if key > k then 48 | let new_right = insert key right in 49 | match new_right with 50 | | Node(k', p', _, _) when p' > p -> 51 | (* New node has higher priority, rotate left *) 52 | rotate_left (Node(k, p, left, new_right)) 53 | | _ -> 54 | Node(k, p, left, new_right) 55 | else 56 | (* Key already exists, just return the node *) 57 | node 58 | 59 | (* Delete a key from the treap *) 60 | let rec delete key = function 61 | | Empty -> Empty 62 | | Node(k, p, left, right) -> 63 | if key < k then 64 | Node(k, p, delete key left, right) 65 | else if key > k then 66 | Node(k, p, left, delete key right) 67 | else 68 | (* Found the node to delete *) 69 | merge left right 70 | 71 | (* Merge two treaps *) 72 | and merge left right = 73 | match left, right with 74 | | Empty, _ -> right 75 | | _, Empty -> left 76 | | Node(k1, p1, l1, r1), Node(k2, p2, l2, r2) -> 77 | if p1 > p2 then 78 | (* Left node has higher priority, becomes root *) 79 | Node(k1, p1, l1, merge r1 right) 80 | else 81 | (* Right node has higher priority, becomes root *) 82 | Node(k2, p2, merge left l2, r2) 83 | 84 | (* Check if a key exists in the treap *) 85 | let rec member key = function 86 | | Empty -> false 87 | | Node(k, _, left, right) -> 88 | if key = k then true 89 | else if key < k then member key left 90 | else member key right 91 | 92 | (* Find the minimum key in the treap *) 93 | let rec find_min = function 94 | | Empty -> failwith "Empty treap has no minimum" 95 | | Node(k, _, Empty, _) -> k 96 | | Node(_, _, left, _) -> find_min left 97 | 98 | (* Find the maximum key in the treap *) 99 | let rec find_max = function 100 | | Empty -> failwith "Empty treap has no maximum" 101 | | Node(k, _, _, Empty) -> k 102 | | Node(_, _, _, right) -> find_max right 103 | 104 | (* Split the treap into two treaps: one with keys < x and one with keys >= x *) 105 | let rec split x = function 106 | | Empty -> (Empty, Empty) 107 | | Node(k, p, left, right) -> 108 | if x < k then 109 | let l1, l2 = split x left in 110 | (l1, Node(k, p, l2, right)) 111 | else 112 | let r1, r2 = split x right in 113 | (Node(k, p, left, r1), r2) 114 | 115 | (* Tree traversals *) 116 | let rec inorder = function 117 | | Empty -> [] 118 | | Node(k, _, left, right) -> 119 | inorder left @ [k] @ inorder right 120 | 121 | let rec preorder = function 122 | | Empty -> [] 123 | | Node(k, _, left, right) -> 124 | [k] @ preorder left @ preorder right 125 | 126 | (* Build a treap from a list *) 127 | let build xs = 128 | List.fold_left (fun t x -> insert x t) Empty xs 129 | 130 | (* Visualize the treap (for debugging) *) 131 | let rec to_string_indented ?(indent=0) = function 132 | | Empty -> String.make indent ' ' ^ ".\n" 133 | | Node(k, p, left, right) -> 134 | let s = String.make indent ' ' ^ 135 | Printf.sprintf "%d (p=%d)\n" k p in 136 | s ^ to_string_indented ~indent:(indent+2) left ^ 137 | to_string_indented ~indent:(indent+2) right -------------------------------------------------------------------------------- /src/trees/trees.ml: -------------------------------------------------------------------------------- 1 | (* Trees Module - Entry point for all tree data structures *) 2 | 3 | module AVL = struct 4 | type 'a tree = 'a Avl_tree.tree = 5 | | Empty 6 | | Node of 'a * 'a tree * 'a tree * int 7 | 8 | let empty = Avl_tree.Empty 9 | let insert = Avl_tree.insert 10 | let delete = Avl_tree.delete 11 | let member = Avl_tree.member 12 | let inorder = Avl_tree.inorder 13 | let preorder = Avl_tree.preorder 14 | let postorder = Avl_tree.postorder 15 | let build = Avl_tree.build 16 | end 17 | 18 | module BST = struct 19 | type 'a tree = 'a Binary_search_tree.tree = 20 | | Leaf 21 | | Node of 'a tree * 'a * 'a tree 22 | 23 | let leaf = Binary_search_tree.leaf 24 | let node = Binary_search_tree.node 25 | let insert = Binary_search_tree.insert 26 | let delete = Binary_search_tree.delete 27 | let member = Binary_search_tree.member 28 | let min_value = Binary_search_tree.min_value 29 | let max_value = Binary_search_tree.max_value 30 | let height = Binary_search_tree.height 31 | let build = Binary_search_tree.build 32 | end 33 | 34 | module RedBlack = struct 35 | type color = Red_black_tree.color = 36 | | Red 37 | | Black 38 | 39 | type 'a tree = 'a Red_black_tree.tree = 40 | | Leaf 41 | | Node of color * 'a * 'a tree * 'a tree 42 | 43 | let insert = Red_black_tree.insert 44 | let member = Red_black_tree.member 45 | end 46 | 47 | module Splay = struct 48 | type 'a tree = 'a Splay_tree.tree = 49 | | Empty 50 | | Node of 'a tree * 'a * 'a tree 51 | 52 | let insert = Splay_tree.insert 53 | let delete = Splay_tree.delete 54 | let member = Splay_tree.member 55 | let find = Splay_tree.find 56 | let inorder = Splay_tree.inorder 57 | let build = Splay_tree.build 58 | end 59 | 60 | module Treap = struct 61 | type 'a tree = 'a Treap.tree = 62 | | Empty 63 | | Node of 'a * int * 'a tree * 'a tree 64 | 65 | let insert = Treap.insert 66 | let delete = Treap.delete 67 | let member = Treap.member 68 | let find_min = Treap.find_min 69 | let find_max = Treap.find_max 70 | let inorder = Treap.inorder 71 | let preorder = Treap.preorder 72 | let build = Treap.build 73 | end 74 | 75 | module Trie = struct 76 | type trie = Trie.trie 77 | 78 | let empty = Trie.empty 79 | let insert = Trie.insert 80 | let search = Trie.search 81 | let starts_with = Trie.starts_with 82 | let get_all_words = Trie.get_all_words 83 | let delete = Trie.delete 84 | let count_words = Trie.count_words 85 | let build_from_list = Trie.build_from_list 86 | let autocomplete = Trie.autocomplete 87 | end 88 | 89 | module SegmentTree = struct 90 | type 'a t = 'a Segment_tree.t 91 | 92 | let build = Segment_tree.build 93 | let query = Segment_tree.query 94 | let update = Segment_tree.update 95 | let sum_segment_tree = Segment_tree.sum_segment_tree 96 | let min_segment_tree = Segment_tree.min_segment_tree 97 | let max_segment_tree = Segment_tree.max_segment_tree 98 | let gcd_segment_tree = Segment_tree.gcd_segment_tree 99 | let product_segment_tree = Segment_tree.product_segment_tree 100 | end 101 | 102 | module FenwickTree = struct 103 | type t = Fenwick_tree.t 104 | 105 | let create = Fenwick_tree.create 106 | let create_empty = Fenwick_tree.create_empty 107 | let prefix_sum = Fenwick_tree.prefix_sum 108 | let range_sum = Fenwick_tree.range_sum 109 | let update = Fenwick_tree.update 110 | let set = Fenwick_tree.set 111 | let get = Fenwick_tree.get 112 | let of_list = Fenwick_tree.of_list 113 | let to_list = Fenwick_tree.to_list 114 | let find_largest_with_sum_leq = Fenwick_tree.find_largest_with_sum_leq 115 | end 116 | 117 | module BTree = struct 118 | type 'a entry = 'a Btree.entry = { 119 | key: 'a; 120 | value: 'a; 121 | } 122 | 123 | type 'a node = 'a Btree.node = { 124 | entries: 'a entry array; 125 | mutable n_entries: int; 126 | mutable children: 'a btree array option; 127 | } 128 | 129 | and 'a btree = 'a Btree.btree = 'a node option 130 | 131 | type 'a t = 'a Btree.t = { 132 | order: int; 133 | mutable root: 'a btree; 134 | } 135 | 136 | let create = Btree.create 137 | let search = Btree.search 138 | let insert = Btree.insert 139 | let traverse = Btree.traverse 140 | end 141 | 142 | module SuffixTree = struct 143 | type node = Suffix_tree.node 144 | type edge = Suffix_tree.edge 145 | type t = Suffix_tree.t 146 | 147 | let create = Suffix_tree.create 148 | let contains = Suffix_tree.contains 149 | let find_all = Suffix_tree.find_all 150 | let visualize = Suffix_tree.visualize 151 | end 152 | 153 | module UnionFind = struct 154 | type t = Union_find.t 155 | 156 | let create = Union_find.create 157 | let find = Union_find.find 158 | let union = Union_find.union 159 | let connected = Union_find.connected 160 | let count = Union_find.count 161 | let get_set = Union_find.get_set 162 | let get_all_sets = Union_find.get_all_sets 163 | let has_cycle = Union_find.has_cycle 164 | let kruskal = Union_find.kruskal 165 | let connected_components = Union_find.connected_components 166 | end -------------------------------------------------------------------------------- /src/trees/trie.ml: -------------------------------------------------------------------------------- 1 | (* Trie Implementation *) 2 | 3 | module CharMap = Map.Make(Char) 4 | 5 | type trie = { 6 | is_end: bool; 7 | children: trie CharMap.t; 8 | } 9 | 10 | (* Create an empty trie *) 11 | let empty = { 12 | is_end = false; 13 | children = CharMap.empty; 14 | } 15 | 16 | (* Insert a word into the trie *) 17 | let insert word trie = 18 | let rec aux chars current = 19 | match chars with 20 | | [] -> { current with is_end = true } 21 | | c :: cs -> 22 | let child = 23 | match CharMap.find_opt c current.children with 24 | | Some(t) -> aux cs t 25 | | None -> aux cs empty 26 | in 27 | { current with children = CharMap.add c child current.children } 28 | in 29 | aux (List.init (String.length word) (String.get word)) trie 30 | 31 | (* Check if a word exists in the trie *) 32 | let search word trie = 33 | let rec aux chars current = 34 | match chars with 35 | | [] -> current.is_end 36 | | c :: cs -> 37 | match CharMap.find_opt c current.children with 38 | | Some(child) -> aux cs child 39 | | None -> false 40 | in 41 | aux (List.init (String.length word) (String.get word)) trie 42 | 43 | (* Check if any word with the given prefix exists in the trie *) 44 | let starts_with prefix trie = 45 | let rec aux chars current = 46 | match chars with 47 | | [] -> true (* Reached the end of prefix *) 48 | | c :: cs -> 49 | match CharMap.find_opt c current.children with 50 | | Some(child) -> aux cs child 51 | | None -> false 52 | in 53 | aux (List.init (String.length prefix) (String.get prefix)) trie 54 | 55 | (* Get all words in the trie *) 56 | let get_all_words trie = 57 | let rec aux current prefix acc = 58 | let acc' = if current.is_end then (prefix :: acc) else acc in 59 | CharMap.fold 60 | (fun c child a -> aux child (prefix ^ String.make 1 c) a) 61 | current.children 62 | acc' 63 | in 64 | aux trie "" [] 65 | 66 | (* Delete a word from the trie *) 67 | let delete word trie = 68 | let rec aux chars current path = 69 | match chars with 70 | | [] -> 71 | if not current.is_end then (current, false) else 72 | if not (CharMap.is_empty current.children) then 73 | ({ current with is_end = false }, false) 74 | else 75 | (empty, true) (* Remove this node *) 76 | | c :: cs -> 77 | match CharMap.find_opt c current.children with 78 | | None -> (current, false) (* Word not in trie *) 79 | | Some(child) -> 80 | let new_child, should_delete = aux cs child (c :: path) in 81 | if should_delete then 82 | if CharMap.cardinal current.children = 1 && not current.is_end then 83 | (empty, true) 84 | else 85 | ({ current with children = CharMap.remove c current.children }, false) 86 | else 87 | ({ current with children = CharMap.add c new_child current.children }, false) 88 | in 89 | let updated, _ = aux (List.init (String.length word) (String.get word)) trie [] in 90 | updated 91 | 92 | (* Count the number of words in the trie *) 93 | let count_words trie = 94 | let rec aux current count = 95 | let count' = if current.is_end then count + 1 else count in 96 | CharMap.fold 97 | (fun _ child c -> aux child c) 98 | current.children 99 | count' 100 | in 101 | aux trie 0 102 | 103 | (* Build a trie from a list of words *) 104 | let build_from_list words = 105 | List.fold_left (fun t word -> insert word t) empty words 106 | 107 | (* Auto-complete: find all words starting with a prefix *) 108 | let autocomplete prefix trie = 109 | let rec find_prefix_node chars current = 110 | match chars with 111 | | [] -> Some current 112 | | c :: cs -> 113 | match CharMap.find_opt c current.children with 114 | | Some child -> find_prefix_node cs child 115 | | None -> None 116 | in 117 | 118 | let prefix_chars = List.init (String.length prefix) (String.get prefix) in 119 | match find_prefix_node prefix_chars trie with 120 | | None -> [] 121 | | Some node -> 122 | let words = get_all_words node in 123 | List.map (fun suffix -> prefix ^ suffix) words -------------------------------------------------------------------------------- /src/trees/union_find.ml: -------------------------------------------------------------------------------- 1 | (* Union-Find (Disjoint Set) Implementation *) 2 | 3 | (* A Union-Find data structure (also called Disjoint Set) efficiently 4 | keeps track of a set of elements partitioned into disjoint subsets, 5 | supporting two operations: 6 | - Find: Determine which set an element belongs to 7 | - Union: Join two sets together 8 | *) 9 | 10 | type t = { 11 | parent: int array; (* parent[i] = parent of i *) 12 | rank: int array; (* rank[i] = rank of the tree rooted at i *) 13 | mutable sets: int; (* Number of disjoint sets *) 14 | } 15 | 16 | (* Create a new Union-Find data structure with n elements *) 17 | let create n = 18 | let parent = Array.init n (fun i -> i) in (* Each element is its own parent *) 19 | let rank = Array.make n 0 in (* All ranks start at 0 *) 20 | { parent; rank; sets = n } 21 | 22 | (* Find the representative of the set containing x, with path compression *) 23 | let rec find uf x = 24 | if uf.parent.(x) <> x then 25 | uf.parent.(x) <- find uf uf.parent.(x); (* Path compression *) 26 | uf.parent.(x) 27 | 28 | (* Union the sets containing x and y, using rank heuristic *) 29 | let union uf x y = 30 | let root_x = find uf x in 31 | let root_y = find uf y in 32 | 33 | if root_x = root_y then 34 | false (* x and y are already in the same set *) 35 | else begin 36 | (* Union by rank: attach smaller rank tree under root of higher rank tree *) 37 | if uf.rank.(root_x) < uf.rank.(root_y) then 38 | uf.parent.(root_x) <- root_y 39 | else if uf.rank.(root_x) > uf.rank.(root_y) then 40 | uf.parent.(root_y) <- root_x 41 | else begin 42 | (* Same rank, make one the parent and increment its rank *) 43 | uf.parent.(root_y) <- root_x; 44 | uf.rank.(root_x) <- uf.rank.(root_x) + 1 45 | end; 46 | 47 | uf.sets <- uf.sets - 1; 48 | true (* Union was successful *) 49 | end 50 | 51 | (* Check if two elements are in the same set *) 52 | let connected uf x y = 53 | find uf x = find uf y 54 | 55 | (* Get the number of disjoint sets *) 56 | let count uf = uf.sets 57 | 58 | (* Get all elements in the same set as x *) 59 | let get_set uf x = 60 | let root_x = find uf x in 61 | let result = ref [] in 62 | for i = 0 to Array.length uf.parent - 1 do 63 | if find uf i = root_x then 64 | result := i :: !result 65 | done; 66 | List.rev !result 67 | 68 | (* Get all the sets as a list of lists *) 69 | let get_all_sets uf = 70 | let n = Array.length uf.parent in 71 | let sets = Hashtbl.create n in 72 | 73 | (* Group elements by their representative *) 74 | for i = 0 to n - 1 do 75 | let root = find uf i in 76 | match Hashtbl.find_opt sets root with 77 | | None -> Hashtbl.add sets root [i] 78 | | Some elements -> Hashtbl.replace sets root (i :: elements) 79 | done; 80 | 81 | (* Convert the hashtable to a list of lists *) 82 | Hashtbl.fold (fun _ elements acc -> elements :: acc) sets [] 83 | 84 | (* Applications of Union-Find *) 85 | 86 | (* Detect cycle in an undirected graph *) 87 | let has_cycle edges n = 88 | let uf = create n in 89 | let rec check = function 90 | | [] -> false 91 | | (u, v) :: rest -> 92 | if connected uf u v then 93 | true (* Cycle found *) 94 | else begin 95 | ignore (union uf u v); 96 | check rest 97 | end 98 | in 99 | check edges 100 | 101 | (* Kruskal's algorithm for Minimum Spanning Tree *) 102 | let kruskal edges n = 103 | (* Sort edges by weight *) 104 | let sorted_edges = List.sort (fun (_, _, w1) (_, _, w2) -> compare w1 w2) edges in 105 | 106 | let uf = create n in 107 | let mst = ref [] in 108 | 109 | List.iter (fun (u, v, weight) -> 110 | if not (connected uf u v) then begin 111 | ignore (union uf u v); 112 | mst := (u, v, weight) :: !mst 113 | end 114 | ) sorted_edges; 115 | 116 | List.rev !mst 117 | 118 | (* Find the number of connected components in a graph *) 119 | let connected_components edges n = 120 | let uf = create n in 121 | 122 | List.iter (fun (u, v) -> 123 | ignore (union uf u v) 124 | ) edges; 125 | 126 | count uf -------------------------------------------------------------------------------- /test/.merlin: -------------------------------------------------------------------------------- 1 | EXCLUDE_QUERY_DIR 2 | B /Users/owainlewis/.opam/system/lib/bytes 3 | B /Users/owainlewis/.opam/system/lib/oUnit 4 | B /Users/owainlewis/.opam/system/lib/ounit 5 | B /usr/local/lib/ocaml 6 | B ../_build/default/src/.ods.objs/byte 7 | B ../_build/default/test/.test_sort.eobjs/byte 8 | S /Users/owainlewis/.opam/system/lib/bytes 9 | S /Users/owainlewis/.opam/system/lib/oUnit 10 | S /Users/owainlewis/.opam/system/lib/ounit 11 | S /usr/local/lib/ocaml 12 | S ../src 13 | S . 14 | FLG -w @1..3@5..28@30..39@43@46..47@49..57@61..62-40 -strict-sequence -strict-formats -short-paths -keep-locs 15 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (tests 2 | (names test_sort test_trees) 3 | (libraries ods ounit)) 4 | -------------------------------------------------------------------------------- /test/test_sort.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Ods 3 | 4 | let test_fixture = "Sorting algorithms" >::: 5 | [ 6 | "bubble" >:: (fun () -> 7 | assert_equal (Sorting.Bubble.sort [1;3;2;4;5;0]) [0;1;2;3;4;5]); 8 | 9 | "insertion" >:: (fun () -> 10 | assert_equal (Sorting.Insertion.sort [5;2;4;6;1;3]) [1;2;3;4;5;6]); 11 | 12 | "selection" >:: (fun () -> 13 | assert_equal (Sorting.Selection.sort [5;2;4;6;1;3]) [1;2;3;4;5;6]); 14 | 15 | "merge" >:: (fun () -> 16 | assert_equal (Sorting.Merge.sort [5;2;4;6;1;3]) [1;2;3;4;5;6]); 17 | 18 | "quick" >:: (fun () -> 19 | assert_equal (Sorting.Quick.sort [5;2;4;6;1;3]) [1;2;3;4;5;6]); 20 | 21 | "heap" >:: (fun () -> 22 | assert_equal (Sorting.Heap.sort_list [5;2;4;6;1;3]) [1;2;3;4;5;6]); 23 | 24 | "counting" >:: (fun () -> 25 | assert_equal (Sorting.Counting.sort_list [5;2;4;6;1;3]) [1;2;3;4;5;6]); 26 | 27 | "radix" >:: (fun () -> 28 | assert_equal (Sorting.Radix.sort_list [5;2;4;6;1;3]) [1;2;3;4;5;6]); 29 | 30 | "smart_sort" >:: (fun () -> 31 | assert_equal (Sorting.sort_list [5;2;4;6;1;3]) [1;2;3;4;5;6]); 32 | ] 33 | 34 | let _ = run_test_tt test_fixture 35 | -------------------------------------------------------------------------------- /test/test_trees.ml: -------------------------------------------------------------------------------- 1 | open OUnit 2 | open Ods 3 | 4 | let test_avl_tree = "AVL Tree" >::: 5 | [ 6 | "insert and member" >:: (fun () -> 7 | let t = Trees.AVL.build [5; 3; 8; 1; 4; 7; 10] in 8 | assert_bool "Should contain 5" (Trees.AVL.member 5 t); 9 | assert_bool "Should contain 1" (Trees.AVL.member 1 t); 10 | assert_bool "Should contain 10" (Trees.AVL.member 10 t); 11 | assert_bool "Should not contain 6" (not (Trees.AVL.member 6 t)); 12 | ); 13 | 14 | "delete" >:: (fun () -> 15 | let t = Trees.AVL.build [5; 3; 8; 1; 4; 7; 10] in 16 | let t' = Trees.AVL.delete 5 t in 17 | assert_bool "Should not contain 5" (not (Trees.AVL.member 5 t')); 18 | assert_bool "Should still contain 8" (Trees.AVL.member 8 t'); 19 | ); 20 | 21 | "inorder traversal" >:: (fun () -> 22 | let t = Trees.AVL.build [5; 3; 8; 1; 4; 7; 10] in 23 | assert_equal (Trees.AVL.inorder t) [1; 3; 4; 5; 7; 8; 10]); 24 | ] 25 | 26 | let test_trie = "Trie" >::: 27 | [ 28 | "insert and search" >:: (fun () -> 29 | let t = Trees.Trie.empty in 30 | let t = Trees.Trie.insert "hello" t in 31 | let t = Trees.Trie.insert "world" t in 32 | let t = Trees.Trie.insert "hi" t in 33 | assert_bool "Should contain hello" (Trees.Trie.search "hello" t); 34 | assert_bool "Should contain world" (Trees.Trie.search "world" t); 35 | assert_bool "Should contain hi" (Trees.Trie.search "hi" t); 36 | assert_bool "Should not contain bye" (not (Trees.Trie.search "bye" t)); 37 | ); 38 | 39 | "starts_with" >:: (fun () -> 40 | let t = Trees.Trie.build_from_list ["hello"; "hell"; "hemisphere"; "world"] in 41 | assert_bool "Should find prefix he" (Trees.Trie.starts_with "he" t); 42 | assert_bool "Should find prefix hell" (Trees.Trie.starts_with "hell" t); 43 | assert_bool "Should not find prefix bye" (not (Trees.Trie.starts_with "bye" t)); 44 | ); 45 | 46 | "get_all_words" >:: (fun () -> 47 | let t = Trees.Trie.build_from_list ["cat"; "car"; "cart"] in 48 | let words = Trees.Trie.get_all_words t in 49 | assert_equal (List.length words) 3; 50 | assert_bool "Should contain cat" (List.mem "cat" words); 51 | assert_bool "Should contain car" (List.mem "car" words); 52 | assert_bool "Should contain cart" (List.mem "cart" words); 53 | ); 54 | ] 55 | 56 | let test_red_black_tree = "Red Black Tree" >::: 57 | [ 58 | "insert and member" >:: (fun () -> 59 | let t = Trees.RedBlack.insert 5 Trees.RedBlack.Leaf in 60 | let t = Trees.RedBlack.insert 3 t in 61 | let t = Trees.RedBlack.insert 8 t in 62 | assert_bool "Should contain 5" (Trees.RedBlack.member 5 t); 63 | assert_bool "Should contain 3" (Trees.RedBlack.member 3 t); 64 | assert_bool "Should contain 8" (Trees.RedBlack.member 8 t); 65 | assert_bool "Should not contain 6" (not (Trees.RedBlack.member 6 t)); 66 | ); 67 | ] 68 | 69 | let test_splay_tree = "Splay Tree" >::: 70 | [ 71 | "insert and member" >:: (fun () -> 72 | let t = Trees.Splay.build [5; 3; 8; 1; 4; 7; 10] in 73 | assert_bool "Should contain 5" (Trees.Splay.member 5 t); 74 | assert_bool "Should contain 1" (Trees.Splay.member 1 t); 75 | assert_bool "Should contain 10" (Trees.Splay.member 10 t); 76 | assert_bool "Should not contain 6" (not (Trees.Splay.member 6 t)); 77 | ); 78 | 79 | "delete" >:: (fun () -> 80 | let t = Trees.Splay.build [5; 3; 8; 1; 4; 7; 10] in 81 | let t' = Trees.Splay.delete 5 t in 82 | assert_bool "Should not contain 5" (not (Trees.Splay.member 5 t')); 83 | assert_bool "Should still contain 8" (Trees.Splay.member 8 t')); 84 | 85 | "inorder traversal" >:: (fun () -> 86 | let t = Trees.Splay.build [5; 3; 8; 1; 4; 7; 10] in 87 | assert_equal (Trees.Splay.inorder t) [1; 3; 4; 5; 7; 8; 10]); 88 | ] 89 | 90 | let test_treap = "Treap" >::: 91 | [ 92 | "insert and member" >:: (fun () -> 93 | let t = Trees.Treap.build [5; 3; 8; 1; 4; 7; 10] in 94 | assert_bool "Should contain 5" (Trees.Treap.member 5 t); 95 | assert_bool "Should contain 1" (Trees.Treap.member 1 t); 96 | assert_bool "Should contain 10" (Trees.Treap.member 10 t); 97 | assert_bool "Should not contain 6" (not (Trees.Treap.member 6 t)); 98 | ); 99 | 100 | "delete" >:: (fun () -> 101 | let t = Trees.Treap.build [5; 3; 8; 1; 4; 7; 10] in 102 | let t' = Trees.Treap.delete 5 t in 103 | assert_bool "Should not contain 5" (not (Trees.Treap.member 5 t')); 104 | assert_bool "Should still contain 8" (Trees.Treap.member 8 t')); 105 | 106 | "inorder traversal" >:: (fun () -> 107 | let t = Trees.Treap.build [5; 3; 8; 1; 4; 7; 10] in 108 | assert_equal (Trees.Treap.inorder t) [1; 3; 4; 5; 7; 8; 10]); 109 | ] 110 | 111 | let test_segment_tree = "Segment Tree" >::: 112 | [ 113 | "range sum" >:: (fun () -> 114 | let arr = [|1; 3; 5; 7; 9; 11|] in 115 | let seg_tree = Trees.SegmentTree.sum_segment_tree arr in 116 | assert_equal (Trees.SegmentTree.query seg_tree 0 2) 9; 117 | assert_equal (Trees.SegmentTree.query seg_tree 1 4) 24; 118 | assert_equal (Trees.SegmentTree.query seg_tree 0 5) 36; 119 | ); 120 | 121 | "update" >:: (fun () -> 122 | let arr = [|1; 3; 5; 7; 9; 11|] in 123 | let seg_tree = Trees.SegmentTree.sum_segment_tree arr in 124 | let _ = Trees.SegmentTree.update seg_tree 2 10 in 125 | assert_equal (Trees.SegmentTree.query seg_tree 0 2) 14; 126 | assert_equal (Trees.SegmentTree.query seg_tree 1 4) 29; 127 | ); 128 | 129 | "min query" >:: (fun () -> 130 | let arr = [|5; 2; 8; 1; 9; 3|] in 131 | let seg_tree = Trees.SegmentTree.min_segment_tree arr in 132 | assert_equal (Trees.SegmentTree.query seg_tree 0 2) 2; 133 | assert_equal (Trees.SegmentTree.query seg_tree 2 5) 1; 134 | ); 135 | ] 136 | 137 | let test_fenwick_tree = "Fenwick Tree" >::: 138 | [ 139 | "prefix sum" >:: (fun () -> 140 | let ft = Trees.FenwickTree.of_list [3; 2; -1; 6; 5; 4] in 141 | assert_equal (Trees.FenwickTree.prefix_sum ft 0) 3; 142 | assert_equal (Trees.FenwickTree.prefix_sum ft 2) 4; 143 | assert_equal (Trees.FenwickTree.prefix_sum ft 5) 19; 144 | ); 145 | 146 | "range sum" >:: (fun () -> 147 | let ft = Trees.FenwickTree.of_list [3; 2; -1; 6; 5; 4] in 148 | assert_equal (Trees.FenwickTree.range_sum ft 1 3) 7; 149 | assert_equal (Trees.FenwickTree.range_sum ft 2 5) 14; 150 | ); 151 | 152 | "update" >:: (fun () -> 153 | let ft = Trees.FenwickTree.of_list [3; 2; -1; 6; 5; 4] in 154 | Trees.FenwickTree.update ft 2 5; 155 | assert_equal (Trees.FenwickTree.prefix_sum ft 2) 9; 156 | assert_equal (Trees.FenwickTree.range_sum ft 1 3) 12; 157 | ); 158 | ] 159 | 160 | let test_union_find = "Union Find" >::: 161 | [ 162 | "connected components" >:: (fun () -> 163 | let edges = [(0, 1); (1, 2); (3, 4); (5, 6); (6, 7); (8, 9)] in 164 | let num_components = Trees.UnionFind.connected_components edges 10 in 165 | assert_equal num_components 4; 166 | ); 167 | 168 | "union and find" >:: (fun () -> 169 | let uf = Trees.UnionFind.create 10 in 170 | ignore (Trees.UnionFind.union uf 0 1); 171 | ignore (Trees.UnionFind.union uf 1 2); 172 | ignore (Trees.UnionFind.union uf 3 4); 173 | assert_bool "0 and 2 should be connected" (Trees.UnionFind.connected uf 0 2); 174 | assert_bool "3 and 4 should be connected" (Trees.UnionFind.connected uf 3 4); 175 | assert_bool "0 and 3 should not be connected" (not (Trees.UnionFind.connected uf 0 3)); 176 | ); 177 | ] 178 | 179 | let _ = run_test_tt_main ( 180 | "Tree data structures" >::: 181 | [ 182 | test_avl_tree; 183 | test_trie; 184 | test_red_black_tree; 185 | test_splay_tree; 186 | test_treap; 187 | test_segment_tree; 188 | test_fenwick_tree; 189 | test_union_find; 190 | ] 191 | ) --------------------------------------------------------------------------------