package fehu

  1. Overview
  2. Docs
Reinforcement learning framework for OCaml

Install 

dune-project
 Dependency

github.com Readme Changelog Edit opam file Versions (2)

Authors

  1. Thibaut Mattio

Maintainers

  1. Thibaut Mattio

Sources

raven-1.0.0.alpha2.tbz
sha256=93abc49d075a1754442ccf495645bc4fdc83e4c66391ec8aca8fa15d2b4f44d2
sha512=5eb958c51f30ae46abded4c96f48d1825f79c7ce03f975f9a6237cdfed0d62c0b4a0774296694def391573d849d1f869919c49008acffca95946b818ad325f6f

doc/src/fehu.visualize/overlay.ml.html

Source file overlay.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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
type ctx = {
  step_idx : int;
  episode_idx : int;
  info : Fehu.Info.t;
  action : Fehu.Space.Value.t option;
  value : float option;
  log_prob : float option;
  reward : float;
  done_ : bool;
}

type t = Fehu.Render.image -> ctx -> Fehu.Render.image

let identity image _ = image

let compose overlays =
 fun image ctx ->
  List.fold_left (fun img overlay -> overlay img ctx) image overlays

let fst3 (a, _, _) = a
let snd3 (_, b, _) = b
let thd3 (_, _, c) = c

module Glyph = struct
  type t = { width : int; rows : int array }

  let make rows =
    let height = Array.length rows in
    if height <> 7 then invalid_arg "Glyph.make: expected 7 rows";
    let width = String.length rows.(0) in
    let rows_bits =
      Array.map
        (fun row ->
          if String.length row <> width then
            invalid_arg "Glyph.make: inconsistent row width";
          let bits = ref 0 in
          for idx = 0 to width - 1 do
            let bit = if row.[idx] <> '0' then 1 else 0 in
            bits := (!bits lsl 1) lor bit
          done;
          !bits)
        rows
    in
    { width; rows = rows_bits }

  let table =
    let open struct
      let glyph c rows = (c, make rows)
    end in
    [
      glyph '0'
        [| "01110"; "10001"; "10011"; "10101"; "11001"; "10001"; "01110" |];
      glyph '1'
        [| "00100"; "01100"; "00100"; "00100"; "00100"; "00100"; "01110" |];
      glyph '2'
        [| "01110"; "10001"; "00001"; "00010"; "00100"; "01000"; "11111" |];
      glyph '3'
        [| "01110"; "10001"; "00001"; "00110"; "00001"; "10001"; "01110" |];
      glyph '4'
        [| "00010"; "00110"; "01010"; "10010"; "11111"; "00010"; "00010" |];
      glyph '5'
        [| "11111"; "10000"; "11110"; "00001"; "00001"; "10001"; "01110" |];
      glyph '6'
        [| "00111"; "01000"; "10000"; "11110"; "10001"; "10001"; "01110" |];
      glyph '7'
        [| "11111"; "00001"; "00010"; "00100"; "01000"; "01000"; "01000" |];
      glyph '8'
        [| "01110"; "10001"; "10001"; "01110"; "10001"; "10001"; "01110" |];
      glyph '9'
        [| "01110"; "10001"; "10001"; "01111"; "00001"; "00010"; "11100" |];
      glyph 'A'
        [| "01110"; "10001"; "10001"; "11111"; "10001"; "10001"; "10001" |];
      glyph 'B'
        [| "11110"; "10001"; "10001"; "11110"; "10001"; "10001"; "11110" |];
      glyph 'C'
        [| "01110"; "10001"; "10000"; "10000"; "10000"; "10001"; "01110" |];
      glyph 'D'
        [| "11100"; "10010"; "10001"; "10001"; "10001"; "10010"; "11100" |];
      glyph 'E'
        [| "11111"; "10000"; "10000"; "11110"; "10000"; "10000"; "11111" |];
      glyph 'F'
        [| "11111"; "10000"; "10000"; "11110"; "10000"; "10000"; "10000" |];
      glyph 'G'
        [| "01110"; "10001"; "10000"; "10000"; "10011"; "10001"; "01111" |];
      glyph 'H'
        [| "10001"; "10001"; "10001"; "11111"; "10001"; "10001"; "10001" |];
      glyph 'I'
        [| "01110"; "00100"; "00100"; "00100"; "00100"; "00100"; "01110" |];
      glyph 'J'
        [| "00001"; "00001"; "00001"; "00001"; "10001"; "10001"; "01110" |];
      glyph 'K'
        [| "10001"; "10010"; "10100"; "11000"; "10100"; "10010"; "10001" |];
      glyph 'L'
        [| "10000"; "10000"; "10000"; "10000"; "10000"; "10000"; "11111" |];
      glyph 'M'
        [| "10001"; "11011"; "10101"; "10101"; "10001"; "10001"; "10001" |];
      glyph 'N'
        [| "10001"; "11001"; "10101"; "10011"; "10001"; "10001"; "10001" |];
      glyph 'O'
        [| "01110"; "10001"; "10001"; "10001"; "10001"; "10001"; "01110" |];
      glyph 'P'
        [| "11110"; "10001"; "10001"; "11110"; "10000"; "10000"; "10000" |];
      glyph 'Q'
        [| "01110"; "10001"; "10001"; "10001"; "10101"; "10010"; "01101" |];
      glyph 'R'
        [| "11110"; "10001"; "10001"; "11110"; "10100"; "10010"; "10001" |];
      glyph 'S'
        [| "01111"; "10000"; "10000"; "01110"; "00001"; "00001"; "11110" |];
      glyph 'T'
        [| "11111"; "00100"; "00100"; "00100"; "00100"; "00100"; "00100" |];
      glyph 'U'
        [| "10001"; "10001"; "10001"; "10001"; "10001"; "10001"; "01110" |];
      glyph 'V'
        [| "10001"; "10001"; "10001"; "10001"; "10001"; "01010"; "00100" |];
      glyph 'W'
        [| "10001"; "10001"; "10001"; "10101"; "10101"; "11011"; "10001" |];
      glyph 'X'
        [| "10001"; "10001"; "01010"; "00100"; "01010"; "10001"; "10001" |];
      glyph 'Y'
        [| "10001"; "10001"; "01010"; "00100"; "00100"; "00100"; "00100" |];
      glyph 'Z'
        [| "11111"; "00001"; "00010"; "00100"; "01000"; "10000"; "11111" |];
      glyph ' '
        [| "00000"; "00000"; "00000"; "00000"; "00000"; "00000"; "00000" |];
      glyph ':'
        [| "00000"; "00100"; "00100"; "00000"; "00100"; "00100"; "00000" |];
      glyph '.'
        [| "00000"; "00000"; "00000"; "00000"; "00000"; "00100"; "00100" |];
      glyph '/'
        [| "00001"; "00010"; "00100"; "01000"; "10000"; "00000"; "00000" |];
      glyph '-'
        [| "00000"; "00000"; "00000"; "11111"; "00000"; "00000"; "00000" |];
      glyph '_'
        [| "00000"; "00000"; "00000"; "00000"; "00000"; "11111"; "00000" |];
      glyph '+'
        [| "00000"; "00100"; "00100"; "11111"; "00100"; "00100"; "00000" |];
    ]

  let lookup =
    let table =
      let tbl = Hashtbl.create 64 in
      List.iter (fun (ch, glyph) -> Hashtbl.add tbl ch glyph) table;
      tbl
    in
    fun ch ->
      let key = Char.uppercase_ascii ch in
      match Hashtbl.find_opt table key with
      | Some glyph -> glyph
      | None -> Hashtbl.find table ' '
end

let with_rgb8 image k =
  let converted, buffer = Utils.convert_to_rgb8 image in
  k converted buffer;
  converted

let draw_text buffer ~width ~x ~y ~r ~g ~b text =
  let cursor_x = ref x in
  String.iter
    (fun ch ->
      let glyph = Glyph.lookup ch in
      for row = 0 to Array.length glyph.rows - 1 do
        let row_bits = glyph.rows.(row) in
        for col = 0 to glyph.width - 1 do
          let mask = 1 lsl (glyph.width - 1 - col) in
          if row_bits land mask <> 0 then
            Utils.set_pixel_rgb8 ~buffer ~width ~x:(!cursor_x + col)
              ~y:(y + row) ~r ~g ~b
        done
      done;
      cursor_x := !cursor_x + glyph.width + 1)
    text

let text ?(pos = (10, 20)) ?(color = (255, 255, 255)) to_string image ctx =
  let label = to_string ctx in
  if String.length label = 0 then image
  else
    with_rgb8 image (fun converted buffer ->
        let x, y = pos in
        draw_text buffer ~width:converted.width ~x ~y ~r:(fst3 color)
          ~g:(snd3 color) ~b:(thd3 color) label)

let clamp_unit value =
  if value < 0. then 0. else if value > 1. then 1. else value

let bar ?pos ?(size = (120, 8)) ?(color = (40, 200, 120))
    ?(background = (20, 20, 20)) ~value image ctx =
  let v = clamp_unit (value ctx) in
  with_rgb8 image (fun converted buffer ->
      let width = converted.width in
      let height = converted.height in
      let x, y =
        match pos with
        | Some (px, py) -> (px, py)
        | None ->
            let default_y = height - snd size - 10 in
            (10, max 0 default_y)
      in
      let bar_width, bar_height = size in
      Utils.fill_rect_rgb8 ~buffer ~width ~x ~y ~w:bar_width ~h:bar_height
        ~r:(fst3 background) ~g:(snd3 background) ~b:(thd3 background);
      let filled =
        int_of_float (Float.round (v *. Float.of_int bar_width))
        |> max 0 |> min bar_width
      in
      Utils.fill_rect_rgb8 ~buffer ~width ~x ~y ~w:filled ~h:bar_height
        ~r:(fst3 color) ~g:(snd3 color) ~b:(thd3 color))