! Copyright (C) 2022 CapitalEx
! See http://factorcode.org/license.txt for BSD license.
USING: accessors advent-of-code.utils assocs binary-search
combinators io.backend io.encodings.utf8 io.files kernel math
math.order math.parser sequences sorting splitting unicode ;
IN: advent-of-code.day-07
CONSTANT: EXAMPLE "$ cd /
$ ls
dir a
14848514 b.txt
8504156 c.dat
dir d
$ cd a
$ ls
dir e
29116 f
2557 g
62596 h.lst
$ cd e
$ ls
584 i
$ cd ..
$ cd ..
$ cd d
$ ls
4060174 j
8033020 d.log
5626152 d.ext
7214296 k"
CONSTANT: MAGIC-NUMBER 6_728_267
: get-input-one ( -- seq )
"vocab:advent-of-code/day-07/_input/one.txt"
normalize-path utf8 file-contents ;
! Generic method for finding the size of each file item
GENERIC: size-of ( item -- fixnum )
! Objects to help with storing data
TUPLE: dir name contents ;
:
( name -- dir )
V{ } clone \ dir boa ;
M: dir size-of
contents>> [ size-of ] map-sum ;
TUPLE: file name size ;
: ( name size -- file )
\ file boa ;
M: file size-of
size>> ;
: string>file ( string -- file )
[ blank? ] split-when first2 swap dec> ;
! Holds all the directs in a flat hashmap
! This is useful for later finding all the sizes
! of each directory.
TUPLE: fs contents current ;
: ( -- fs )
H{ } clone "" \ fs boa ;
M: fs size-of
contents>> "/" swap at size-of ;
! Words for testing paths
: parent? ( string -- ? )
".." = ;
: root? ( string -- ? )
"/" = ;
! words for testing commands
: cd-line? ( string -- ? )
"$ cd" swap subseq? ;
: ls-line? ( string -- ? )
"$ ls" swap subseq? ;
: dir-line? ( string -- ? )
"dir" swap subseq? ;
! Words for menuplating the current directory
: get-dir ( string -- string )
" " split1-last nip ;
: add-dir! ( fs dir -- )
dup name>> exhume contents>> ?set-at-if-emtpy ;
: current-dir-contents ( fs -- vector )
[ current>> ] [ contents>> ] bi at contents>> ;
: add-to-current-dir! ( fs item -- )
swap current-dir-contents push ;
: ?add-slash ( string ? -- string )
not [ "/" prepend ] when ;
: add-to-path ( fs string -- string )
'[ _ append ] change-current ;
: switch-dir! ( fs string -- fs )
dup root? ?add-slash add-to-path dup dup current>> add-dir! ;
: exit-dir! ( fs -- fs )
[ "/" split1-last drop ] change-current ;
! Handle the forms of outputs
: handle-cd! ( fs command -- fs )
get-dir dup parent? [ drop exit-dir! ]
[ switch-dir! ] if ;
: handle-ls ( fs command -- fs )
drop ;
: handle-dir! ( fs line -- fs )
[ dup dup current>> ] dip get-dir "/" glue
[ add-dir! ]
[ add-to-current-dir! ] 2bi ;
: handle-file! ( fs line -- fs )
[ dup ] dip string>file add-to-current-dir! ;
! Process the output
: process-line ( fs line -- fs )
{
{ [ dup cd-line? ] [ handle-cd! ] }
{ [ dup ls-line? ] [ handle-ls ] }
{ [ dup dir-line? ] [ handle-dir! ] }
[ handle-file! ]
} cond ;
: build-fs ( input -- fs )
split-lines [ process-line ] reduce ;
! Compute properties of the file-system
: sizes ( fs -- seq )
contents>> values [ size-of ] map ;
: find-deletable ( fs -- seq )
sizes [ 100000 < ] filter ;
: find-minimum-file ( seq -- file )
natural-sort [ MAGIC-NUMBER > ] find nip ;
! Solve the puzzle
: solve-part-one ( -- solution )
get-input-one build-fs find-deletable sum ;
: solve-part-two ( -- solution )
get-input-one build-fs sizes find-minimum-file ;