USING: accessors combinators deques dlists eval
io.encodings.ascii io.files kernel math math.functions
math.parser math.statistics namespaces peg.parsers peg.search
prettyprint quotations sequences sequences.generalizations
splitting ;
IN: aoc2022.day11

TUPLE: monkey
    { items dlist }
    { op quotation read-only }
    { divisor integer read-only }
    { success integer read-only }
    { failure integer read-only }
    { inspected integer } ;

: parse-op ( str -- quot )
    dup "old * old" = [ drop [ sq ] ]
    [ " " split 2 tail* reverse " " join parse-string ] if ;

: last-int ( str -- n ) " " split last dec> ;

: <monkey> ( seq -- monkey )
    rest 5 firstn
    {
        [ integer-parser search <dlist> tuck push-all-front ]
        [ " " split 3 tail* " " join parse-op ]
        [ last-int ]
        [ last-int ]
        [ last-int ]
    } spread 0 monkey boa ;

: parse-monkeys ( -- seq )
    "vocab:aoc2022/day11/input.txt" ascii file-lines
    { "" } split [ <monkey> ] map ;

SYMBOLS: m w ;
: reset ( quot -- ) w set parse-monkeys m set ;
: monkeys ( -- seq ) m get ;
: worry-reducer ( -- quot ) w get ;

: lob ( item n -- ) monkeys nth items>> push-front ;

: inspect ( monkey -- )
    {
        [ items>> pop-back ]
        [ op>> call( x -- x ) worry-reducer call( x -- x ) dup ]
        [ divisor>> divisor? ]
        [ success>> ]
        [ failure>> ? lob ]
        [ [ 1 + ] change-inspected drop ]
    } cleave ;

: do-turn ( monkey -- )
    [ dup items>> deque-empty? ] [ dup inspect ] until drop ;

: do-round ( -- ) monkeys [ do-turn ] each ;

: monkey-business ( rounds -- n )
    [ do-round ] times monkeys [ inspected>> ] map
    { 0 1 } kth-largests product ;

: part1 ( -- ) [ 3 /i ] reset 20 monkey-business . ;

: part2 ( -- )
    monkeys 1 [ divisor>> lcm ] reduce '[ _ mod ] reset
    10,000 monkey-business . ;

: day11 ( -- ) part1 part2 ;

MAIN: day11