Source file Prelude.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(** {1 helpers} *)

let string_opt_to_string = function
  | None -> "None"
  | Some s -> Printf.sprintf "Some %s" s

let string_list_to_string string_list =
  Printf.sprintf "[%s]" (String.concat "; " string_list)

let get_nick h = CCString.Split.left_exn ~by:"!" h |> fst

let ( |? ) o x =
  match o with
  | None -> x
  | Some y -> y

let contains s (re : Re.re) = Re.execp re s

let re_match2 f r s =
  match Re.exec_opt r s with
  | None -> None
  | Some g -> f (Re.Group.get g 1) (Re.Group.get g 2) |> Option.some

let re_match1 f r s =
  match Re.exec_opt r s with
  | None -> None
  | Some g -> f (Re.Group.get g 1) |> Option.some

let re_match0 x r s =
  if contains s r then
    Some x
  else
    None

(* from containers 1.0 *)
let edit_distance s1 s2 =
  if String.length s1 = 0 then
    String.length s2
  else if String.length s2 = 0 then
    String.length s1
  else if s1 = s2 then
    0
  else (
    (* distance vectors (v0=previous, v1=current) *)
    let v0 = Array.make (String.length s2 + 1) 0 in
    let v1 = Array.make (String.length s2 + 1) 0 in
    (* initialize v0: v0(i) = A(0)(i) = delete i chars from t *)
    for i = 0 to String.length s2 do
      v0.(i) <- i
    done;
    (* main loop for the bottom up dynamic algorithm *)
    for i = 0 to String.length s1 - 1 do
      (* first edit distance is the deletion of i+1 elements from s *)
      v1.(0) <- i + 1;

      (* try add/delete/replace operations *)
      for j = 0 to String.length s2 - 1 do
        let cost =
          if Char.compare (String.get s1 i) (String.get s2 j) = 0 then
            0
          else
            1
        in
        v1.(j + 1) <- min (v1.(j) + 1) (min (v0.(j + 1) + 1) (v0.(j) + cost))
      done;

      (* copy v1 into v0 for next iteration *)
      Array.blit v1 0 v0 0 (String.length s2 + 1)
    done;
    v1.(String.length s2)
  )

module StrMap = CCMap.Make (String)

(** {2 Random Distribution} *)
module Rand_distrib = struct
  type 'a t = ('a * float) list

  let return x = [ x, 1. ]

  let rec add x p = function
    | [] -> [ x, p ]
    | (y, q) :: t ->
      if x = y then
        (y, q +. p) :: t
      else
        (y, q) :: add x p t

  let rec ( >>= ) (a : 'a t) (b : 'a -> 'b t) : 'b t =
    match a with
    | [] -> []
    | (x, t) :: tl ->
      List.fold_left (fun pre (c, u) -> add c (u *. t) pre) (tl >>= b) (b x)

  let binjoin a b = List.map (fun (x, d) -> x, d /. 2.) (a @ b)

  let join l =
    let flatten = List.fold_left ( @ ) [] in
    let n = List.length l in
    flatten (List.map (List.map (fun (x, d) -> x, d /. float_of_int n)) l)

  let uniform l = join (List.map return l)
  let filter p l = List.filter (fun (a, _) -> p a) l

  let top d =
    let m = List.fold_left (fun b (_, u) -> max b u) 0. d in
    List.filter (fun (_, u) -> u = m) d

  let bot d =
    let m = List.fold_left (fun b (_, u) -> min b u) 2. d in
    List.filter (fun (_, u) -> u = m) d

  let () = Random.self_init ()

  let run x =
    let rec aux f = function
      | [] -> assert false
      | [ (v, _) ] -> v
      | (v, h) :: t ->
        if f <= h then
          v
        else
          aux (f -. h) t
    in
    aux (Random.float 1.) x

  let normalize l =
    let i = List.fold_left (fun a (_, b) -> a +. b) 0. l in
    List.map (fun (a, k) -> a, k /. i) l
end

let random_l l = Rand_distrib.(run @@ uniform l)