Source

papl / src / PaplMetric.ml

(*
  Copyright (c) 2012 Anders Lau Olsen.
  See LICENSE file for terms and conditions.
*)

type 'a pair_t = 'a * 'a

type 'a t = 'a -> 'a -> float

type 'a norm_t = 'a -> float

type 'a option_t = 'a -> 'a -> float option

type 'a norm_option_t = 'a -> float option

type 'a threshold_t = 'a t * float

let to_option m = (); fun a b -> Some (m a b)

let map_result f m a b = f (m a b)

let scale s = map_result (( *. ) s)

let add m n a b = m a b +. n a b

let pow m p = map_result (fun v -> v**p) m

let path_length m xs =
  match xs with
      [] -> invalid_arg "path_length: empty path."
    | [_] -> invalid_arg "path_length: one-element path."
    | x :: xs -> fst
        (List.fold_left
           (fun (len, prev) next -> (len +. m prev next, next))
           (0., x)
           xs)

module Float = struct
  let dist a b = abs_float (b -. a)
end

module Int = struct
  let dist a b = float_of_int (abs (b - a))
end

module Tuple2 = struct
  let dist_helper f g m0 m1 (a0, a1) (b0, b1) =
    let d0 = m0 a0 b0 in
    let d1 = m1 a1 b1 in
      g (f d0) (f d1)

  let id x = x

  let dist1 m0 m1 = dist_helper id (+.) m0 m1

  let sq x = x *. x
  let dist2_sqr m0 m1 = dist_helper sq (+.) m0 m1

  let dist2 m0 m1 = dist_helper sq (fun a b -> sqrt (a +. b)) m0 m1

  let dist_inf m0 m1 = dist_helper id max m0 m1
end