Fold

Investigating the fold function and its variants in Ocaml. Usual tutorials on fold start with the fold_right function i.e.

let rec fold_right f a lst = match lst with
  | [] -> a
  | x :: xs -> f x (fold_right f a xs);;

e.g. fold_right f 0 [1;2;3] = f 1 (f 2 (f 3 0))

This is equivalent to the reduce function in the paper ["Why Functional Programming Matters"].

The other fold function is fold_left:

let rec fold_left f a lst = match lst with
  | [] -> a
  | x :: xs -> fold_left f (f a x) xs

e.g. fold_left f 0 [1;2;3] = f (f (f (0 1) 2) 3

foldleft is sometimes more efficient than foldright, e.g. for reversing a list. foldleft can be defined in terms of foldright but not vice-versa, since foldleft is strict in the tail of the list argument but foldright is not (i.e. fold_left acting on bottom gives bottom).

Below is Ocaml code implementing a range of functions that use one of the fold higher order functions.
See the appendix of "Introduction to Functional Programming using Haskell" by Richard Bird for some other standard functions.

(* Define the foldr function, equivalent to the List.fold_right function
   except for the order of the arguments *)
let rec foldr f a lst = match lst with 
  | [] -> a
  | x::xs -> f x (foldr f a xs);;

(* Define the foldl function, equivalent to List.fold_left function *)
let rec foldl f a lst = match lst with
  | [] -> a
  | x::xs -> foldl f (f a x) xs;;

(* Define an exception for attempting to operate on an empty list  *)
exception Empty_list;;

(* Fold right using the first element of the list as the accumulator *)
let foldr1 f lst = match lst with 
  | [] -> raise Empty_list
  | x::xs -> foldr f x xs;;

(* Fold left using the first element of the list as the accumulator *)
let foldl1 f lst = match lst with 
  | [] -> raise Empty_list
  | x::xs -> foldl f x xs;;

(* Define the identity function *)
let id x = x;;

(* Define map in terms of foldr *)
let map f= foldr (fun x lst-> (f x)::lst) [];;

(* Define the compose function acting on two functions *)
let compose f g x = f(g x);;

(* Define the compose function acting on a list of functions*)
let composelst = foldr compose id;; 

(* Define a length function for a list, in terms of foldl since
   it is more efficient (tail-recursive) *)
let len = foldl (fun x lst -> x+1) 0;;

(* Define a list reversal function *)
let rev = foldl (fun lst x -> x::lst) [];;

(* Sum the elements in an integer list *)
let sum = foldl (fun acc x -> acc + x) 0;;

(* Multiply all elements of an integer list together *)
let prod = foldl (fun acc x -> acc * x) 1;;

(* Return the maximum element of a list *)
let max = foldl1 (fun x y -> if x>y then x else y);;

(* Return the minimum element of a list *)
let min = foldl1 (fun x y -> if x<y then x else y);;

(* Filter out values satisfying a predicate p *)
let filter p = foldr (fun x acc -> if p x then x::acc else acc) [];;

(* Position of elements in a list *)
let position p alst = rev(snd(
                       foldl (fun (ind,lst) x-> if p x then (ind+1,ind::lst)
                                 else (ind+1,lst)) (1,[]) alst));;

(* Position of elements matching the argument *)
let pos e lst = position (fun x->x=e) lst;;

(* Partition the list into two lists depending on a predicate *)
let partition p = foldr (fun x (tlst,flst)->
                   if p x then (x::tlst,flst) else (tlst,x::flst))
           ([],[]);;

(* Take the initial segment of a list while predicate is satisfied *)
let rec takeWhile p lst = match lst with 
  | [] -> []
  | x::xs -> if p x then x :: (takeWhile p xs) else [];;

(* Concatenate a list of lists together *)
let concat = foldr ( @ ) [];;

(* Zip two lists (possibly unequal lengths) into a tuple *)
let rec zip lst1 lst2 = match lst1,lst2 with
  | [],_ -> []
  | _, []-> []
  | (x::xs),(y::ys) -> (x,y) :: (zip xs ys);;

(* Unzip a list of tuples to two lists *)
let rec unzip tuplst = foldr (fun (x,y) (flst,slst)->(x::flst,y::slst))
                             ([],[]) tuplst;;

(* Wrap a value into a singleton list *)
let wrap x = [x];;

(* Get the nth element of a list, raise Not_found if list is 
   too short (indexing starts from 1) *)
exception Not_found;;

let rec nth n lst = match n,lst with 
  | _,[] -> raise Not_found 
  | 1, (x :: xs)-> x
  | k, (x :: xs)-> nth (n-1) xs;;

(* Return the last element of the list *)
let last lst = let lastind = len lst in nth lastind lst;;


(* ************ Polynomials represented as lists [a0;a1;a2;...] ************ *)
(* Evaluate poly at x: an*x**n + ... + a1*x + a0
    = a0 + x(a1 + x*(a2 + x*(a3+....))) *)
let evalpoly lst x = foldr (fun acc coeff-> acc+. x*. coeff) 0. lst;; 

(* Sum two polynomials together *)
let rec sumpoly p1 p2 = match p1,p2 with
  | [],[] -> []
  | [],(y::ys as lst) -> lst
  | (x::xs as lst),[] -> lst
  | (x::xs, y::ys)-> (x+.y)::(sumpoly xs ys);;
(* ******** End Polynomials represented as lists [a0;a1;a2;...] ************ *)

(* ******************* Test values ***************************** *)
Random.init 25632;;
let tstilst=[1;2;3];;       (* Test integer list *)
let tstflst = [1.;2.;3.];;  (* Test float list *)
let tstrnd=map (fun x->Random.int 100) [0;0;0;0;0;0;0;0;0];; (* Random int list *)
partition (fun x->x mod 2=0) tstrnd;;
max tstrnd;;
min tstrnd;;

(* Some test functions on integers *)
let sq x = x*x;;
let cube x= x*x*x;;
let sextuple = composelst [sq;cube];; (* Compose the square and cube functions *)

(* Test some of the functions defined above on an integer list *)
map sextuple tstilst;;
rev tstilst;;
len tstilst;;
sum tstilst;;
prod tstilst;;

(* Test the polynomial functions *)
map (evalpoly [0.;0.;1.]) tstflst;; (* i.e. x^2 *)
sumpoly [1.;2.;3.;4.] [3.;6.;2.];;