day12.ps (10485B)
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- day12.ps <day12.txt | display 19 20 /datafile (%stdin) (r) file def 21 /stderr (%stderr) (w) file def 22 23 % [ item_1 ... item_n ] item_0 -> [ item_0 item_1 ... item_n ] 24 /apush { 25 % array new_item 26 exch aload length 1 add array astore 27 } bind def 28 29 /rawdata [ 30 { 31 datafile 200 string readline 32 not { pop exit } if 33 } loop 34 ] def 35 36 /width rawdata 1 get length def 37 /height rawdata length def 38 39 % x y -> valid? 40 /xy-valid? { 41 % x y 42 1 index 0 ge 43 % x y x≥0 44 2 index width lt and 45 % x y x-valid? 46 1 index 0 ge 47 % x y x-valid? y≥0 48 2 index height lt and 49 % x y x-valid? y-valid? 50 and 51 % x y valid? 52 3 1 roll pop pop 53 % valid? 54 } bind def 55 56 % composite x y -> element 57 /getxy { 58 2 copy xy-valid? not { 1.125 pstack quit } if 59 % composite x y 60 width mul add 61 % composite offset 62 get 63 } bind def 64 65 % composite x y element -> 66 /putxy { 67 3 copy pop xy-valid? not { 2.125 pstack quit } if 68 % compose x y element 69 3 1 roll 70 % compose element x y 71 width mul add 72 % compose element offset 73 exch put 74 } bind def 75 76 % composite -> 77 /dumpmap { 78 0 1 height 1 sub { 79 % composite y 80 0 1 width 1 sub { 81 % composite y x 82 3 copy exch getxy 83 % composite y x element 84 15 string cvs 85 % composite y x (element) 86 stderr 32 write 87 stderr exch writestring 88 % composite y x 89 pop 90 % composite y 91 } for 92 % composite y 93 stderr 10 write 94 % composite y 95 pop 96 % composite 97 } for 98 % composite 99 pop 100 } bind def 101 102 /zmap width height mul string def 103 104 0 rawdata { 105 % y line 106 dup (S) search 107 { % y line suffix (S) prefix 108 length 109 % y line suffix (S) x 110 /startx exch def 111 % y line suffix (S) 112 pop pop 113 % y line 114 1 index /starty exch def 115 % y line 116 dup startx 97 put 117 % y fixed-line 118 } 119 { % y line line 120 pop 121 } 122 ifelse 123 % y line 124 dup (E) search 125 { % y line suffix (E) prefix 126 length 127 % y line suffix (E) x 128 /endx exch def 129 % y line suffix (E) 130 pop pop 131 % y line 132 1 index /endy exch def 133 % y line 134 dup endx 122 put 135 % y fixed-line 136 } 137 { % y line line 138 pop 139 } 140 ifelse 141 % y fixed-line 142 zmap exch 143 % y zmap fixed-line 144 2 index width mul 145 % y zmap fixed-line offset 146 exch putinterval 147 % y 148 1 add 149 % next-y 150 } forall 151 152 /stepmap [ 153 width height mul 154 % size 155 dup 1 sub 156 % size repeat-count 157 { dup } repeat 158 ] def 159 160 stepmap startx starty 0 putxy 161 162 % x y -> has-step? 163 /xy-has-step? { 164 % x y 165 stepmap 3 1 roll getxy 166 % steps 167 width height mul eq not 168 % has-step? 169 } bind def 170 171 % -> empty-queue 172 /new-queue { 100 dict } bind def 173 174 % queue x y -> 175 /enqueue { 176 2 dup xy-valid? 177 { width mul add 1 put } 178 { pop pop pop } 179 ifelse 180 } bind def 181 182 % whatever-is-pushed-by-queue-forall -> x y 183 /dequeue { 184 % key value 185 pop 186 % key 187 dup width mod 188 % key x 189 exch width idiv 190 % x y 191 } bind def 192 193 % source-x source-y dest-x dest-y -> valid? 194 /step-valid? { 195 % source-x source-y dest-x dest-y 196 zmap 3 1 roll getxy 197 % source-x source-y dest-z 198 zmap 4 2 roll getxy 199 % dest-z source-z 200 1 add le 201 } bind def 202 203 % valid-array x y ssource-x source-y -> new-valid-array 204 /push-step-if-exists { 205 2 copy xy-valid? 206 { 4 array astore apush } 207 { pop pop pop pop } 208 ifelse 209 } bind def 210 211 % x y proc -> 212 % proc is called repeatedly with [x y neighbor-x neighbor-y] 213 /forall-neighbors { 214 3 1 roll 0 array 215 % proc x y valid-array 216 3 copy pop 1 index 1 sub 1 index 217 % proc x y valid-array x y x-1 y 218 push-step-if-exists 219 % proc x y valid-array 220 3 copy pop 1 index 1 add 1 index 221 % proc x y valid-array x y x+1 y 222 push-step-if-exists 223 % proc x y valid-array 224 3 copy pop 2 copy 1 sub 225 % proc x y valid-array x y x y-1 226 push-step-if-exists 227 % proc x y valid-array 228 3 copy pop 2 copy 1 add 229 % proc x y valid-array x y x y+1 230 push-step-if-exists 231 % proc x y valid-array 232 3 1 roll pop pop 233 % proc valid-array 234 exch forall 235 } bind def 236 237 % x y proc -> 238 /forall-source-neighbors { 239 0 array 4 2 roll 240 % proc arg-array x y 241 { 242 % proc arg-array [x y neighbor-x neighbor-y] 243 dup aload pop 244 % proc arg-array [x y neighbor-x neighbor-y] x y neighbor-x neighbor-y 245 4 2 roll 246 % proc arg-array [x y neighbor-x neighbor-y] neighbor-x neighbor-y x y 247 step-valid? 248 { apush } 249 { pop } 250 ifelse 251 % proc arg-array 252 } forall-neighbors 253 % proc arg-array 254 exch forall 255 } bind def 256 257 % x y proc -> 258 /forall-dest-neighbors { 259 0 array 4 2 roll 260 % proc arg-array x y 261 { 262 % proc arg-array [x y neighbor-x neighbor-y] 263 dup aload pop 264 % proc arg-array [x y neighbor-x neighbor-y] x y neighbor-x neighbor-y 265 step-valid? 266 { apush } 267 { pop } 268 ifelse 269 % proc arg-array 270 } forall-neighbors 271 % proc arg-array 272 exch forall 273 } bind def 274 275 % queue -> 276 /draw-queue { 277 % queue 278 0 1 height 1 sub { 279 % queue y 280 width string 281 % queue y empty-string 282 0 1 width 1 sub { 283 % queue y string x 284 2 index 285 % queue y string x y 286 2 copy width mul add 287 % queue y string x y key 288 5 index exch known 289 % queue y string x y in-queue? 290 { 113 } 291 { 2 copy xy-has-step? { 35 } { 46 } ifelse } 292 ifelse 293 % queue y string x y char 294 3 index 3 index 3 2 roll put 295 % queue y string x y 296 pop pop 297 } for 298 % queue y string 299 stderr exch writestring 300 stderr 10 write 301 % queue y 302 pop 303 } for 304 % queue 305 pop 306 } bind def 307 308 309 310 % stderr (Height map:) writestring 311 % stderr 10 write 312 % zmap dumpmap 313 % 314 % stderr (Coordinates: ) writestring 315 % stderr startx 15 string cvs writestring 316 % stderr (, ) writestring 317 % stderr starty 15 string cvs writestring 318 % stderr ( -> ) writestring 319 % stderr endx 15 string cvs writestring 320 % stderr (, ) writestring 321 % stderr endy 15 string cvs writestring 322 % stderr 10 write 323 324 325 % queue x y -> 326 /enqueue-neighbors { 327 { 328 aload pop 329 % queue x y neighbor-x neighbor-y 330 4 copy step-valid? 331 { 332 % queue x y neighbor-x neighbor-y 333 4 2 roll pop pop 334 % queue neighbor-x neighbor-y 335 2 index 3 1 roll enqueue 336 % queue 337 } 338 { pop pop pop pop } 339 ifelse 340 % queue 341 } forall-neighbors 342 % queue 343 pop 344 } bind def 345 346 new-queue 347 startx starty { 348 aload pop 349 % queue x y neighbor-x neighbor-y 350 4 2 roll pop pop 351 % queue neighbor-x neighbor-y 352 2 index 3 1 roll enqueue 353 % queue 354 } forall-dest-neighbors 355 0 exch 356 { 357 % prev-cycle-count cur-queue 358 exch 1 add exch 359 % cycle-count cur-queue 360 dup length 0 eq { pop exit } if 361 % cycle-count cur-queue 362 new-queue exch 363 % cycle-count next-queue cur-queue 364 { 365 dequeue 366 % next-queue x y 367 2 copy stepmap 3 1 roll getxy 368 % next-queue x y old-steps 369 dup 4 1 roll 370 % next-queue old-steps x y old-steps 371 3 copy pop { 372 aload pop 373 % next-queue old-steps x y prev-steps x y neighbor-x neighbor-y 374 stepmap 3 1 roll getxy 375 % next-queue old-steps x y prev-steps x y neighbor-steps 376 1 add 377 % next-queue old-steps x y prev-steps x y new-steps 378 3 1 roll pop pop 379 % next-queue old-steps x y prev-steps new-steps 380 2 copy gt { exch } if pop 381 % next-queue old-steps x y min-steps 382 } forall-source-neighbors 383 % next-queue old-steps x y min-steps 384 dup 5 4 roll 385 % next-queue x y min-steps min-steps old-steps 386 lt { 387 % next-queue x y min-steps 388 3 copy pop { 389 aload pop 390 % next-queue x y min-steps x y neighbor-x neighbor-y 391 4 2 roll pop pop 392 % next-queue x y min-steps neighbor-x neighbor-y 393 5 index 3 1 roll enqueue 394 % next-queue x y min-steps 395 } forall-dest-neighbors 396 % next-queue x y min-steps 397 stepmap 4 1 roll putxy 398 } 399 { pop pop pop } 400 ifelse 401 % next-queue 402 } forall 403 } loop 404 405 /Helvetica 20 selectfont 406 407 408 (First Puzzle: ) 409 72 700 moveto show 410 stepmap endx endy getxy 411 dup width height mul eq 412 { pop (--error--) } 413 { 15 string cvs } 414 ifelse 415 show 416 417 (Second Puzzle: ) 418 72 664 moveto show 419 420 /stepmap [ 421 width height mul 422 % size 423 dup 1 sub 424 % size repeat-count 425 { dup } repeat 426 ] def 427 428 stepmap endx endy 0 putxy 429 430 new-queue 431 endx endy { 432 aload pop 433 % queue x y neighbor-x neighbor-y 434 4 2 roll pop pop 435 % queue neighbor-x neighbor-y 436 2 index 3 1 roll enqueue 437 % queue 438 } forall-source-neighbors 439 0 exch 440 { 441 % prev-cycle-count cur-queue 442 exch 1 add exch 443 % cycle-count cur-queue 444 dup length 0 eq { pop exit } if 445 % cycle-count cur-queue 446 new-queue exch 447 % cycle-count next-queue cur-queue 448 { 449 dequeue 450 % next-queue x y 451 2 copy stepmap 3 1 roll getxy 452 % next-queue x y old-steps 453 dup 4 1 roll 454 % next-queue old-steps x y old-steps 455 3 copy pop { 456 aload pop 457 % next-queue old-steps x y prev-steps x y neighbor-x neighbor-y 458 stepmap 3 1 roll getxy 459 % next-queue old-steps x y prev-steps x y neighbor-steps 460 1 add 461 % next-queue old-steps x y prev-steps x y new-steps 462 3 1 roll pop pop 463 % next-queue old-steps x y prev-steps new-steps 464 2 copy gt { exch } if pop 465 % next-queue old-steps x y min-steps 466 } forall-dest-neighbors 467 % next-queue old-steps x y min-steps 468 3 copy pop zmap 3 1 roll getxy 469 % next-queue old-steps x y min-steps z 470 97 eq { 471 ( ) show 472 dup 15 string cvs show 473 } if 474 % next-queue old-steps x y min-steps 475 dup 5 4 roll 476 % next-queue x y min-steps min-steps old-steps 477 lt { 478 % next-queue x y min-steps 479 3 copy pop { 480 aload pop 481 % next-queue x y min-steps x y neighbor-x neighbor-y 482 4 2 roll pop pop 483 % next-queue x y min-steps neighbor-x neighbor-y 484 5 index 3 1 roll enqueue 485 % next-queue x y min-steps 486 } forall-source-neighbors 487 % next-queue x y min-steps 488 stepmap 4 1 roll putxy 489 } 490 { pop pop pop } 491 ifelse 492 % next-queue 493 } forall 494 } loop 495 496 showpage 497 quit