aoc-all

My solutions to all Advent of Code
git clone https://git.instinctive.eu/aoc-all.git
Log | Files | Refs | README | LICENSE

day17.ps (21366B)


      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- day17.ps <day17.txt | display
     19 
     20 /datafile (%stdin) (r) file def
     21 /stderr (%stderr) (w) file def
     22 
     23 /data datafile 10100 string readline not { quit } if def
     24 
     25 /width 7 def
     26 
     27 % height -> arena
     28 /new-arena {
     29   % height
     30   width mul dup string exch
     31   % new-arena length
     32   1 sub
     33   % new-arena last-index
     34   0 1 3 2 roll {
     35     % new-arena index
     36     1 index exch 46 put % `.`
     37     % new-arena
     38   } for
     39   % new-arena
     40 } bind def
     41 
     42 % arena ->
     43 /dump-arena {
     44   % arena
     45   dup length width sub
     46   % arena first-index
     47   width neg 0 {
     48     % arena cur-index
     49     1 index exch width getinterval
     50     % arena cur-line
     51     stderr exch writestring
     52     stderr 10 write
     53     % arena
     54   } for
     55   % arena
     56   pop
     57 } bind def
     58 
     59 %%% [dx dy] of cells used by each shape, from the bottom left corner
     60 /shapes [
     61   %%% -
     62   [[0 0] [1 0] [2 0] [3 0]]
     63   %%% +
     64   [[1 0] [0 1] [1 1] [2 1] [1 2]]
     65   %%% J
     66   [[0 0] [1 0] [2 0] [2 1] [2 2]]
     67   %%% I
     68   [[0 0] [0 1] [0 2] [0 3]]
     69   %%% O
     70   [[0 0] [1 0] [0 1] [1 1]]
     71 ] def
     72 
     73 % arena shape-id x y -> bool
     74 /shape-fits? {
     75   % arena shape-id x y
     76   3 2 roll shapes length mod shapes exch get
     77   % arena x y cell-array
     78   true exch
     79   % arena x y result cell-array
     80   {
     81     % arena x y result cur-cell
     82     aload pop
     83     % arena x y result dx dy
     84     3 index add exch 4 index add
     85     % arena x y result cell-y cell-x
     86     dup 0 ge
     87     % arena x y result cell-y cell-x cell-x>=0?
     88     1 index width lt and
     89     % arena x y result cell-y cell-x cell-x-valid?
     90     2 index 0 ge and
     91     % arena x y result cell-y cell-x cell-xy-valid?
     92     { exch width mul add
     93       % arena x y result cell-offset
     94       4 index exch get
     95       % arena x y result cell-char
     96       46 eq
     97       % arena x y result cell-empty?
     98       not { pop false exit } if
     99       % arena x y result
    100     }
    101     { pop pop pop false exit }
    102     ifelse
    103     % arena x y result
    104   } forall
    105   % arena x y result
    106   4 1 roll pop pop pop
    107   % result
    108 } bind def
    109 
    110 % arena shape-id x y char ->
    111 /put-shape {
    112   % arena shape-id x y char
    113   4 3 roll
    114   % arena x y char shape-id
    115   shapes length mod shapes exch get
    116   % arena x y char cell-array
    117   {
    118     % arena x y char cur-cell
    119     aload pop
    120     % arena x y char dx dy
    121     3 index add exch 4 index add exch
    122     % arena x y char cell-x cell-y
    123     width mul add
    124     % arena x y char cell-offset
    125     4 index exch 2 index put
    126     % arena x y char
    127   } forall
    128   % arena x y char
    129   pop pop pop pop
    130   %
    131 } bind def
    132 
    133 % arena -> y
    134 /top-used-line {
    135   % arena
    136   dup length width idiv 1 sub
    137   % arena max-y
    138   {
    139     % arena cur-y
    140     dup 0 lt { exit } if
    141     % arena cur-y
    142     true
    143     % arena cur-y line-empty?
    144     0 1 width 1 sub {
    145       % arena cur-y line-empty? cur-x
    146       2 index width mul add
    147       % arena cur-y line-empty? cur-offset
    148       3 index exch get
    149       % arena cur-y line-empty? cur-cell
    150       46 eq
    151       % arena cur-y line-empty? cur-cell-empty?
    152       not { pop false exit } if
    153       % arena cur-y line-empty?
    154     } for
    155     % arena cur-y line-empty?
    156     not { exit } if
    157     % arena cur-y
    158     1 sub
    159     % arena next-y
    160   } loop
    161   % arena result
    162   exch pop
    163   % result
    164 } bind def
    165 
    166 % arena -> height-array
    167 /column-heights {
    168   % arena
    169   [ exch 0 1 width 1 sub {
    170       % mark prev-heights arena x
    171       1 index length width idiv
    172       % mark prev-heights arena x max-y+1
    173       {
    174         % mark prev-heights arena x prev-y
    175         1 sub
    176         % mark prev-heights arena x y
    177         dup 0 lt { exit } if
    178         % mark prev-heights arena x y
    179         dup width mul 2 index add
    180         % mark prev-heights arena x y offset
    181         3 index exch get 46 eq
    182         % mark prev-heights arena x y cell-empty?
    183         not { exit } if
    184         % mark prev-heights arena x y
    185       } loop
    186       % mark prev-heights arena x y
    187       3 1 roll pop
    188       % mark prev-heights y arena
    189     } for
    190     % mark heights arena
    191     pop
    192   ]
    193   % height-array
    194 } bind def
    195 
    196 % arena -> height-array
    197 /column-reverse-heights {
    198   % arena
    199   column-heights
    200   % height-array
    201   0 1 index {
    202     % height-array prev-max cur-item
    203     2 copy lt { exch } if pop
    204     % height-array cur-max
    205   } forall
    206   % height-array max
    207   exch
    208   % max height-array
    209   [ 3 1 roll
    210     % mark max height-array
    211     {
    212       % mark prev-items max cur-height
    213       1 index exch sub
    214       % mark prev-items max cur-item
    215       exch
    216       % mark prev-items cur-item max
    217     } forall
    218     % mark items max
    219     pop
    220   ]
    221   % reverse-height-array
    222 } bind def
    223 
    224 % array1 array2 -> bool
    225 /deep-eq {
    226   % array1 array2
    227   dup length
    228   % array1 array2 length2
    229   2 index length 1 index eq
    230   { % array1 array2 length
    231     true exch
    232     % array1 array2 cur-result length
    233     1 sub 0 1 3 2 roll {
    234       % array1 array2 prev-result index
    235       3 index 1 index get
    236       % array1 array2 prev-result index item1
    237       3 index 2 index get eq
    238       % array1 array2 prev-result index item1=item2?
    239       exch pop and
    240       % array1 array2 cur-result
    241       dup not { exit } if
    242       % array1 array2 cur-result
    243     } for
    244     % array1 array2 result
    245     3 1 roll pop pop
    246     % result
    247   }
    248   { pop pop pop false }
    249   ifelse
    250 } bind def
    251 
    252 % arena empty-lines-needed -> new-arena
    253 /ensure-lines {
    254   % arena empty-lines-needed
    255   1 index top-used-line 1 add
    256   % arena empty-lines-needed lines-used
    257   add
    258   % arena total-lines-needed
    259   width mul
    260   % arena total-length-needed
    261   1 index length 1 index ge
    262   % arena total-length-needed arena-is-big-enough?
    263   { pop }
    264   { % arena total-length-needed
    265     dup string exch
    266     % old-arena new-arena new-arena-length
    267     2 index length exch
    268     % old-arena new-arena old-arena-length new-arena-length
    269     1 sub 1 exch {
    270       % old-arena new-arena new-index
    271       1 index exch 46 put
    272       % old-arena new-arena
    273     } for
    274     % old-arena new-arena
    275     dup 0 4 3 roll putinterval
    276     % new-arena
    277   }
    278   ifelse
    279   % arena
    280 } bind def
    281 
    282 % arena -> shape-x shape-y
    283 /create-shape {
    284   % arena
    285   top-used-line 4 add
    286   % shape-y
    287   2 exch
    288   % shape-x shape-y
    289 } bind def
    290 
    291 % prev-arena prev-shape-id prev-time -> arena last-shape-id last-time
    292 /simulate-rock {
    293   % prev-arena prev-shape-id prev-time
    294   exch 1 add exch
    295   % prev-arena shape-id prev-time
    296   3 2 roll 7 ensure-lines 3 1 roll
    297   % arena shape-id prev-time
    298   2 index create-shape
    299   % arena shape-id prev-time shape-x shape-y
    300   {
    301     % arena shape-id prev-time shape-x shape-y
    302     3 2 roll 1 add dup 4 1 roll
    303     % arena shape-id time shape-x shape-y time
    304     data length mod
    305     % arena shape-id time shape-x shape-y move-offset
    306     data exch get
    307     % arena shape-id time shape-x shape-y move-char
    308     dup 60 eq
    309     % arena shape-id time shape-x shape-y move-char move-left?
    310     { pop -1 }
    311     { 62 eq
    312       % arena shape-id time shape-x shape-y move-right?
    313       { 1 }
    314       { 1.125 pstack quit }
    315       ifelse
    316     }
    317     ifelse
    318     % arena shape-id time shape-x shape-y dx
    319     2 index add
    320     % arena shape-id time shape-x shape-y new-shape-x
    321     5 index 5 index 2 index 4 index shape-fits?
    322     % arena shape-id time shape-x shape-y new-shape-x x-move-ok?
    323     { exch 3 2 roll pop }
    324     { pop }
    325     ifelse
    326     % arena shape-id time shape-x shape-y
    327     4 index 4 index 3 index 3 index 1 sub shape-fits?
    328     % arena shape-id time shape-x shape-y y-move-ok?
    329     { 1 sub }
    330     { % arena shape-id time shape-x shape-y
    331       4 index 4 index 4 2 roll
    332       % arena shape-id time arena shape-id shape-x shape-y
    333       35 put-shape % `#`
    334       % updated-arena shape-id time
    335       exit
    336     }
    337     ifelse
    338     % arena shape-id time shape-x shape-y
    339   } loop
    340   % updated-arena new-shape-id time
    341 } bind def
    342 
    343 
    344 /Helvetica 20 selectfont
    345 
    346 
    347 (First Puzzle: )
    348 72 700 moveto show
    349 
    350 10 new-arena -1 -1
    351 % arena shape-id time
    352 2022 { simulate-rock } repeat
    353 % arena last-shape-id last-time
    354 pop pop top-used-line 1 add
    355 % tower-height
    356 15 string cvs show
    357 
    358 (Second Puzzle: )
    359 72 664 moveto show
    360 
    361 %%% Let's assume no rock will be tucked below an overhang,
    362 %%% So that the whole floor can be represented by the height difference
    363 %%% of each cell with the tallest one.
    364 %%% We will use the convention of Y positive downwards, and Y=0 for the
    365 %%% highest non-empty row.
    366 %%% The height difference array, rock shape, and wind index describe
    367 %%% completely a state, and will be looking for a cycle
    368 %%%
    369 %%% UPDATE: turns out the reference inputs don't involve such a tuck,
    370 %%% but my input does. So most of the simulation stuff below is not
    371 %%% good enough. Let's try assuming the height difference array is good
    372 %%% enough as a hash of the current state, and use the pedestrian
    373 %%% simulation to derive the state machine.
    374 
    375 /shape-width [
    376   shapes {
    377     % cell-array
    378     0 exch {
    379       % prev-max-dx cell
    380       0 get
    381       % prev-max-dx cur-dx
    382       2 copy lt { exch } if pop
    383       % max-dx
    384     } forall
    385     % max-dx
    386     1 add
    387   } forall
    388 ] def
    389 
    390 % floor-array shape-id any shape-x shape-y -> bool
    391 /shape-fits-2 {
    392   { %%% 1-iteration loop to use `exit` as a short circuit
    393     % floor-array shape-id any shape-x shape-y
    394     1 index 0 lt
    395     % floor-array shape-id any shape-x shape-y shape-x<0
    396     5 index length 5 index shape-width exch get sub
    397     % floor-array shape-id any shape-x shape-y shape-x<0 max-shape-x
    398     3 index lt or
    399     % floor-array shape-id any shape-x shape-y shape-x-oob?
    400     { pop pop pop pop pop false exit } if
    401     % floor-array shape-id any shape-x shape-y
    402     dup 0 lt
    403     { pop pop pop pop pop true exit } if
    404     % floor-array shape-id any shape-x shape-y
    405     true 6 1 roll
    406     % true floor-array shape-id any shape-x shape-y
    407     shapes 4 index get {
    408       % result floor-array shape-id any shape-x shape-y cell
    409       aload pop
    410       % result floor-array shape-id any shape-x shape-y dx dy
    411       2 index exch sub
    412       % result floor-array shape-id any shape-x shape-y dx cell-y
    413       exch 3 index add
    414       % result floor-array shape-id any shape-x shape-y cell-y cell-x
    415       6 index exch get
    416       % result floor-array shape-id any shape-x shape-y cell-y floor-height-at-x
    417       ge {
    418         % result floor-array shape-id any shape-x shape-y
    419         6 5 roll pop false 6 1 roll
    420         % result floor-array shape-id any shape-x shape-y
    421         exit
    422       } if
    423       % result floor-array shape-id any shape-x shape-y
    424     } forall
    425     % result floor-array shape-id any shape-x shape-y
    426     pop pop pop pop pop
    427     % result
    428     exit
    429   } loop
    430 } bind def
    431 
    432 /wind-dx <<
    433  60 -1
    434  62  1
    435 >> def
    436 
    437 % floor-array shape-id wind-id shape-x shape-y
    438 %   -> floor-array shape-id wind-id shape-x shape-y finished?
    439 /time-step {
    440   % floor-array shape-id wind-id shape-x shape-y
    441   5 copy
    442   % save floor-array shape-id wind-id shape-x shape-y
    443   2 index data exch get wind-dx exch get
    444   % save floor-array shape-id wind-id shape-x shape-y wind-dx
    445   3 2 roll add
    446   % save floor-array shape-id wind-id shape-y updated-shape-x
    447   dup 6 1 roll exch
    448   % save updated-shape-x floor-array shape-id wind-id updated-shape-x shape-y
    449   shape-fits-2
    450   % floor-array shape-id wind-id shape-x shape-y updated-shape-x fits?
    451   { 3 1 roll exch } if pop
    452   % floor-array shape-id wind-id new-shape-x shape-y
    453   1 add
    454   % floor-array shape-id wind-id new-shape-x new-shape-y
    455   5 copy shape-fits-2
    456   % floor-array shape-id wind-id new-shape-x new-shape-y fits?
    457   { false }
    458   { 1 sub true }
    459   ifelse
    460 } bind def
    461 
    462 % total-height floor-array shape-id wind-id
    463 %   -> total-height floor-array shape-id wind-id
    464 /rock-step {
    465   % total-height floor-array shape-id wind-id
    466   2 -4
    467   % total-height floor-array shape-id wind-id shape-x shape-y
    468   { time-step
    469     % total-height floor-array shape-id wind-id shape-x shape-y finished?
    470     4 3 roll 1 add data length mod 4 1 roll
    471     % total-height floor-array shape-id next-wind-id shape-x shape-y finished?
    472     { exit } if
    473   } loop
    474   % total-height floor-array shape-id wind-id shape-x shape-y
    475   0 6 1 roll
    476   % total-height floor-min floor-array shape-id wind-id shape-x shape-y
    477   shapes 4 index get {
    478     % total-height floor-min floor-array shape-id wind-id shape-x shape-y cell
    479     aload pop
    480     % total-height floor-min floor-array shape-id wind-id shape-x shape-y dx dy
    481     2 index exch sub exch 3 index add exch
    482     % total-height floor-min floor-array shape-id wind-id shape-x shape-y cell-x cell-y
    483     6 index 2 index get
    484     % total-height floor-min floor-array shape-id wind-id shape-x shape-y cell-x cell-y floor-y
    485     2 copy gt { exch } if pop
    486     % total-height floor-min floor-array shape-id wind-id shape-x shape-y cell-x new-floor-y
    487     dup 8 index lt
    488     { 8 7 roll pop dup 8 1 roll } if
    489     % total-height floor-min floor-array shape-id wind-id shape-x shape-y cell-x new-floor-y
    490     6 index 3 1 roll put
    491     % total-height floor-min floor-array shape-id wind-id shape-x shape-y
    492   } forall
    493   % total-height floor-min floor-array shape-id wind-id shape-x shape-y
    494   pop pop
    495   % total-height floor-min floor-array shape-id wind-id
    496   5 3 roll
    497   % floor-array shape-id wind-id total-height floor-min
    498   exch 1 index sub
    499   % floor-array shape-id wind-id floor-min new-total-height
    500   5 1 roll
    501   % total-height floor-array shape-id wind-id floor-min
    502   0 1 5 index length 1 sub {
    503     % total-height floor-array shape-id wind-id floor-min i
    504     4 index 1 index get
    505     % total-height floor-array shape-id wind-id floor-min i old-y
    506     2 index sub
    507     % total-height floor-array shape-id wind-id floor-min i new-y
    508     5 index 3 1 roll put
    509     % total-height floor-array shape-id wind-id floor-min
    510   } for
    511   % total-height floor-array shape-id wind-id floor-min
    512   pop
    513   % total-height floor-array shape-id wind-id
    514   exch 1 add shapes length mod exch
    515   % total-height floor-array next-shape-id wind-id
    516 } bind def
    517 
    518 % floor-array shape-id wind-id -> key
    519 /state-to-key {
    520   % floor-array shape-id wind-id
    521   2 index length 3 add string
    522   % floor-array shape-id wind-id empty-key
    523   0 1 5 index length 1 sub {
    524     % floor-array shape-id wind-id key index
    525     4 index 1 index get
    526     % floor-array shape-id wind-id key index value
    527     2 index 3 1 roll put
    528     % floor-array shape-id wind-id key
    529   } for
    530   % floor-array shape-id wind-id key
    531   4 3 roll length
    532   % shape-id wind-id key shape-index
    533   1 index 1 index 5 index put
    534   % shape-id wind-id key shape-index
    535   1 add
    536   % shape-id wind-id key MSB-wind-index
    537   1 index 1 index 4 index 256 idiv put
    538   % shape-id wind-id key MSD-wind-index
    539   1 add
    540   % shape-id wind-id key LSD-wind-index
    541   1 index 1 index 4 index 256 mod put
    542   % shape-id wind-id key LSD-wind-index
    543   4 2 roll pop pop pop
    544   % key
    545 } bind def
    546 
    547 % key ->
    548 /dump-key {
    549   stderr ([) writestring
    550   {
    551     % char
    552     15 string cvs
    553     % (element)
    554     dup length 4 exch sub
    555     % (element) pad-count
    556     { stderr 32 write } repeat
    557     stderr exch writestring
    558   } forall
    559   stderr ( ]) writestring
    560 } bind def
    561 
    562 /state-machine 10000 dict def
    563 
    564 %%% 0 0 [ 7 { 0 } repeat ] 0 0
    565 %%% % stone-count total-height floor-array shape-id wind-id
    566 %%% 3 copy state-to-key 5 1 roll
    567 %%% {
    568 %%%   % prev-stone-count prev-key total-height floor-array shape-id wind-id
    569 %%%   6 5 roll 1 add 6 1 roll
    570 %%%   % stone-count prev-key total-height floor-array shape-id wind-id
    571 %%%   rock-step
    572 %%%   % stone-count prev-key total-height floor-array shape-id wind-id
    573 %%%   3 copy state-to-key
    574 %%%   % stone-count prev-key total-height floor-array shape-id wind-id new-key
    575 %%%   state-machine 6 index known
    576 %%%   { % stone-count prev-key total-height floor-array shape-id wind-id new-key
    577 %%%     stderr (Cycle found from stone ) writestring
    578 %%%     state-machine 6 index get 1 get
    579 %%%     stderr exch 15 string cvs writestring
    580 %%%     stderr ( at height ) writestring
    581 %%%     state-machine 6 index get 2 get
    582 %%%     stderr exch 15 string cvs writestring
    583 %%%     stderr ( to stone ) writestring
    584 %%%     6 index stderr exch 15 string cvs writestring
    585 %%%     stderr ( at height ) writestring
    586 %%%     4 index stderr exch 15 string cvs writestring
    587 %%%     stderr 10 write
    588 %%%     exit
    589 %%%   } if
    590 %%%   % stone-count prev-key total-height floor-array shape-id wind-id new-key
    591 %%%   [ 1 index 8 index 7 index ]
    592 %%%   % stone-count prev-key total-height floor-array shape-id wind-id new-key record
    593 %%%   6 index exch state-machine 3 1 roll put
    594 %%%   % stone-count prev-key total-height floor-array shape-id wind-id new-key
    595 %%%   6 1 roll 5 4 roll pop
    596 %%%   % stone-count new-key total-height floor-array shape-id wind-id
    597 %%% } loop
    598 %%% %%% At the end of the first cycle:
    599 %%% % stone-count prev-key total-height floor-array shape-id wind-id begin-key
    600 %%% 4 1 roll pop pop pop
    601 %%% % stone-count prev-key total-height begin-key
    602 %%% state-machine 3 index get aload pop
    603 %%% % stone-count prev-key total-height begin-key next-key begin-count begin-height
    604 %%% 5 4 roll 1 index sub
    605 %%% % stone-count prev-key begin-key next-key begin-count begin-height cycle-height
    606 %%% 7 6 roll 3 index sub
    607 %%% % prev-key begin-key next-key begin-count begin-height cycle-height cycle-count
    608 %%% 6 4 roll pop pop
    609 %%% % prev-key begin-count begin-height cycle-height cycle-count
    610 %%% 2022
    611 %%% % prev-key begin-count begin-height cycle-height cycle-count problem-count
    612 %%% 5 4 roll sub 4 3 roll pop
    613 %%% % prev-key cycle-height cycle-count problem-count-left
    614 %%% dup 2 index idiv
    615 %%% % prev-key cycle-height cycle-count problem-count-left full-cycles-in-problem
    616 %%% stderr (Found ) writestring
    617 %%% stderr 1 index 15 string cvs writestring
    618 %%% stderr ( cycles\012) writestring
    619 %%% % prev-key cycle-height cycle-count problem-count-left full-cycles-in-problem
    620 %%% 3 index mul exch
    621 %%% % prev-key cycle-height cycle-count height-in-full-cycles problem-count-left
    622 %%% 2 index mod
    623 %%% % prev-key cycle-height cycle-count height-in-full-cycles count-in-last-cycle
    624 %%% 4 index exch {
    625 %%%   % ... cur-key
    626 %%%   state-machine exch get 0 get
    627 %%%   % ... next-key
    628 %%% } repeat
    629 %%% % prev-key cycle-height cycle-count height-in-full-cycles last-key
    630 %%% state-machine exch get 2 get
    631 %%% % prev-key cycle-height cycle-count height-in-full-cycles last-height
    632 %%% add
    633 %%% % prev-key cycle-height cycle-count total-height
    634 %%% stderr (Result: ) writestring
    635 %%% stderr exch 15 string cvs writestring
    636 %%% stderr 10 write
    637 
    638 % key -> floor-array
    639 /key-to-column-heights {
    640   [ exch { } forall pop pop pop ]
    641 } bind def
    642 
    643 [ 7 { 0 } repeat ] 0 0
    644 state-to-key
    645 10 new-arena -1 -1
    646 % key arena rock-count time
    647 {
    648   % cur-key arena rock-count time
    649   simulate-rock
    650   % prev-key arena rock-count time
    651   2 index column-reverse-heights
    652   % prev-key arena rock-count time floor-array
    653   2 index shapes length mod
    654   % prev-key arena rock-count time floor-array shape-id
    655   2 index data length mod
    656   % prev-key arena rock-count time floor-array shape-id wind-id
    657   state-to-key
    658   % prev-key arena rock-count time cur-key
    659   state-machine 5 index known { exit } if
    660   % prev-key arena rock-count time cur-key
    661   [ 1 index 4 index 6 index top-used-line 1 add ]
    662   % prev-key arena rock-count time cur-key record
    663   state-machine exch 6 index exch put
    664   % prev-key arena rock-count time cur-key
    665   5 1 roll 4 3 roll pop
    666   % cur-key arena rock-count time
    667 } loop
    668 %%% We found a cycle here:
    669 %%%   prolog ---> last-prolog-key,count1,height1
    670 %%%   last-prolog-key ---> first-cycle-key,count2,height2
    671 %%%   first-cycle-key ---> second-cycle-key,count3,height3
    672 %%%   last-cycle-key  ---> first-cycle-key,count4,height4 ---> current-state
    673 
    674 % first-cycle-key arena rock-count time second-cycle-key
    675 pop
    676 % first-cycle-key arena rock-count time
    677 state-machine 4 index get aload pop 3 2 roll pop
    678 % first-cycle-key arena rock-count time count3 height3
    679 4 index top-used-line 1 add exch sub
    680 % first-cycle-key arena rock-count time count3 cycle-height
    681 3 index 2 index sub
    682 % first-cycle-key arena rock-count time count3 cycle-height cycle-count
    683 stderr (Cycle height: ) writestring
    684 stderr 2 index 15 string cvs writestring
    685 stderr (\012Cycle count: ) writestring
    686 stderr 1 index 15 string cvs writestring
    687 stderr (\012Cycle start: ) writestring
    688 stderr 3 index 15 string cvs writestring
    689 stderr 10 write
    690 % first-cycle-key arena rock-count time count3 cycle-height cycle-count
    691 6 3 roll pop pop pop
    692 % first-cycle-key count3 cycle-height cycle-count
    693 1000000000000
    694 % first-cycle-key count3 cycle-height cycle-count problem-count
    695 3 index sub
    696 % first-cycle-key count3 cycle-height cycle-count problem-count-after-prolog
    697 dup 2 index idiv
    698 % first-cycle-key count3 cycle-height cycle-count problem-count-after-prolog problem-cycles
    699 exch 2 index mod
    700 % first-cycle-key count3 cycle-height cycle-count problem-cycles epilog-count
    701 state-machine 6 index get exch 1 sub {
    702   % prev-state
    703   0 get
    704   % prev-key
    705   state-machine exch get
    706   % cur-state
    707 } repeat
    708 % first-cycle-key count3 cycle-height cycle-count problem-cycles last-state
    709 2 get
    710 % first-cycle-key count3 cycle-height cycle-count problem-cycles epilog-height
    711 exch 3 index mul add
    712 % first-cycle-key count3 cycle-height cycle-count problem-height
    713 15 string cvs show
    714 
    715 showpage
    716 quit