papl / src / PaplPlanner.ml

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

type 'a pair_t = 'a * 'a

type 'a region_t = 'a list PaplSampler.t

type 'a region_pair_t = 'a region_t pair_t

exception Path_not_found of string

type ('target, 'result) t = PaplStopCriteria.t -> 'target -> 'result

type ('target, 'result) option_t = ('target, 'result option) t

type ('target, 'q) path_t = ('target, 'q list) t

type 'a point_path_t = ('a * 'a, 'a) path_t

type 'a region_path_t = ('a region_pair_t, 'a) path_t

type ('target, 'q) trajectory_t = ('target, 'q PaplTrajectory.t) t

type 'q point_trajectory_t = ('q * 'q, 'q) trajectory_t

type 'a region_trajectory_t = ('a region_pair_t, 'a) trajectory_t

let fail msg = raise (Path_not_found msg)

let to_option planner =
  let planner stop target =
    try Some (planner stop target)
    with Path_not_found msg ->
      Printf.printf "Planner message: %s\n" msg;
      None
  in
    planner

let bind_target f planner = ();
  fun stop target -> planner stop (f target)

let map_result f planner = ();
  fun stop target -> f (planner stop target)

let point_to_region q = BatList.enum [[q]]

let point_to_region_target target =
  BatPair.map point_to_region target

let region_to_point_planner region_planner =
  bind_target point_to_region_target region_planner

let point_to_region_planner pp =
  let rec get stop region =
    if PaplStopCriteria.stop stop then
      fail "Stop criteria said stop before region point was found"
    else
      match BatEnum.get region with
          None -> fail "Region sampler is empty"
        | Some [] -> get stop region
        | Some (q :: _) -> q
  in
  let sp stop target =
    pp stop (BatPair.map (get stop) target)
  in
    sp

module Trajectory = struct
  let of_metric ?t0 interpolate metric path_planner =
    map_result
      (fun path -> PaplTrajectory.of_path ?t0 interpolate metric path)
      path_planner
end

module type S = sig
  type q_t
  type target_t

  val planner : (target_t, q_t) path_t
end

module type POINT = sig
  type q_t
  include S with type q_t := q_t
            and type target_t = q_t * q_t
end

module type REGION = sig
  type q_t
  include S with type q_t := q_t
            and type target_t = q_t region_t pair_t
end

let make_buffered_region
    ?(region_name = "")
    ?(max_region_tries = max_int)
    ?(max_constr_tries = max_int)
    ?(max_buffer_len = max_int)
    ?(retrieve = (fun _ _ -> true))
    constr
    region
    =
  let incr var = var := !var + 1 in
  let returned_cnt = ref 0 in
  let region_tries = ref 0 in
  let region_found = ref false in
  let constr_tries = ref 0 in
  let constr_found = ref false in
  let module A = BatDynArray in
  let buffer = A.make 50 in
  let empty_region_msg = Printf.sprintf
    "PaplPlanner.make_buffered_region: region \"%s\" seems empty. %d attempts of retrieving a configuration were made."
    region_name
    max_region_tries
  in
  let rejected_region_msg = Printf.sprintf
    "PaplPlanner.make_buffered_region: region \"%s\" seems empty. %d configurations were rejected."
    region_name
    max_constr_tries
  in
  let retrieve () =
    let bad found max tries = not !found && !tries > max in
      if A.empty buffer then begin
        if bad region_found max_region_tries region_tries then
          fail empty_region_msg;
        if bad constr_found max_constr_tries constr_tries then
          fail rejected_region_msg;
        Some []
      end
      else if retrieve !region_tries !returned_cnt then begin
        let q = A.last buffer in
          A.delete_last buffer;
          incr returned_cnt;
          Some [q]
      end
      else
        Some []
  in
  let next () =
    incr region_tries;
    if A.length buffer < max_buffer_len then
      match BatEnum.get region with
          None -> retrieve ()
        | Some [] -> retrieve ()
        | Some qs ->
            region_found := true;
            List.iter
              (fun q ->
                 incr constr_tries;
                 if PaplConstraint.accept constr q then begin
                   constr_found := true;
                   A.add buffer q
                 end)
              qs;
            retrieve ()
    else
      retrieve ()
  in
    BatEnum.from_while next
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.