Paste: AoC Day 11

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

SYMBOL: @stressed

TUPLE: op a b op ;
C: <op> op

TUPLE: monkey items
    operation 
    test 
    to-true
    to-false
    counter ;


C: <monkey> monkey

! Parsing the program
: parse-items ( line -- items )
    ": " after ", " split-subseq [ dec> ] V{ } map-as ;

: ?parse-num ( str -- str/fixnum )
    dup [ digit? ] all? [ dec> ] when ;

: parse-op-quote ( str -- quote )
    "*" = ;

: parse-op ( line -- op )
    " = " after " " split [ ?parse-num ] map
        first3 swap parse-op-quote <op> ;

: parse-test ( line -- fixnum ) " by "     after dec> ;
: parse-if   ( line -- fixnum ) " monkey " after dec> ;

: parse-monkey ( seq -- monkey )
    { 
        [ second parse-items ]
        [ third  parse-op    ]
        [ fourth parse-test  ]
        [ fifth  parse-if    ]
        [ sixth  parse-if    ]
    } cleave 0 <monkey> ;

: parse-monkeys ( string -- monkeys )
    split-lines harvest 6 group [ parse-monkey ] map ;


! Compuing the next value 
: value ( item value -- n )
    dup "old" = [ drop ] [ nip ] if ;

: do-operation ( monkey item -- n )
    [ a>> value ] 
    [ b>> value ] 
    [ nip op>>  ] 2tri [ * ] [ + ] if
        9699690 mod ;

: ?get-bored ( n -- n )
    @stressed get not [ 3 /i ] when ;

: next-worry-level ( monkey item  -- monkey item )
    dupd swap operation>> do-operation ?get-bored  ;

! Find who to throw to
: check? ( monkey item -- ? )
    swap test>> divisor? ;

: target ( monkey item -- n )
    dupd check? [ to-true>> ] [ to-false>> ] if ;


! Count monkey business
: count ( monkey -- )
    [ 1 + ] change-counter drop ;


! Throw items
: transfer-item ( monkeys n item -- )
    [ swap nth items>> ] dip suffix! drop ;

: throw! ( monkeys monkey item -- )
    [ dup count ] dip next-worry-level [ target ] keep transfer-item ;


! Play game
: turn ( monkeys monkey -- )
    dup items>> [ throw! ] 2with each ;

: take-turn ( monkeys monkey -- )
    [ turn ] [ items>> delete-all ] bi ;

: step ( monkeys -- monkeys )
    dup dup [ take-turn ] with each ;

: play-for ( monkeys n -- monkeys )
    [ step ] times ;

: monkey-business-level ( seq -- n )
    { { counter>> >=< } } sort-by first2 [ counter>> ] bi@ * ;

: get-monkeys ( -- monkeys )
    get-input-one parse-monkeys ;

: be-relaxed ( -- )
    f @stressed set ;

: solve-part-one ( -- )
    get-monkeys 
    be-relaxed
    20 play-for 
    monkey-business-level
    >dec print ;

: become-stressed-out ( -- )
    t @stressed set ;

: solve-part-two ( -- )
    get-monkeys 
    become-stressed-out
    10000 play-for 
    monkey-business-level
    >dec print ;