day 6

aoc2020.ml

@@ -1,7 +1,8 @@
 open Aoc2020
 
 let days =
-  [|Day1.main; Day2.main; Day3.main; Day4.main; Day5.main|]
+  [|Day1.main; Day2.main; Day3.main; Day4.main; Day5.main;
+    Day6.main|]
 
 let _ =
   match Array.to_list Sys.argv with

bracket.ml

@@ -12,3 +12,10 @@ let infile_lines ~line:f ~of_seq name =
   infile name ~act
 
 let infile_iter_lines ~line ~iter = infile_lines ~of_seq:(Seq.iter iter) ~line
+
+let infile_chunks' ~chunk ~of_seq input =
+  let of_seq seq = Seq.line_chunks' seq |> Seq.map chunk |> of_seq in
+  infile_lines input ~line:Fun.id ~of_seq
+
+let infile_chunks ?(join=" ") ~chunk =
+  infile_chunks' ~chunk:(fun lst -> chunk (String.concat join lst))

bracket.mli

@@ -6,3 +6,10 @@ val infile_lines: line:(string -> 'a) -> of_seq:('a Seq.t -> 'b) -> string -> 'b
 
 val infile_iter_lines:
   line:(string -> 'a) -> iter:('a -> unit) -> string -> unit
+
+val infile_chunks':
+  chunk:(string list -> 'a) -> of_seq:('a Seq.t -> 'b) -> string -> 'b
+
+val infile_chunks:
+  ?join:string -> chunk:(string -> 'a) -> of_seq:('a Seq.t -> 'b) ->
+  string -> 'b

day4.ml

@@ -1,32 +1,3 @@
-
-type acc = {cur: string list; all: string list}
-
-let chunks seq =
-  let make strs all =
-    match strs with
-    | [] -> all
-    | _::_ -> String.concat " " (List.rev strs) :: all in
-  let next acc str =
-    if str = "" then
-      {cur = []; all = make acc.cur acc.all}
-    else
-      {acc with cur = str :: acc.cur} in
-  let res' = Seq.fold_left next {cur = []; all = []} seq in
-  List.rev (make res'.cur res'.all)
-
-let%test_module _ = (module struct
-  let chunks' lst = chunks (List.to_seq lst)
-
-  let%test "ε" = chunks' [] = []
-  let%test "a b c" = chunks' ["a"; "b"; "c"] = ["a b c"]
-  let%test "a b | c" = chunks' ["a"; "b"; ""; "c"] = ["a b"; "c"]
-  let%test "a b || c" = chunks' ["a"; "b"; ""; ""; "c"] = ["a b"; "c"]
-  let%test "a b | c |" = chunks' ["a"; "b"; ""; "c"; ""] = ["a b"; "c"]
-end)
-
-let chunk_input = Bracket.infile_lines ~line:Fun.id ~of_seq:chunks
-
-
 type field = string * string
 
 let fields0 str =
@@ -80,7 +51,7 @@ end)
 
 
 let main' make valid file =
-  let items = chunk_input file |> List.map make in
+  let items = Bracket.infile_chunks file ~chunk:make ~of_seq:List.of_seq in
   let len_all = List.length items in
   let len_valid = List.(length (filter valid items)) in
   Printf.printf "%d valid out of %d\n" len_valid len_all

day6.ml

@@ -0,0 +1,89 @@
+module CharSet = Set_ext.Make(Char)
+
+let to_set str = String.to_seq str |> CharSet.of_seq
+
+let count_distinct str = to_set str |> CharSet.cardinal
+
+let main1 input =
+  Bracket.infile_chunks input ~join:"" ~chunk:count_distinct ~of_seq:List.of_seq
+  |> Misc.print_sum ~format:true
+
+let count_intersect strs =
+  match List.map to_set strs with
+  | []    -> failwith "empty list"
+  | s::ss -> List.fold_left CharSet.inter s ss |> CharSet.cardinal
+
+let main2 input =
+  Bracket.infile_chunks' input ~chunk:count_intersect ~of_seq:List.of_seq
+  |> Misc.print_sum ~format:true
+
+let main = Misc.main 6 [|main1; main2|]
+
+let%expect_test "main1" =
+  main1 "../../data/day6";
+  [%expect{|
+    26 + 8 + 24 + 21 + 22 + 13 + 6 + 8 + 14 + 20 + 16 + 15 + 8 + 24 + 7 + 5 + 6 +
+    18 + 7 + 25 + 24 + 6 + 13 + 13 + 4 + 24 + 9 + 6 + 8 + 6 + 18 + 14 + 16 + 3 +
+    26 + 11 + 22 + 12 + 1 + 13 + 13 + 12 + 9 + 17 + 7 + 25 + 14 + 21 + 6 + 9 +
+    8 + 1 + 16 + 23 + 2 + 19 + 17 + 25 + 8 + 14 + 8 + 11 + 15 + 2 + 21 + 17 +
+    24 + 6 + 11 + 12 + 20 + 8 + 25 + 16 + 12 + 17 + 4 + 24 + 4 + 21 + 16 + 7 +
+    14 + 2 + 19 + 2 + 26 + 8 + 1 + 3 + 7 + 8 + 14 + 21 + 19 + 17 + 12 + 20 + 17 +
+    16 + 12 + 5 + 2 + 22 + 13 + 21 + 20 + 22 + 16 + 14 + 5 + 23 + 9 + 5 + 6 +
+    23 + 23 + 12 + 15 + 2 + 18 + 16 + 25 + 9 + 14 + 2 + 17 + 16 + 26 + 24 + 8 +
+    19 + 17 + 10 + 12 + 5 + 14 + 4 + 6 + 3 + 11 + 16 + 1 + 26 + 3 + 20 + 3 + 12 +
+    18 + 12 + 26 + 10 + 9 + 16 + 11 + 12 + 3 + 1 + 21 + 8 + 18 + 5 + 19 + 18 +
+    1 + 10 + 10 + 11 + 12 + 13 + 13 + 7 + 8 + 8 + 15 + 12 + 7 + 4 + 13 + 13 +
+    17 + 3 + 15 + 20 + 4 + 10 + 2 + 9 + 21 + 4 + 15 + 11 + 17 + 5 + 1 + 6 + 12 +
+    20 + 18 + 4 + 2 + 22 + 6 + 4 + 7 + 10 + 23 + 23 + 8 + 6 + 7 + 8 + 1 + 6 +
+    12 + 9 + 9 + 24 + 8 + 7 + 9 + 20 + 16 + 18 + 26 + 26 + 6 + 13 + 19 + 11 +
+    23 + 9 + 26 + 12 + 22 + 16 + 20 + 4 + 3 + 5 + 21 + 4 + 21 + 8 + 25 + 26 +
+    20 + 20 + 3 + 12 + 25 + 10 + 21 + 15 + 5 + 15 + 14 + 12 + 26 + 20 + 20 + 5 +
+    15 + 20 + 20 + 26 + 24 + 22 + 13 + 15 + 13 + 10 + 21 + 11 + 20 + 11 + 2 +
+    18 + 2 + 18 + 15 + 19 + 17 + 26 + 7 + 16 + 18 + 5 + 3 + 23 + 17 + 3 + 19 +
+    11 + 25 + 2 + 20 + 22 + 3 + 9 + 8 + 5 + 18 + 24 + 7 + 8 + 6 + 26 + 4 + 13 +
+    26 + 26 + 8 + 23 + 17 + 25 + 20 + 24 + 22 + 10 + 5 + 24 + 10 + 15 + 1 + 21 +
+    20 + 9 + 19 + 4 + 10 + 20 + 10 + 21 + 2 + 14 + 22 + 20 + 9 + 7 + 16 + 25 +
+    12 + 22 + 19 + 10 + 12 + 5 + 6 + 23 + 3 + 11 + 23 + 25 + 2 + 5 + 11 + 22 +
+    3 + 3 + 22 + 15 + 3 + 19 + 20 + 2 + 5 + 24 + 15 + 1 + 23 + 20 + 24 + 6 + 8 +
+    8 + 15 + 9 + 15 + 10 + 6 + 15 + 19 + 11 + 11 + 13 + 1 + 15 + 18 + 6 + 20 +
+    13 + 23 + 12 + 16 + 16 + 9 + 26 + 12 + 7 + 19 + 6 + 26 + 9 + 3 + 11 + 8 +
+    11 + 7 + 22 + 6 + 8 + 4 + 9 + 2 + 11 + 16 + 18 + 18 + 26 + 10 + 24 + 9 + 26 +
+    23 + 8 + 21 + 19 + 7 + 21 + 2 + 9 + 21 + 13 + 11 + 12 + 22 + 5 + 6 + 25 +
+    16 + 8 + 9 + 18 + 22 + 3 + 7 + 12 + 22 + 25 + 19 + 9 + 18 + 4 + 16 + 23 + 8 +
+    6 + 10 + 22 + 20 + 22 + 25 + 25 + 8 + 2 + 20 + 15 + 19 + 3 + 26 + 1 + 12 +
+    1 + 22 + 12 + 20 + 5 + 3 + 8 + 14 + 15 + 22 + 20 + 12 + 6 + 24 + 13 + 3 +
+    25 + 24 =
+    6587 |}]
+
+let%expect_test "main2" =
+  main2 "../../data/day6";
+  [%expect{|
+    5 + 8 + 16 + 7 + 3 + 3 + 3 + 8 + 7 + 1 + 14 + 10 + 8 + 1 + 7 + 1 + 0 + 6 +
+    2 + 12 + 7 + 3 + 11 + 2 + 2 + 2 + 6 + 1 + 0 + 0 + 2 + 4 + 7 + 0 + 11 + 3 +
+    21 + 4 + 1 + 9 + 2 + 4 + 0 + 1 + 1 + 3 + 5 + 9 + 0 + 7 + 5 + 1 + 1 + 7 + 1 +
+    10 + 4 + 13 + 8 + 10 + 4 + 0 + 7 + 1 + 11 + 0 + 15 + 2 + 1 + 1 + 20 + 6 + 0 +
+    1 + 8 + 2 + 1 + 21 + 1 + 10 + 8 + 1 + 6 + 2 + 3 + 2 + 12 + 7 + 1 + 0 + 6 +
+    8 + 2 + 16 + 15 + 13 + 1 + 0 + 17 + 15 + 1 + 2 + 2 + 21 + 13 + 11 + 0 + 3 +
+    8 + 9 + 3 + 14 + 3 + 5 + 5 + 6 + 5 + 5 + 9 + 1 + 14 + 9 + 6 + 5 + 13 + 1 +
+    16 + 15 + 23 + 19 + 1 + 17 + 7 + 10 + 5 + 0 + 12 + 2 + 6 + 3 + 2 + 0 + 1 +
+    1 + 3 + 0 + 1 + 7 + 12 + 11 + 0 + 1 + 4 + 6 + 4 + 6 + 1 + 1 + 19 + 6 + 0 +
+    1 + 15 + 6 + 1 + 8 + 5 + 2 + 7 + 11 + 13 + 4 + 7 + 3 + 3 + 11 + 0 + 1 + 12 +
+    12 + 13 + 1 + 0 + 20 + 3 + 10 + 0 + 1 + 0 + 1 + 14 + 2 + 6 + 2 + 1 + 6 + 12 +
+    15 + 5 + 4 + 1 + 1 + 3 + 2 + 0 + 0 + 0 + 16 + 8 + 3 + 0 + 4 + 1 + 5 + 5 + 6 +
+    4 + 9 + 2 + 3 + 7 + 18 + 16 + 11 + 21 + 8 + 6 + 4 + 18 + 1 + 0 + 8 + 0 + 1 +
+    0 + 2 + 20 + 2 + 1 + 4 + 3 + 2 + 11 + 6 + 14 + 25 + 7 + 6 + 3 + 8 + 11 + 5 +
+    15 + 11 + 5 + 4 + 4 + 0 + 22 + 3 + 13 + 2 + 14 + 6 + 8 + 8 + 23 + 1 + 9 + 4 +
+    6 + 0 + 9 + 6 + 10 + 9 + 1 + 12 + 1 + 6 + 1 + 11 + 15 + 12 + 4 + 0 + 1 + 1 +
+    2 + 1 + 4 + 0 + 3 + 8 + 20 + 1 + 3 + 22 + 0 + 9 + 1 + 3 + 1 + 5 + 4 + 8 + 4 +
+    5 + 1 + 2 + 5 + 18 + 0 + 17 + 3 + 2 + 16 + 19 + 7 + 7 + 5 + 18 + 1 + 14 + 1 +
+    19 + 18 + 7 + 10 + 2 + 2 + 3 + 9 + 2 + 2 + 9 + 7 + 20 + 0 + 6 + 12 + 5 + 11 +
+    7 + 2 + 10 + 8 + 3 + 5 + 22 + 2 + 6 + 10 + 14 + 0 + 1 + 4 + 3 + 3 + 1 + 10 +
+    5 + 3 + 9 + 14 + 0 + 0 + 23 + 10 + 1 + 14 + 5 + 21 + 3 + 8 + 4 + 9 + 5 + 11 +
+    8 + 3 + 13 + 0 + 8 + 5 + 3 + 1 + 15 + 8 + 2 + 5 + 13 + 10 + 8 + 12 + 13 + 6 +
+    6 + 7 + 7 + 8 + 2 + 14 + 6 + 0 + 9 + 4 + 8 + 4 + 0 + 2 + 7 + 3 + 2 + 2 + 2 +
+    4 + 18 + 15 + 24 + 5 + 6 + 4 + 26 + 14 + 3 + 14 + 14 + 3 + 3 + 2 + 8 + 6 +
+    12 + 0 + 3 + 0 + 3 + 6 + 2 + 13 + 1 + 3 + 1 + 22 + 0 + 0 + 4 + 17 + 10 + 13 +
+    3 + 9 + 4 + 5 + 9 + 4 + 0 + 4 + 20 + 20 + 10 + 11 + 12 + 4 + 2 + 13 + 0 +
+    18 + 2 + 24 + 1 + 6 + 1 + 14 + 0 + 14 + 5 + 3 + 3 + 4 + 9 + 12 + 7 + 11 + 3 +
+    1 + 4 + 2 + 22 + 24 =
+    3235 |}]

misc.ml

@@ -26,16 +26,23 @@ let%test _ = fold_list add  [1;2;3;4] = 10
 let%test _ = fold_list mult [1;2;3;4] = 24
 
 
-let print_fold mon xs =
+let print_fold ?(format=false) mon xs =
   let res = List.fold_left mon.op mon.id xs in
   let rec go fmt = function
     | []    -> Format.fprintf fmt "%a" mon.pp mon.id
     | [x]   -> Format.fprintf fmt "%a" mon.pp x
-    | x::xs -> Format.fprintf fmt "%a %s %a" mon.pp x mon.op_name go xs in
-  Format.printf "%a = %a\n" go xs mon.pp res
+    | x::xs ->
+        let f =
+          if format then Format.fprintf fmt "%a %s@ %a"
+          else Format.fprintf fmt "%a %s %a" in
+        f mon.pp x mon.op_name go xs in
+  let f =
+    if format then Format.printf "%a =@ %a\n"
+    else Format.printf "%a = %a\n" in
+  f go xs mon.pp res
 
-let print_prod = print_fold mult
-let print_sum  = print_fold add
+let print_prod ?format = print_fold ?format mult
+let print_sum  ?format = print_fold ?format add
 
 let%expect_test _ =
   print_prod [];

misc.mli

@@ -14,6 +14,6 @@ val fold_list: 'a monoid -> 'a list -> 'a
 val mult: int monoid
 val add: int monoid
 
-val print_fold: 'a monoid -> 'a list -> unit
-val print_prod: int list -> unit
-val print_sum:  int list -> unit
+val print_fold: ?format:bool -> 'a monoid -> 'a list -> unit
+val print_prod: ?format:bool -> int list -> unit
+val print_sum:  ?format:bool -> int list -> unit

seq.ml

@@ -0,0 +1,70 @@
+include Stdlib.Seq
+
+type 'a span = Empty_seq | Span of 'a list * 'a t
+
+let span' p seq =
+  let rec go acc = function
+    | Nil -> begin
+        match acc with
+        | []   -> Empty_seq
+        | _::_ -> Span (List.rev acc, empty)
+      end
+    | Cons (x, xs) ->
+        if p x then
+          go (x :: acc) (xs ())
+        else
+          Span (List.rev acc, cons x xs) in
+  go [] (seq ())
+
+let%test_module _ = (module struct
+  let (@=) sp (l2, s2) =
+    match sp with
+    | Span (l1, s1) -> l1 = l2 && List.of_seq s1 = s2
+    | Empty_seq     -> false
+
+  let%test _ =
+    span' (fun x -> x < 4) (List.to_seq [1;2;3;4;5;6;7]) @=
+      ([1;2;3], [4;5;6;7])
+
+  let%test _ =
+    span' (fun _ -> true) (List.to_seq []) = Empty_seq
+
+  let%test _ =
+    span' (fun x -> x < 0) (List.to_seq [1;2;3;4;5;6;7]) @=
+      ([], [1;2;3;4;5;6;7])
+end)
+
+let break' p = span' (Fun.negate p)
+
+let from_span = function
+  | Empty_seq       -> [], empty
+  | Span (lst, seq) -> lst, seq
+
+let span p seq = from_span (span' p seq)
+let break p seq = from_span (break' p seq)
+
+
+let rec drop_while p seq =
+  match seq () with
+  | Nil -> empty
+  | Cons (x, xs) ->
+      if p x then drop_while p xs else cons x xs
+
+let chunks p =
+  unfold (fun seq ->
+    match break' p seq with
+    | Empty_seq -> None
+    | Span (lst, seq) -> Some (lst, drop_while p seq))
+
+let line_chunks' = chunks (fun s -> s = "")
+let line_chunks ?(join=" ") seq = map (String.concat join) (line_chunks' seq)
+
+let%test_module _ = (module struct
+  let lc lst = List.(of_seq (line_chunks (to_seq lst)))
+
+  let%test "ε"         = lc [] = []
+  let%test "a b c"     = lc ["a"; "b"; "c"] = ["a b c"]
+  let%test "a b | c"   = lc ["a"; "b"; ""; "c"] = ["a b"; "c"]
+  let%test "a b || c"  = lc ["a"; "b"; ""; ""; "c"] = ["a b"; "c"]
+  let%test "a b | c |" = lc ["a"; "b"; ""; "c"; ""] = ["a b"; "c"]
+end)

seq.mli

@@ -0,0 +1,17 @@
+include module type of Stdlib.Seq
+
+type 'a span = Empty_seq | Span of 'a list * 'a t
+
+val span': ('a -> bool) -> 'a t -> 'a span
+val break': ('a -> bool) -> 'a t -> 'a span
+
+val span: ('a -> bool) -> 'a t -> 'a list * 'a t
+val break: ('a -> bool) -> 'a t -> 'a list * 'a t
+
+val drop_while: ('a -> bool) -> 'a t -> 'a t
+
+
+val chunks: ('a -> bool) -> 'a t -> 'a list t
+
+val line_chunks': string t -> string list t
+val line_chunks: ?join:string -> string t -> string t