day11-bigint-wrong.ps (12879B)
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 % bigints are arrays of limbs, least significant first 28 29 % WARNING: 30 % this produces wrong results, so there is probably 31 % a bug in some corner case here. 32 33 /radix 100 def 34 35 /datafile (%stdin) (r) file def 36 /stderr (%stderr) (w) file def 37 38 % [ item_1 ... item_n ] item_0 -> [ item_0 item_1 ... item_n ] 39 /apush { 40 % array new_item 41 exch aload length 1 add array astore 42 } bind def 43 44 % [ item_0 ... item_n-1 ] item_n -> [ item_0 item_1 ... item_n ] 45 /aappend { 46 exch aload length 47 % new-item item-0 item-1 ... item-n-1 n 48 dup dup 2 add exch 1 add roll 49 % item-0 item-1 ... item-n-1 n new-item 50 exch 51 % item-0 item-1 ... item-n-1 new-item n 52 1 add array astore 53 } bind def 54 55 % [ item_0 item_1 ... item_n ] -> [ item_1 ... item_n ] item_0 56 /apop { 57 aload length 1 sub array astore exch 58 } bind def 59 60 % file bigint -> ø 61 /writebigint { 62 1 index ([) writestring 63 { 64 % file limb 65 1 index 32 write 66 % file (limb) 67 15 string cvs 68 % file (limb) 69 1 index exch 70 % file file (limb) 71 writestring 72 % file 73 } forall 74 ( ]) writestring 75 } bind def 76 77 % bigint factor carry -> bigint 78 /bigaddmul { 79 % bigint factor carry 80 2 index aload length array astore 81 % bigint factor carry bigint-copy 82 4 1 roll 3 2 roll pop 83 % bigint-copy factor carry 84 0 { 85 % bigint factor carry index 86 3 index length 1 index le 87 % bigint factor carry index overflow? 88 { pop 89 % bigint factor carry 90 dup 0 eq 91 { pop pop } 92 { exch pop aappend } 93 ifelse 94 % bigint 95 exit 96 } if 97 % bigint factor carry index 98 exch 3 index 2 index get 99 % bigint factor index carry cur-limb 100 3 index mul 101 % bigint factor index carry temp-product 102 add 103 % bigint factor index result 104 dup radix mod 105 % bigint factor index result new-limb 106 exch radix idiv 107 % bigint factor index new-limb new-carry 108 3 1 roll 109 % bigint factor new-carry index new-limb 110 4 index 2 index 2 index put 111 % updated-bigint factor new-carry index new-limb 112 pop 113 % updated-bigint factor new-carry index 114 1 add 115 % updated-bigint factor new-carry next-index 116 } loop 117 } bind def 118 119 % bigint int -> bigint 120 /bigadd { 1 exch bigaddmul } bind def 121 /vbigadd { 122 1 index stderr exch writebigint 123 stderr ( + ) writestring 124 dup 15 string cvs stderr exch writestring 125 stderr ( = ) writestring 126 bigadd 127 dup stderr exch writebigint 128 stderr 10 write 129 } bind def 130 131 % bigint int -> bigint 132 /bigmul { 0 bigaddmul } bind def 133 /vbigmul { 134 1 index stderr exch writebigint 135 stderr ( * ) writestring 136 dup 15 string cvs stderr exch writestring 137 stderr ( = ) writestring 138 bigmul 139 dup stderr exch writebigint 140 stderr 10 write 141 } bind def 142 143 % bigint factor index -> bigint 144 /bigbigmulpart { 145 dup 0 eq 146 { bigaddmul } 147 { 148 % bigint factor index 149 2 index 0 2 index getinterval 150 % bigint factor index prefix 151 3 index 2 index 152 % bigint factor index prefix bigint index 153 1 index length 1 index sub getinterval 154 % bigint factor index prefix suffix 155 3 index 0 bigaddmul 156 % bigint factor index prefix new-suffix 157 1 index length 1 index length add array 158 % bigint factor index prefix new-suffix new-bigint 159 6 1 roll 5 4 roll pop 160 % new-bigint factor index prefix new-suffix 161 4 index exch 3 index exch putinterval 162 % new-bigint factor index prefix 163 3 index exch 0 exch putinterval 164 % new-bigint factor index 165 pop pop 166 } ifelse 167 } bind def 168 169 % bigint bigint -> bigint 170 /bigbigmul { 171 % bigint bigint 172 1 index length 1 index length 173 % bigint bigint len1 len2 174 gt { exch } if 175 % smaller-bigint larger-bigint 176 0 1 3 index length 1 sub { 177 % smaller-bigint accumulator-bigint index 178 2 index 1 index get 179 % smaller-bigint accumulator-bigint index factor 180 exch bigbigmulpart 181 % smaller-bigint accumulator-bigint 182 } for 183 % smaller-bigint result-bigint 184 exch pop 185 % result-bigint 186 } bind def 187 188 /vbigbigmul { 189 1 index stderr exch writebigint 190 stderr ( * ) writestring 191 dup stderr exch writebigint 192 stderr ( = ) writestring 193 bigbigmul 194 dup stderr exch writebigint 195 stderr 10 write 196 } bind def 197 198 % dividand-bigint divisor-int -> quotient-bigint remainder-int 199 /bigdivmod { 200 % bigint divisor 201 exch aload length array astore exch 202 % bigint-copy divisor 203 0 2 index length 1 sub -1 0 { 204 % bigint divisor carry index 205 exch radix mul 206 % bigint divisor index multiplied-carry 207 3 index 2 index get 208 % bigint divisor index multiplied-carry cur-limb 209 add 210 % bigint divisor index cur-dividand 211 dup 3 index mod 212 % bigint divisor index cur-dividand cur-remainder 213 exch 3 index idiv 214 % bigint divisor index cur-remainder cur-quotient 215 4 index exch 3 index exch put 216 % updated-bigint divisor index cur-remainder 217 exch pop 218 % updated-bigint divisor next-carry 219 } for 220 % quotient-bigint divisor remainder 221 exch pop exch 222 % remainder quotient-bigint 223 { 224 % remainder quotient-bigint 225 dup length 1 eq { exit } if 226 % remainder quotient-bigint 227 dup dup length 1 sub get 228 % remainder quotient-bigint last-limb 229 0 eq 230 { aload 231 length 1 sub array 232 exch pop 233 astore 234 } 235 { exit } 236 ifelse 237 } loop 238 % remainder quotient-bigint 239 exch 240 % quotient-bigint remainder 241 } bind def 242 243 /vbigdivmod { 244 1 index stderr exch writebigint 245 stderr ( = ) writestring 246 dup 15 string cvs stderr exch writestring 247 stderr ( * ) writestring 248 bigdivmod 249 1 index stderr exch writebigint 250 stderr ( + ) writestring 251 dup 15 string cvs stderr exch writestring 252 stderr 10 write 253 } bind def 254 255 % bigint int -> bigint 256 /bigidiv { bigdivmod pop } bind def 257 /vbigidiv { vbigdivmod pop } bind def 258 259 % bigint int -> int 260 /bigmod { bigdivmod exch pop } bind def 261 /vbigmod { vbigdivmod exch pop } bind def 262 263 264 /init-data [ 265 { 266 datafile 100 string readline 267 not { pop exit } if 268 269 { %%% 1-iteration loop to use `exit` as a short circuit 270 (Monkey ) anchorsearch { 271 pop pop [ exit 272 } if 273 274 ( Starting items: ) anchorsearch { 275 % (item, item, ..., item) match 276 pop [ exch 277 { % mark prev-items suffix 278 (, ) search 279 { % mark prev-items new-suffix (, ) (cur-item) 280 exch pop cvi 281 % mark prev-items new-suffix cur-item 282 [ exch ] 283 % mark prev-items new-suffix [cur-item] 284 exch 285 % mark prev-items cur-item new-suffix 286 } 287 { % mark prev-item (last-item) 288 [ exch cvi ] ] exit 289 } 290 ifelse 291 } loop 292 % worry-array 293 exit 294 } if 295 296 ( Operation: new = old ) anchorsearch { 297 % (operator operand) match 298 pop 299 % (operator operand) 300 dup (* old) eq 301 { pop /dup load /bigbigmul load } 302 { 303 (* ) anchorsearch 304 { pop /bigmul load exch } 305 { (+ ) anchorsearch 306 { pop /bigadd load exch } 307 { 1.125 pstack quit } 308 ifelse 309 } ifelse 310 % operator-proc (operand) 311 cvi exch 312 } ifelse 313 % operand operator-proc 314 /exec load 3 array astore cvx bind 315 % operation-proc 316 exit 317 } if 318 319 ( Test: divisible by ) anchorsearch { 320 % (operand) match 321 pop cvi 322 % operand 323 [ exch /bigmod load /exec load 0 /eq load ] cvx bind 324 % test-proc 325 exit 326 } if 327 328 ( If true: throw to monkey ) anchorsearch { 329 % (monkey-index) match 330 pop cvi exit 331 } if 332 333 ( If false: throw to monkey ) anchorsearch { 334 % (monkey-index) match 335 pop cvi ] exit 336 } if 337 338 dup length 0 eq { pop exit } if 339 340 2.125 pstack quit 341 } loop 342 } loop 343 ] def 344 345 % data monkey-array divisor -> ø 346 /single-turn { 347 exch 348 % data divisor monkey-array 349 dup 0 get 350 % data divisor monkey-array worry-item-array 351 1 index 0 0 array put 352 % data divisor updated-monkey-array worry-item-array 353 { 354 % data divisor monkey-array prev-cur-worry 355 1 index 1 get 356 % data divisor monkey-array prev-cur-worry operation-proc 357 exec 358 % data divisor monkey-array intermediate-cur-worry 359 2 index dup 1 eq not { bigidiv } { pop } ifelse 360 % data divisor monkey-array cur-worry 361 dup 2 index 2 get 362 % data divisor monkey-array cur-worry cur-worry test-proc 363 exec 364 % data divisor monkey-array cur-worry test-proc-result 365 { 1 index 3 get } 366 { 1 index 4 get } 367 ifelse 368 % data divisor monkey-array cur-worry target-monkey-index 369 4 index exch get 370 % data divisor monkey-array cur-worry target-monkey-array 371 dup 0 get 372 % data divisor monkey-array cur-worry target-monkey-array prev-target-worry-array 373 3 2 roll aappend 374 % data divisor monkey-array target-monkey-array updated-target-worry-array 375 0 exch put 376 % data divisor monkey-array 377 } forall 378 % data divisor monkey-array 379 pop pop pop 380 } bind def 381 382 /dump-worry-levels { 383 0 384 data { 385 % index monkey-array 386 0 get 387 % index worry-array 388 stderr (Monkey ) writestring 389 1 index 15 string cvs stderr exch writestring 390 stderr (:) writestring 391 % index worry-array 392 { 393 % index cur-worry-value 394 stderr ( ) writestring 395 15 string cvs stderr exch writestring 396 % index 397 } forall 398 % index 399 stderr 10 write 400 % index 401 1 add 402 % next-index 403 } forall 404 pop 405 } bind def 406 407 % divisor round-count -> inspect-array 408 /main-run { 409 % divisor round-count 410 [ init-data { 411 % init-monkey-array 412 dup length array copy 413 % cur-monkey-array 414 dup 0 get 415 % cur-monkey-array init-worry-array 416 dup length array copy 417 % cur-monkey-array new-worry-array 418 1 index exch 0 exch put 419 % cur-monkey-array 420 } forall ] 421 % divisor round-count data-copy 422 [ 1 index length { 0 } repeat ] 423 % divisor round-count data-copy init-inspect-array 424 3 2 roll 425 % divisor data-copy init-inspect-array round-count 426 0 5 1 roll 427 % round-index divisor data-copy init-inspect-array round-count 428 { 429 % prev-round-index divisor data inspect-array 430 4 3 roll 1 add 431 stderr (Round ) writestring 432 dup 15 string cvs stderr exch writestring 433 stderr 10 write 434 4 1 roll 435 % round-index divisor data inspect-array 436 0 437 % divisor data inspect-array index 438 2 index { 439 % divisor data inspect-array index monkey-array 440 dup 0 get length 441 % divisor data inspect-array index monkey-array cur-worry-count 442 3 index 3 index get add 443 % divisor data inspect-array index monkey-array total-worry-count 444 3 index 3 index 3 2 roll put 445 % divisor data updated-inspect-array index monkey-array 446 3 index exch 5 index 447 % divisor data updated-inspect-array index data monkey-array divisor 448 single-turn 449 % divisor data updated-inspect-array index 450 1 add 451 } forall 452 % divisor data updated-inspect-array index 453 pop 454 %%% dumps 455 %dump-worry-levels 456 %stderr 10 write 457 } repeat 458 % divisor data inspect-array 459 3 1 roll pop pop 460 % inspect-array 461 } bind def 462 463 % inspect-array -> inspect-array 464 /dump-inspect-array { 465 0 1 index { 466 % index inspect-count 467 stderr (Monkey ) writestring 468 1 index 15 string cvs stderr exch writestring 469 stderr (: ) writestring 470 15 string cvs stderr exch writestring 471 stderr 10 write 472 1 add 473 } forall 474 pop 475 } bind def 476 477 % inspect-array -> business-index 478 /business-index { 479 % inspect-array 480 0 0 3 2 roll 481 % init-max init-second-max inspect-array 482 { 483 % max second-max cur-count 484 2 index 1 index lt 485 % max second-max cur-count is-new-max? 486 { 3 1 roll pop 487 % cur-count old-max 488 } 489 { 2 copy lt { exch } if pop } 490 ifelse 491 % updated-max updated-second-max 492 } forall 493 % max second-max 494 mul 495 } bind def 496 497 498 /Helvetica 20 selectfont 499 500 501 (First Puzzle: ) 502 72 700 moveto show 503 3 20 main-run 504 % inspect-array 505 business-index 506 15 string cvs show 507 508 509 (Second Puzzle: ) 510 72 664 moveto show 511 1 10000 main-run 512 % inspect-array 513 business-index 514 15 string cvs show 515 516 showpage 517 quit