move chunking stuff out of day4

This commit is contained in:
Rhiannon Morris 2020-12-06 09:11:35 +01:00
parent 26ae755b1f
commit ef1719c280
5 changed files with 95 additions and 30 deletions

View file

@ -12,3 +12,7 @@ let infile_lines ~line:f ~of_seq name =
infile name ~act infile name ~act
let infile_iter_lines ~line ~iter = infile_lines ~of_seq:(Seq.iter iter) ~line 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

View file

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

31
day4.ml
View file

@ -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 type field = string * string
let fields0 str = let fields0 str =
@ -80,7 +51,7 @@ end)
let main' make valid file = 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_all = List.length items in
let len_valid = List.(length (filter valid items)) in let len_valid = List.(length (filter valid items)) in
Printf.printf "%d valid out of %d\n" len_valid len_all Printf.printf "%d valid out of %d\n" len_valid len_all

70
seq.ml Normal file
View file

@ -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 seq = map (String.concat " ") (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)

17
seq.mli Normal file
View file

@ -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: string t -> string t