Dsolve Demo

Pick a demo

Options

No Recrefs
Hide Rectypes

Logical Qualifiers

Specification

Ocaml Program

(* DSOLVE -no-recrefs -hide-rectypes *)

(**********************************************************************)
(* Some Generic Helper Functions **************************************)
(**********************************************************************)

let (|>) = fun x f -> f x

let show = fun x -> ()

let rec len = function
  | x::xs -> 1 + len xs 
  | []    -> 0

(**********************************************************************)
(* STEP 1: MAP (map each input into key-value pair)    ****************)
(**********************************************************************)

let rec map f xs = 
  match xs with
  | []      -> []
  | x::xs'  -> f x :: map f xs'

(**********************************************************************)
(* STEP 2: GROUP (cluster key-value pairs by key) *********************)
(**********************************************************************)

let group kvs = 
  let t = Hashtbl.create 37 in
  List.iter begin fun (k,v) -> 
    let vs    = if Hashtbl.mem t k then Hashtbl.find t k else [] in
    Hashtbl.add t k (v::vs)
  end kvs;
  t

(**********************************************************************)
(* STEP 3: REDUCE (fold over values associated with each key **********)
(**********************************************************************)

let reduce f t = 
  Hashtbl.fold begin fun k vs acc ->
    match vs with
    | v::vs' -> (k, List.fold_left f v vs')::acc
    | []     -> assert (0=1); assert false      (* NON-NULL *)
  end t []

(**********************************************************************)
(* CLIENT: K-MEANS via Map-Reduce ***********************************)
(**********************************************************************)

let rec ffor i j f = 
  if i < j then (
    f i; 
    ffor (i+1) j f
  )

let min_index a =
  let min = ref 0 in
  ffor 0 (Array.length a) (fun i ->
    if a.(i) < a.(!min) then            (* ARRAY BOUNDS *)
      min := i
  );
  !min

let nearest dist ctra x  =
  let da = Array.map (dist x) ctra in
  (min_index da, (x, 1))

let centroid plus p1 p2 = 
  let (x1, size1) = p1 in
  let (x2, size2) = p2 in 
  (plus x1 x2, size1 + size2)

let update_centers div a ixs =
  List.iter (fun (i, (x, size)) -> a.(i) <- div x size) ixs
            (* ARRAY BOUNDS, DIV BY ZERO *)

let kmeans n dist plus div (points : 'a list) (centera : 'a array) =
  assert (Array.length centera > 0); 
  ffor 0 n begin fun _ ->
    let point_centers   = map      (nearest dist centera) points      in
    let center_clusters = group    point_centers                      in 
    let new_centers     = reduce   (centroid plus) center_clusters    in
    update_centers div centera new_centers
  end