papl / src / PaplEdgeConstraint.ml

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

type 'a t = ('a * 'a) PaplConstraint.t

let mr = PaplConstraint.make_reject
let ma = PaplConstraint.make_accept
let re = PaplConstraint.reject
let ac = PaplConstraint.accept

let constrain_both constr = mr (fun (a, b) -> re constr a || re constr b)

let constrain_fst constr = mr (fun x -> re constr (fst x))

let constrain_snd constr = mr (fun x -> re constr (snd x))

let reject_threshold_by_cmp (metric, eps) cmp =
  mr (fun (x, y) -> cmp (metric x y) eps)

let accept_threshold_by_cmp (metric, eps) cmp =
  ma (fun (x, y) -> cmp (metric x y) eps)

let greater_than threshold =
  reject_threshold_by_cmp threshold (<=)

let constrain_intermediary constr intermediary =
  let reject (a, b) = BatEnum.exists (re constr) (intermediary a b)
  in mr reject

let less_than threshold =
  reject_threshold_by_cmp threshold (>=)

let constrain_steps constr interpolate threshold =
  constrain_intermediary
    constr
    (PaplInterpolate.intermediary_steps interpolate threshold)

let constrain_by_subdivision q_constr interpolate threshold =
  PaplIncrConstraint.to_constraint
    (PaplIncrEdgeConstraint.constrain_by_subdivision
       q_constr interpolate threshold)

let constrain_path ec =
  let reject xs =
    match xs with
        [] -> invalid_arg "constrain_path: empty path."
      | [_] -> invalid_arg "constrain_path: one-element path."
      | _ ->
          let rec loop xs =
            match xs with
                x0 :: x1 :: rest ->
                  PaplConstraint.reject ec (x0, x1) || loop (x1 :: rest)
              | _ -> false
          in loop xs
  in PaplConstraint.make_reject reject

let to_incremental metric ec ((a, b) as edge) =
  let len = metric a b in
  let cost () = len in
  let stop = ref false in
  let reject () =
    if !stop then None
    else
      let r = Some (PaplConstraint.reject ec edge) in
        stop := true;
        r
  in PaplIncrConstraint.make_reject reject cost

module Metric = struct
  let to_option constr m = ();
    fun a b ->
      if PaplConstraint.reject constr (a, b) then None
      else Some (m a b)

  let pre_constrain_option constr m = ();
    fun a b ->
      if PaplConstraint.reject constr (a, b) then None
      else m a b

  let post_constrain_option constr m = ();
    fun a b ->
      match m a b with
          None -> None
        | Some dist as result ->
            if PaplConstraint.reject constr (a, b) then None
            else result
end
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.