add solutions for 2015/01

advent_of_code/advent_of_code.ml

@@ -1,4 +1,36 @@
-let solve () =
-  Utils.print_message "Solved!";
+module Solutions (Reader : Utils.Reader) = struct
+  let solve_2015_01_one, solve_2015_01_two =
+    let module Solutions = Solutions_2015_01.Make (Reader) in
+    (Solutions.part_one, Solutions.part_two)
 
-  ()
+  let registry =
+    let open Registry in
+    let open Utils.Result in
+    let map =
+      Ok (empty ())
+      >>= add ~year:2015 ~day:1 ~part:1 ~value:solve_2015_01_one
+      >>= add ~year:2015 ~day:1 ~part:2 ~value:solve_2015_01_two
+    in
+    match map with Ok registry -> registry | Error exn -> raise exn
+
+  let years =
+    let open Registry in
+    all_years registry
+
+  let days ~year =
+    let open Registry in
+    registry |> all_days ~year
+
+  let parts ~year ~day =
+    let open Registry in
+    registry |> all_parts ~year ~day
+
+  let solve ~year ~day ~part (input : Reader.t) =
+    let open Registry in
+    let solve = registry |> find_opt ~year ~day ~part in
+    match solve with
+    | Some solve -> (
+        try Some (solve input)
+        with Exceptions.Invalid_input -> Some (Error "Invalid input"))
+    | None -> None
+end

advent_of_code/advent_of_code.mli

@@ -0,0 +1,13 @@
+module Solutions (Reader : Utils.Reader) : sig
+  val registry : (Reader.t -> (string, string) result) Registry.t
+  val years : int list
+  val days : year:int -> int list
+  val parts : year:int -> day:int -> bool * bool
+
+  val solve :
+    year:int ->
+    day:int ->
+    part:int ->
+    Reader.t ->
+    (string, string) result option
+end

advent_of_code/dune

@@ -1,5 +1,5 @@
 (library
  (name advent_of_code)
- (modules advent_of_code)
+ (modules advent_of_code exceptions registry solutions_2015_01)
  (libraries utils)
  (modes melange native))

advent_of_code/exceptions.ml

@@ -0,0 +1 @@
+exception Invalid_input

advent_of_code/registry.ml

@@ -0,0 +1,64 @@
+module Key = struct
+  type t = int * int * int
+
+  let compare = Stdlib.compare
+end
+
+module RegistryMap = Map.Make (Key)
+module IntSet = Set.Make (Stdlib.Int)
+
+type 'a t = 'a RegistryMap.t
+
+let empty () = RegistryMap.empty
+
+exception Year_out_of_range of int
+exception Day_out_of_range of int
+exception Part_out_of_range of int
+
+let validate_input ~year ~day ~part =
+  let min_year = 2015 and max_year = 2024 in
+  let min_day = 1 and max_day = 25 in
+  let min_part = 1 and max_part = 2 in
+  if year < min_year || year > max_year then Error (Year_out_of_range year)
+  else if day < min_day || day > max_day then Error (Day_out_of_range year)
+  else if part < min_part || part > max_part then Error (Part_out_of_range part)
+  else Ok (year, day, part)
+
+exception Duplicated_solution of int * int * int
+
+let add ~year ~day ~part ~value map =
+  match validate_input ~year ~day ~part with
+  | Error msg -> Error msg
+  | Ok key ->
+      if RegistryMap.mem key map then
+        Error (Duplicated_solution (year, day, part))
+      else Ok (RegistryMap.add key value map)
+
+let all_years map =
+  let get_year (year, _, _) = year in
+  let put_year set year = IntSet.add year set in
+  let pairs = RegistryMap.bindings map in
+  let keys = List.map fst pairs in
+  let years = List.map get_year keys in
+  let unique_years = List.fold_left put_year IntSet.empty years in
+  IntSet.to_list unique_years
+
+let all_days ~year map =
+  let filter_map key =
+    match key with
+    | current_year, day, _ when current_year == year -> Some day
+    | _ -> None
+  in
+  let put_day set day = IntSet.add day set in
+  let pairs = RegistryMap.bindings map in
+  let keys = List.map fst pairs in
+  let all_days = List.filter_map filter_map keys in
+  let unique_days = List.fold_left put_day IntSet.empty all_days in
+  IntSet.to_list unique_days
+
+let all_parts ~year ~day map =
+  let one = RegistryMap.mem (year, day, 1) map in
+  let two = RegistryMap.mem (year, day, 2) map in
+  (one, two)
+
+let find_opt ~year ~day ~part map = RegistryMap.find_opt (year, day, part) map

advent_of_code/registry.mli

@@ -0,0 +1,11 @@
+type 'a t
+
+val empty : unit -> 'a t
+
+val add :
+  year:int -> day:int -> part:int -> value:'a -> 'a t -> ('a t, exn) result
+
+val all_years : 'a t -> int list
+val all_days : year:int -> 'a t -> int list
+val all_parts : year:int -> day:int -> 'a t -> bool * bool
+val find_opt : year:int -> day:int -> part:int -> 'a t -> 'a option

advent_of_code/solutions_2015_01.ml

@@ -0,0 +1,26 @@
+module Make (Reader : Utils.Reader) = struct
+  let parse input =
+    let to_int char =
+      match char with
+      | '(' -> 1
+      | ')' -> -1
+      | _ -> raise Exceptions.Invalid_input
+    in
+    input |> Reader.chars_of |> Seq.map to_int
+
+  let part_one (input : Reader.t) =
+    let result = input |> parse |> Seq.fold_left ( + ) 0 |> string_of_int in
+    Ok result
+
+  let part_two (input : Reader.t) =
+    let rec fold_until acc idx seq =
+      match seq () with
+      | Seq.Nil -> acc
+      | Seq.Cons (x, next) ->
+          let acc = acc + x in
+          let next_idx = idx + 1 in
+          if acc = -1 then next_idx else fold_until acc next_idx next
+    in
+    let result = input |> parse |> fold_until 0 0 |> string_of_int in
+    Ok result
+end

index.html

@@ -1,20 +1,16 @@
-<!DOCTYPE html>
+<!doctype html>
 <html lang="en-us">
   <head>
     <meta charset="utf-8" />
 
     <title>Advent of OCaml</title>
 
-    <link
-      ref="stylesheet"
-      href="./node_modules/@fontsource/source-code-pro/300.css"
-    />
-
     <link rel="shortcut icon" href="./web/assets/favicon.png" />
 
     <script
       src="./_build/default/web/output/web/main.js"
       type="module"
+      defer
     ></script>
   </head>
   <body>

native/main.ml

@@ -12,4 +12,17 @@ let speclist =
     ("-i", Arg.Set_string input_file, "Set input file name");
   ]
 
-let () = Arg.parse speclist (fun _ -> ()) usage
+let () =
+  Arg.parse speclist (fun _ -> ()) usage;
+
+  let input = open_in input_file.contents in
+  let year = year.contents in
+  let day = day.contents in
+  let part = part.contents in
+  let answer = Solutions.solve ~year ~day ~part input in
+  match answer with
+  | Some answer -> (
+      match answer with
+      | Ok answer -> print_endline answer
+      | Error answer -> print_endline answer)
+  | None -> ()

native/reader.ml

@@ -0,0 +1,14 @@
+type t = in_channel
+
+let unfold read input =
+  let read () =
+    try
+      let chunk = read input in
+      Some (chunk, ())
+    with End_of_file -> None
+  in
+  Seq.unfold read ()
+
+let chars_of input = input |> unfold input_char
+let bytes_of input = input |> unfold input_byte
+let lines_of input = input |> unfold input_line

native/solutions.ml

@@ -0,0 +1 @@
+include Advent_of_code.Solutions (Reader)

package.json

@@ -19,6 +19,7 @@
   },
   "devDependencies": {
     "@rollup/plugin-node-resolve": "^15.3.0",
+    "prettier": "^3.3.3",
     "vite": "^5.4.11"
   }
 }

utils/dune

@@ -1,4 +1,4 @@
 (library
  (name utils)
- (modules utils)
+ (modules reader result utils)
  (modes melange native))

utils/reader.ml

@@ -0,0 +1,7 @@
+module type Reader = sig
+  type t
+
+  val bytes_of : t -> int Seq.t
+  val chars_of : t -> char Seq.t
+  val lines_of : t -> string Seq.t
+end

utils/result.ml

@@ -0,0 +1 @@
+let ( >>= ) r f = Stdlib.Result.bind r f

utils/result.mli

@@ -0,0 +1 @@
+val ( >>= ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result

utils/utils.ml

@@ -1 +1,3 @@
-let print_message message = print_endline message
+module Result = Result
+
+module type Reader = Reader.Reader

vite.config.mjs

@@ -1,9 +1,15 @@
+import path from "node:path";
+
 import { defineConfig } from "vite";
 import { nodeResolve } from "@rollup/plugin-node-resolve";
 
+const rootDir = import.meta.dirname;
+
 export default defineConfig({
   base: "./",
 
+  root: rootDir,
+
   build: {
     assetsInlineLimit: 0,
   },

web/application.module.css

@@ -0,0 +1,66 @@
+.root {
+  color: white;
+}
+
+.root {
+  display: grid;
+  grid-template-columns: auto 1fr;
+  grid-template-rows: repeat(4, auto);
+  grid-template-areas: "title years" "subtitle days" "form form" "results results";
+  column-gap: 20px;
+}
+
+.title {
+  grid-area: title;
+  color: var(--interactive--highlight);
+  text-shadow:
+    0 0 2px var(--interactive--highlight),
+    0 0 5px var(--interactive--highlight);
+}
+
+.years {
+  grid-area: years;
+}
+
+.subTitle {
+  grid-area: subtitle;
+  color: var(--interactive--highlight);
+  text-align: right;
+  text-shadow:
+    0 0 2px var(--interactive--highlight),
+    0 0 5px var(--interactive--highlight);
+}
+
+.subTitleDelimiter {
+  color: var(--interactive--inactive);
+  text-align: right;
+  text-shadow:
+    0 0 2px var(--interactive--inactive),
+    0 0 5px var(--interactive--inactive);
+}
+
+.days {
+  grid-area: days;
+}
+
+.form {
+  grid-area: form;
+  margin-top: var(--line-height);
+}
+
+.results {
+  grid-area: results;
+  margin-top: var(--line-height);
+  color: var(--text--primary);
+}
+
+.result {
+}
+
+.ok {
+  color: var(--accent);
+}
+
+.fail {
+  color: var(--error);
+}