Paste: AoC Day 09

USING: accessors assocs combinators.smart io.backend
io.encodings.utf8 io.files kernel math math.parser math.vectors
sequences sets splitting unicode ;
IN: advent-of-code.day-09

CONSTANT: DIRS H{
    { "L" { -1  0 } }
    { "R" {  1  0 } }
    { "U" {  0 -1 } }
    { "D" {  0  1 } }
}

: get-input-one ( -- seq )
    "vocab:advent-of-code/day-09/_input/one.txt" 
        normalize-path utf8 file-contents ;

TUPLE: instruction dir steps ;
C: <instruction> instruction

: parse-instruction ( string -- instruction )
    [ blank? ] split-when first2
        [ DIRS at ]
           [ dec> ] bi* <instruction> ;

: parse-instructions ( string -- seq )
    split-lines [ parse-instruction ] map ;

! Implement simulation two
TUPLE: piece pos head tail ;
: <piece> ( -- rope ) 
    \ piece new { 0 0 } clone >>pos ;

TUPLE: tail < piece visited ;
: <tail> ( -- tail ) 
    \ tail new 
        { 0 0 } clone 
            >>pos
        HS{ { 0 0 } } clone 
            >>visited ;

! Build chain
: add-piece ( head -- tail )
    <piece> tuck [ head<< ] [ swap tail<< ] 2bi ;

: end-chain ( head -- )
    <tail> [ head<< ] [ swap tail<< ] 2bi ;

: make-chain ( seq head -- chain )
    [ [ drop add-piece ] reduce end-chain ] keep ;

: <chain> ( length -- long-rope )
    1 - <iota> <piece> make-chain ;


! Helper functions
: extract-tail ( head -- tail )
    dup tail? not [ tail>> extract-tail ] when ;

: count-visited ( head -- tail )
    extract-tail visited>> cardinality ;

: piece-delta ( piece -- v )
    [ head>> pos>> ] [ pos>> ] bi v- ;

: out-of-bounds? ( piece -- ? )
    piece-delta vabs [ 2 >= ] any? ;

: compute-move ( piece -- v )
    piece-delta [ sgn ] map ;


! Functions for moving the rope
: remember! ( tail -- )
    [ pos>> ] [ visited>> ] bi adjoin ;

: catch-up! ( piece -- )
    [ compute-move ] 
        [ [ v+ ] change-pos drop ] 
            [ [ tail? ] [ remember! ] smart-when* ] tri ;

: move! ( piece instruction -- )
    dir>> over pos>> v+ >>pos drop ;

DEFER: update-chain!
: (update-chain!) ( piece -- )
    dup catch-up! tail>> [ update-chain! ] when* ;

: update-chain! ( piece -- )
    [ out-of-bounds? ] [ (update-chain!) ] smart-when*  ;

: (simulate-rope) ( head instruction -- )
    dupd move! tail>> update-chain! ;

: simulate-rope ( head instruction -- head )
    dup steps>> [ 2dup (simulate-rope) ] times drop ;

: run-simulation ( instruction chain -- head )
    [ simulate-rope ] reduce ;


! Solution functions
: solve-part-one ( -- solution )
    get-input-one parse-instructions 
        1 <chain> run-simulation count-visited ;

: solve-part-two ( -- solution )
    get-input-one parse-instructions 
        9 <chain> run-simulation count-visited ;