Solved Problems

Output a string to the console

Write the string "Hello World!" to STDOUT
ocaml
print_string "Hello world!\n";;
print_endline "Hello world!";;
Printf.printf "Hello world!\n";;

Retrieve a string containing ampersands from the variables in a url

My PHP script first does a query to obtain customer info for a form. The form has first name and last name fields among others. The customer has put entries such as "Ron & Jean" in the first name field in the database. Then the edit form script is called with variables such as

"http://myserver.com/custinfo/edit.php?mode=view&fname=Ron & Jean&lname=Smith".

The script variable for first name $_REQUEST['firstname'] never gets beyond the "Ron" value because of the ampersand in the data.

I have tried various functions like urldecode but all to no avail. I even tried encoding the url before the view screen is painted so that the url looks like "http://myserver/custinfo/edit.php?mode=view&fname="Ronxxnbsp;xxamp;xxnbsp;Jean"&lname=SMITH". (sorry I had to add the xx to replace the ampersand or it didn't display meaningful url contents the browser sees.)

Of course this fails for the same reasons. What is a better approach?
ocaml
let query =
Netencoding.Url.mk_url_encoded_parameters [
"mode", "view";
"fname", "Ron & Jean";
"lname", "Smith";
]

let url =
"http://myserver.com/custinfo/edit.php?" ^ query

string-wrap

Wrap the string "The quick brown fox jumps over the lazy dog. " repeated ten times to a max width of 78 chars, starting each line with "> "

Expected output:
> The quick brown fox jumps over the lazy dog. The quick brown fox jumps over t
> he lazy dog. The quick brown fox jumps over the lazy dog. The quick brown fox
> jumps over the lazy dog. The quick brown fox jumps over the lazy dog. The qui
> ck brown fox jumps over the lazy dog. The quick brown fox jumps over the lazy
> dog. The quick brown fox jumps over the lazy dog. The quick brown fox jumps o
> ver the lazy dog. The quick brown fox jumps over the lazy dog.
ocaml
let wrapper margin =
let cur = ref 0 in
fun word ->
let len = String.length word in
let beginning_of_line () =
Printf.printf "> %s" word;
cur := len + 2 in
if !cur = 0 then
beginning_of_line ()
else begin
cur := !cur + 1 + len;
if !cur <= margin then
Printf.printf " %s" word
else begin
print_newline ();
beginning_of_line ()
end
end

let wrap_string wrapper s =
let len = String.length s in
let rec aux_out i =
if i < len then
match s.[i] with
| ' ' | '\t' | '\n' ->
aux_out (i+1)
| _ -> aux_in i (i+1)
and aux_in i0 i =
if i >= len then
wrapper (String.sub s i0 (len - i0))
else match s.[i] with
| ' ' | '\t' | '\n' ->
wrapper (String.sub s i0 (i - i0));
aux_out (i+1)
| _ ->
aux_in i0 (i+1) in
aux_out 0

let () =
let base_string = "The quick brown fox jumps over the lazy dog. " in
let w = wrapper 78 in
for i = 1 to 10 do
wrap_string w base_string
done;
print_newline ()

write a recursive c function to compute gcd(x,y).

ocaml
let rec gcd m n = if n = 0
then m
else gcd n (m mod n);;

binary search tree

i want to create a bst in ocaml with two functions
1.insert: which is use to add a number in a bst.
2. search: to search an element in bst.
please submit the code for that in ocaml
ocaml

Define a string containing special characters

Define the literal string "\#{'}${"}/"
ocaml
"\\#{'}${\"}/"

Define a multiline string

Define the string:
"This
Is
A
Multiline
String"
ocaml
"This\nIs\nA\nMultiline\nString"
"This
Is
A
Multiline
String"

Define a string containing variables and expressions

Given variables a=3 and b=4 output "3+4=7"
ocaml
Printf.printf "%d+%d=%d" a b (a+b);;
Printf.printf "%d+%d=%d" a b (a+b);;

Reverse the characters in a string

Given the string "reverse me", produce the string "em esrever"
ocaml
let reverse str =
let len = String.length str in
let res = String.create len in
for i = 0 to pred len do
let j = pred len - i in
res.[i] <- str.[j]
done;
(res)
let rev_char str =
let l = Str.split (Str.regexp "") str in
List.fold_left (fun a b -> b ^ a) "" l
;;

Reverse the words in a string

Given the string "This is a end, my only friend!", produce the string "friend! only my end, the is This"
ocaml
let rev_words str =
let l = Str.split (Str.regexp " ") str in
String.concat " " (List.rev l)
;;

Text wrapping

Wrap the string "The quick brown fox jumps over the lazy dog. " repeated ten times to a max width of 78 chars, starting each line with "> ", yielding this result:

> The quick brown fox jumps over the lazy dog. The quick brown fox jumps
> over the lazy dog. The quick brown fox jumps over the lazy dog. The
> quick brown fox jumps over the lazy dog. The quick brown fox jumps
> over the lazy dog. The quick brown fox jumps over the lazy dog. The
> quick brown fox jumps over the lazy dog. The quick brown fox jumps
> over the lazy dog. The quick brown fox jumps over the lazy dog. The
> quick brown fox jumps over the lazy dog.
ocaml
(* ocamlbuild -no-hygiene textwrap.native && ./textwrap.native *)

let wrap s prefix width =
let width = width - (String.length prefix) in
let len = String.length s in
let rec loop start =
if start >= len then
[]
else
let stop = min (len - start) width in
let sub = String.sub s start stop in
(prefix ^ sub) :: loop (start+stop)
in
loop 0
in

let wrap_and_print s prefix width =
List.iter print_endline (wrap s prefix width)
in
let s = ref "" in
for i = 1 to 10 do
s := !s ^ "The quick brown fox jumps over the lazy dog. "
done;
wrap_and_print !s "> " 78


Remove leading and trailing whitespace from a string

Given the string "  hello    " return the string "hello".
ocaml
let left_pos s len =
let rec aux i =
if i >= len then None
else match s.[i] with
| ' ' | '\n' | '\t' | '\r' -> aux (succ i)
| _ -> Some i
in
aux 0

let right_pos s len =
let rec aux i =
if i < 0 then None
else match s.[i] with
| ' ' | '\n' | '\t' | '\r' -> aux (pred i)
| _ -> Some i
in
aux (pred len)

let trim s =
let len = String.length s in
match left_pos s len, right_pos s len with
| Some i, Some j -> String.sub s i (j - i + 1)
| None, None -> ""
| _ -> assert false

let () =
let res = trim " hello " in
print_endline res
String.trim " hello "

Simple substitution cipher

Take a string and return the ROT13 and ROT47 (Check Wikipedia) version of the string.
For example:
String is: Hello World #123
ROT13 returns: Uryyb Jbeyq #123
ROT47 returns: w6==@ (@C=5 R`ab
ocaml
let rot_char13 c = match c with
| 'A'..'M' | 'a'..'m' -> Char.chr ((Char.code c) + 13)
| 'N'..'Z' | 'n'..'z' -> Char.chr ((Char.code c) - 13)
| _ -> c

let rot_char47 c = match c with
| '!'..'N' -> Char.chr ((Char.code c) + 47)
| 'O'..'~' -> Char.chr ((Char.code c) - 47)
| _ -> c

let rot f str =
let len = String.length str in
let res = String.create len in
for i = 0 to pred len do
res.[i] <- f str.[i]
done;
(res)

let rot13 = rot rot_char13
let rot47 = rot rot_char47

Make a string uppercase

Transform "Space Monkey" into "SPACE MONKEY"
ocaml
String.uppercase "Space Monkey";;

Make a string lowercase

Transform "Caps ARE overRated" into "caps are overrated"
ocaml
String.lowercase "Caps ARE overRated";;

Capitalise the first letter of each word

Transform "man OF stEEL" into "Man Of Steel"
ocaml
let capitalize_words str =
let len = String.length str in
let res = String.copy str in
let rec aux i do_up =
if i >= len then res else
match str.[i] with
| ' ' | '\n' | '\t' | '\r' -> aux (succ i) true
| _ ->
res.[i] <-
(if do_up then Char.uppercase else Char.lowercase) str.[i];
aux (succ i) false
in
aux 0 true

let () =
print_endline (capitalize_words "man OF stEEL")
let capitalize_words str =
let capitalize_word w =
String.capitalize (String.lowercase w) in
let l = Str.split (Str.regexp " ") str in
String.concat " " (List.map (capitalize_word) l)
;;


let () =
print_endline (capitalize_words "man OF stEEL");;

Find the distance between two points

ocaml
type point = { x:float; y:float };;
let distance a b = sqrt((a.x -. b.x)**2. +. (a.y -. b.y)**2.);;

Zero pad a number

Given the number 42, pad it to 8 characters like 00000042
ocaml
Printf.printf "%08d" 42;;
let s = Printf.sprintf "%08d" 42 in
print_string s;;

Right Space pad a number

Given the number 1024 right pad it to 6 characters "1024  "
ocaml
Printf.printf "%-6i" 1024;;

Format a decimal number

Format the number 7/8 as a decimal with 2 places: 0.88
ocaml
Printf.printf "%4.2f" (7. /. 8.);;
let s = Printf.sprintf "%4.2f" (7. /. 8.) in
print_string s;;

Left Space pad a number

Given the number 73 left pad it to 10 characters "        73"
ocaml
Printf.printf "%10d" 73;;

Generate a random integer in a given range

Produce a random integer between 100 and 200 inclusive
ocaml
Random.self_init ();;
let a = 100 and b = 200 in
Random.int ( b - a + 1 ) + a;;

Generate a repeatable random number sequence

Initialise a random number generator with a seed and generate five decimal values. Reset the seed and produce the same values.
ocaml
let random_stream seed =
Random.init seed;
let state = ref (Random.get_state ()) in
Stream.from
(fun x ->
Random.set_state !state;
let res = Random.float 1. in
state := Random.get_state ();
Some res);;

Stream.npeek 5 (random_stream 1);;
Stream.npeek 5 (random_stream 1);;

Check if a string matches a regular expression

Display "ok" if "Hello" matches /[A-Z][a-z]+/
ocaml
if Str.string_match (Str.regexp "[A-Z][a-z]+") "Hello" 0
then print_string "ok";;

Check if a string matches with groups

Display "two" if "one two three" matches /one (.*) three/
ocaml
#load "str.cma" ;;

let s = "one two three" in
if Str.string_match (Str.regexp "one \\(.*\\) three") s 0 then
print_string (Str.matched_group 1 s)

Check if a string contains a match to a regular expression

Display "ok" if "abc 123 @#$" matches /\d+/
ocaml
#load "str.cma" ;;

let re = Str.regexp "[0-9]+" in
try let _ = Str.search_forward re "abc 123 @#$" 0 in
print_string "ok"
with _ -> ()

Loop through a string matching a regex and performing an action for each match

Create a list [fish1,cow3,boat4] when matching "(fish):1 sausage (cow):3 tree (boat):4" with regex /\((\w+)\):(\d+)/
ocaml
let result =
let str = "(fish):1 sausage (cow):3 tree (boat):4" in
let ms = Pcre.exec_all ~pat:"\\((\\w+)\\):(\\d+)" str in
Array.to_list (
Array.map (fun m ->
let s = Pcre.get_substrings m in
Printf.sprintf "%s%s" s.(1) s.(2);
) ms
)

Replace the first regex match in a string with a static string

Transform "Red Green Blue" into "R*d Green Blue" by replacing /e/ with "*"
ocaml
let replaced = Str.replace_first (Str.regexp "e") "*" "Red Green Blue" in
print_endline replaced ;;

Replace all regex matches in a string with a static string

Transform "She sells sea shells" into "She X X shells" by replacing /se\w+/ with "X"
ocaml
let s = "She sells sea shells" in
Str.global_replace (Str.regexp "se[^ \\t\\n]*") "X" s

Replace all regex matches in a string with a dynamic string

Transform "The {Quick} Brown {Fox}" into "The kciuQ Brown xoF" by reversing words in braces using the regex /\{(\w+)\}/.
ocaml
let s = "The {Quick} Brown {Fox}" in
let r = Str.regexp "{\\([^ \\t\\n]*\\)}" in
Str.global_substitute r (fun m -> string_rev (Str.matched_group 1 m)) s

Define an empty list

Assign the variable "list" to a list with no elements
ocaml
let list = [];;

Define a static list

Define the list [One, Two, Three, Four, Five]
ocaml
let list = [ "One"; "Two"; "Three"; "Four"; "Five" ];;

Join the elements of a list, separated by commas

Given the list [Apple, Banana, Carrot] produce "Apple, Banana, Carrot"
ocaml
let () =
let lst = ["Apple"; "Banana"; "Carrot"] in
let str = String.concat ", " lst in
print_endline str

Join the elements of a list, in correct english

Create a function join that takes a List and produces a string containing an english language concatenation of the list. It should work with the following examples:
join([Apple, Banana, Carrot]) = "Apple, Banana, and Carrot"
join([One, Two]) = "One and Two"
join([Lonely]) = "Lonely"
join([]) = ""
ocaml
let join list =
let rec join' list acc =
match list with
| [] -> ""
| [single] -> single
| one::[two] ->
if acc = "" then one ^ " and " ^ two
else acc ^ one ^ ", and " ^ two
| first::others -> join' others (acc ^ first ^ ", ")
in
join' list ""

Produce the combinations from two lists

Given two lists, produce the list of tuples formed by taking the combinations from the individual lists. E.g. given the letters ["a", "b", "c"] and the numbers [4, 5], produce the list: [["a", 4], ["b", 4], ["c", 4], ["a", 5], ["b", 5], ["c", 5]]
ocaml
let combinations =
let l1 = ["a"; "b"; "c"]
and l2 = [4; 5] in
List.rev (
List.fold_left (fun acc y ->
List.fold_left (fun acc2 x ->
(x, y)::acc2
) acc l1
) [] l2
)

From a List Produce a List of Duplicate Entries

Taking a list:
["andrew", "bob", "chris", "bob"]

Write the code to produce a list of duplicates in the list:
["bob"]
ocaml
let rem v lst =
let rec aux acc = function
| [] -> List.rev acc
| x::xs ->
if compare v x = 0
then aux acc xs
else aux (x::acc) xs
in
aux [] lst

(** in case of a match, returns a list with the duplicate(s) removed *)
let rec mem_rem v lst =
let rec aux acc = function
| [] -> None
| x::xs ->
if compare v x = 0
then Some(List.rev_append acc (rem v xs))
else aux (x::acc) xs
in
aux [] lst

let duplicates lst =
let rec aux acc = function
| [] -> List.rev acc
| x::xs ->
match mem_rem x xs with
| Some ret -> aux (x::acc) ret
| None -> aux acc xs
in
aux [] lst

let () =
let lst = ["andrew"; "bob"; "chris"; "bob"; "mike"; "peter"; "bob"] in
let dup = duplicates lst in
List.iter print_endline dup
(* Using standard (functorized) sets *)

module SetTools(ASet: Set.S) =
struct
let find_duplicates l =
let rec aux l seen acc =
match l with
| [] -> acc
| h :: q ->
if ASet.mem h seen then
aux q seen (h :: acc)
else
aux q (ASet.add h seen) acc in
aux l (ASet.empty) []
end

module StringSet = Set.Make(String)

module StringSetTools = SetTools(StringSet)

StringSetTools.find_duplicates ["andrew"; "bob"; "chris"; "bob"];;

Fetch an element of a list by index

Given the list [One, Two, Three, Four, Five], fetch the third element ('Three')
ocaml
let third = List.nth [ "One"; "Two"; "Three"; "Four"; "Five" ] 3;;

Fetch the last element of a list

Given the list [Red, Green, Blue], access the last element ('Blue')
ocaml
let list = [ "Red"; "Green"; "Blue" ] in
let last = List.nth list ( (List.length list) - 1 );;
let list = [ "Red"; "Green"; "Blue" ] in
let last = List.hd (List.rev list);;
let list_last l =
let rec aux h q =
match q with
| [] -> h
| h :: q -> aux h q in
match l with
| [] -> invalid_arg "list_last"
| h :: q -> aux h q
;;
list_last ["Red"; "Green"; "Blue"]

Find the common items in two lists

Given two lists, find the common items. E.g. given beans = ['broad', 'mung', 'black', 'red', 'white'] and colors = ['black', 'red', 'blue', 'green'], what are the bean varieties that are also color names?
ocaml
let beans = ["broad"; "mung"; "black"; "red"; "white"]

let colors = ["black"; "red"; "blue"; "green"]

let f common c = if List.mem c beans then c::common else common

let common = List.fold_left f [] colors;;

(* common will contain a list with the common elements *)
(* using standard (functorized) sets *)

module SetTools(ASet: Set.S) =
struct
let of_list l =
List.fold_left (fun acc e -> ASet.add e acc) ASet.empty l

let find_common l1 l2 =
ASet.elements (ASet.inter (of_list l1) (of_list l2))
end

module StringSet = Set.Make(String)

module StringSetTools = SetTools(StringSet)
;;
let beans = ["broad"; "mung"; "black"; "red"; "white"] in
let colors = ["black"; "red"; "blue"; "green"] in
StringSetTools.find_common beans colors;;

Display the unique items in a list

Display the unique items in a list, e.g. given ages = [18, 16, 17, 18, 16, 19, 14, 17, 19, 18], display the unique elements, i.e. with duplicates removed.
ocaml
let ages = [18; 16; 17; 18; 16; 19; 14; 17; 19; 18]

let f res e = if List.mem e res then res else e::res

let unique = List.fold_left f [] ages;;
(* using standard (functorized) sets *)

module SetTools(ASet: Set.S) =
struct
let of_list l =
List.fold_left (fun acc e -> ASet.add e acc) ASet.empty l

let unique l =
ASet.elements (of_list l)
end

module Integer =
struct
type t = int
let compare (x:t) y = Pervasives.compare x y
end

module IntegerSet = Set.Make(Integer)
module IntegerSetTools = SetTools(IntegerSet)
;;
IntegerSetTools.unique [18; 16; 17; 18; 16; 19; 14; 17; 19; 18];;
let removeDuplicate list =
let rec aux acc = function
| [] -> acc
| h :: t -> if (List.mem h t) then aux acc t else aux (h::acc) t
in
List.rev (aux [] list);;

Remove an element from a list by index

Given the list [Apple, Banana, Carrot], remove the first element to produce the list [Banana, Carrot]
ocaml
let delete_at i al =
if i < 0 || i >= List.length al then
invalid_arg "delete_at"
else
let rec del i l =
match l with
| [] -> []
| h::t when i = 0 -> t
| h::t -> h :: del (i-1) t
in
del i al
;;
let rem_first l =
match l with
| [] -> []
| h::t -> t
;;
List.tl ["Apple"; "Banana"; "Carrot"]

Remove the last element of a list

ocaml
let remove_last list =
match (List.rev list) with
| h::t -> List.rev t
| [] -> []
let remove_last lst =
List.rev (List.tl (List.rev lst))
let list_remove_last l =
let rec aux h q acc =
match q with
| [] -> List.rev acc
| h2 :: q -> aux h2 q (h :: acc) in
match l with
| [] -> invalid_arg "list_remove_last"
| h :: q -> aux h q []

Rotate a list

Given a list ["apple", "orange", "grapes", "bananas"], rotate it by removing the first item and placing it on the end to yield ["orange", "grapes", "bananas", "apple"]
ocaml
let rotate list =
match list with
| head::tail -> tail@[head]
| [] -> []

Gather together corresponding elements from multiple lists

Given several lists, gather together the first element from every list, the second element from every list, and so on for all corresponding index values in the lists. E.g. for these three lists, first = ['Bruce', 'Tommy Lee', 'Bruce'], last = ['Willis', 'Jones', 'Lee'], years = [1955, 1946, 1940] the result should produce 3 actors. The middle actor should be Tommy Lee Jones.
ocaml
let rec combine3 f l y =
match f, l, y with
| [], [], [] -> []
| fh :: fq, lh :: lq, yh :: yq ->
(fh, lh, yh) :: combine3 fq lq yq
| _ -> invalid_arg "combine3"
;;
let first = ["Bruce"; "Tommy Lee"; "Bruce"] in
let last = ["Willis"; "Jones"; "Lee"] in
let years = [1955; 1946; 1940] in
combine3 first last years

List Combinations

Given two source lists (or sets), generate a list (or set) of all the pairs derived by combining elements from the individual lists (sets). E.g. given suites = ['H', 'D', 'C', 'S'] and faces = ['2', '3', '4', '5', '6', '7', '8', '9', '10', 'J', 'Q', 'K', 'A'], generate the deck of 52 cards, confirm the deck size and check it contains an expected card, say 'Ace of Hearts'.
ocaml
let suites = ["H"; "D"; "C"; "S"]
let faces = ["2";"3";"4";"5";"6";"7";"8";"9";"10";"J";"Q";"K";"A"]

let desk =
List.fold_left (fun acc y ->
List.fold_left (fun acc2 x ->
(x, y)::acc2
) acc faces
) [] suites

let () =
assert (List.length desk = 52);
if List.mem ("A", "H") desk
then print_endline "Ace of Hearts found!"
else print_endline "Ace of Hearts not found :("

Perform an operation on every item of a list

Perform an operation on every item of a list, e.g.
for the list ["ox", "cat", "deer", "whale"] calculate
the list of sizes of the strings, e.g. [2, 3, 4, 5]
ocaml
List.map String.length ["ox"; "cat"; "deer"; "whale"];;

Split a list of things into numbers and non-numbers

Given a list that might contain e.g. a string, an integer, a float and a date,
split the list into numbers and non-numbers.
ocaml
(* OCaml is a strongly statically typed language so it is not possible to mix
items of different types in a single list.
So here we use a list of strings, some of these strings represent a number *)

let is_a_number v =
try ignore(float_of_string v); true
with _ -> false

let numbers, others =
List.partition is_a_number ["Joe"; "3.14"; "8"; "hello"; "23/04/2009"]

(* ========================================================================== *)
(* If we really want to mix items of several types, we can declare a variant: *)

type item = Int of int | Float of float | String of string | Char of char

let is_a_number = function
| Float _ | Int _ -> true
| String _ | Char _ -> false

let numbers, others =
List.partition is_a_number [String "Joe"; Float 3.14; Int 8; Char 'Z']

Test if a condition holds for all items of a list

Given a list, test if a certain logical condition (i.e. predicate) holds for all items of the list.
ocaml
(* from the interactive loop *)
# List.for_all (fun x -> x > 1) [2; 3; 4] ;;
- : bool = true

Test if a condition holds for any items of a list

Given a list, test if a certain logical condition (i.e. predicate) holds for any items of the list.
ocaml
(* from the interactive loop: *)
# List.exists (fun x -> x > 3) [2; 3; 4] ;;
- : bool = true

Define an empty map

ocaml
module StringMap = Map.Make (String)
let m = StringMap.empty
let m = Hashtbl.create 42

Define an unmodifiable empty map

ocaml
(* OCaml maps are functional data structures (so are immutable) *)
module StringMap = Map.Make (String)
let m = StringMap.empty

Define an initial map

Define the map {circle:1, triangle:3, square:4}
ocaml
module StringMap = Map.Make (String)

let m0 = StringMap.empty

let m1 = StringMap.add "circle" 1 m0
let m2 = StringMap.add "triangle" 3 m1
let m3 = StringMap.add "square" 4 m2
let m = Hashtbl.create 42;;

Hashtbl.replace m "circle" 1;;
Hashtbl.replace m "triangle" 3;;
Hashtbl.replace m "square" 4;;

Check if a key exists in a map

Given a map pets {joe:cat,mary:turtle,bill:canary} print "ok" if an pet exists for "mary"
ocaml
module StringMap = Map.Make (String)

let map =
List.fold_left (fun map (key, value) ->
StringMap.add key value map
) StringMap.empty [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")]

let () =
if StringMap.mem "mary" map
then print_endline "OK"
let () =
let map = Hashtbl.create 42 in
List.iter (fun (key, value) ->
Hashtbl.add map key value
) [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")];

if Hashtbl.mem map "mary" then print_endline "OK"

Retrieve a value from a map

Given a map pets {joe:cat,mary:turtle,bill:canary} print the pet for "joe" ("cat")
ocaml
module StringMap = Map.Make (String)

let map =
List.fold_left (fun map (key, value) ->
StringMap.add key value map
) StringMap.empty [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")]

let () =
try
let pet = StringMap.find "joe" map in
Printf.printf "Joe's pet is a %s.\n" pet
with Not_found ->
prerr_endline "No pet found for Joe."
let () =
let map = Hashtbl.create 42 in
List.iter (fun (key, value) ->
Hashtbl.add map key value
) [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")];

try
let pet = Hashtbl.find map "joe" in
Printf.printf "Joe's pet is a %s.\n" pet
with Not_found ->
prerr_endline "No pet found for Joe."

Add an entry to a map

Given an empty pets map, add the mapping from "rob" to "dog"
ocaml
module StringMap = Map.Make (String)

let pets = StringMap.add "rob" "dog" StringMap.empty
let () =
let map = Hashtbl.create 42 in
Hashtbl.replace map "rob" "dog"

Remove an entry from a map

Given a map pets {joe:cat,mary:turtle,bill:canary} remove the mapping for "bill" and print "canary"
ocaml
module StringMap = Map.Make (String)

let pets =
List.fold_left (fun map (key, value) ->
StringMap.add key value map
) StringMap.empty [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")]

let get_and_rem key m =
try
let value = StringMap.find key m in
let rm = StringMap.remove key m in
Some (value, rm)
with Not_found ->
None

let () =
let key = "bill" in
match get_and_rem key pets with
| Some (found, new_pets) ->
Printf.printf "%s : %s removed\n" key found
| None ->
Printf.printf "Key %s not found" key
let get_and_rem m key =
try
let value = Hashtbl.find m key in
Hashtbl.remove m key;
Some value
with Not_found ->
None

let () =
let pets = Hashtbl.create 42 in
List.iter (fun (key, value) ->
Hashtbl.add pets key value
) [("joe", "cat"); ("mary", "turtle"); ("bill", "canary")];

let key = "bill" in
match get_and_rem pets key with
| Some found ->
Printf.printf "%s : %s removed\n" key found
| None ->
Printf.printf "Key %s not found" key

Create a histogram map from a list

Given the list [a,b,a,c,b,b], produce a map {a:2, b:3, c:1} which contains the count of each unique item in the list
ocaml
module StringMap = Map.Make (String)

let histogram lst =
List.fold_left (fun m v ->
let n =
if StringMap.mem v m
then succ (StringMap.find v m)
else 1
in
StringMap.add v n m
) StringMap.empty lst

let () =
let h = histogram ["a"; "b"; "a"; "c"; "b"; "b"] in
StringMap.iter (fun key value ->
Printf.printf " %s: %d\n" key value
) h

Categorise a list

Given the list [one, two, three, four, five] produce a map {3:[one, two], 4:[four, five], 5:[three]} which sorts elements into map entries based on their length
ocaml
let map =
List.fold_left (fun map v ->
let len = String.length v in
let before =
try IntMap.find len map
with Not_found -> [] in
IntMap.add len (v :: before) map
) IntMap.empty ["one"; "two"; "three"; "four"; "five"]

Perform an action if a condition is true (IF .. THEN)

Given a variable name, if the value is "Bob", display the string "Hello, Bob!". Perform no action if the name is not equal.
ocaml
if name = "Bob"
then print_string "Hello, Bob!"

Perform different actions depending on a boolean condition (IF .. THEN .. ELSE)

Given a variable age, if the value is greater than 42 display "You are old", otherwise display "You are young"
ocaml
if age > 42
then print_string "You are old"
else print_string "You are young"

Perform different actions depending on several boolean conditions (IF .. THEN .. ELSIF .. ELSE)

ocaml
if age > 84 then
print_endline "You are really ancient"
else if age > 30 then
print_endline "You are middle-aged"
else
print_endline "You are young"

Replacing a conditional with many branches with a switch/case statement

Many languages support more compact forms of branching than just if ... then ... else such as switch or case or match. Use such a form to add an appropriate placing suffix to the numbers 1..40, e.g. 1st, 2nd, 3rd, 4th, ..., 11th, 12th, ... 39th, 40th
ocaml
let numsuffix i =
match i with
| 11 | 12 | 13 -> "th"
| x when x mod 10 = 1 -> "st"
| x when x mod 10 = 2 -> "nd"
| x when x mod 10 = 3 -> "rd"
| _ -> "th"
;;
(* alternate implementation without using guards:
let numsuffix i =
match i with
| 11 | 12 | 13 -> "th"
| x -> match x mod 10 with
| 1 -> "st"
| 2 -> "nd"
| 3 -> "rd"
| _ -> "th"
*)

for i = 1 to 40 do
Printf.printf "%d%s " i (numsuffix i);
done;
print_newline ()

Perform an action multiple times based on a boolean condition, checked before the first action (WHILE .. DO)

Starting with a variable x=1, Print the sequence "1,2,4,8,16,32,64,128," by doubling x and checking that x is less than 150.
ocaml
let x = ref 1 ;;

while !x < 150 do
Printf.printf "%d," !x;
x := !x * 2;
done;

print_newline()

Perform an action multiple times based on a boolean condition, checked after the first action (DO .. WHILE)

Simulate rolling a die until you get a six. Produce random numbers, printing them until a six is rolled. An example output might be "4,2,1,2,6"
ocaml
let () =
Random.self_init ();
let rec loop () =
let n = (Random.int 6) + 1 in
print_int n;
if n <> 6 then (print_char ','; loop ())
else print_newline ()
in
loop ()

Perform an action a fixed number of times (FOR)

Display the string "Hello" five times like "HelloHelloHelloHelloHello"
ocaml
let rec write_hello = function
0 -> ()
| n ->
print_string "Hello" ;
write_hello (n-1)
;;
write_hello 5;;
let write_hello n =
for i = 1 to n do
print_string "Hello";
done

let () = write_hello 5

Perform an action a fixed number of times with a counter

Display the string "10 .. 9 .. 8 .. 7 .. 6 .. 5 .. 4 .. 3 .. 2 .. 1 .. Liftoff!"
ocaml
for i = 10 downto 1 do
Printf.printf "%d .. " i
done;
print_endline "Liftoff!"

Read the contents of a file into a string

ocaml
let read_file f =
let ic = open_in f in
let n = in_channel_length ic in
let s = String.create n in
really_input ic s 0 n;
close_in ic;
(s)

let file_contents = read_file "file.txt"

Process a file one line at a time

Open the source file to your solution and print each line in the file, prefixed by the line number, like:
1> First line of file
2> Second line of file
3> Third line of file
ocaml
let () =
let ic = open_in Sys.argv.(1) in
let i = ref 1 in
try
while true do
Printf.printf "%d> %s\n" !i (input_line ic);
incr i
done
with End_of_file ->
close_in ic
let input_line_opt ic =
try Some (input_line ic)
with End_of_file -> None

let () =
let ic = open_in Sys.argv.(1) in
let rec aux i =
match input_line_opt ic with
| Some line ->
Printf.printf "%d> %s\n" i line;
aux (succ i)
| None ->
close_in ic
in
aux 1

Write a string to a file

ocaml
try
let cout = open_out filename in
let co = Format.formatter_of_out_channel cout in
Format.fprintf co "%s\n" text_to_write;
close_out cout
with Sys_error _ as e ->
Format.printf "Cannot open file \"%s\": %s\n" filename (Printexc.to_string e)

Append to a file

ocaml
let () =
let oc =
open_out_gen
[Open_wronly; Open_creat; Open_append; Open_text] 0o666 "test.txt" in
output_string oc "This line appended to file!\n";
close_out oc

Process each file in a directory

ocaml
let process dir file =
if not (Sys.is_directory (Filename.concat dir file))
then print_endline file

let () =
let dir = "." in
let files = Sys.readdir dir in
Array.iter (process dir) files

Process each file in a directory recursively

ocaml
let rec recurse_dir dir f =
let filenames = Sys.readdir dir in
Array.iter (fun name ->
let fullname = Filename.concat dir name in
if Sys.is_directory fullname then
recurse_dir fullname f
else
f fullname
) filenames
;;
recurse_dir (Sys.getenv "HOME") print_endline ;;

Parse a date and time from a string

Given the string "2008-05-06 13:29", parse it as a date representing 6th March, 2008 1:29:00pm in the local time zone.
ocaml
let s = "2008-05-06 13:29" in
let r = Str.regexp "\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)-\\([0-9][0-9]\\) \\([0-9][0-9]\\):\\([0-9][0-9]\\)" in
assert (Str.string_match r s 0);
Unix.mktime { Unix.tm_sec = 0;
tm_min = int_of_string (Str.matched_group 5 s);
tm_hour = int_of_string (Str.matched_group 4 s);
tm_mday = int_of_string (Str.matched_group 3 s);
tm_mon = int_of_string (Str.matched_group 2 s) - 1;
tm_year = int_of_string (Str.matched_group 1 s) - 1900;
tm_wday = -1;
tm_yday = -1;
tm_isdst = true; (** Daylight time savings in effect *)
}

Display information about a date

Display the day of month, day of year, month name and day name of the day 8 days from now.
ocaml
let days = [| "Sunday"; "Monday"; "Tuesday"; "Wednesday"; "Thursday"; "Friday"; "Saturday" |]
let months = [| "January"; "February"; "March"; "April"; "May"; "June"; "July"; "August"; "September"; "October"; "November"; "December" |]

let current_time = Unix.time () in
let one_day = 86400. (* seconds *) in
let future_time = Unix.localtime (current_time +. 8. *. one_day) in
Printf.printf "day of month = %d, day of year = %d, month name = %s, day name = %s\n"
future_time.Unix.tm_mday
future_time.Unix.tm_yday
months.(future_time.Unix.tm_mon)
days.(future_time.Unix.tm_wday)

Display the current date and time

Create a Date object representing the current date and time. Print it out.
If you can also do this without creating a Date object you can show that too.
ocaml
Unix.localtime (Unix.gettimeofday ())
OOP

Define a class

Declare a class named Greeter that takes a string on creation and greets using this string if you call the "greet" method.
ocaml
class greeter message =
object
method greet = print_endline message
end

let o = new greeter "Hello" in
o#greet

Instantiate object with mutable state

Reimplement the Greeter class so that the 'whom' property or data member remains private but is mutable, and is provided with getter and setter methods. Invoke the setter to change the greetee, invoke 'greet', then use the getter in displaying the line, "I have just greeted {whom}.".

For example, if the greetee is changed to 'Tommy' using the setter, the 'greet' method would display:

Hello, Tommy!

The getter would then be used to display the line:

I have just greeted Tommy.
ocaml
class greeter =
object
val mutable whom = "someone"
method set_whom greetee = whom <- greetee
method get_whom = whom
method greet = Printf.printf "Hello, %s!\n" whom
end;;

let o = new greeter in
o#set_whom "Tommy";
o#greet;
Printf.printf "I have just greeted %s.\n" o#get_whom

Implement Inheritance Heirarchy

Implement a Shape abstract class which will form the base of an inheritance hierarchy that models 2D geometric shapes. It will have:

* A non-mutable 'name' property or data member set by derived or descendant classes at construction time
* A 'area' method intended to be overridden by derived or descendant classes ( double precision floating point return value)
* A 'print' method (also for overriding) will display the shape's name, area, and all shape-specific values

Two derived or descendant classes will be created:
* Circle    -> Constructor requires a '
radius' argument, and a 'circumference' method to be implemented  
* Rectangle -> Constructor requires '
length' and 'breadth' arguments, and a 'perimeter' method to be implemented 

Instantiate an object of each class, and invoke each objects '
print' method to show relevant details.
ocaml
class virtual shape =
object(self)
method name = "shape"
method virtual area : float
method print = Printf.sprintf "%s, area %f" self#name self#area
end ;;

let pi = 4. *. atan 1.

class circle radius =
object(self)
inherit shape as super
method name = "circle"
method area = radius *. radius *. pi
method circumference = radius *. 2. *. pi
method print = Printf.sprintf "%s, circumference %f" super#print self#circumference
end

class rectangle length breadth =
object(self)
inherit shape as super
method name = "rectangle"
method area = length *. breadth
method perimeter = 2. *. ( length +. breadth)
method print = Printf.sprintf "%s, perimeter %f" super#print self#perimeter
end

let c = new circle 5. in
let r = new rectangle 7. 3. in
print_endline c#print;
print_endline r#print

Implement and use an Interface

Create a Serializable interface consisting of 'save' and 'restore' methods, each of which:

* Accept a stream or handle or descriptor argument for the source or destination
* Save to destination or restore from source the properties or data members of the implementing class (restrict yourself to the primitive types 'int' and 'string')

Next, create a Person class which has 'name' and 'age' properties or data members and implements this interface. Instantiate a Person object, save it to a serial stream, and instantiate a new Person object by restoring it from the serial stream.
ocaml
(* in OCaml, interfaces are class types, and have nothing to do with inheritance,
so I'm not sure what's the correct answer to this problem (if any) *)

class type serializable =
object
method save: out_channel -> unit
method restore: in_channel -> unit
end

class person name age =
object
val mutable my_name = name
val mutable my_age = age
method save oc = output_value oc my_name; output_value oc my_age
method restore ic = my_name <- input_value ic; my_age <- input_value ic
method print = Printf.printf "I'm %s, %d\n" my_name my_age
end

let transfer (o1: serializable) (o2: serializable) =
let temp_filename = "_person" in
let backing_store_save = open_out_bin temp_filename in
o1#save backing_store_save;
close_out backing_store_save;

let backing_store_restore = open_in_bin temp_filename in
o2#restore backing_store_restore;
close_in backing_store_restore


let o = new person "john" 42 in
let o2 = new person "nobody" 0 in
transfer (o :> serializable) (o2 :> serializable);
o2#print

Send an email

Use library functions, classes or objects to create a short email addressed to your own email address. The subject should be, "Greetings from langref.org", and the user should be prompted for the message body, and whether to cancel or proceed with sending the email.
ocaml
(* Using the library smtp-mail-0.1.3:
http://www.linux-nantes.org/%7Efmonnier/OCaml/smtp-mail/ *)

let () =
let h = Smtp.connect "smtp.example.com" in
Smtp.helo h "hostname";
Smtp.mail h "<john.smith@example.com>";
Smtp.rcpt h "<jane.smith@example.com>";
let email_header = "\
From: John Smith <john.smith@example.com>\r\n\
To: Jane Smith <jane.smith@example.com>\r\n\
Subject: Greetings from langref.org" in
let email_msg = "Hi,\n\nHow are you?" in
Smtp.data h (email_header ^ "\r\n\r\n" ^ email_msg);
Smtp.quit h;
;;
XML

Process an XML document

Given the XML Document:

<shopping>
  <item name="bread" quantity="3" price="2.50"/>
  <item name="milk" quantity="2" price="3.50"/>
</shopping>

Print out the total cost of the items, e.g. $14.50
ocaml
let () =
let xml = Xml.parse_file "shopping.xml" in
let res =
Xml.fold (fun total xml ->
match xml with
| Xml.Element ("item", attrs, _) ->
let quantity = float_of_string (List.assoc "quantity" attrs)
and price = float_of_string (List.assoc "price" attrs) in
total +. (quantity *. price)
| _ -> total
) 0.0 xml
in
Printf.printf "Total cost of the items: %g\n" res

create some XML programmatically

Given the following CSV:

bread,3,2.50
milk,2,3.50

Produce the equivalent information in XML, e.g.:

<shopping>
  <item name="bread" quantity="3" price="2.50" />
  <item name="milk" quantity="2" price="3.50" />
</shopping>
ocaml
(* Compilation (native):
$ ocamlopt -I +csv csv.cmxa -I +xml-light xml-light.cmxa csv2xml.ml -o csv2xml
*)

let () =
let table = Csv.load "shopping.csv" in
let columns = ["name"; "quantity"; "price"] in

let xml = Xml.Element ("shopping", [],
List.rev (
List.fold_left (fun acc row ->
Xml.Element ("item",
List.combine columns row, []) :: acc) [] table)) in

print_endline (Xml.to_string_fmt xml)

Find all Pythagorean triangles with length or height less than or equal to 20

Pythagorean triangles are right angle triangles whose sides comply with the following equation:

a * a + b * b = c * c

where c represents the length of the hypotenuse, and a and b represent the lengths of the other two sides. Find all such triangles where a, b and c are non-zero integers with a and b less than or equal to 20. Sort your results by the size of the hypotenuse. The expected answer is:

[3, 4, 5]
[6, 8, 10]
[5, 12, 13]
[9, 12, 15]
[8, 15, 17]
[12, 16, 20]
[15, 20, 25]
ocaml
let is_int v =
v = (snd (modf v))

let sort_by_third tup =
let third (_,_,v) = v in
let cmp a b = compare (third a) (third b) in
List.sort cmp tup

let hypi ia ib =
let hyp a b = sqrt(a**2.0 +. b**2.0) in
hyp (float_of_int ia) (float_of_int ib)

let find_pythag max =
let rec py t = match t with
| (a,_) when a > max -> []
| (a,b) when b > max -> py (a+1,a+1)
| (a,b) ->
let next = (a,b+1) in
let cf = hypi a b in
if (is_int cf) then
( a,b,(int_of_float cf) ) :: (py next)
else
py next
in
sort_by_third ( py (1,1) )

Greatest Common Divisor

Find the largest positive integer that divides two given numbers without a remainder. For example, the GCD of 8 and 12 is 4.

ocaml
(* tail recursive *)
let rec gcd n m =
if m = 0 then
n
else if n > m then
gcd (n-m) m
else
gcd n (m-n)
;;
Fun

produces a copy of its own source code

In computing, a quine is a computer program which produces a copy of its own source code as its only output.
ocaml
(fun s -> Printf.printf "%s %S" s s) "(fun s -> Printf.printf \"%s %S\" s s)"
(fun p -> Printf.printf p (string_of_format p)) "(fun p -> Printf.printf p (string_of_format p)) %S"

Create a multithreaded "Hello World"

Create a program which outputs the string "Hello World" to the console, multiple times, using separate threads or processes.

Example:

-Output-

Thread one says Hello World!
Thread two says Hello World!
Thread four says Hello World!
Thread three says Hello World!

-Notice that the threads can print in any order.
ocaml

(* Compilation (native):
$ ocamlopt -thread unix.cmxa threads.cmxa threads_hello.ml -o threads_hello
*)

let say_hello (i, msg) =
Printf.printf "Thread %d says %s\n" i msg
;;
let thread_ids = Array.init 4 (fun i ->
Thread.create say_hello (i, "Hello World!")) in
Array.iter Thread.join thread_ids;
flush_all ()

Create read/write lock on a shared resource.

Create multiple threads or processes who are either readers or writers. There should be more readers then writers.

(From Wikipedia):

Multiple readers can read the data in parallel but an exclusive lock is needed while writing the data. When a writer is writing the data, readers will be blocked until the writer is finished writing.

Example:

-Output-

Thread one says that the value is 8.
Thread three says that the value is 8.
Thread two is taking the lock.
Thread four tried to read the value, but could not.
Thread five tried to write to the value, but could not.
Thread two is changing the value to 9.
Thread two is releasing the lock.
Thread four says that the value is 9.
...

--Notice that when a needed resource is locked, a thread can set a timer and try again in the future, or wait to be notified that the resource is no longer locked.
ocaml

(* Compilation (native):
$ ocamlopt -thread unix.cmxa threads.cmxa threads_lock.ml -o threads_lock
*)

let value = ref 8
let mutex = Mutex.create ()

let create_writer i =
if not (Mutex.try_lock mutex) then begin
Printf.printf "Thread %d tried to write the value but could not.\n" i;
Mutex.lock mutex
end;
value := Random.int 10;
Printf.printf "Thread %d is changing the value to %d\n" i !value;
Mutex.unlock mutex;
Printf.printf "Thread %d is releasing the lock.\n" i

let create_reader i =
if not (Mutex.try_lock mutex) then begin
Printf.printf "Thread %d tried to read the value but could not.\n" i;
Mutex.lock mutex
end;
Printf.printf "Thread %d says that the value is %d\n" i !value;
Mutex.unlock mutex
;;

let thread_ids = Array.init 20 (fun i ->
Thread.create (if i mod 3 == 0 then create_writer else create_reader) i) in
Array.iter Thread.join thread_ids

Separate user interaction and computation.

Allow your program to accept user interaction while conducting a long running computation.

Example:

Hello user! Please input a string to permute: (input thread)
abcdef
Passing on abcdef... (input thread)
Please input another string to permute: (input thread)
lol
Passing on lol... (input thread)
Done Work On abcdef! (worker thread)
["abcdef", "abcefd", ... ] (worker thread)
Please input another string to permute: (input thread)
EXIT
Quitting, I'll let my worker thread know... (input thread)
We'
re quitting! Alright! (worker thread)

--Notice, that this could be accomplished on the command line or within a GUI. The point is that computation and user interaction should take place on separate threads of control.
ocaml
(* Compile (native):
$ ocamlopt -thread unix.cmxa threads.cmxa async_interface.ml -o async_interface
*)

module Mailbox =
struct

type 'a t = {
lock: Mutex.t;
notempty_condition: Condition.t;
queue: 'a Queue.t;
}

let create () = {
lock = Mutex.create ();
notempty_condition = Condition.create ();
queue = Queue.create ();
}

let add mb v =
Mutex.lock mb.lock;
Queue.add v mb.queue;
Condition.signal mb.notempty_condition;
Mutex.unlock mb.lock

let take mb =
Mutex.lock mb.lock;
while Queue.is_empty mb.queue do
Printf.printf "(waiting)\n%!";
Condition.wait mb.notempty_condition mb.lock
done;
let v = Queue.take mb.queue in
Mutex.unlock mb.lock;
v
end

type 'a orders =
Process of 'a
| Terminate

let permute_string s buf =
let len = String.length s in
let sep = ref "" in
let rec aux i =
if i = 0 then begin
Buffer.add_string buf !sep;
Buffer.add_char buf '"';
Buffer.add_string buf s;
Buffer.add_char buf '"';
sep := ","
end
else
let c = s.[i] in
for j = 0 to i - 1 do
s.[i] <- s.[j];
s.[j] <- c;
aux (i - 1);
s.[j] <- s.[i]
done;
s.[i] <- c;
aux (i - 1)
in
if len > 0 then
aux (len - 1)

let rec slave_loop mailbox =
match Mailbox.take mailbox with
| Process s ->
Printf.printf "Working on %s...%!" s;
let len = String.length s in
let fact n =
let rec aux i acc =
if i < 2 then acc
else aux (i - 1) (acc * i) in
aux n 1 in
(* Buffers reallocate as needed, but since we know the size beforehand... *)
let expected_output_size = (len + 3) * (fact len) + 2 in
let buf = Buffer.create expected_output_size in
Buffer.add_char buf '[';
permute_string s buf;
Buffer.add_string buf "]\n";
Printf.printf " Done Work On %s!\n" s;
Buffer.output_buffer stdout buf;
flush stdout;
slave_loop mailbox
| Terminate ->
Printf.printf "%s\n%!" "We're quitting! Alright!"


let rec master_loop mailbox article =
Printf.printf "Please input %s string to permute: %!" article;
let exit_string = "EXIT" in
let s =
try
read_line ()
with End_of_file -> exit_string in
if s = exit_string then begin
Printf.printf "%s\n%!" "Quitting, I'll let my worker thread know";
Mailbox.add mailbox Terminate
end
else begin
Printf.printf "Passing on %s...\n%!" s;
Mailbox.add mailbox (Process s);
master_loop mailbox "another"
end

let () =
let mailbox = Mailbox.create () in
let slave_thread_id = Thread.create slave_loop mailbox in

print_string "Hello user! ";
master_loop mailbox "a";

Thread.join slave_thread_id