day16.ps (13274B)
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- day16.ps <day16.txt | display 19 20 % (str1) (str2) -> (str1str2) 21 /strcat { 22 % (str1) (str2) 23 dup length 24 % (str1) (str2) str2-len 25 2 index length add 26 % (str1) (str2) result-len 27 string 28 % (str1) (str2) (null) 29 3 copy exch 3 2 roll length exch 30 % (str1) (str2) (null) (null) str1-len (str2) 31 putinterval 32 % (str1) (str2) (nullstr2) 33 exch pop 34 % (str1) (nullstr2) 35 dup 3 2 roll 36 % (nullstr2) (nullstr2) (str1) 37 0 exch putinterval 38 % (str1str2) 39 } bind def 40 41 % [ item_1 ... item_n ] item_0 -> [ item_0 item_1 ... item_n ] 42 /apush { 43 % array new_item 44 exch aload length 1 add array astore 45 } bind def 46 47 % [ item_0 item_1 ... item_n ] -> [ item_1 ... item_n ] item_0 48 /apop { 49 aload length 1 sub array astore exch 50 } bind def 51 52 53 54 /datafile (%stdin) (r) file def 55 /stderr (%stderr) (w) file def 56 57 58 /id-dict 100 dict def 59 /rate-dict 100 dict def 60 /link-dict 100 dict def 61 0 62 { 63 1 add 64 % id 65 datafile 300 string readline 66 not { pop exit } if 67 % id (Valve AA has flow rate=0; tunnels lead to valves DD, II, BB) 68 (Valve ) anchorsearch 69 not { pstack quit } if 70 pop 71 % id (AA has flow rate=0; tunnels lead to valves DD, II, BB) 72 ( has flow rate=) search 73 not { pstack quit } if 74 exch pop exch 75 % id key (0; tunnels lead to valves DD, II, BB) 76 (; ) search 77 not { pstack quit } if 78 exch pop cvi exch 79 % id key rate (tunnels lead to valves DD, II, BB) 80 [ exch 81 % key rate mark (tunnels lead to valves DD, II, BB) 82 (tunnel leads to valve ) anchorsearch 83 { pop } 84 { (tunnels lead to valves ) anchorsearch 85 not { pstack quit } if 86 pop 87 % key rate mark (DD, II, BB) 88 { 89 % prev-conections suffix 90 (, ) search 91 { exch pop exch 92 % prev-connections cur-connection next-suffix 93 } 94 { % prev-connections last-connection 95 exit 96 } 97 ifelse 98 } loop 99 % key rate mark connections 100 } 101 ifelse 102 ] 103 % id key rate connections 104 link-dict exch 3 index exch put 105 % id key rate 106 id-dict 2 index 4 index put 107 % id key rate 108 rate-dict 3 1 roll put 109 % id 110 } loop 111 % first-unused-id 112 1 sub dup mul dict /shortest-path-length exch def 113 114 /dump-shortest-path-length { 115 stderr ( ) writestring 116 id-dict { 117 pop 2 string cvs 118 stderr 32 write 119 stderr exch writestring 120 } forall 121 stderr 10 write 122 id-dict { 123 pop 2 string cvs 124 % (start) 125 stderr 1 index writestring 126 id-dict { 127 pop 2 string cvs 128 % (start) (end) 129 1 index exch strcat 130 % (start) (startend) 131 shortest-path-length 1 index known 132 % (start) (startend) known? 133 { shortest-path-length exch get 134 % (start) length 135 15 string cvs 136 % (start) (length) 137 3 string 138 % (start) (length) (cell) 139 0 1 2 index length 1 sub { 140 % (start) (length) (cell) offset 141 1 index exch 32 put 142 % (start) (length) (cell) 143 } for 144 % (start) (length) (cell) 145 dup dup length 3 index length sub 146 % (start) (length) (cell) (cell) offset 147 4 3 roll putinterval 148 % (start) (cell) 149 } 150 { pop ( .) } 151 ifelse 152 % (start) (cell) 153 stderr exch writestring 154 % (start) 155 } forall 156 % (start) 157 pop 158 % 159 stderr 10 write 160 } forall 161 } bind def 162 163 %%% seed shortest-path-length with 0-step and 1-step paths 164 link-dict { 165 % start dest-list 166 exch 2 string cvs exch 167 % start dest-list 168 { 169 % start dest 170 1 index exch strcat 171 % start startdest 172 shortest-path-length exch 1 put 173 % start 174 } forall 175 % start 176 dup strcat 177 % startstart 178 shortest-path-length exch 0 put 179 % 180 } forall 181 182 %%% extend paths while shortest-path-length is not full 183 1 { 184 % prev-step-rank 185 1 add 186 % step-rank 187 shortest-path-length length shortest-path-length maxlength eq 188 % step-rank finished? 189 { exit } if 190 % 191 link-dict { 192 % step-rank step-start step-dest-list 193 exch 2 string cvs exch 194 % step-rank step-start step-dest-list 195 { 196 % step-rank step-start step-dest 197 shortest-path-length { 198 % step-rank step-start step-dest path-key path-len 199 dup 1 add 5 index eq 200 { 201 % step-rank step-start step-dest path-key path-len 202 exch 4 string cvs 203 % step-rank step-start step-dest path-len path-key 204 dup 2 2 getinterval 205 % step-rank step-start step-dest path-len path-key path-suffix 206 4 index eq 207 % step-rank step-start step-dest path-len path-key step-extends-path? 208 { % step-rank step-start step-dest path-len path-key 209 0 2 getinterval 2 index strcat 210 % step-rank step-start step-dest path-len new-path-key 211 shortest-path-length 1 index known 212 % step-rank step-start step-dest path-len new-path-key new-path-known? 213 { pop pop } 214 { % step-rank step-start step-dest path-len new-path-key 215 exch 1 add 216 % step-rank step-start step-dest new-path-key new-path-len 217 shortest-path-length 3 1 roll put 218 % step-rank step-start step-dest 219 } 220 ifelse 221 % step-rank step-start step-dest 222 } 223 { pop pop } 224 ifelse 225 % step-rank step-start step-dest 226 } 227 { pop pop } 228 ifelse 229 % step-rank step-start step-dest 230 } forall 231 % step-rank step-start step-dest 232 pop 233 % step-rank step-start 234 } forall 235 % step-rank step-start 236 pop 237 } forall 238 % step-rank 239 } loop 240 241 %dump-shortest-path-length quit 242 243 /nz-valve-list [ 244 rate-dict { 245 % name rate 246 0 eq 247 { pop } 248 { 2 string cvs } 249 ifelse 250 } forall 251 ] def 252 253 /nz-id-dict << 254 0 nz-valve-list { 255 % prev-count name 256 exch 257 % name prev-count 258 dup 1 add 259 % name prev-count count 260 } forall 261 % name1 rank1 ... namen rankn count 262 pop 263 >> def 264 265 % id -> bitset 266 /nz-id-mask { 267 % id 268 nz-id-dict exch get 269 % rank 270 1 exch { 2 mul } repeat 271 % bitset 272 } bind def 273 274 /nz-count nz-valve-list length def 275 /nz-pow 1 nz-count { 2 mul } repeat def 276 277 % set id -> bool 278 /nz-set-contains { 279 % set id 280 nz-id-mask 281 % set mask 282 and 0 eq not 283 % result 284 } bind def 285 286 % set id -> new-set 287 /nz-set-include { 288 nz-id-mask or 289 } bind def 290 291 %%% best-score dictionary: 292 %%% starting-id * nz-pow + bitfield-of-available-valves 293 %%% -> array of score over time 294 %%% with index 0 being the minute of opening starting-id 295 /best-score nz-count nz-pow mul dict def 296 297 % [val1 val2 .. valn] i -> [0 .. 0 val1 val2 .. valn-i] 298 /shift-array { 299 % [val1 val2 .. valn] i 300 dup { 0 exch } repeat 301 % [val1 val2 .. valn] 0 .. 0 i 302 dup 2 add dup 1 sub roll 303 % 0 .. 0 i [val1 val2 .. valn] 304 aload length 305 % 0 .. 0 i val1 val2 .. valn n 306 dup 2 add dup 1 sub roll 307 % 0 .. 0 val1 val2 .. valn n i 308 { exch pop } repeat 309 % 0 .. 0 val1 val2 .. valn-i n 310 array astore 311 % [0 .. 0 val1 val2 .. valn-i] 312 } bind def 313 314 % [val1a val2a ... valna] [val1b val2b ... valmb] 315 % -> [max(val1a,val1b) max(val2a,val2b) ... max(val(min(m,n))a, val(min(m,n))b) 316 /each-max-array { 317 % [val1a val2a ... valna] [val1b val2b ... valmb] 318 0 1 3 index length 3 index length 319 % [val1a val2a ... valna] [val1b val2b ... valmb] 0 1 n m 320 2 copy gt { exch } if pop 321 % [val1a val2a ... valna] [val1b val2b ... valmb] 0 1 min(m,n) 322 [ 6 1 roll 323 % mark [val1a val2a ... valna] [val1b val2b ... valmb] 0 1 min(m,n) 324 1 sub { 325 % prev-items [val1a val2a ... valna] [val1b val2b ... valmb] i 326 2 index 1 index get 327 % prev-items [val1a val2a ... valna] [val1b val2b ... valmb] i valia 328 exch 2 index exch get 329 % prev-items [val1a val2a ... valna] [val1b val2b ... valmb] valia valib 330 2 copy lt { exch } if pop 331 % prev-items [val1a val2a ... valna] [val1b val2b ... valmb] cur-item 332 3 1 roll 333 % prev-items cur-item [val1a val2a ... valna] [val1b val2b ... valmb] 334 } for 335 % mark items [val1a val2a ... valna] [val1b val2b ... valmb] 336 pop pop 337 ] 338 } bind def 339 340 % starting-node available-mask -> best-score-array 341 /best-score-from { 342 % starting-node mask 343 [] 344 % starting-node mask cur-best 345 nz-valve-list { 346 % starting-node mask prev-best next-node 347 2 index 1 index nz-set-contains 348 % starting-node mask prev-best next-node next-node-in-mask? 349 { % starting-node mask prev-best next-node 350 nz-id-dict 1 index get 351 % starting-node mask prev-best next-node next-node-num 352 nz-pow mul 3 index add 353 % starting-node mask prev-best next-node next-node-key 354 best-score exch get 355 % starting-node mask prev-best next-node best-score-from-next-node 356 4 index 2 index strcat 357 shortest-path-length exch get 358 shift-array 359 % starting-node mask prev-best next-node best-score-from-starting-node 360 exch pop 361 % starting-node mask prev-best best-score-from-starting-node 362 1 index length 0 eq 363 { exch pop } 364 { each-max-array } 365 ifelse 366 % starting-node mask cur-best 367 } 368 { pop } 369 ifelse 370 % starting-node mask cur-best 371 } forall 372 % starting-node mask best-score-array 373 3 1 roll pop pop 374 % best-score-array 375 } bind def 376 377 %%% seed the score dictionary with single-valves and prepate todo-dict 378 nz-count dict 379 nz-valve-list { 380 % prev-todo valve-name 381 rate-dict 1 index get 382 % prev-todo valve-name rate 383 1 index nz-id-mask 384 % prev-todo valve-name rate mask 385 3 index 1 index 1 put 386 % todo valve-name rate mask 387 nz-id-dict 3 index get 388 % todo valve-name rate mask valve-num 389 nz-pow mul add 390 % todo valve-name rate key 391 exch [ exch 0 exch 392 % todo valve-name key [ 0 rate 393 dup 30 mul { } for ] 394 % todo valve-name key score-array 395 best-score 3 1 roll put 396 % todo valve-name 397 pop 398 } forall 399 % todo-dict 400 401 { 402 % todo-dict 403 [ exch { pop } forall ] 404 % todo-list 405 stderr (Cycle with ) writestring 406 stderr 1 index length 15 string cvs writestring 407 stderr ( to do\012) writestring 408 stderr flushfile 409 % cur-todo 410 dup length 0 eq { exit } if 411 % cur-todo 412 nz-pow dict exch 413 % next-todo cur-todo 414 { 415 % next-todo cur-mask 416 nz-valve-list { 417 % next-todo cur-mask new-valve 418 2 copy nz-set-contains 419 { pop } 420 { % next-todo cur-mask new-valve 421 rate-dict 1 index get 422 % next-todo cur-mask new-valve rate 423 1 index 3 index best-score-from 424 % next-todo cur-mask new-valve rate best-score-from-new-valve 425 1 shift-array 426 % next-todo cur-mask new-valve rate shifted-best-score 427 1 1 2 index length 1 sub { 428 % ... rate best-score index 429 2 copy get 430 % ... rate best-score index prev-value 431 3 index 2 index mul add 432 % ... rate best-score index new-value 433 2 index 3 1 roll put 434 % ... rate updated-best-score 435 } for 436 % next-todo cur-mask new-valve rate best-score-with-new-valve 437 exch pop 438 % next-todo cur-mask new-valve best-score-with-new-valve 439 2 index 2 index nz-set-include 440 % next-todo cur-mask new-valve best-score-with-new-valve new-mask 441 4 index 1 index 1 put 442 % next-todo cur-mask new-valve best-score-with-new-valve new-mask 443 3 2 roll 444 % next-todo cur-mask best-score-with-new-valve new-mask new-valve 445 nz-id-dict exch get nz-pow mul add 446 % next-todo cur-mask best-score-with-new-valve new-key 447 exch best-score 3 1 roll put 448 % next-todo cur-mask 449 } 450 ifelse 451 % next-todo cur-mask 452 } forall 453 % next-todo cur-mask 454 pop 455 } forall 456 % next-todo 457 } loop 458 459 460 /Helvetica 20 selectfont 461 462 463 (First Puzzle: ) 464 72 700 moveto show 465 (AA) nz-pow 1 sub best-score-from 466 29 get 467 15 string cvs show 468 469 470 (Second Puzzle: ) 471 72 664 moveto show 472 0 0 1 1 nz-pow 2 sub { 473 % prev-progress prev-best my-mask 474 dup 100 mul nz-pow 2 sub idiv 475 % prev-progress prev-best my-mask cur-progress 476 3 index 1 index eq 477 { pop } 478 { stderr (\015Second puzzle at ) writestring 479 stderr 1 index 15 string cvs writestring 480 stderr (%) writestring 481 stderr flushfile 482 % prev-progress prev-best my-mask cur-progress 483 4 1 roll 3 2 roll pop 484 % cur-progress prev-best my-mask 485 } 486 ifelse 487 % progress prev-best my-mask 488 nz-pow 1 sub 1 index sub 489 % progress prev-best my-mask elephant-mask 490 (AA) exch best-score-from 25 get 491 % progress prev-best my-mask elephant-score 492 exch (AA) exch best-score-from 25 get 493 % progress prev-best elephant-score my-score 494 add 495 % progress prev-best total-score 496 2 copy lt { exch } if pop 497 % progress best-score 498 } for 499 stderr 10 write 500 15 string cvs show 501 502 showpage 503 quit