I could use some help with how to wire signals in the framework of the React FRP library.
Here is my boiled-down example. A running table of labels with associated counts is constructed; labels are added dynamically; the counts are themselves signals. One ends up with the dynamic table running_table : (label * count signal) list signal
. Here, the outer signal
is for tracking the builder
events. The inner signal
s track the changer
events. (I added a printing function for convenience):
open React
(* utility *)
let unequal _ _ = false
let string_empty s = String.length s = 0
type label = string
type count = int
let (builder: label event), build = E.create ()
let (changer: (label * count) event), change = E.create ()
(* A running table of changeable signals constructed from the labels seen
so far. The labels act as addresses; changes emitted by the changer
event will be tracked by the signal with matching address. *)
let running_table =
let apply_change s i (s', j) = if String.equal s' s then j else i in
let change_tracker s = S.Special.Si.fold (apply_change s) 0 changer in
let add_tracker s l = (s, change_tracker s) :: l in
S.accum ~eq:unequal (E.map add_tracker builder) []
let pp_running_table fmt () =
let t = S.value running_table in
let string_rep = List.fold_left (fun ss (s, c) ->
ss ^ (if string_empty ss then "" else ", ")
^ s ^ " " ^ string_of_int (S.value c)) "" t in
Format.fprintf fmt "%s" string_rep
Up to here this works just fine; try it with
build "apples";
build "oranges";
Format.printf "table:@;%a@." pp_running_table ();
if you like.
Now I also want a running aggregate result. For the purpose of this example, let’s say a table that sums up all the counts for labels beginning with the same letter. I tried to construct running_aggregate_result: (char * count) list signal
as follows:
let running_aggregate_result =
let classify s =
if string_empty s then None else Some (String.get s 0) in
let compose f f' = fun a -> f' (f a) in
let update_tally s i_new i_old aggregate =
match classify s with
| None -> aggregate
| Some cat ->
match List.assoc_opt cat aggregate with
| None -> (cat, i_new) :: aggregate
| Some j ->
(cat, j + i_new - i_old) :: List.remove_assoc cat aggregate in
let running_updaters = S.map ~eq:unequal
(fun l ->
let updaters = List.map (fun (s, count_signal) ->
S.diff (update_tally s) count_signal) l in
E.merge compose Fun.id updaters)
running_table in
let transformer =
(* S.sample (fun _e s -> s) builder running_updaters *) (* alternative *)
S.changes running_updaters
|> E.switch E.never in (* initial signal value lost here? *)
S.accum transformer []
let pp_running_aggregate fmt () =
let a = S.value running_aggregate_result in
let string_rep = List.fold_left (fun ss (cat, c) ->
ss ^ (if string_empty ss then "" else ", ")
^ String.make 1 cat ^ " " ^ string_of_int c)
"" a in
Format.fprintf fmt "%s" string_rep
When I then test this with the code below, I find that running_table
gets updated whenever a new label is added by build
, but running_aggregate
remains empty. Only after change
is called, running_aggregate
is initialized.
let _main =
build "apples";
build "oranges";
Format.printf "table:@;%a@." pp_running_table ();
Format.printf "aggregate:@;%a@." pp_running_aggregate ();
Format.printf "now adding an apple.@.";
change ("apples", 1);
Format.printf "table:@;%a@." pp_running_table ();
Format.printf "aggregate:@;%a@." pp_running_aggregate ();
Format.printf "now adding three almonds.@.";
build "almonds";
change ("almonds", 3);
Format.printf "table:@;%a@." pp_running_table ();
Format.printf "aggregate:@;%a@." pp_running_aggregate ();
What do I need to do differently? The construction of running_aggregate
feels clumsy, and my guess is that in the line with E.switch
all builder
events before the first changer
event get lost…
Thanks for any pointers!