🏡 index : ~doyle/aoc.git

author Jordan Doyle <jordan@doyle.la> 2024-12-12 2:53:12.0 +00:00:00
committer Jordan Doyle <jordan@doyle.la> 2024-12-12 3:01:34.0 +00:00:00
commit
132714f73f234a364156f9c9eb7da07e0a9c7cfd [patch]
tree
c42e911ac60f04eb8371eea11dbbdc908f4155ac
parent
cfe1a0f1c93e8e6e3bb88fcb2be6ea9c7023dfc2
download
132714f73f234a364156f9c9eb7da07e0a9c7cfd.tar.gz

Add 2024 day 9



Diff

 README     |   4 ++--
 2024/09.ml | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 117 insertions(+), 2 deletions(-)

diff --git a/README b/README
index 02fb2af..edec381 100644
--- a/README
+++ a/README
@@ -22,8 +22,8 @@
|        6 | Zig      | |        6 | Haskell  | |        6 | Apache2  |
|        7 | Rust     | |        7 | Haskell  | +---------------------+
|        8 | Rust     | |        8 | Haskell  |
+---------------------+ |        9 | Haskell  |
                        |       10 | Haskell  |
|        9 | OCaml    | |        9 | Haskell  |
+---------------------+ |       10 | Haskell  |
                        |       11 | Haskell  |
                        |       12 | Rust     |
                        |       13 | Haskell  |
diff --git a/2024/09.ml b/2024/09.ml
new file mode 100755
index 0000000..fcf79d6 100755
--- /dev/null
+++ a/2024/09.ml
@@ -1,0 +1,115 @@
#!/usr/bin/env nix-shell

(*
#!nix-shell --pure -i ocaml -p ocaml
*)

let input =
  let rec calc blocks n xs =
    match xs with
    | [] ->
        blocks
    | block_size :: free_space :: xs ->
        calc (blocks @ [(Some n, block_size); (None, free_space)]) (n + 1) xs
    | block_size :: xs ->
        calc (blocks @ [(Some n, block_size)]) (n + 1) xs
  in
  read_line () |> String.to_seq
  |> Seq.map (String.make 1)
  |> Seq.map int_of_string |> List.of_seq |> calc [] 0

let rec remove_last lst =
  let rec aux = function
    | [] ->
        (None, [])
    | (Some block_id, size) :: xs ->
        (Some (block_id, size), List.rev xs)
    | (None, _) :: xs ->
        aux xs
  in
  List.rev lst |> aux

let rec replace_at n replacement = function
  | [] ->
      []
  | x :: xs ->
      if n == 0 then replacement @ xs
      else x :: replace_at (n - 1) replacement xs

let rec fold_res n acc lst =
  match lst with
  | [] ->
      acc
  | (_, 0) :: xs ->
      fold_res n acc xs
  | (None, size) :: xs ->
      fold_res (n + size) acc xs
  | (Some block_id, size) :: xs ->
      fold_res (n + 1) ((block_id * n) + acc) ((Some block_id, size - 1) :: xs)

let part1 =
  let rec reorg curr input =
    let handle free_space block_id size xs =
      if free_space > size then
        (Some block_id, size) :: reorg None ((None, free_space - size) :: xs)
      else if free_space == size then (Some block_id, size) :: reorg None xs
      else
        (Some block_id, free_space)
        :: reorg (Some (block_id, size - free_space)) xs
    in
    match (input, curr) with
    | [], None ->
        []
    | [], Some (block_id, size) ->
        [(Some block_id, size)]
    | (Some block_id, size) :: xs, _ ->
        (Some block_id, size) :: reorg curr xs
    | (None, free_space) :: xs, Some (block_id, size) ->
        handle free_space block_id size xs
    | (None, free_space) :: xs, None -> (
      match remove_last xs with
      | Some (block_id, size), xs ->
          handle free_space block_id size xs
      | None, xs ->
          reorg curr xs )
  in
  input |> reorg None |> fold_res 0 0

let part2 =
  let rec find_fitting_free_space required_space to_scan n =
    match to_scan with
    | [] ->
        None
    | (None, block_size) :: xs ->
        if block_size >= required_space then Some (n, block_size)
        else find_fitting_free_space required_space xs (n + 1)
    | (Some _, _) :: xs ->
        find_fitting_free_space required_space xs (n + 1)
  in
  let rec reorg input =
    match input with
    | [] ->
        []
    | (None, size) :: xs ->
        (None, size) :: reorg xs
    | (Some block_id, size) :: xs -> (
      match find_fitting_free_space size (List.rev xs) 0 with
      | None ->
          (Some block_id, size) :: reorg xs
      | Some (idx, space) ->
          (None, size)
          :: replace_at
               (List.length xs - idx - 1)
               [(None, space - size); (Some block_id, size)]
               xs
          |> reorg )
  in
  input |> List.rev |> reorg |> List.rev |> fold_res 0 0

let _ = print_int part1

let _ = print_endline ""

let _ = print_int part2

let _ = print_endline ""