Paste: AoC 2022 Day 11

! 2022 nomennescio
USING: accessors kernel literals math math.functions math.statistics multiline prettyprint sequences ;
IN: aoc2022

<<
TUPLE: monkey items op inspections ;
C: <monkey> monkey
>>

CONSTANT: monkeys { $[
  V{ 65 58 93 57 66 } [ 7 * 3 /i dup 19 divisor? 6 4 ? ] 0 <monkey>
  V{ 76 97 58 72 57 92 82 } [ 4 + 3 /i dup 3 divisor? 7 5 ? ] 0 <monkey>
  V{ 90 89 96 } [ 5 * 3 /i dup 13 divisor? 5 1 ? ] 0 <monkey>
  V{ 72 63 72 99 } [ dup * 3 /i dup 17 divisor? 0 4 ? ] 0 <monkey>
  V{ 65 } [ 1 + 3 /i dup 2 divisor? 6 2 ? ] 0 <monkey>
  V{ 97 71 } [ 8 + 3 /i dup 11 divisor? 7 3 ? ] 0 <monkey>
  V{ 83 68 88 55 87 67 } [ 2 + 3 /i dup 5 divisor? 2 1 ? ] 0 <monkey>
  V{ 64 81 50 96 82 53 62 92 } [ 5 + 3 /i dup 7 divisor? 3 0 ? ] 0 <monkey>
] }

! to bound computation without disturbing divisor tests, compute modulo product of all unique prime divisors

CONSTANT: limit $[ { 19 3 13 17 2 11 5 7 } product ]
CONSTANT: crazy-monkeys { $[
  V{ 65 58 93 57 66 } [ 7 * limit mod dup 19 divisor? 6 4 ? ] 0 <monkey>
  V{ 76 97 58 72 57 92 82 } [ 4 + limit mod dup 3 divisor? 7 5 ? ] 0 <monkey>
  V{ 90 89 96 } [ 5 * limit mod dup 13 divisor? 5 1 ? ] 0 <monkey>
  V{ 72 63 72 99 } [ dup * limit mod dup 17 divisor? 0 4 ? ] 0 <monkey>
  V{ 65 } [ 1 + limit mod dup 2 divisor? 6 2 ? ] 0 <monkey>
  V{ 97 71 } [ 8 + limit mod dup 11 divisor? 7 3 ? ] 0 <monkey>
  V{ 83 68 88 55 87 67 } [ 2 + limit mod dup 5 divisor? 2 1 ? ] 0 <monkey>
  V{ 64 81 50 96 82 53 62 92 } [ 5 + limit mod dup 7 divisor? 3 0 ? ] 0 <monkey>
] }

: count-inspections ( monkey -- ) [ items>> length ] [ [ + ] change-inspections drop ] bi ;
: fling ( monkeys worry i -- monkeys ) swap [ over nth items>> ] dip suffix! drop ;
: inspect ( monkeys monkey -- monkeys ) [ [ items>> ] [ op>> ] bi [ call( worry -- worry' i ) fling ] curry each ] keep items>> delete-all ;
: turn ( monkeys monkey -- monkeys ) [ count-inspections ] [ inspect ] bi ;
: part1 ( monkeys rounds -- n ) [ dup [ turn ] each ] times [ inspections>> ] map { 0 1 } kth-largests product ;
: day11 ( -- ) monkeys 20 part1 . crazy-monkeys 10000 part1 . ;

MAIN: day11