sorts.ml

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

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

(*  TODO: implement monoids and the foldable typeclass with modules*)

let id = fun x -> x

let sum = fold_left (+) 0

let fold_left1 f xs =
  match xs with
  | [] -> raise (Failure "empty list")
  | x::xs -> List.fold_left f x xs

let lst = [12; 34; 6; 7; 34444; 90; 78; 3748475; 898; 09; 89;]


(* Sorts *)

(* Insertion Sort *)
let insertionSort xs =
  let rec insert i xs = match xs with
    | [] -> [i]
    | x::xs -> if i <= x then i :: (x::xs) else x :: insert i xs
  in let rec go ss us = match us with
       | [] -> ss
       | u::us -> go (insert u ss) us
  in go [] xs

(*  with fold *)
let insertionSort xs =
  let rec insert i xs = match xs with
    | [] -> [i]
    | x::xs -> if i <= x then i :: (x::xs) else x :: insert i xs
  in List.fold_right insert xs []

(* Selection Sort *)
let rec selectionSort xs =
  let findMin = fold_left1 min
  and removeMin m = List.filter ((!=) m)
  in match xs with
     | [] | [_] -> xs
     | _ -> let m = findMin xs in
            m :: selectionSort (removeMin m xs)

(* Bubble Sort *)
let rec sorted x = match x with
  | [] | [_] -> true
  | x::y::zs -> if x <= y then sorted (y::zs) else false

(* With fold *)
let sorted xs = match xs with
  | [] -> true
  | x::_ -> fst (List.fold_left (fun (b,p) x -> (b && x >= p, x)) (true, x) xs)

let rec bubbleSort xs =
  if sorted xs then xs else
    let go1 = match xs with
        | [] | [_] -> xs
        | x::y::zs -> if x <= y 
                      then x :: bubbleSort (y::zs)
                      else y :: bubbleSort (x::zs)
    in bubbleSort go1

(* Merge Sort *)
let rec merge xs ys = match (xs, ys) with
  | (xs,[]) -> xs
  | ([],ys) -> ys
  | (x::xs, y::ys) -> if x <= y
                      then x :: merge xs (y::ys)
                      else y :: merge (x::xs) ys

let rec split xs = match xs with
  | x::y::zs -> let (ls,rs) = split zs in
                (x::ls, y::rs)
  | _ -> (xs, [])

let rec mergeSort xs =
  match xs with
  | [] | [_] -> xs
  | _ -> let (ls,rs) = split xs in
     merge (mergeSort ls) (mergeSort rs)

(* Quicksort *)
let rec quicksort xs =
  match xs with
  | [] | [_] -> xs
  | x::xs -> let (lt,gt) = List.partition ((>=) x) xs in
             quicksort lt @ x :: quicksort gt