Merge loops/ocaml into architecture: OCaml-on-SX language port (Phase 5.1 + ~200 baselines)

# Conflicts:
#	plans/ocaml-on-sx.md
This commit is contained in:
2026-05-12 20:39:48 +00:00
218 changed files with 15358 additions and 103 deletions

View File

@@ -0,0 +1,23 @@
let div_sum n =
let s = ref 1 in
let i = ref 2 in
while !i * !i <= n do
if n mod !i = 0 then begin
s := !s + !i;
let q = n / !i in
if q <> !i then s := !s + q
end;
i := !i + 1
done;
if n = 1 then 0 else !s
let count_abundant n =
let c = ref 0 in
for i = 12 to n - 1 do
if div_sum i > i then c := !c + 1
done;
!c
;;
count_abundant 100

View File

@@ -0,0 +1,8 @@
let rec ack m n =
if m = 0 then n + 1
else if n = 0 then ack (m - 1) 1
else ack (m - 1) (ack m (n - 1))
;;
ack 3 4

View File

@@ -0,0 +1,31 @@
let max_nonoverlap intervals =
let arr = Array.of_list intervals in
let n = Array.length arr in
let sorted = Array.make n (0, 0) in
for i = 0 to n - 1 do
sorted.(i) <- arr.(i)
done;
for i = 0 to n - 1 do
for j = 0 to n - 2 - i do
let (_, e1) = sorted.(j) in
let (_, e2) = sorted.(j + 1) in
if e1 > e2 then begin
let t = sorted.(j) in
sorted.(j) <- sorted.(j + 1);
sorted.(j + 1) <- t
end
done
done;
let count = ref 0 in
let last_end = ref (-1000000) in
for i = 0 to n - 1 do
let (s, e) = sorted.(i) in
if s >= !last_end then begin
count := !count + 1;
last_end := e
end
done;
!count
;;
max_nonoverlap [(1, 4); (3, 5); (0, 6); (5, 7); (3, 8); (5, 9); (6, 10); (8, 11); (8, 12); (2, 13); (12, 14)]

View File

@@ -0,0 +1,13 @@
let adler32 s =
let a = ref 1 in
let b = ref 0 in
let m = 65521 in
for i = 0 to String.length s - 1 do
a := (!a + Char.code s.[i]) mod m;
b := (!b + !a) mod m
done;
!b * 65536 + !a
;;
adler32 "Wikipedia"

View File

@@ -0,0 +1,23 @@
let to_counts s =
let counts = Array.make 256 0 in
for i = 0 to String.length s - 1 do
let c = Char.code s.[i] in
counts.(c) <- counts.(c) + 1
done;
counts
let same_counts a b =
let result = ref true in
for i = 0 to 255 do
if a.(i) <> b.(i) then result := false
done;
!result
let is_anagram s t = same_counts (to_counts s) (to_counts t)
;;
(if is_anagram "listen" "silent" then 1 else 0) +
(if is_anagram "hello" "world" then 1 else 0) +
(if is_anagram "anagram" "nagaram" then 1 else 0) +
(if is_anagram "abc" "abcd" then 1 else 0)

View File

@@ -0,0 +1,29 @@
let canonical s =
let chars = Array.make 26 0 in
for i = 0 to String.length s - 1 do
let k = Char.code s.[i] - Char.code 'a' in
if k >= 0 && k < 26 then chars.(k) <- chars.(k) + 1
done;
let buf = Buffer.create 26 in
for i = 0 to 25 do
for _ = 1 to chars.(i) do
Buffer.add_string buf (String.make 1 (Char.chr (i + Char.code 'a')))
done
done;
Buffer.contents buf
let group_anagrams xs =
let h = Hashtbl.create 8 in
List.iter (fun s ->
let k = canonical s in
let cur = match Hashtbl.find_opt h k with
| Some xs -> xs
| None -> []
in
Hashtbl.replace h k (s :: cur)
) xs;
Hashtbl.length h
;;
group_anagrams ["eat"; "tea"; "tan"; "ate"; "nat"; "bat"]

View File

@@ -0,0 +1,26 @@
(* Baseline: count anagram groups using Hashtbl + sort *)
(* Sort the chars in a string to get its anagram-equivalence key *)
let canonical s =
let n = String.length s in
let chars = ref [] in
for i = 0 to n - 1 do
chars := (String.get s i) :: !chars
done ;
let sorted = List.sort compare !chars in
String.concat "" sorted
;;
let count_groups words =
let counts = Hashtbl.create 16 in
List.iter
(fun w ->
let k = canonical w in
match Hashtbl.find_opt counts k with
| None -> Hashtbl.add counts k 1
| Some n -> Hashtbl.replace counts k (n + 1))
words ;
Hashtbl.length counts
;;
count_groups ["eat"; "tea"; "tan"; "ate"; "nat"; "bat"]

17
lib/ocaml/baseline/atm.ml Normal file
View File

@@ -0,0 +1,17 @@
type account = { mutable balance : int }
exception Insufficient
let withdraw acct amt =
if amt > acct.balance then raise Insufficient
else acct.balance <- acct.balance - amt
let deposit acct amt = acct.balance <- acct.balance + amt
;;
let a = { balance = 100 } in
deposit a 50;
withdraw a 30;
try (withdraw a 200; -1)
with Insufficient -> a.balance

18
lib/ocaml/baseline/bag.ml Normal file
View File

@@ -0,0 +1,18 @@
let count_words text =
let words = String.split_on_char ' ' text in
let counts = Hashtbl.create 8 in
List.iter (fun w ->
let n = match Hashtbl.find_opt counts w with
| Some n -> n + 1
| None -> 1
in
Hashtbl.replace counts w n
) words;
counts
let max_count counts =
Hashtbl.fold (fun _ v acc -> if v > acc then v else acc) counts 0
;;
max_count (count_words "the quick brown fox jumps over the lazy dog the fox")

View File

@@ -0,0 +1,25 @@
let is_balanced s =
let stack = Stack.create () in
let n = String.length s in
let ok = ref true in
let i = ref 0 in
while !i < n && !ok do
let c = s.[!i] in
(if c = '(' || c = '[' || c = '{' then Stack.push c stack
else if c = ')' then
(if Stack.is_empty stack || Stack.pop stack <> '(' then ok := false)
else if c = ']' then
(if Stack.is_empty stack || Stack.pop stack <> '[' then ok := false)
else if c = '}' then
(if Stack.is_empty stack || Stack.pop stack <> '{' then ok := false));
i := !i + 1
done;
!ok && Stack.is_empty stack
;;
(if is_balanced "({[abc]d}e)" then 1 else 0) +
(if is_balanced "(a]" then 1 else 0) +
(if is_balanced "{[}]" then 1 else 0) +
(if is_balanced "(())" then 1 else 0) +
(if is_balanced "" then 1 else 0)

View File

@@ -0,0 +1,19 @@
let to_base_n n base =
let digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" in
if n = 0 then "0"
else begin
let m = ref (abs n) in
let acc = ref "" in
while !m > 0 do
acc := String.make 1 digits.[!m mod base] ^ !acc;
m := !m / base
done;
if n < 0 then "-" ^ !acc else !acc
end
;;
String.length (to_base_n 255 16) +
String.length (to_base_n 1024 2) +
String.length (to_base_n 100 10) +
String.length (to_base_n 0 16)

View File

@@ -0,0 +1,42 @@
let interpret prog =
let mem = Array.make 256 0 in
let ptr = ref 0 in
let pc = ref 0 in
let n = String.length prog in
let acc = ref 0 in
while !pc < n do
let c = prog.[!pc] in
(if c = '>' then ptr := !ptr + 1
else if c = '<' then ptr := !ptr - 1
else if c = '+' then mem.(!ptr) <- mem.(!ptr) + 1
else if c = '-' then mem.(!ptr) <- mem.(!ptr) - 1
else if c = '.' then acc := !acc + mem.(!ptr)
else if c = '[' then begin
if mem.(!ptr) = 0 then begin
let depth = ref 1 in
while !depth > 0 do
pc := !pc + 1;
let c = prog.[!pc] in
if c = '[' then depth := !depth + 1
else if c = ']' then depth := !depth - 1
done
end
end
else if c = ']' then begin
if mem.(!ptr) <> 0 then begin
let depth = ref 1 in
while !depth > 0 do
pc := !pc - 1;
let c = prog.[!pc] in
if c = ']' then depth := !depth + 1
else if c = '[' then depth := !depth - 1
done
end
end);
pc := !pc + 1
done;
!acc
;;
interpret "+++[.-]"

43
lib/ocaml/baseline/bfs.ml Normal file
View File

@@ -0,0 +1,43 @@
(* Baseline: graph BFS using Queue + Hashtbl visited set.
Returns the count of reachable nodes. *)
(* Adjacency as an assoc list of (node, neighbors). *)
let graph =
[ ("A", ["B"; "C"])
; ("B", ["D"])
; ("C", ["D"; "E"])
; ("D", ["F"])
; ("E", ["F"])
; ("F", [])
]
;;
let neighbors n =
match List.assoc_opt n graph with
| None -> []
| Some ns -> ns
;;
let bfs start =
let visited = Hashtbl.create 16 in
let q = Queue.create () in
Queue.push start q ;
Hashtbl.add visited start true ;
let rec loop () =
if Queue.is_empty q then ()
else
let v = Queue.pop q in
List.iter
(fun n ->
if not (Hashtbl.mem visited n) then begin
Hashtbl.add visited n true ;
Queue.push n q
end)
(neighbors v) ;
loop ()
in
loop () ;
Hashtbl.length visited
;;
bfs "A"

View File

@@ -0,0 +1,42 @@
let h = 5
let w = 5
let grid = [|
[| 0; 0; 1; 0; 0 |];
[| 1; 0; 1; 0; 1 |];
[| 0; 0; 0; 0; 0 |];
[| 0; 1; 1; 1; 0 |];
[| 0; 0; 0; 0; 0 |]
|]
let step dist q r c nr nc =
if nr >= 0 && nr < h && nc >= 0 && nc < w
&& grid.(nr).(nc) = 0 && dist.(nr).(nc) = -1 then begin
dist.(nr).(nc) <- dist.(r).(c) + 1;
Queue.push (nr * 10 + nc) q
end
let bfs sr sc tr tc =
let dist = Array.init h (fun _ -> Array.make w (-1)) in
let q = Queue.create () in
dist.(sr).(sc) <- 0;
Queue.push (sr * 10 + sc) q;
let go = ref true in
while !go do
if Queue.is_empty q then go := false
else if dist.(tr).(tc) <> -1 then go := false
else begin
let rc = Queue.pop q in
let r = rc / 10 in
let c = rc mod 10 in
step dist q r c (r - 1) c;
step dist q r c (r + 1) c;
step dist q r c r (c - 1);
step dist q r c r (c + 1)
end
done;
dist.(tr).(tc)
;;
bfs 0 0 4 4

View File

@@ -0,0 +1,24 @@
let bigint_add a b =
let rec aux a b carry =
match (a, b) with
| ([], []) -> if carry = 0 then [] else [carry]
| (x :: xs, []) ->
let s = x + carry in
(s mod 10) :: aux xs [] (s / 10)
| ([], y :: ys) ->
let s = y + carry in
(s mod 10) :: aux [] ys (s / 10)
| (x :: xs, y :: ys) ->
let s = x + y + carry in
(s mod 10) :: aux xs ys (s / 10)
in
aux a b 0
;;
let r1 = bigint_add [9;9;9] [1] in
let r2 = bigint_add [5;6;7] [8;9;1] in
let r3 = bigint_add [9;9;9;9;9;9;9;9] [1] in
List.fold_left (+) 0 r1
+ List.fold_left (+) 0 r2
+ List.length r3

View File

@@ -0,0 +1,47 @@
let parent i = (i - 1) / 2
let lchild i = 2 * i + 1
let rchild i = 2 * i + 2
let swap a i j =
let t = a.(i) in
a.(i) <- a.(j);
a.(j) <- t
let rec sift_up a i =
if i > 0 && a.(parent i) > a.(i) then begin
swap a i (parent i);
sift_up a (parent i)
end
let rec sift_down a n i =
let l = lchild i and r = rchild i in
let smallest = ref i in
if l < n && a.(l) < a.(!smallest) then smallest := l;
if r < n && a.(r) < a.(!smallest) then smallest := r;
if !smallest <> i then begin
swap a i !smallest;
sift_down a n !smallest
end
let push a size x =
a.(!size) <- x;
size := !size + 1;
sift_up a (!size - 1)
let pop a size =
let m = a.(0) in
size := !size - 1;
a.(0) <- a.(!size);
sift_down a !size 0;
m
;;
let a = Array.make 20 0 in
let s = ref 0 in
List.iter (fun x -> push a s x) [9; 4; 7; 1; 8; 3; 5; 2; 6];
let total = ref 0 in
for _ = 1 to 9 do
total := !total * 10 + pop a s
done;
!total

View File

@@ -0,0 +1,39 @@
let is_bipartite n adj =
let color = Array.make n (-1) in
let ok = ref true in
let q = Queue.create () in
for src = 0 to n - 1 do
if color.(src) = -1 then begin
color.(src) <- 0;
Queue.push src q;
while not (Queue.is_empty q) do
let u = Queue.pop q in
List.iter (fun v ->
if color.(v) = -1 then begin
color.(v) <- 1 - color.(u);
Queue.push v q
end else if color.(v) = color.(u) then
ok := false
) adj.(u)
done
end
done;
let zeros = ref 0 in
for i = 0 to n - 1 do
if color.(i) = 0 then zeros := !zeros + 1
done;
if !ok then !zeros else -1
;;
let n = 7 in
let adj = [|
[1; 3];
[0; 2; 4];
[1; 5];
[0; 4; 6];
[1; 3];
[2; 6];
[3; 5]
|] in
is_bipartite n adj

View File

@@ -0,0 +1,13 @@
let bisect f lo hi =
let lo = ref lo and hi = ref hi in
for _ = 1 to 50 do
let mid = (!lo +. !hi) /. 2.0 in
if f mid = 0.0 || f !lo *. f mid < 0.0 then hi := mid
else lo := mid
done;
!lo
;;
let r = bisect (fun x -> x *. x -. 2.0) 1.0 2.0 in
int_of_float (r *. 100.0)

View File

@@ -0,0 +1,12 @@
let popcount n =
let count = ref 0 in
let m = ref n in
while !m > 0 do
if !m land 1 = 1 then count := !count + 1;
m := !m lsr 1
done;
!count
;;
popcount 1023 + popcount 5 + popcount 1024 + popcount 0xff

View File

@@ -0,0 +1,24 @@
let bowling_score frames =
let arr = Array.of_list frames in
let n = Array.length arr in
let total = ref 0 in
let i = ref 0 in
let frame = ref 1 in
while !frame <= 10 && !i < n do
if arr.(!i) = 10 then begin
total := !total + 10 + arr.(!i + 1) + arr.(!i + 2);
i := !i + 1
end else if !i + 1 < n && arr.(!i) + arr.(!i + 1) = 10 then begin
total := !total + 10 + arr.(!i + 2);
i := !i + 2
end else begin
total := !total + arr.(!i) + arr.(!i + 1);
i := !i + 2
end;
frame := !frame + 1
done;
!total
;;
bowling_score [10; 7; 3; 9; 0; 10; 0; 8; 8; 2; 0; 6; 10; 10; 10; 8; 1]

View File

@@ -0,0 +1,32 @@
let bracket_match s =
let n = String.length s in
let stack = ref [] in
let ok = ref true in
let i = ref 0 in
while !ok && !i < n do
let c = s.[!i] in
if c = '(' || c = '[' || c = '{' then
stack := c :: !stack
else if c = ')' || c = ']' || c = '}' then begin
match !stack with
| [] -> ok := false
| top :: rest ->
let pair =
(c = ')' && top = '(') ||
(c = ']' && top = '[') ||
(c = '}' && top = '{')
in
if pair then stack := rest else ok := false
end;
i := !i + 1
done;
if !ok && !stack = [] then 1 else 0
;;
let strings = ["()"; "[{()}]"; "({[}])"; ""; "(("; "()[](){}"; "(a(b)c)"; "(()"; "])"] in
let count = ref 0 in
List.iter (fun s ->
count := !count + bracket_match s
) strings;
!count

View File

@@ -0,0 +1,20 @@
let interpret prog =
let mem = Array.make 256 0 in
let ptr = ref 0 in
let pc = ref 0 in
let n = String.length prog in
let acc = ref 0 in
while !pc < n do
let c = prog.[!pc] in
(if c = '>' then ptr := !ptr + 1
else if c = '<' then ptr := !ptr - 1
else if c = '+' then mem.(!ptr) <- mem.(!ptr) + 1
else if c = '-' then mem.(!ptr) <- mem.(!ptr) - 1
else if c = '.' then acc := !acc + mem.(!ptr));
pc := !pc + 1
done;
!acc
;;
interpret "+++++.+++++.+++++.+++++.+++++."

View File

@@ -0,0 +1,27 @@
let lower_bound arr x =
let lo = ref 0 and hi = ref (Array.length arr) in
while !lo < !hi do
let mid = (!lo + !hi) / 2 in
if arr.(mid) < x then lo := mid + 1
else hi := mid
done;
!lo
let upper_bound arr x =
let lo = ref 0 and hi = ref (Array.length arr) in
while !lo < !hi do
let mid = (!lo + !hi) / 2 in
if arr.(mid) <= x then lo := mid + 1
else hi := mid
done;
!lo
;;
let a = [| 1; 2; 2; 3; 3; 3; 5; 7; 9 |] in
let cnt3 = upper_bound a 3 - lower_bound a 3 in
let cnt2 = upper_bound a 2 - lower_bound a 2 in
let cnt5 = upper_bound a 5 - lower_bound a 5 in
let cnt9 = upper_bound a 9 - lower_bound a 9 in
let cnt4 = upper_bound a 4 - lower_bound a 4 in
cnt3 * 1000 + cnt2 * 100 + cnt5 * 10 + cnt9 + cnt4

View File

@@ -0,0 +1,25 @@
let bs_rotated arr target =
let lo = ref 0 in
let hi = ref (Array.length arr - 1) in
let result = ref (-1) in
while !lo <= !hi && !result = -1 do
let mid = (!lo + !hi) / 2 in
if arr.(mid) = target then result := mid
else if arr.(!lo) <= arr.(mid) then begin
if target >= arr.(!lo) && target < arr.(mid) then
hi := mid - 1
else
lo := mid + 1
end else begin
if target > arr.(mid) && target <= arr.(!hi) then
lo := mid + 1
else
hi := mid - 1
end
done;
!result
;;
let a = [| 4; 5; 6; 7; 0; 1; 2 |] in
bs_rotated a 0 + bs_rotated a 7 * 10 + bs_rotated a 3 * 100

View File

@@ -0,0 +1,16 @@
let bsearch arr target =
let n = Array.length arr in
let lo = ref 0 and hi = ref (n - 1) in
let found = ref (-1) in
while !lo <= !hi && !found = -1 do
let mid = (!lo + !hi) / 2 in
if arr.(mid) = target then found := mid
else if arr.(mid) < target then lo := mid + 1
else hi := mid - 1
done;
!found
;;
let a = Array.of_list [1;3;5;7;9;11;13;15;17;19;21] in
bsearch a 13 + bsearch a 5 + bsearch a 100

View File

@@ -0,0 +1,25 @@
(* Baseline: binary search tree with insert + in-order traversal *)
type 'a tree =
| Leaf
| Node of 'a * 'a tree * 'a tree
;;
let rec insert x t =
match t with
| Leaf -> Node (x, Leaf, Leaf)
| Node (v, l, r) ->
if x < v then Node (v, insert x l, r)
else if x > v then Node (v, l, insert x r)
else t
;;
let rec inorder t =
match t with
| Leaf -> []
| Node (v, l, r) -> List.append (inorder l) (v :: inorder r)
;;
let from_list xs = List.fold_left (fun t x -> insert x t) Leaf xs ;;
let t = from_list [5; 3; 8; 1; 4; 7; 9; 2] ;;
List.fold_left (fun a b -> a + b) 0 (inorder t)

View File

@@ -0,0 +1,14 @@
let shift_char c k =
let n = Char.code c in
if n >= 97 && n <= 122 then
Char.chr (((n - 97 + k) mod 26 + 26) mod 26 + 97)
else c
let encode s k =
String.init (String.length s) (fun i -> shift_char s.[i] k)
;;
(* ROT13 round-trip: encode (encode "hello" 13) 13 = "hello".
Sum the codes of two chars to give a deterministic integer check. *)
let r = encode (encode "hello" 13) 13 in
Char.code r.[0] + Char.code r.[4]

View File

@@ -0,0 +1,76 @@
(* Baseline: recursive-descent calculator for "+", "*", parens, ints. *)
type expr =
| Lit of int
| Add of expr * expr
| Mul of expr * expr
;;
let parse_input src =
let pos = ref 0 in
let peek () = if !pos < String.length src then String.get src !pos else "" in
let advance () = pos := !pos + 1 in
let skip_ws () =
while !pos < String.length src && peek () = " " do advance () done
in
let rec parse_atom () =
skip_ws () ;
if peek () = "(" then begin
advance () ;
let e = parse_expr () in
skip_ws () ;
advance () ; (* consume ')' *)
e
end
else
let start = !pos in
let rec digits () =
if !pos < String.length src then
let c = peek () in
if c >= "0" && c <= "9" then begin advance () ; digits () end
else ()
in
digits () ;
let n = Int.of_string (String.sub src start (!pos - start)) in
Lit n
and parse_term () =
skip_ws () ;
let lhs = ref (parse_atom ()) in
let rec loop () =
skip_ws () ;
if peek () = "*" then begin
advance () ;
lhs := Mul (!lhs, parse_atom ()) ;
loop ()
end
in
loop () ;
!lhs
and parse_expr () =
skip_ws () ;
let lhs = ref (parse_term ()) in
let rec loop () =
skip_ws () ;
if peek () = "+" then begin
advance () ;
lhs := Add (!lhs, parse_term ()) ;
loop ()
end
in
loop () ;
!lhs
in
parse_expr ()
;;
let rec eval e =
match e with
| Lit n -> n
| Add (a, b) -> eval a + eval b
| Mul (a, b) -> eval a * eval b
;;
(* (1 + 2) * 3 + 4 = 9 + 4 = 13 *)
eval (parse_input "(1 + 2) * 3 + 4")

View File

@@ -0,0 +1,13 @@
let catalan n =
let dp = Array.make (n + 1) 0 in
dp.(0) <- 1;
for i = 1 to n do
for j = 0 to i - 1 do
dp.(i) <- dp.(i) + dp.(j) * dp.(i - 1 - j)
done
done;
dp.(n)
;;
catalan 5

View File

@@ -0,0 +1,5 @@
(* Baseline: closures + curried application *)
let make_adder n = fun x -> n + x ;;
let add5 = make_adder 5 ;;
let add10 = make_adder 10 ;;
add5 100 + add10 200

View File

@@ -0,0 +1,15 @@
let coin_change coins target =
let dp = Array.make (target + 1) (target + 1) in
dp.(0) <- 0;
for i = 1 to target do
List.iter (fun c ->
if c <= i && dp.(i - c) + 1 < dp.(i) then
dp.(i) <- dp.(i - c) + 1
) coins
done;
if dp.(target) > target then -1
else dp.(target)
;;
coin_change [1; 5; 10; 25] 67

View File

@@ -0,0 +1,16 @@
let coin_min coins amount =
let dp = Array.make (amount + 1) (-1) in
dp.(0) <- 0;
for i = 1 to amount do
List.iter (fun c ->
if c <= i && dp.(i - c) >= 0 then begin
let cand = dp.(i - c) + 1 in
if dp.(i) < 0 || cand < dp.(i) then dp.(i) <- cand
end
) coins
done;
dp.(amount)
;;
coin_min [1; 5; 10; 25] 67

View File

@@ -0,0 +1,12 @@
let rec choose k xs =
if k = 0 then [[]]
else
match xs with
| [] -> []
| h :: rest ->
List.map (fun c -> h :: c) (choose (k - 1) rest)
@ choose k rest
;;
List.length (choose 4 [1; 2; 3; 4; 5; 6; 7; 8; 9])

View File

@@ -0,0 +1,43 @@
let cross ox oy ax ay bx by =
(ax - ox) * (by - oy) - (ay - oy) * (bx - ox)
let hull_size pts =
let n = List.length pts in
if n < 3 then n
else begin
let sorted = List.sort (fun (a, b) (c, d) ->
if a <> c then compare a c else compare b d) pts in
let arr = Array.of_list sorted in
let h = Array.make (2 * n) (0, 0) in
let k = ref 0 in
for i = 0 to n - 1 do
let (xi, yi) = arr.(i) in
let cont = ref true in
while !cont && !k >= 2 do
let (ox, oy) = h.(!k - 2) in
let (ax, ay) = h.(!k - 1) in
if cross ox oy ax ay xi yi <= 0 then k := !k - 1
else cont := false
done;
h.(!k) <- (xi, yi);
k := !k + 1
done;
let lo = !k + 1 in
for i = n - 2 downto 0 do
let (xi, yi) = arr.(i) in
let cont = ref true in
while !cont && !k >= lo do
let (ox, oy) = h.(!k - 2) in
let (ax, ay) = h.(!k - 1) in
if cross ox oy ax ay xi yi <= 0 then k := !k - 1
else cont := false
done;
h.(!k) <- (xi, yi);
k := !k + 1
done;
!k - 1
end
;;
hull_size [(0, 0); (1, 1); (2, 0); (2, 2); (0, 2); (1, 0); (3, 3); (5, 1)]

View File

@@ -0,0 +1,14 @@
let count_bits n =
let result = Array.make (n + 1) 0 in
for i = 1 to n do
result.(i) <- result.(i / 2) + (i mod 2)
done;
let sum = ref 0 in
for i = 0 to n do
sum := !sum + result.(i)
done;
!sum
;;
count_bits 100

View File

@@ -0,0 +1,13 @@
let count_ways coins target =
let dp = Array.make (target + 1) 0 in
dp.(0) <- 1;
List.iter (fun c ->
for i = c to target do
dp.(i) <- dp.(i) + dp.(i - c)
done
) coins;
dp.(target)
;;
count_ways [1; 2; 5; 10; 25] 50

View File

@@ -0,0 +1,42 @@
let count_inv arr =
let n = Array.length arr in
let temp = Array.make n 0 in
let count = ref 0 in
let rec merge lo mid hi =
let i = ref lo and j = ref (mid + 1) and k = ref lo in
while !i <= mid && !j <= hi do
if arr.(!i) <= arr.(!j) then begin
temp.(!k) <- arr.(!i);
i := !i + 1
end else begin
temp.(!k) <- arr.(!j);
count := !count + (mid - !i + 1);
j := !j + 1
end;
k := !k + 1
done;
while !i <= mid do
temp.(!k) <- arr.(!i);
i := !i + 1; k := !k + 1
done;
while !j <= hi do
temp.(!k) <- arr.(!j);
j := !j + 1; k := !k + 1
done;
for x = lo to hi do
arr.(x) <- temp.(x)
done
and sort lo hi =
if lo < hi then begin
let mid = (lo + hi) / 2 in
sort lo mid;
sort (mid + 1) hi;
merge lo mid hi
end
in
sort 0 (n - 1);
!count
;;
count_inv [|8; 4; 2; 1; 3; 5; 7; 6|]

View File

@@ -0,0 +1,17 @@
let count_pal s =
let n = String.length s in
let count = ref 0 in
for c = 0 to 2 * n - 2 do
let l = ref (c / 2) in
let r = ref ((c + 1) / 2) in
while !l >= 0 && !r < n && s.[!l] = s.[!r] do
count := !count + 1;
l := !l - 1;
r := !r + 1
done
done;
!count
;;
count_pal "aabaa"

View File

@@ -0,0 +1,42 @@
let n = 6
let adj = [|
[1; 2];
[3];
[3; 4];
[5];
[5];
[]
|]
let in_deg = Array.make n 0
let paths = Array.make n 0
let count_paths () =
for u = 0 to n - 1 do
List.iter (fun v -> in_deg.(v) <- in_deg.(v) + 1) adj.(u)
done;
let order = ref [] in
let q = Queue.create () in
for v = 0 to n - 1 do
if in_deg.(v) = 0 then Queue.push v q
done;
while not (Queue.is_empty q) do
let u = Queue.pop q in
order := u :: !order;
List.iter (fun v ->
in_deg.(v) <- in_deg.(v) - 1;
if in_deg.(v) = 0 then Queue.push v q
) adj.(u)
done;
paths.(0) <- 1;
let topo = List.rev !order in
List.iter (fun u ->
List.iter (fun v ->
paths.(v) <- paths.(v) + paths.(u)
) adj.(u)
) topo;
paths.(n - 1)
;;
count_paths ()

View File

@@ -0,0 +1,16 @@
let count_subarr_sum_k arr k =
let n = Array.length arr in
let prefix = Array.make (n + 1) 0 in
for i = 0 to n - 1 do
prefix.(i + 1) <- prefix.(i) + arr.(i)
done;
let count = ref 0 in
for i = 0 to n - 1 do
for j = i + 1 to n do
if prefix.(j) - prefix.(i) = k then count := !count + 1
done
done;
!count
;;
count_subarr_sum_k [| 1; 1; 1; 2; -1; 3; 1; -2; 4 |] 3

12
lib/ocaml/baseline/csv.ml Normal file
View File

@@ -0,0 +1,12 @@
let sum_second_col text =
let lines = String.split_on_char '\n' text in
List.fold_left (fun acc line ->
let fields = String.split_on_char ',' line in
if List.length fields >= 2 then
acc + int_of_string (List.nth fields 1)
else acc
) 0 lines
;;
sum_second_col "a,1,extra\nb,2,extra\nc,3,extra\nd,4,extra"

View File

@@ -0,0 +1,24 @@
let daily_temperatures temps =
let n = Array.length temps in
let answer = Array.make n 0 in
let stack = ref [] in
for i = 0 to n - 1 do
let cont = ref true in
while !cont do
match !stack with
| top :: rest when temps.(top) < temps.(i) ->
answer.(top) <- i - top;
stack := rest
| _ -> cont := false
done;
stack := i :: !stack
done;
let sum = ref 0 in
for i = 0 to n - 1 do
sum := !sum + answer.(i)
done;
!sum
;;
daily_temperatures [| 73; 74; 75; 71; 69; 72; 76; 73 |]

View File

@@ -0,0 +1,37 @@
let n = 5
let edges = [|
[(1, 4); (2, 1)];
[(3, 1)];
[(1, 2); (3, 5)];
[(4, 3)];
[]
|]
let dijkstra src =
let dist = Array.make n 1000000 in
dist.(src) <- 0;
let visited = Array.make n false in
for _ = 0 to n - 1 do
let u = ref (-1) in
let best = ref 1000000 in
for v = 0 to n - 1 do
if (not visited.(v)) && dist.(v) < !best then begin
best := dist.(v);
u := v
end
done;
if !u >= 0 then begin
visited.(!u) <- true;
List.iter (fun (v, w) ->
if dist.(!u) + w < dist.(v) then
dist.(v) <- dist.(!u) + w
) edges.(!u)
end
done;
dist
;;
let d = dijkstra 0 in
d.(4)

View File

@@ -0,0 +1,20 @@
let count_subseq s t =
let m = String.length s in
let n = String.length t in
let dp = Array.init (m + 1) (fun _ -> Array.make (n + 1) 0) in
for i = 0 to m do
dp.(i).(0) <- 1
done;
for i = 1 to m do
for j = 1 to n do
if s.[i - 1] = t.[j - 1] then
dp.(i).(j) <- dp.(i - 1).(j) + dp.(i - 1).(j - 1)
else
dp.(i).(j) <- dp.(i - 1).(j)
done
done;
dp.(m).(n)
;;
count_subseq "rabbbit" "rabbit"

View File

@@ -0,0 +1,27 @@
let word_break s words =
let n = String.length s in
let dp = Array.make (n + 1) false in
dp.(0) <- true;
for i = 1 to n do
List.iter (fun w ->
let wl = String.length w in
if i >= wl && dp.(i - wl) then begin
let prefix = String.sub s (i - wl) wl in
if prefix = w then dp.(i) <- true
end
) words
done;
if dp.(n) then 1 else 0
let count_ok strings words =
let count = ref 0 in
List.iter (fun s ->
count := !count + word_break s words
) strings;
!count
;;
let dict = ["apple"; "pen"; "pine"; "pineapple"; "cats"; "cat"; "and"; "sand"; "dog"] in
let inputs = ["applepenapple"; "pineapplepenapple"; "catsanddog"; "catsandog"; "applesand"] in
count_ok inputs dict

View File

@@ -0,0 +1,26 @@
let egg_drop eggs floors =
let dp = Array.init (eggs + 1) (fun _ -> Array.make (floors + 1) 0) in
for f = 1 to floors do
dp.(1).(f) <- f
done;
for e = 1 to eggs do
dp.(e).(0) <- 0;
dp.(e).(1) <- 1
done;
for e = 2 to eggs do
for f = 2 to floors do
let best = ref 100000000 in
for k = 1 to f do
let bre = dp.(e - 1).(k - 1) in
let sur = dp.(e).(f - k) in
let cand = 1 + (if bre > sur then bre else sur) in
if cand < !best then best := cand
done;
dp.(e).(f) <- !best
done
done;
dp.(eggs).(floors)
;;
egg_drop 2 36

View File

@@ -0,0 +1,10 @@
let euler1 limit =
let sum = ref 0 in
for i = 1 to limit - 1 do
if i mod 3 = 0 || i mod 5 = 0 then sum := !sum + i
done;
!sum
;;
euler1 1000

View File

@@ -0,0 +1,22 @@
let sieve_sum n =
let s = Array.make (n + 1) true in
s.(0) <- false;
s.(1) <- false;
for i = 2 to n do
if s.(i) then begin
let j = ref (i * i) in
while !j <= n do
s.(!j) <- false;
j := !j + i
done
end
done;
let total = ref 0 in
for i = 2 to n do
if s.(i) then total := !total + i
done;
!total
;;
sieve_sum 100

View File

@@ -0,0 +1,25 @@
let collatz_len n =
let m = ref n in
let c = ref 0 in
while !m > 1 do
if !m mod 2 = 0 then m := !m / 2
else m := 3 * !m + 1;
c := !c + 1
done;
!c
let euler14 limit =
let best = ref 0 in
let best_n = ref 0 in
for n = 2 to limit do
let l = collatz_len n in
if l > !best then begin
best := l;
best_n := n
end
done;
!best_n
;;
euler14 100

View File

@@ -0,0 +1,14 @@
let euler16 n =
let p = ref 1 in
for _ = 1 to n do p := !p * 2 done;
let sum = ref 0 in
let m = ref !p in
while !m > 0 do
sum := !sum + !m mod 10;
m := !m / 10
done;
!sum
;;
euler16 15

View File

@@ -0,0 +1,15 @@
let euler2 limit =
let a = ref 1 in
let b = ref 2 in
let sum = ref 0 in
while !a <= limit do
if !a mod 2 = 0 then sum := !sum + !a;
let c = !a + !b in
a := !b;
b := c
done;
!sum
;;
euler2 4000000

View File

@@ -0,0 +1,25 @@
let div_sum n =
let s = ref 1 in
let i = ref 2 in
while !i * !i <= n do
if n mod !i = 0 then begin
s := !s + !i;
let q = n / !i in
if q <> !i then s := !s + q
end;
i := !i + 1
done;
if n = 1 then 0 else !s
let euler21 limit =
let total = ref 0 in
for a = 2 to limit do
let b = div_sum a in
if b <> a && b > a && b <= limit && div_sum b = a then
total := !total + a + b
done;
!total
;;
euler21 300

View File

@@ -0,0 +1,17 @@
let euler25 n =
let a = ref 1 in
let b = ref 1 in
let i = ref 2 in
let target = ref 1 in
for _ = 1 to n - 1 do target := !target * 10 done;
while !b < !target do
let c = !a + !b in
a := !b;
b := c;
i := !i + 1
done;
!i
;;
euler25 12

View File

@@ -0,0 +1,15 @@
let euler28 n =
let s = ref 1 in
let k = ref 1 in
for layer = 1 to (n - 1) / 2 do
let step = 2 * layer in
for _ = 1 to 4 do
k := !k + step;
s := !s + !k
done
done;
!s
;;
euler28 7

View File

@@ -0,0 +1,14 @@
let euler29 n =
let h = Hashtbl.create 64 in
for a = 2 to n do
for b = 2 to n do
let p = ref 1 in
for _ = 1 to b do p := !p * a done;
Hashtbl.replace h !p ()
done
done;
Hashtbl.length h
;;
euler29 5

View File

@@ -0,0 +1,15 @@
let largest_prime_factor n =
let m = ref n in
let factor = ref 2 in
let largest = ref 0 in
while !m > 1 do
if !m mod !factor = 0 then begin
largest := !factor;
m := !m / !factor
end else factor := !factor + 1
done;
!largest
;;
largest_prime_factor 13195

View File

@@ -0,0 +1,22 @@
let pow_digit_sum n p =
let m = ref n in
let s = ref 0 in
while !m > 0 do
let d = !m mod 10 in
let pd = ref 1 in
for _ = 1 to p do pd := !pd * d done;
s := !s + !pd;
m := !m / 10
done;
!s
let euler30 p limit =
let total = ref 0 in
for n = 2 to limit do
if pow_digit_sum n p = n then total := !total + n
done;
!total
;;
euler30 3 999

View File

@@ -0,0 +1,24 @@
let fact n =
let r = ref 1 in
for i = 2 to n do r := !r * i done;
!r
let digit_fact_sum n =
let m = ref n in
let s = ref 0 in
while !m > 0 do
s := !s + fact (!m mod 10);
m := !m / 10
done;
!s
let euler34 limit =
let total = ref 0 in
for n = 3 to limit do
if digit_fact_sum n = n then total := !total + n
done;
!total
;;
euler34 2000

View File

@@ -0,0 +1,41 @@
let pal_dec n =
let s = string_of_int n in
let len = String.length s in
let p = ref true in
for i = 0 to len / 2 - 1 do
if s.[i] <> s.[len - 1 - i] then p := false
done;
!p
let to_binary n =
if n = 0 then "0"
else
let buf = Buffer.create 32 in
let m = ref n in
let stack = ref [] in
while !m > 0 do
stack := (!m mod 2) :: !stack;
m := !m / 2
done;
List.iter (fun d -> Buffer.add_string buf (string_of_int d)) !stack;
Buffer.contents buf
let pal_bin n =
let s = to_binary n in
let len = String.length s in
let p = ref true in
for i = 0 to len / 2 - 1 do
if s.[i] <> s.[len - 1 - i] then p := false
done;
!p
let euler36 limit =
let sum = ref 0 in
for n = 1 to limit - 1 do
if pal_dec n && pal_bin n then sum := !sum + n
done;
!sum
;;
euler36 1000

View File

@@ -0,0 +1,22 @@
let euler40 () =
let buf = Buffer.create 4096 in
let len = ref 0 in
let i = ref 1 in
while !len < 1500 do
let s = string_of_int !i in
Buffer.add_string buf s;
len := !len + String.length s;
i := !i + 1
done;
let s = Buffer.contents buf in
let prod = ref 1 in
let positions = [1; 10; 100; 1000] in
List.iter (fun p ->
let c = s.[p - 1] in
prod := !prod * (Char.code c - Char.code '0')
) positions;
!prod
;;
euler40 ()

View File

@@ -0,0 +1,21 @@
let is_pal n =
let s = string_of_int n in
let len = String.length s in
let p = ref true in
for i = 0 to len / 2 - 1 do
if s.[i] <> s.[len - 1 - i] then p := false
done;
!p
let euler4 lo hi =
let m = ref 0 in
for a = lo to hi do
for b = a to hi do
let p = a * b in
if p > !m && is_pal p then m := p
done
done;
!m
;;
euler4 10 99

View File

@@ -0,0 +1,11 @@
let rec gcd a b = if b = 0 then a else gcd b (a mod b)
let lcm a b = a * b / gcd a b
let euler5 n =
let r = ref 1 in
for i = 2 to n do
r := lcm !r i
done;
!r
;;
euler5 20

View File

@@ -0,0 +1,12 @@
let euler6 n =
let sum = ref 0 in
let sum_sq = ref 0 in
for i = 1 to n do
sum := !sum + i;
sum_sq := !sum_sq + i * i
done;
!sum * !sum - !sum_sq
;;
euler6 100

View File

@@ -0,0 +1,22 @@
let nth_prime n =
let count = ref 0 in
let i = ref 1 in
let result = ref 0 in
while !count < n do
i := !i + 1;
let p = ref true in
let j = ref 2 in
while !j * !j <= !i && !p do
if !i mod !j = 0 then p := false;
j := !j + 1
done;
if !p then begin
count := !count + 1;
if !count = n then result := !i
end
done;
!result
;;
nth_prime 100

View File

@@ -0,0 +1,17 @@
let euler9 () =
let result = ref 0 in
for a = 1 to 333 do
let num = 500000 - 1000 * a in
let den = 1000 - a in
if num mod den = 0 then begin
let b = num / den in
if b > a then
let c = 1000 - a - b in
if c > b then result := a * b * c
end
done;
!result
;;
euler9 ()

View File

@@ -0,0 +1,17 @@
(* Baseline: exception declaration + raise + try-with *)
exception NegArg of int ;;
let safe_sqrt n =
if n < 0 then raise (NegArg n)
else
begin
let rec find_sqrt i =
if i * i > n then i - 1
else find_sqrt (i + 1)
in find_sqrt 0
end ;;
let result =
try
safe_sqrt 16
with
| NegArg _ -> 0 ;;
result

View File

@@ -0,0 +1,16 @@
exception Negative of int
let safe_sqrt n =
if n < 0 then raise (Negative n)
else
let g = ref 1 in
while !g * !g < n do g := !g + 1 done;
!g
let try_sqrt n =
try safe_sqrt n with
| Negative x -> -x
;;
try_sqrt 16 + try_sqrt 25 + try_sqrt (-7) + try_sqrt 100

View File

@@ -0,0 +1,207 @@
{
"abundant.ml": 21,
"activity_select.ml": 4,
"ackermann.ml": 125,
"adler32.ml": 300286872,
"anagram_check.ml": 2,
"anagram_groups.ml": 3,
"anagrams.ml": 3,
"atm.ml": 120,
"bag.ml": 3,
"bowling.ml": 167,
"bf_full.ml": 6,
"bisect.ml": 141,
"bigint_add.ml": 28,
"binary_heap.ml": 123456789,
"bipartite.ml": 4,
"bits.ml": 21,
"balance.ml": 3,
"bracket_match.ml": 5,
"base_n.ml": 17,
"bfs.ml": 6,
"bfs_grid.ml": 8,
"btree.ml": 39,
"brainfuck.ml": 75,
"bs_bounds.ml": 3211,
"bs_rotated.ml": -66,
"bsearch.ml": 7,
"caesar.ml": 215,
"calc.ml": 13,
"catalan.ml": 42,
"closures.ml": 315,
"combinations.ml": 126,
"convex_hull.ml": 5,
"coin_change.ml": 6,
"coin_min.ml": 6,
"count_bits.ml": 319,
"count_change.ml": 406,
"count_paths_dag.ml": 3,
"count_inversions.ml": 12,
"count_palindromes.ml": 9,
"count_subarrays_k.ml": 7,
"csv.ml": 10,
"daily_temperatures.ml": 10,
"egg_drop.ml": 8,
"dijkstra.ml": 7,
"dp_word_break.ml": 4,
"distinct_subseq.ml": 3,
"exception_handle.ml": 4,
"exception_user.ml": 26,
"euler1.ml": 233168,
"euler16.ml": 26,
"euler10.ml": 1060,
"euler14.ml": 97,
"euler2.ml": 4613732,
"euler21_small.ml": 504,
"euler25.ml": 55,
"euler28.ml": 261,
"euler29_small.ml": 15,
"euler30_cube.ml": 1301,
"euler34_small.ml": 145,
"euler36.ml": 1772,
"euler40_small.ml": 15,
"euler3.ml": 29,
"euler4_small.ml": 9009,
"euler5.ml": 232792560,
"euler6.ml": 25164150,
"euler7.ml": 541,
"euler9.ml": 31875000,
"expr_eval.ml": 16,
"expr_simp.ml": 22,
"factorial.ml": 3628800,
"fenwick_tree.ml": 228,
"fib_doubling.ml": 102334155,
"fib_mod.ml": 391360,
"fraction.ml": 7,
"frequency.ml": 5,
"gas_station.ml": 3,
"gcd_lcm.ml": 60,
"gray_code.ml": 136,
"grep_count.ml": 3,
"grid_paths.ml": 210,
"group_consec.ml": 53,
"hailstone.ml": 111,
"harshad.ml": 33,
"hamming.ml": 4,
"hanoi.ml": 1023,
"hist.ml": 75,
"house_robber.ml": 22,
"histogram_area.ml": 10,
"huffman.ml": 224,
"int_sqrt.ml": 1027,
"interval_overlap.ml": 6,
"is_prime.ml": 25,
"island_count.ml": 5,
"fizz_classifier.ml": 540,
"fizzbuzz.ml": 57,
"flatten_tree.ml": 28,
"flood_fill.ml": 7,
"floyd_cycle.ml": 8,
"floyd_warshall.ml": 9,
"lis.ml": 6,
"list_ops.ml": 30,
"lps_dp.ml": 7,
"lru_cache.ml": 499,
"luhn.ml": 2,
"magic_square.ml": 65,
"mat_mul.ml": 621,
"matrix_power.ml": 832040,
"max_path_tree.ml": 11,
"max_product3.ml": 300,
"max_run.ml": 5,
"mod_inverse.ml": 27,
"josephus.ml": 11,
"json_pretty.ml": 24,
"kadane.ml": 6,
"kmp.ml": 5,
"kth_two.ml": 8,
"knapsack.ml": 36,
"lambda_calc.ml": 7,
"lcs.ml": 4,
"majority_vote.ml": 4,
"manacher.ml": 7,
"lev_iter.ml": 16,
"levenshtein.ml": 11,
"memo_fib.ml": 75025,
"mortgage.ml": 1073,
"mst_kruskal.ml": 11,
"merge_intervals.ml": 12,
"min_meeting_rooms.ml": 4,
"merge_sort.ml": 44,
"merge_two.ml": 441,
"min_cost_path.ml": 12,
"min_jumps.ml": 4,
"min_subarr_target.ml": 2,
"module_use.ml": 3,
"monotonic.ml": 4,
"newton_sqrt.ml": 1414,
"next_greater.ml": 153,
"next_permutation.ml": 119,
"number_words.ml": 106,
"mutable_record.ml": 10,
"option_match.ml": 5,
"palindrome.ml": 4,
"palindrome_part.ml": 1,
"palindrome_sum.ml": 49500,
"paren_depth.ml": 7,
"partition.ml": 3025,
"partition_count.ml": 176,
"pancake_sort.ml": 910,
"pascal.ml": 252,
"peano.ml": 30,
"perfect.ml": 3,
"permutations_gen.ml": 12,
"pi_leibniz.ml": 314,
"prefix_sum.ml": 66,
"pretty_table.ml": 64,
"poly_stack.ml": 5,
"polygon_area.ml": 32,
"pow_mod.ml": 738639,
"powerset_target.ml": 20,
"prime_factors.ml": 17,
"pythagorean.ml": 16,
"queens.ml": 2,
"quickselect.ml": 5,
"quicksort.ml": 44,
"radix_sort.ml": 802002,
"roman.ml": 44,
"rolling_hash.ml": 6,
"regex_simple.ml": 7,
"reverse_int.ml": 54329,
"rpn.ml": 9,
"run_decode.ml": 21,
"run_length.ml": 11,
"safe_div.ml": 20,
"segment_tree.ml": 4232,
"shuffle.ml": 55,
"simpson_int.ml": 10000,
"stable_unique.ml": 46,
"stock_two.ml": 6,
"subseq_check.ml": 3,
"tail_factorial.ml": 479001600,
"task_scheduler.ml": 7,
"tarjan_scc.ml": 4,
"subset_sum.ml": 8,
"tic_tac_toe.ml": 1,
"topo_dfs.ml": 24135,
"topo_sort.ml": 6,
"wildcard_match.ml": 6,
"word_freq.ml": 8,
"xor_cipher.ml": 601,
"zerosafe.ml": 28,
"zigzag.ml": 55,
"zip_unzip.ml": 1000,
"sieve.ml": 15,
"sum_squares.ml": 385,
"tree_depth.ml": 4,
"trapping_rain.ml": 6,
"triangle.ml": 11,
"trie.ml": 6,
"triangle_div.ml": 120,
"twosum.ml": 5,
"union_find.ml": 4,
"unique_paths_obs.ml": 3,
"unique_set.ml": 9,
"validate.ml": 417,
"word_count.ml": 3
}

View File

@@ -0,0 +1,19 @@
(* Baseline: a tiny expression evaluator using ADTs + match *)
type expr =
| Lit of int
| Add of expr * expr
| Mul of expr * expr
| Neg of expr
;;
let rec eval e =
match e with
| Lit n -> n
| Add (a, b) -> eval a + eval b
| Mul (a, b) -> eval a * eval b
| Neg x -> 0 - eval x
;;
(* (1 + 2) * (3 + 4) - 5 = 21 - 5 = 16 *)
eval
(Add (Mul (Add (Lit 1, Lit 2), Add (Lit 3, Lit 4)), Neg (Lit 5)))

View File

@@ -0,0 +1,33 @@
type expr =
| Num of int
| Add of expr * expr
| Mul of expr * expr
let rec simp e =
match e with
| Num n -> Num n
| Add (a, b) ->
(match (simp a, simp b) with
| (Num 0, x) -> x
| (x, Num 0) -> x
| (Num n, Num m) -> Num (n + m)
| (a', b') -> Add (a', b'))
| Mul (a, b) ->
(match (simp a, simp b) with
| (Num 0, _) -> Num 0
| (_, Num 0) -> Num 0
| (Num 1, x) -> x
| (x, Num 1) -> x
| (Num n, Num m) -> Num (n * m)
| (a', b') -> Mul (a', b'))
let rec eval e =
match e with
| Num n -> n
| Add (a, b) -> eval a + eval b
| Mul (a, b) -> eval a * eval b
;;
let e = Add (Mul (Num 3, Num 5), Add (Num 0, Mul (Num 1, Num 7))) in
eval (simp e)

View File

@@ -0,0 +1,4 @@
(* Baseline: factorial via let-rec *)
let rec fact n =
if n = 0 then 1 else n * fact (n - 1) ;;
fact 10

View File

@@ -0,0 +1,33 @@
let n = 8
let bit = Array.make (n + 1) 0
let lowbit i =
let r = ref 1 in
while !r * 2 <= i && i mod (!r * 2) = 0 do
r := !r * 2
done;
!r
let rec update i delta =
if i <= n then begin
bit.(i) <- bit.(i) + delta;
update (i + lowbit i) delta
end
let rec prefix_sum i =
if i <= 0 then 0
else bit.(i) + prefix_sum (i - lowbit i)
let range_sum l r = prefix_sum r - prefix_sum (l - 1)
;;
let a = [| 1; 3; 5; 7; 9; 11; 13; 15 |] in
for i = 0 to n - 1 do
update (i + 1) a.(i)
done;
let total = prefix_sum n in
update 1 100;
let after = prefix_sum n in
total + after

View File

@@ -0,0 +1,14 @@
let rec fib_pair n =
if n = 0 then (0, 1)
else
let (a, b) = fib_pair (n / 2) in
let c = a * (2 * b - a) in
let d = a * a + b * b in
if n mod 2 = 0 then (c, d)
else (d, c + d)
let fib n = let (f, _) = fib_pair n in f
;;
fib 40

View File

@@ -0,0 +1,13 @@
let fib_mod n m =
let a = ref 0 in
let b = ref 1 in
for _ = 1 to n do
let c = (!a + !b) mod m in
a := !b;
b := c
done;
!a
;;
fib_mod 100 1000003

View File

@@ -0,0 +1,21 @@
let classify n =
let by3 = n mod 3 = 0 in
let by5 = n mod 5 = 0 in
if by3 && by5 then `FizzBuzz
else if by3 then `Fizz
else if by5 then `Buzz
else `Num n
let score x = match x with
| `FizzBuzz -> 100
| `Fizz -> 10
| `Buzz -> 5
| `Num n -> n
;;
let total = ref 0 in
for i = 1 to 30 do
total := !total + score (classify i)
done;
!total

View File

@@ -0,0 +1,17 @@
(* Baseline: fizzbuzz returning a list of strings *)
let fizzbuzz n =
let acc = ref [] in
for i = 1 to n do
let s =
if i mod 15 = 0 then "FizzBuzz"
else if i mod 3 = 0 then "Fizz"
else if i mod 5 = 0 then "Buzz"
else Int.to_string i
in
acc := s :: !acc
done ;
List.rev !acc
;;
(* Concatenated for a deterministic check value via String.length *)
String.length (String.concat "," (fizzbuzz 15))

View File

@@ -0,0 +1,17 @@
type 'a tree = Leaf of 'a | Node of 'a tree list
let rec flatten t =
match t with
| Leaf x -> [x]
| Node ts -> List.concat (List.map flatten ts)
;;
let t = Node [
Leaf 1;
Node [Leaf 2; Leaf 3];
Node [Node [Leaf 4]; Leaf 5; Leaf 6];
Leaf 7
]
in
List.fold_left (+) 0 (flatten t)

View File

@@ -0,0 +1,38 @@
let h = 5
let w = 5
let grid = [|
[| 1; 1; 0; 1; 1 |];
[| 1; 0; 0; 0; 1 |];
[| 0; 0; 1; 0; 0 |];
[| 1; 1; 1; 1; 0 |];
[| 0; 0; 0; 1; 1 |]
|]
let rec flood visited r c =
if r < 0 || r >= h || c < 0 || c >= w then 0
else if visited.(r).(c) || grid.(r).(c) = 0 then 0
else begin
visited.(r).(c) <- true;
1 + flood visited (r - 1) c
+ flood visited (r + 1) c
+ flood visited r (c - 1)
+ flood visited r (c + 1)
end
let largest_component () =
let visited = Array.init h (fun _ -> Array.make w false) in
let best = ref 0 in
for r = 0 to h - 1 do
for c = 0 to w - 1 do
if grid.(r).(c) = 1 && not visited.(r).(c) then begin
let s = flood visited r c in
if s > !best then best := s
end
done
done;
!best
;;
largest_component ()

View File

@@ -0,0 +1,29 @@
let f x = (x * 2 + 5) mod 17
let floyd_cycle x0 =
let slow = ref x0 in
let fast = ref x0 in
let meet = ref false in
while not !meet do
slow := f !slow;
fast := f (f !fast);
if !slow = !fast then meet := true
done;
slow := x0;
let mu = ref 0 in
while !slow <> !fast do
slow := f !slow;
fast := f !fast;
mu := !mu + 1
done;
let lam = ref 1 in
fast := f !slow;
while !slow <> !fast do
fast := f !fast;
lam := !lam + 1
done;
!mu * 100 + !lam
;;
floyd_cycle 1

View File

@@ -0,0 +1,26 @@
let inf_int = 1000000
let floyd n graph =
let d = Array.init n (fun i ->
Array.init n (fun j -> graph.(i).(j))) in
for k = 0 to n - 1 do
for i = 0 to n - 1 do
for j = 0 to n - 1 do
if d.(i).(k) + d.(k).(j) < d.(i).(j) then
d.(i).(j) <- d.(i).(k) + d.(k).(j)
done
done
done;
d
;;
let n = 4 in
let g = Array.init n (fun _ -> Array.make n inf_int) in
for i = 0 to n - 1 do g.(i).(i) <- 0 done;
g.(0).(1) <- 5;
g.(0).(3) <- 10;
g.(1).(2) <- 3;
g.(2).(3) <- 1;
let d = floyd n g in
d.(0).(3)

View File

@@ -0,0 +1,20 @@
type frac = { num : int; den : int }
let rec gcd a b = if b = 0 then a else gcd b (a mod b)
let make n d =
let g = gcd (abs n) (abs d) in
if d < 0 then { num = -n / g; den = -d / g }
else { num = n / g; den = d / g }
let add x y =
make (x.num * y.den + y.num * x.den) (x.den * y.den)
let mul x y = make (x.num * y.num) (x.den * y.den)
;;
let r = add (make 1 2) (make 1 3) in
let s = mul (make 2 3) (make 3 4) in
let t = add r s in
t.num + t.den

View File

@@ -0,0 +1,18 @@
let count_chars s =
let t = Hashtbl.create 8 in
for i = 0 to String.length s - 1 do
let c = s.[i] in
let n = match Hashtbl.find_opt t c with
| Some v -> v + 1
| None -> 1
in
Hashtbl.replace t c n
done;
t
let max_count t =
Hashtbl.fold (fun _ v acc -> if v > acc then v else acc) t 0
;;
max_count (count_chars "abracadabra")

View File

@@ -0,0 +1,21 @@
let gas_circuit gas cost =
let n = Array.length gas in
let total = ref 0 in
let curr = ref 0 in
let start = ref 0 in
for i = 0 to n - 1 do
let diff = gas.(i) - cost.(i) in
total := !total + diff;
curr := !curr + diff;
if !curr < 0 then begin
start := i + 1;
curr := 0
end
done;
if !total < 0 then -1 else !start
;;
let gas = [| 1; 2; 3; 4; 5 |] in
let cost = [| 3; 4; 5; 1; 2 |] in
gas_circuit gas cost

View File

@@ -0,0 +1,6 @@
let rec gcd a b = if b = 0 then a else gcd b (a mod b)
let lcm a b = a * b / gcd a b
;;
gcd 36 48 + lcm 4 6 + lcm 12 18

View File

@@ -0,0 +1,12 @@
let gray n =
let m = 1 lsl n in
let result = Array.make m 0 in
for i = 0 to m - 1 do
result.(i) <- i lxor (i lsr 1)
done;
result
;;
let g = gray 4 in
Array.fold_left (+) 0 g + Array.length g

View File

@@ -0,0 +1,17 @@
let rec str_contains s sub i =
let nl = String.length s in
let sl = String.length sub in
if i + sl > nl then false
else if String.sub s i sl = sub then true
else str_contains s sub (i + 1)
let count_matching needle text =
let lines = String.split_on_char '\n' text in
List.fold_left (fun acc line ->
if str_contains line needle 0 then acc + 1
else acc
) 0 lines
;;
count_matching "fox" "the quick brown fox\nfox runs fast\nthe dog\nfoxes are clever"

View File

@@ -0,0 +1,17 @@
let count_paths m n =
let dp = Array.make ((m + 1) * (n + 1)) 0 in
dp.(0) <- 1;
for i = 0 to m do
for j = 0 to n do
if i > 0 || j > 0 then begin
let above = if i > 0 then dp.((i - 1) * (n + 1) + j) else 0 in
let left = if j > 0 then dp.(i * (n + 1) + j - 1) else 0 in
dp.(i * (n + 1) + j) <- above + left
end
done
done;
dp.(m * (n + 1) + n)
;;
count_paths 4 6

View File

@@ -0,0 +1,18 @@
let rec group xs =
match xs with
| [] -> []
| x :: rest ->
let rec collect cur acc tail =
match tail with
| [] -> (List.rev acc, [])
| y :: ys ->
if y = cur then collect cur (y :: acc) ys
else (List.rev acc, y :: ys)
in
let (g, tail) = collect x [x] rest in
g :: group tail
;;
let gs = group [1;1;2;2;2;3;1;1;4] in
List.length gs * 10 + List.length (List.nth gs 1)

View File

@@ -0,0 +1,13 @@
let collatz_length n =
let m = ref n in
let count = ref 0 in
while !m > 1 do
if !m mod 2 = 0 then m := !m / 2
else m := 3 * !m + 1;
count := !count + 1
done;
!count
;;
collatz_length 27

View File

@@ -0,0 +1,13 @@
let hamming s t =
if String.length s <> String.length t then -1
else begin
let d = ref 0 in
for i = 0 to String.length s - 1 do
if s.[i] <> t.[i] then d := !d + 1
done;
!d
end
;;
hamming "karolin" "kathrin" + hamming "1011101" "1001001" + hamming "abc" "abcd"

View File

@@ -0,0 +1,11 @@
let rec hanoi n from to_ via =
if n = 0 then 0
else
let a = hanoi (n - 1) from via to_ in
let b = 1 in
let c = hanoi (n - 1) via to_ from in
a + b + c
;;
hanoi 10 1 3 2

View File

@@ -0,0 +1,19 @@
let digit_sum n =
let m = ref n in
let s = ref 0 in
while !m > 0 do
s := !s + !m mod 10;
m := !m / 10
done;
!s
let count_harshad limit =
let c = ref 0 in
for n = 1 to limit do
if n mod (digit_sum n) = 0 then c := !c + 1
done;
!c
;;
count_harshad 100

View File

@@ -0,0 +1,21 @@
let hist xs =
let h = Hashtbl.create 8 in
List.iter (fun x ->
let n = match Hashtbl.find_opt h x with
| Some n -> n + 1
| None -> 1
in
Hashtbl.replace h x n
) xs;
h
let max_value h =
Hashtbl.fold (fun _ v acc -> if v > acc then v else acc) h 0
let total h =
Hashtbl.fold (fun _ v acc -> acc + v) h 0
;;
let h = hist [1;2;3;1;4;5;1;2;6;7;1;8;9;1;0] in
total h * max_value h

View File

@@ -0,0 +1,27 @@
let max_rect heights =
let n = Array.length heights in
let stack = ref [] in
let best = ref 0 in
for i = 0 to n do
let h = if i = n then 0 else heights.(i) in
let cont = ref true in
while !cont do
match !stack with
| top :: rest when heights.(top) > h ->
let height = heights.(top) in
stack := rest;
let width = match !stack with
| [] -> i
| t :: _ -> i - t - 1
in
let area = height * width in
if area > !best then best := area
| _ -> cont := false
done;
if i < n then stack := i :: !stack
done;
!best
;;
max_rect [| 2; 1; 5; 6; 2; 3 |]

View File

@@ -0,0 +1,19 @@
let rob houses =
let n = Array.length houses in
if n = 0 then 0
else if n = 1 then houses.(0)
else begin
let dp = Array.make n 0 in
dp.(0) <- houses.(0);
dp.(1) <- if houses.(0) > houses.(1) then houses.(0) else houses.(1);
for i = 2 to n - 1 do
let take = dp.(i - 2) + houses.(i) in
let skip = dp.(i - 1) in
dp.(i) <- if take > skip then take else skip
done;
dp.(n - 1)
end
;;
rob [| 2; 7; 9; 3; 1; 5; 8; 6 |]

View File

@@ -0,0 +1,38 @@
type tree = Leaf of int * char | Node of int * tree * tree
let weight = function
| Leaf (w, _) -> w
| Node (w, _, _) -> w
let rec insert t lst =
match lst with
| [] -> [t]
| h :: rest ->
if weight t <= weight h then t :: lst
else h :: insert t rest
let rec build_tree lst =
match lst with
| [] -> failwith "empty"
| [t] -> t
| a :: b :: rest ->
let merged = Node (weight a + weight b, a, b) in
build_tree (insert merged rest)
let rec depth d t =
match t with
| Leaf (w, _) -> w * d
| Node (_, l, r) -> depth (d + 1) l + depth (d + 1) r
;;
let initial = [
Leaf (5, 'a');
Leaf (9, 'b');
Leaf (12, 'c');
Leaf (13, 'd');
Leaf (16, 'e');
Leaf (45, 'f')
] in
let t = build_tree initial in
depth 0 t

View File

@@ -0,0 +1,14 @@
let isqrt n =
if n < 2 then n
else
let x = ref n in
let y = ref ((!x + 1) / 2) in
while !y < !x do
x := !y;
y := (!x + n / !x) / 2
done;
!x
;;
isqrt 144 + isqrt 200 + isqrt 1000000 + isqrt 2

View File

@@ -0,0 +1,16 @@
let count_overlaps intervals =
let arr = Array.of_list intervals in
let n = Array.length arr in
let count = ref 0 in
for i = 0 to n - 1 do
let (s1, e1) = arr.(i) in
for j = i + 1 to n - 1 do
let (s2, e2) = arr.(j) in
if s1 <= e2 && s2 <= e1 then count := !count + 1
done
done;
!count
;;
count_overlaps [(1, 4); (2, 5); (7, 9); (3, 6); (8, 10); (11, 12); (0, 2)]

View File

@@ -0,0 +1,21 @@
let is_prime n =
if n < 2 then false
else
let p = ref true in
let i = ref 2 in
while !i * !i <= n && !p do
if n mod !i = 0 then p := false;
i := !i + 1
done;
!p
let count_primes n =
let c = ref 0 in
for i = 2 to n do
if is_prime i then c := !c + 1
done;
!c
;;
count_primes 100

View File

@@ -0,0 +1,37 @@
let h = 6
let w = 7
let grid = [|
[| 1; 1; 0; 0; 0; 1; 1 |];
[| 1; 0; 0; 0; 1; 1; 0 |];
[| 0; 0; 1; 1; 0; 0; 0 |];
[| 0; 1; 1; 1; 0; 1; 1 |];
[| 1; 0; 0; 0; 0; 1; 0 |];
[| 1; 1; 0; 1; 1; 1; 0 |]
|]
let rec fill visited r c =
if r < 0 || r >= h || c < 0 || c >= w then ()
else if visited.(r).(c) || grid.(r).(c) = 0 then ()
else begin
visited.(r).(c) <- true;
fill visited (r - 1) c;
fill visited (r + 1) c;
fill visited r (c - 1);
fill visited r (c + 1)
end
let count_islands () =
let visited = Array.init h (fun _ -> Array.make w false) in
let count = ref 0 in
for r = 0 to h - 1 do
for c = 0 to w - 1 do
if grid.(r).(c) = 1 && not visited.(r).(c) then begin
count := !count + 1;
fill visited r c
end
done
done;
!count
;;
count_islands ()

Some files were not shown because too many files have changed in this diff Show More