day11.ps (7592B)
1 %!PS 2 % 3 % Copyright (c) 2022, Natacha Porté 4 % 5 % Permission to use, copy, modify, and distribute this software for any 6 % purpose with or without fee is hereby granted, provided that the above 7 % copyright notice and this permission notice appear in all copies. 8 % 9 % THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 % WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 % MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 % ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 % WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 % ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 % OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 % 17 % Usage: 18 % gs -q- -sDEVICE=png16m -o- day11.ps <day11.txt | display 19 20 % each monkey is represented by an array: 21 % [ item-worry-array 22 % operation-proc 23 % test-proc 24 % monkey-index-true 25 % monkey-index-false ] 26 27 % I wasted a lot of time trying to write bigint primitives and getting 28 % them wrong, until I figured out the trick implemented here. 29 30 /datafile (%stdin) (r) file def 31 /stderr (%stderr) (w) file def 32 33 % [ item_1 ... item_n ] item_0 -> [ item_0 item_1 ... item_n ] 34 /apush { 35 % array new_item 36 exch aload length 1 add array astore 37 } bind def 38 39 % [ item_0 ... item_n-1 ] item_n -> [ item_0 item_1 ... item_n ] 40 /aappend { 41 exch aload length 42 % new-item item-0 item-1 ... item-n-1 n 43 dup dup 2 add exch 1 add roll 44 % item-0 item-1 ... item-n-1 n new-item 45 exch 46 % item-0 item-1 ... item-n-1 new-item n 47 1 add array astore 48 } bind def 49 50 % [ item_0 item_1 ... item_n ] -> [ item_1 ... item_n ] item_0 51 /apop { 52 aload length 1 sub array astore exch 53 } bind def 54 55 /radix 1 def 56 57 /init-data [ 58 { 59 datafile 100 string readline 60 not { pop exit } if 61 62 { %%% 1-iteration loop to use `exit` as a short circuit 63 (Monkey ) anchorsearch { 64 pop pop [ exit 65 } if 66 67 ( Starting items: ) anchorsearch { 68 % (item, item, ..., item) match 69 pop [ exch 70 { % mark prev-items suffix 71 (, ) search 72 { % mark prev-items new-suffix (, ) (cur-item) 73 exch pop cvi 74 % mark prev-items new-suffix cur-item 75 exch 76 % mark prev-items cur-item new-suffix 77 } 78 { % mark prev-item (last-item) 79 cvi ] exit 80 } 81 ifelse 82 } loop 83 % worry-array 84 exit 85 } if 86 87 ( Operation: new = old ) anchorsearch { 88 % (operator operand) match 89 pop 90 % (operator operand) 91 dup (* old) eq 92 { pop /dup load /mul load } 93 { 94 (* ) anchorsearch 95 { pop /mul load exch } 96 { (+ ) anchorsearch 97 { pop /add load exch } 98 { 1.125 pstack quit } 99 ifelse 100 } ifelse 101 % operator-proc (operand) 102 cvi exch 103 } ifelse 104 % operand operator-proc 105 2 array astore cvx bind 106 % operation-proc 107 exit 108 } if 109 110 ( Test: divisible by ) anchorsearch { 111 % (operand) match 112 pop cvi 113 % operand 114 dup radix mul /radix exch def 115 % operand 116 [ exch /mod load 0 /eq load ] cvx bind 117 % test-proc 118 exit 119 } if 120 121 ( If true: throw to monkey ) anchorsearch { 122 % (monkey-index) match 123 pop cvi exit 124 } if 125 126 ( If false: throw to monkey ) anchorsearch { 127 % (monkey-index) match 128 pop cvi ] exit 129 } if 130 131 dup length 0 eq { pop exit } if 132 133 2.125 pstack quit 134 } loop 135 } loop 136 ] def 137 138 % data monkey-array divisor -> ø 139 /single-turn { 140 exch 141 % data divisor monkey-array 142 dup 0 get 143 % data divisor monkey-array worry-item-array 144 1 index 0 0 array put 145 % data divisor updated-monkey-array worry-item-array 146 { 147 % data divisor monkey-array prev-cur-worry 148 1 index 1 get 149 % data divisor monkey-array prev-cur-worry operation-proc 150 exec radix mod 151 % data divisor monkey-array intermediate-cur-worry 152 2 index idiv radix mod 153 % data divisor monkey-array cur-worry 154 dup 2 index 2 get 155 % data divisor monkey-array cur-worry cur-worry test-proc 156 exec 157 % data divisor monkey-array cur-worry test-proc-result 158 { 1 index 3 get } 159 { 1 index 4 get } 160 ifelse 161 % data divisor monkey-array cur-worry target-monkey-index 162 4 index exch get 163 % data divisor monkey-array cur-worry target-monkey-array 164 dup 0 get 165 % data divisor monkey-array cur-worry target-monkey-array prev-target-worry-array 166 3 2 roll aappend 167 % data divisor monkey-array target-monkey-array updated-target-worry-array 168 0 exch put 169 % data divisor monkey-array 170 } forall 171 % data divisor monkey-array 172 pop pop pop 173 } bind def 174 175 /dump-worry-levels { 176 0 177 data { 178 % index monkey-array 179 0 get 180 % index worry-array 181 stderr (Monkey ) writestring 182 1 index 15 string cvs stderr exch writestring 183 stderr (:) writestring 184 % index worry-array 185 { 186 % index cur-worry-value 187 stderr ( ) writestring 188 15 string cvs stderr exch writestring 189 % index 190 } forall 191 % index 192 stderr 10 write 193 % index 194 1 add 195 % next-index 196 } forall 197 pop 198 } bind def 199 200 % divisor round-count -> inspect-array 201 /main-run { 202 % divisor round-count 203 [ init-data { 204 % init-monkey-array 205 dup length array copy 206 % cur-monkey-array 207 dup 0 get 208 % cur-monkey-array init-worry-array 209 dup length array copy 210 % cur-monkey-array new-worry-array 211 1 index exch 0 exch put 212 % cur-monkey-array 213 } forall ] 214 % divisor round-count data-copy 215 [ 1 index length { 0 } repeat ] 216 % divisor round-count data-copy init-inspect-array 217 3 2 roll 218 % divisor data-copy init-inspect-array round-count 219 { 220 % divisor data inspect-array 221 0 222 % divisor data inspect-array index 223 2 index { 224 % divisor data inspect-array index monkey-array 225 dup 0 get length 226 % divisor data inspect-array index monkey-array cur-worry-count 227 3 index 3 index get add 228 % divisor data inspect-array index monkey-array total-worry-count 229 3 index 3 index 3 2 roll put 230 % divisor data updated-inspect-array index monkey-array 231 3 index exch 5 index 232 % divisor data updated-inspect-array index data monkey-array divisor 233 single-turn 234 % divisor data updated-inspect-array index 235 1 add 236 } forall 237 % divisor data updated-inspect-array index 238 pop 239 %%% dumps 240 %dump-worry-levels 241 %stderr 10 write 242 } repeat 243 % divisor data inspect-array 244 3 1 roll pop pop 245 % inspect-array 246 } bind def 247 248 % inspect-array -> inspect-array 249 /dump-inspect-array { 250 0 1 index { 251 % index inspect-count 252 stderr (Monkey ) writestring 253 1 index 15 string cvs stderr exch writestring 254 stderr (: ) writestring 255 15 string cvs stderr exch writestring 256 stderr 10 write 257 1 add 258 } forall 259 pop 260 } bind def 261 262 % inspect-array -> business-index 263 /business-index { 264 % inspect-array 265 0 0 3 2 roll 266 % init-max init-second-max inspect-array 267 { 268 % max second-max cur-count 269 2 index 1 index lt 270 % max second-max cur-count is-new-max? 271 { 3 1 roll pop 272 % cur-count old-max 273 } 274 { 2 copy lt { exch } if pop } 275 ifelse 276 % updated-max updated-second-max 277 } forall 278 % max second-max 279 mul 280 } bind def 281 282 283 /Helvetica 20 selectfont 284 285 286 (First Puzzle: ) 287 72 700 moveto show 288 3 20 main-run 289 % inspect-array 290 business-index 291 15 string cvs show 292 293 294 (Second Puzzle: ) 295 72 664 moveto show 296 1 10000 main-run 297 % inspect-array 298 business-index 299 15 string cvs show 300 301 showpage 302 quit