#!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 ""