Add 2024 day 9
Diff
README | 4 ++--
2024/09.ml | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 117 insertions(+), 2 deletions(-)
@@ -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 |
@@ -1,0 +1,115 @@
(*
*)
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 ""