open List
open Printf
open String
(* ----- TUPLES ----- *)
(** Returns the first component of a pair. *)
let fst (a, _) = a
(** Returns the second component of pair. *)
let snd (_, b) = b
(* ----- FOLDS AND TRAVERSALS ----- *)
(**
* Left-associative fold of a list.
* This function is not tail recursive.
*
* @param fn function to apply to each element of the list;
* fn is called with the accumulator and an element,
* and must return a new accumulator
* @param acc initial accumulator value
* @param lst list of elements to be fed to f
* @result final accumulator value created by applying f
* to each element of xs, from the left
* @see fold_left
*)
let foldl fn acc lst = fold_left fn acc lst
(**
* Right-associative fold of a list.
* This function is tail recursive.
*
* @param fn function to apply to each element of the list;
* fn is called with the accumulator and an element,
* and must return a new accumulator
* @param acc initial accumulator value
* @param lst list of elements to be fed to f
* @result final accumulator value created by applying f
* to each element of xs, from the right
* @see fold_right
*)
let foldr fn lst acc = fold_right fn lst acc
(**
* Maps each element of a list to a function, and combines the results.
* This function is not tail recursive.
*
* @param fn function to apply to each element of the list
* @param lst list of elements to be fed to f
* @result new list of the form [f l1; f l2; f l3; ...]
* @see map
*)
let map fn lst = List.map fn lst
(**
* Maps each element of a list to a function, and throws away the results.
* This function is not tail recursive.
*
* @param fn function to apply to each element of the list
* @param lst list of elements to be fed to f
* @see List.iter
*)
let map_ fn lst = List.iter fn lst
(**
* Returns the last element of a list, which must be non-empty.
* This function is tail-recursive.
*
* @param lst list to get the last element of
* @see first
*)
let rec last lst = match lst with
| x::[] -> x
| x::xs -> last xs
| _ -> failwith "last []"
(**
* Returns all elements excepting the last of a list,
* which must be non-empty.
* This function is not tail-recursive.
*
* @param lst list from which to extract the initial elements
* @see tail
*)
let rec init lst = match lst with
| x::[] -> []
| x::xs -> x::init xs
| _ -> failwith "init []"
(**
* Left-associative fold of a list, which must be non-empty.
* The first element of the list is used as the initial accumulator value.
* This function is not tail recursive.
*
* @param fn function to apply to each element of the list;
* fn is called with the accumulator and an element,
* and must return a new accumulator
* @param lst list of elements to be fed to f
* @see foldl
* @see fold_left
* @see foldr'
*)
let foldl' fn lst = match lst with
| x::xs -> fold_left fn x xs
| _ -> failwith "foldl' []"
(**
* Right-associative fold of a list, which must be non-empty.
* The last element of the list is used as the initial accumulator value.
* This function is tail recursive.
*
* @param fn function to apply to each element of the list, from the right;
* fn is called with the accumulator and an element,
* and must return a new accumulator
* @param lst list of elements to be fed to f
* @see foldr
* @see fold_right
* @see foldl'
*)
let foldr' fn lst = match lst with
| _::_ -> let acc = init lst
and lst' = last lst in
fold_right fn acc lst'
| _ -> failwith "foldr' []"
(* ----- LIST OPERATIONS ----- *)
(** Returns whether or not a list is empty. *)
let null lst = match lst with
| [] -> true
| _ -> false
(** Returns the length of a list. *)
let length = List.length
(** Returns the first element of a list, which must be non-empty. *)
let head lst = match lst with
| _::_ -> List.hd lst
| [] -> failwith "head []"
(** Returns the remaining elements of a list, which must be non-empty. *)
let tail lst = match lst with
| _::_ -> List.tl lst
| [] -> failwith "tail []"
(** Returns a copy of a list, with the elements in reverse order. *)
let reverse = List.rev
(** Appends two lists .*)
let (++) lst1 lst2 = append lst1 lst2
(**
* Equivalent to `(reverse lst1) ++ lst2`,
* but tail recursive and more efficient.
*
* @see reverse
* @see (++)
* @see append
*)
let reverse_append lst1 lst2 = List.rev_append lst1 lst2
(**
* Concatenates a list of lists.
*
* @param xss a list of lists of the form [[]; []; ...]
*)
let concat xss = List.concat xss
(**
* Returns a number of elements from the beginning of a list.
* This function is not tail-recursive.
*
* @param num number of items to take from the list
* @param lst list from which to take elements from the left of
* @see drop
*)
let rec take num lst =
if num <= 0 || (null lst)
then []
else head lst::take (num-1) (tail lst)
(**
* Drops a number of elements from the beginning of a list.
* This function is tail-recursive.
*
* @param num the number of elements to drop from the list
* @param lst list from which to drop elements
* @result a list that is the list lst with the first num elements removed
* @see @take
*)
let rec drop num lst =
if num <= 0
then lst
else drop (num-1) (tail lst)
(**
* Returns the biggest element of a list, which must be non-empty.
*
* @see minimum
*)
let maximum lst = match lst with
| _::_ -> foldl' (fun a b -> max a b) lst
| _ -> failwith "maximum []"
(**
* Returns the smallest element of a list, which must be non-empty.
*
* @see maximum
*)
let minimum lst = match lst with
| _::_ -> foldl' (fun a b -> min a b) lst
| _ -> failwith "minimum []"
(**
* Returns the sum of a list of integers, which must be non-empty.
*
* @see product
*)
let sum lst = match lst with
| _::_ -> foldl' (fun a b -> a+b) lst
| _ -> failwith "sum []"
(**
* Returns the product of a list of integers, which must be non-empty.
*
* @see sum
*)
let product lst = match lst with
| _::_ -> foldl' (fun a b -> a*b) lst
| _ -> failwith "product []"
(**
* Returns whether or not an element is in a list.
* This function is tail-recursive.
*
* @param x the element to search for
* @param lst the list in which to search for the element x
* @result true if x is found in the list lst, otherwise false
*)
let rec elem x lst = match lst with
| y::ys -> if x = y
then true
else elem x ys;
| [] -> false
(* ----- NUMERIC FUNCTIONS ----- *)
(** Returns the negative of an integer. *)
let negate n = (-n)
(** Returns whether or not an integer is even. *)
let even n = n mod 2 = 0
(** Returns whether or not an integer is odd. *)
let odd n = n mod 2 != 0
(** Returns the sign of an integer, either 1 or -1. *)
let signum n = if n >= 0 then 1 else (-1)
(**
* Returns the greatest common divisor of two integers.
* This function is tail-recursive.
*)
let gcd a b =
let rec gcd' a b = if b = 0
then a
else gcd' b (a mod b) in
gcd' (abs a) (abs b)
(** Returns the smallest positive integer that two integers divide by. *)
let lcm a b = match (a, b) with
| (_, 0) -> 0
| (0, _) -> 0
| (a, b) -> (abs a*b) / (gcd a b)
(* ----- STRING OPERATIONS ----- *)
(** Returns whether or not the string is empty. *)
let is_empty str = str = ""
(** Compares two strings, ignoring case. *)
let compare_ignore_case str1 str2 =
let lower1 = lowercase str1
and lower2 = lowercase str2 in
compare lower1 lower2
(**
* Returns whether or not two strings are equal, ignoring case.
*
* @see compare_ignore_case
*)
let equals_ignore_case str1 str2 = compare_ignore_case str1 str2 = 0
(**
* Returns whether or not one string begins with another.
*
* @param prefix prefix to be searched for in str
* @param str string to be tested if it begins with prefix
* @result true if str begins with prefix, otherwise false
* @see ends_with
*)
let begins_with prefix str =
let str_len = String.length str
and pref_len = String.length prefix in
if str_len < pref_len
then false
else String.sub str 0 pref_len = prefix
(**
* Returns whether or not one string ends with another.
*
* @param suffix suffix to be searched for in str
* @param str string to be tested if it ends with suffix
* @result true if str ends with suffix, otherwise false
* @see begins_with
*)
let ends_with suffix str =
let str_len = String.length str
and suff_len = String.length suffix in
let pos = str_len-suff_len in
if str_len < suff_len
then false
else String.sub str pos suff_len = suffix
(**
* Returns whether or not the string contains the substring.
* This function is tail-recursive.
*
* @param substr substring to search for in the string
* @param str string to be searched for the substring
* @result true if the string contains the substring, otherwise false
*)
let rec contains_substring substr str = match str with
| "" -> false
| _ -> if begins_with substr str
then true
else
let str_len = (String.length str)-1 in
let new_str = String.sub str 1 str_len in
contains_substring substr new_str
(**
* Returns the index within the string of the character ch.
* Throws Not_found if the character does not occur in the string.
*
* @param ch character to search for in the string
* @param str string to search for the character ch
* @result index of the first position where ch occurs in str
* @see index_of
* @see last_index_of_char
*)
let index_of_char ch str = index str ch
(**
* Returns the index within the string str of the string substr.
* Throws Not_found if the string does not occur in the string str.
* This function is tail-recursive.
*
* @param substr string to search for in the string str
* @param str string to search for the string substr
* @result index of the first position where substr occurs in str
* @see index_of_char
* @see last_index_of
*)
let index_of substr str =
if substr = ""
then 0
else
let ch = substr.[0] in
let rec fn from =
let i = index_from str from ch in
let sub_len = String.length substr in
let found = String.sub str i sub_len in
if found = substr
then i
else fn (i+1) in
fn 0
(**
* Returns the last index within the string of the character ch.
* Throws Not_found if the character does not occur in the string.
*
* @param ch character to search for in the string
* @param str string to search for the character ch
* @result index of the last position where ch occurs in the string
* @see index_of_char
* @see last_index_of
*)
let last_index_of_char ch str = rindex str ch
(**
* Returns the last index within the string str of the string substr.
* Throws Not_found if the string does not occur in the string str.
* This function is tail-recursive.
*
* @param substr string to search for in the string str
* @param str string to search for the string substr
* @result index of the last position where substr occurs in str
* @see index_of
* @see last_index_of_char
*)
let last_index_of substr str =
let last_index = String.length str - 1 in
if substr = ""
then last_index
else let sub_len = String.length substr
and ch = substr.[0] in
let rec fn from =
let i = rindex_from str from ch in
let found = String.sub str i sub_len in
if found = substr
then i
else fn (i-1) in
fn last_index
(**
* Replaces all occurances of a character within
* the string with a different character.
*
* @param old character to replace in the string
* @param nu character to replace the old character with
* @param str string in which to replace occurances of a character
* @return new string with all occurances of old replaced by nu
*)
let replace_char old nu str =
let fn ch = if ch = old
then nu
else ch in
String.map fn str
(**
* Splits the string str on sep and returns a list of the resulting strings.
* The separator string is not included in the returned list of strings.
* This function is tail-recursive.
*
* @param sep separator used to split the string
* @param str string that (possibly) contains one or more
* occurances of the separator
* @result list of strings that were separated by sep
*)
let split_on sep str =
let sep_len = String.length sep in
let rec fn acc str =
try let i = last_index_of sep str in
let pos = sep_len+i
and len = (String.length str)-sep_len-i in
let new_str = String.sub str 0 i
and substr = String.sub str pos len in
fn (substr::acc) new_str
with Not_found -> str::acc in
fn [] str
(**
* Joins the list of strings, interspersing the separator sep between them.
*
* @param sep separator to put between each pair of strings
* @param strs list of strings to be joined together, with the separator sep
* in between each pair
* @result string concatenation of the strings in strs, separated by sep
*)
let join_with sep strs = String.concat sep strs
(** Returns the string representation of a boolean value. *)
let string_of_boolean flag = match flag with
| true -> "true"
| _ -> "false"
(** Folds a list into a string. *)
let string_of_list fn lst =
fold_left fn "" lst |> sprintf "[%s]"
(** Returns the string representation of a list of integers. *)
let string_of_int_list lst =
let fn a n = if a = ""
then sprintf "%d" n
else sprintf "%s; %d" a n in
string_of_list fn lst
(** Returns the string representation of a list of strings. *)
let string_of_string_list lst =
let fn a x = if a = ""
then sprintf "\"%s\"" x
else sprintf "%s; \"%s\"" a x in
string_of_list fn lst
(** ----- MISCELLANEOUS FUNCTIONS ----- *)
(** Returns the identity of a value. *)
let id x = x
(**
* Extracts the second element of a list,
* which must have at least two elements.
*
* @param lst the list from which to extract the second element
* @return second element of list lst
*)
let second lst = match lst with
| _::x::xs -> x
| _ -> failwith "second"
(* ----- FUNCTION TESTS ----- *)
type boolean_test = { test : string; expect : bool; result : bool }
type int_test = { test : string; expect : int; result : int }
type string_test = { test : string; expect : string; result : string }
type int_list_test = { test : string; expect : int list; result : int list }
type string_list_test = { test : string; expect : string list; result : string list }
type test =
| BooleanTest of boolean_test
| IntTest of int_test
| StringTest of string_test
| IntListTest of int_list_test
| StringListTest of string_list_test
(** Prints the result of performing the test. *)
let print_test_result x =
let print_test test expect result =
let msg = test ^ " => " ^ result in
print_endline @@ if expect = result
then msg
else msg ^ " *** BUT EXPECTED "^ expect in
match x with
| BooleanTest x -> print_test x.test
(string_of_boolean x.expect)
(string_of_boolean x.result)
| IntTest x -> print_test x.test
(string_of_int x.expect)
(string_of_int x.result)
| StringTest x -> print_test x.test x.expect x.result
| IntListTest x -> print_test x.test
(string_of_int_list x.expect)
(string_of_int_list x.result)
| StringListTest x -> print_test x.test
(string_of_string_list x.expect)
(string_of_string_list x.result)
let () =
let p = ["alpha"; "bravo"; "charlie"; "delta"; "echo"]
and q = ["foxtrot"; "golf"; "hotel"; "igloo"; "juliet"]
and r = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
and n = 42 in
let t = (p, q) in
let tests = [
StringListTest { test = "fst t";
expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"];
result = fst t };
StringListTest { test = "snd t";
expect = ["foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
result = snd t };
BooleanTest { test = "even n"; expect = true; result = even n };
BooleanTest { test = "odd n"; expect = false; result = odd n };
IntTest { test = "signum n"; expect = 1; result = signum n };
IntTest { test = "negate n"; expect = (-42); result = negate n };
IntTest { test = "gcd 42 12"; expect = 6; result = gcd 42 12 };
IntTest { test = "lcm 42 12"; expect = 84; result = lcm 42 12 };
IntTest { test = "minimum r"; expect = 1; result = minimum r };
IntTest { test = "maximum r"; expect = 10; result = maximum r };
IntTest { test = "sum r"; expect = 55; result = sum r };
IntTest { test = "product r"; expect = 3628800; result = product r };
BooleanTest { test = "is_empty \"\"";
expect = true;
result = is_empty "" };
BooleanTest { test = "is_empty \"NOT!\"";
expect =false;
result = is_empty "NOT!" };
IntTest { test = "compare_ignore_case \"JESUS\" \"Jesus\"";
expect = 0;
result = compare_ignore_case "JESUS" "Jesus" };
(*
BooleanTest { test = "begins_with \"H\" \"Hello\"";
expect = true;
test = begins_with "H" "Hello" };
*)
BooleanTest { test = "ends_with '!' \"Hello!\"";
expect = true;
result = ends_with "!" "Hello, World!" };
BooleanTest { test = "contains_substring \"World\" \"Hello, World!\"";
expect = true;
result = contains_substring "World" "Hello, World!" };
BooleanTest { test = "contains_substring \"world\" \"Hello, World!\"";
expect = false;
result = contains_substring "world" "Hello, World!" };
IntTest { test = "index_of_char '!' \"Hello!, World!\"";
expect = 5;
result = index_of_char '!' "Hello!, World!" };
IntTest { test = "index_of \"World\" \"HelloW, World!\"";
expect = 8;
result = index_of "World" "HelloW, World!" };
IntTest { test = "last_index_of_char '!' \"Hello!, World!\"";
expect = 13;
result = last_index_of_char '!' "Hello!, World!" };
IntTest { test = "last_index_of \"o!\" \"Hello!, World!\"";
expect = 4;
result = last_index_of "o!" "Hello!, World!" };
StringTest { test = "replace_char 'l' 'x' \"Hello, World!\"";
expect = "Hexxo, Worxd!";
result = replace_char 'l' 'x' "Hello, World!" };
BooleanTest { test = "null p"; expect = false; result = null p };
IntTest { test = "length p"; expect = 5; result = length p };
BooleanTest { test = "elem 3 r"; expect = true; result = elem 3 r };
StringTest { test = "head q"; expect = "foxtrot"; result = head q };
StringTest { test = "second q"; expect = "golf"; result = second q };
StringListTest { test = "tail q";
expect = ["golf"; "hotel"; "igloo"; "juliet"];
result = tail q };
StringListTest { test = "init p";
expect = ["alpha"; "bravo"; "charlie"; "delta"];
result = init p };
StringTest { test = "last p"; expect = "echo"; result = last p };
IntListTest { test = "reverse r";
expect = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1];
result = reverse r };
StringListTest { test = "append p q";
expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
result = append p q };
StringListTest { test = "reverse_append p q";
expect = ["echo"; "delta"; "charlie"; "bravo"; "alpha"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
result = reverse_append p q };
StringListTest { test = "concat [p; q]";
expect = ["alpha"; "bravo"; "charlie"; "delta"; "echo"; "foxtrot"; "golf"; "hotel"; "igloo"; "juliet"];
result = concat [p; q] };
StringListTest { test = "take 2 p";
expect = ["alpha"; "bravo"];
result = take 2 p };
StringListTest { test = "drop 2 p";
expect = ["charlie"; "delta"; "echo"];
result = drop 2 p };
IntTest { test = "foldl (fun a n -> a-n) 0 r";
expect = -55;
result = foldl (fun a n -> a-n) 0 r };
IntTest { test = "foldr (fun n a -> n+a) r 0";
expect = 55;
result = foldr (fun n a -> n+a) r 0 };
IntTest { test = "foldl' (fun a n -> a-n) r";
expect = -53;
result = foldl' (fun a n -> a-n) r };
IntTest { test = "foldr' (fun a n -> a+n) r";
expect = 55;
result = foldr' (fun a n -> a+n) r };
IntListTest { test = "map String.length p";
expect = [5; 5; 7; 5; 4];
result = map String.length p };
StringListTest { test = "split_on \";\" \"aaa;bbb;;ccc\"";
expect = ["aaa"; "bbb"; ""; "ccc"];
result = split_on ";" "aaa;bbb;;ccc" };
StringTest { test = "join_with \", \" [\"aaa\"; \"bbb\"; \"ccc\"]";
expect = "aaa, bbb, ccc";
result = join_with ", " ["aaa"; "bbb"; "ccc"] } ] in
printf "p => %s\n" (string_of_string_list p);
printf "q => %s\n" (string_of_string_list q);
printf "r => %s\n" (string_of_int_list r);
printf "t => (%s, %s)\n" (string_of_string_list p) (string_of_string_list q);
print_endline "";
List.iter print_test_result tests;
print_endline ""
