Paste: AoC Day 07

! 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 ;
: <dir> ( name -- dir  ) 
    V{ } clone \ dir boa ;

M: dir size-of 
    contents>> [ size-of ] map-sum ;


TUPLE: file name size ;
: <file> ( name size -- file )
    \ file boa ;

M: file size-of 
    size>> ;

: string>file ( string -- file ) 
    [ blank? ] split-when first2 swap dec> <file> ;


! 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> ( -- 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>> <dir> 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 <dir>
        [ 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 <fs> [ 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 ;