: 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 TUPLE: monkey items operation test to-true to-false counter ; C: 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 ; : 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 ; : 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 ;