Done day 22.
authorNeil Smith <neil.git@njae.me.uk>
Sat, 23 Nov 2019 17:53:26 +0000 (17:53 +0000)
committerNeil Smith <neil.git@njae.me.uk>
Sat, 23 Nov 2019 17:53:26 +0000 (17:53 +0000)
advent-of-code.cabal
problems/day22.html [new file with mode: 0644]
src/advent21/advent21-from-megathread.hs [new file with mode: 0644]
src/advent22/advent22.hs [new file with mode: 0644]

index 68d29fa1d191ccbc574f9c6fc0e0788721a5e73c..47dfd898673965efc9fddaa0da549707f4f0db57 100644 (file)
@@ -249,4 +249,24 @@ executable advent21
                      , containers
                      , mtl
                      , text
-                     , megaparsec   
\ No newline at end of file
+                     , megaparsec   
+
+executable advent21fm
+  hs-source-dirs:      src/advent21
+  main-is:             advent21-from-megathread.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , containers
+                     , mtl
+                     , text
+                     , megaparsec
+                     , monad-loops
+                     , array
+
+executable advent22
+  hs-source-dirs:      src/advent22
+  main-is:             advent22.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , containers
+                     , pqueue
diff --git a/problems/day22.html b/problems/day22.html
new file mode 100644 (file)
index 0000000..107b467
--- /dev/null
@@ -0,0 +1,435 @@
+<!DOCTYPE html>
+<html lang="en-us">
+<head>
+<meta charset="utf-8"/>
+<title>Day 22 - Advent of Code 2018</title>
+<!--[if lt IE 9]><script src="/static/html5.js"></script><![endif]-->
+<link href='//fonts.googleapis.com/css?family=Source+Code+Pro:300&subset=latin,latin-ext' rel='stylesheet' type='text/css'>
+<link rel="stylesheet" type="text/css" href="/static/style.css?20"/>
+<link rel="stylesheet alternate" type="text/css" href="/static/highcontrast.css?0" title="High Contrast"/>
+<link rel="shortcut icon" href="/favicon.png"/>
+</head><!--
+
+
+
+
+Oh, hello!  Funny seeing you here.
+
+I appreciate your enthusiasm, but you aren't going to find much down here.
+There certainly aren't clues to any of the puzzles.  The best surprises don't
+even appear in the source until you unlock them for real.
+
+Please be careful with automated requests; I'm not Google, and I can only take
+so much traffic.  Please be considerate so that everyone gets to play.
+
+If you're curious about how Advent of Code works, it's running on some custom
+Perl code. Other than a few integrations (auth, analytics, ads, social media),
+I built the whole thing myself, including the design, animations, prose, and
+all of the puzzles.
+
+The puzzles are most of the work; the easiest ones take 3-4 hours each, but the
+harder ones take 6-8 hours, and a few even longer than that. A lot of effort
+went into building this thing - I hope you're enjoying playing it as much as I
+enjoyed making it for you!
+
+If you'd like to hang out, I'm @ericwastl on Twitter.
+
+- Eric Wastl
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+-->
+<body>
+<header><div><h1 class="title-global"><a href="/">Advent of Code</a></h1><nav><ul><li><a href="/2018/about">[About]</a></li><li><a href="/2018/events">[Events]</a></li><li><a href="https://teespring.com/adventofcode-2019" target="_blank">[Shop]</a></li><li><a href="/2018/settings">[Settings]</a></li><li><a href="/2018/auth/logout">[Log Out]</a></li></ul></nav><div class="user">Neil Smith <a href="/2018/support" class="supporter-badge" title="Advent of Code Supporter">(AoC++)</a> <span class="star-count">44*</span></div></div><div><h1 class="title-event">&nbsp;&nbsp;<span class="title-event-wrap">{year=&gt;</span><a href="/2018">2018</a><span class="title-event-wrap">}</span></h1><nav><ul><li><a href="/2018">[Calendar]</a></li><li><a href="/2018/support">[AoC++]</a></li><li><a href="/2018/sponsors">[Sponsors]</a></li><li><a href="/2018/leaderboard">[Leaderboard]</a></li><li><a href="/2018/stats">[Stats]</a></li></ul></nav></div></header>
+
+<div id="sidebar">
+<div id="sponsor"><div class="quiet">Our <a href="/2018/sponsors">sponsors</a> help make Advent of Code possible:</div><div class="sponsor"><a href="https://www.wearedevelopers.com/world-congress/" target="_blank" onclick="if(ga)ga('send','event','sponsor','click',this.href);" rel="noopener">WeAreDevelopers</a> - Use &quot;AOC-25&quot;, save EUR 25 and join 10^4 devs on June 6-7 at the WeAreDevelopers World Congress in Berlin ticket.get(now)</div></div>
+</div><!--/sidebar-->
+
+<main>
+<article class="day-desc"><h2>--- Day 22: Mode Maze ---</h2><p>This is it, your final stop: the year <span title="Yes, really: there is no year zero.">-483</span>. It's snowing and dark outside; the only light you can see is coming from a small cottage in the distance. You make your way there and knock on the door.</p>
+<p>A portly man with a large, white beard answers the door and invites you inside. For someone living near the North Pole in -483, he must not get many visitors, but he doesn't act surprised to see you. Instead, he offers you some milk and cookies.</p>
+<p>After talking for a while, he asks a favor of you. His friend hasn't come back in a few hours, and he's not sure where he is.  Scanning the region briefly, you discover one life signal in a cave system nearby; his friend must have taken shelter there.  The man asks if you can go there to retrieve his friend.</p>
+<p>The cave is divided into square <em>regions</em> which are either dominantly <em>rocky</em>, <em>narrow</em>, or <em>wet</em> (called its <em>type</em>). Each region occupies exactly one <em>coordinate</em> in <code>X,Y</code> format where <code>X</code> and <code>Y</code> are integers and zero or greater. (Adjacent regions can be the same type.)</p>
+<p>The scan (your puzzle input) is not very detailed: it only reveals the <em>depth</em> of the cave system and the <em>coordinates of the target</em>. However, it does not reveal the type of each region. The mouth of the cave is at <code>0,0</code>.</p>
+<p>The man explains that due to the unusual geology in the area, there is a method to determine any region's type based on its <em>erosion level</em>. The erosion level of a region can be determined from its <em>geologic index</em>. The geologic index can be determined using the first rule that applies from the list below:</p>
+<ul>
+<li>The region at <code>0,0</code> (the mouth of the cave) has a geologic index of <code>0</code>.</li>
+<li>The region at the coordinates of the target has a geologic index of <code>0</code>.</li>
+<li>If the region's <code>Y</code> coordinate is <code>0</code>, the geologic index is its <code>X</code> coordinate times <code>16807</code>.</li>
+<li>If the region's <code>X</code> coordinate is <code>0</code>, the geologic index is its <code>Y</code> coordinate times <code>48271</code>.</li>
+<li>Otherwise, the region's geologic index is the result of multiplying the erosion <em>levels</em> of the regions at <code>X-1,Y</code> and <code>X,Y-1</code>.</li>
+</ul>
+<p>A region's <em>erosion level</em> is its <em>geologic index</em> plus the cave system's <em>depth</em>, all <a href="https://en.wikipedia.org/wiki/Modulo_operation">modulo</a> <code>20183</code>. Then:</p>
+<ul>
+<li>If the <em>erosion level modulo <code>3</code></em> is <code>0</code>, the region's type is <em>rocky</em>.</li>
+<li>If the <em>erosion level modulo <code>3</code></em> is <code>1</code>, the region's type is <em>wet</em>.</li>
+<li>If the <em>erosion level modulo <code>3</code></em> is <code>2</code>, the region's type is <em>narrow</em>.</li>
+</ul>
+<p>For example, suppose the cave system's depth is <code>510</code> and the target's coordinates are <code>10,10</code>. Using <code>%</code> to represent the modulo operator, the cavern would look as follows:</p>
+<ul>
+<li>At <code>0,0</code>, the geologic index is <code>0</code>. The erosion level is <code>(0 + 510) % 20183 = 510</code>. The type is <code>510 % 3 = 0</code>, <em>rocky</em>.</li>
+<li>At <code>1,0</code>, because the <code>Y</code> coordinate is <code>0</code>, the geologic index is <code>1 * 16807 = 16807</code>. The erosion level is <code>(16807 + 510) % 20183 = 17317</code>. The type is <code>17317 % 3 = 1</code>, <em>wet</em>.</li> 
+<li>At <code>0,1</code>, because the <code>X</code> coordinate is <code>0</code>, the geologic index is <code> 1 * 48271 = 48271</code>. The erosion level is <code>(48271 + 510) % 20183 = 8415</code>. The type is <code>8415 % 3 = 0</code>, <em>rocky</em>.</li>
+<li>At <code>1,1</code>, neither coordinate is <code>0</code> and it is not the coordinate of the target, so the geologic index is the erosion level of <code>0,1</code> (<code>8415</code>) times the erosion level of <code>1,0</code> (<code>17317</code>), <code>8415 * 17317 = 145722555</code>. The erosion level is <code>(145722555 + 510) % 20183 = 1805</code>. The type is <code>1805 % 3 = 2</code>, <em>narrow</em>.</li>
+<li>At <code>10,10</code>, because they are the target's coordinates, the geologic index is <code>0</code>. The erosion level is <code>(0 + 510) % 20183 = 510</code>. The type is <code>510 % 3 = 0</code>, <em>rocky</em>.</li>
+</ul>
+<p>Drawing this same cave system with rocky as <code>.</code>, wet as <code>=</code>, narrow as <code>|</code>, the mouth as <code>M</code>, the target as <code>T</code>, with <code>0,0</code> in the top-left corner, <code>X</code> increasing to the right, and <code>Y</code> increasing downward, the top-left corner of the map looks like this:</p>
+<pre><code><em>M</em>=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===<em>T</em>===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+</code></pre>
+<p>Before you go in, you should determine the <em>risk level</em> of the area. For the rectangle that has a top-left corner of region <code>0,0</code> and a bottom-right corner of the region containing the target, add up the risk level of each individual region: <code>0</code> for rocky regions, <code>1</code> for wet regions, and <code>2</code> for narrow regions.</p>
+<p>In the cave system above, because the mouth is at <code>0,0</code> and the target is at <code>10,10</code>, adding up the risk level of all regions with an <code>X</code> coordinate from <code>0</code> to <code>10</code> and a <code>Y</code> coordinate from <code>0</code> to <code>10</code>, this total is <code><em>114</em></code>.</p>
+<p><em>What is the total risk level for the smallest rectangle that includes <code>0,0</code> and the target's coordinates?</em></p>
+</article>
+<p>Your puzzle answer was <code>8575</code>.</p><article class="day-desc"><h2 id="part2">--- Part Two ---</h2><p>Okay, it's time to go rescue the man's friend.</p>
+<p>As you leave, he hands you some tools: a <em>torch</em> and some <em>climbing gear</em>. You can't equip both tools at once, but you can choose to use <em>neither</em>.</p>
+<p>Tools can only be used in certain regions:</p>
+<ul>
+<li>In <em>rocky</em> regions, you can use the <em>climbing gear</em> or the <em>torch</em>. You cannot use <em>neither</em> (you'll likely slip and fall).</li>
+<li>In <em>wet</em> regions, you can use the <em>climbing gear</em> or <em>neither</em> tool. You cannot use the <em>torch</em> (if it gets wet, you won't have a light source).</li>
+<li>In <em>narrow</em> regions, you can use the <em>torch</em> or <em>neither</em> tool. You cannot use the <em>climbing gear</em> (it's too bulky to fit).</li>
+</ul>
+<p>You start at <code>0,0</code> (the mouth of the cave) with <em>the torch equipped</em> and must reach the target coordinates as quickly as possible. The regions with negative <code>X</code> or <code>Y</code> are solid rock and cannot be traversed. The fastest route might involve entering regions beyond the <code>X</code> or <code>Y</code> coordinate of the target.</p>
+<p>You can <em>move to an adjacent region</em> (up, down, left, or right; never diagonally) if your currently equipped tool allows you to enter that region. Moving to an adjacent region takes <em>one minute</em>. (For example, if you have the <em>torch</em> equipped, you can move between <em>rocky</em> and <em>narrow</em> regions, but cannot enter <em>wet</em> regions.)</p>
+<p>You can <em>change your currently equipped tool or put both away</em> if your new equipment would be valid for your current region. Switching to using the <em>climbing gear</em>, <em>torch</em>, or <em>neither</em> always takes <em>seven minutes</em>, regardless of which tools you start with. (For example, if you are in a <em>rocky</em> region, you can switch from the <em>torch</em> to the <em>climbing gear</em>, but you cannot switch to <em>neither</em>.)</p>
+<p>Finally, once you reach the target, you need the <em>torch</em> equipped before you can find him in the dark. The target is always in a <em>rocky</em> region, so if you arrive there with <em>climbing gear</em> equipped, you will need to spend seven minutes switching to your torch.</p>
+<p>For example, using the same cave system as above, starting in the top left corner (<code>0,0</code>) and moving to the bottom right corner (the target, <code>10,10</code>) as quickly as possible, one possible route is as follows, with your current position marked <code>X</code>:</p>
+<pre><code>Initially:
+<em>X</em>=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down:
+M=.|=.|.|=.|=|=.
+<em>X</em>|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.<em>X</em>=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using the torch to neither tool:
+M=.|=.|.|=.|=|=.
+.<em>X</em>=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right 3:
+M=.|=.|.|=.|=|=.
+.|=|<em>X</em>|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using neither tool to the climbing gear:
+M=.|=.|.|=.|=|=.
+.|=|<em>X</em>|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down 7:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..<em>X</em>==..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..=<em>X</em>=..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down 3:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||.<em>X</em>.|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||..<em>X</em>|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.<em>X</em>..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right 4:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=<em>X</em>||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Up 2:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===<em>X</em>===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using the climbing gear to the torch:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===<em>X</em>===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+</code></pre>
+<p>This is tied with other routes as the <em>fastest way to reach the target</em>: <code><em>45</em></code> minutes. In it, <code>21</code> minutes are spent switching tools (three times, seven minutes each) and the remaining <code>24</code> minutes are spent moving.</p>
+<p><em>What is the fewest number of minutes you can take to reach the target?</em></p>
+</article>
+<p>Your puzzle answer was <code>999</code>.</p><p class="day-success">Both parts of this puzzle are complete! They provide two gold stars: **</p>
+<p>At this point, you should <a href="/2018">return to your Advent calendar</a> and try another puzzle.</p>
+<p>If you still want to see it, you can <a href="22/input" target="_blank">get your puzzle input</a>.</p>
+<p>You can also <span class="share">[Share<span class="share-content">on
+  <a href="https://twitter.com/intent/tweet?text=I%27ve+completed+%22Mode+Maze%22+%2D+Day+22+%2D+Advent+of+Code+2018&amp;url=https%3A%2F%2Fadventofcode%2Ecom%2F2018%2Fday%2F22&amp;related=ericwastl&amp;hashtags=AdventOfCode" target="_blank">Twitter</a>
+  <a href="http://www.reddit.com/submit?url=https%3A%2F%2Fadventofcode%2Ecom%2F2018%2Fday%2F22&amp;title=I%27ve+completed+%22Mode+Maze%22+%2D+Day+22+%2D+Advent+of+Code+2018" target="_blank">Reddit</a
+></span>]</span> this puzzle.</p>
+</main>
+
+<!-- ga -->
+<script>
+(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+})(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+ga('create', 'UA-69522494-1', 'auto');
+ga('set', 'anonymizeIp', true);
+ga('send', 'pageview');
+</script>
+<!-- /ga -->
+</body>
+</html>
\ No newline at end of file
diff --git a/src/advent21/advent21-from-megathread.hs b/src/advent21/advent21-from-megathread.hs
new file mode 100644 (file)
index 0000000..6a52cf8
--- /dev/null
@@ -0,0 +1,107 @@
+{-|
+Module:         Day21
+Description:    <https://adventofcode.com/2018/day/21 Day 21: Chronal Conversion>
+-}
+{-# LANGUAGE FlexibleContexts, RecordWildCards, TypeApplications #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+import Control.Monad.Cont (callCC, runCont, runContT)
+import Control.Monad.Loops (iterateM_)
+import Control.Monad.State (evalState, get, put)
+import Data.Array.Unboxed (Array, IArray, Ix, UArray, (!), (//), bounds, inRange, listArray)
+import Data.Bits (Bits, (.&.), (.|.))
+import Data.Bool (bool)
+import qualified Data.IntSet as S (empty, insert, member)
+import Data.List (genericLength)
+import Text.Megaparsec (MonadParsec, between, choice, parseMaybe, sepEndBy)
+import Text.Megaparsec.Char (newline, space, string)
+import Text.Megaparsec.Char.Lexer (decimal)
+
+data Op
+  = ADDR | ADDI | MULR | MULI | BANR | BANI | BORR | BORI
+  | SETR | SETI | GTIR | GTRI | GTRR | EQIR | EQRI | EQRR
+  deriving (Eq)
+
+data Instruction i = Instruction {op :: Op, a :: i, b :: i, c :: i}
+
+
+main :: IO ()
+main = do 
+        text <- readFile "data/advent21.txt"
+        print $ day21a text
+        print $ day21b text
+
+
+parser :: (IArray a (Instruction i), MonadParsec e String m, Integral i, Ix i) => m (i, a i (Instruction i))
+parser = do
+    ip <- between (string "#ip" *> space) newline decimal
+    isns <- flip sepEndBy newline $ do
+        op <- choice
+          [ ADDR <$ string "addr", ADDI <$ string "addi"
+          , MULR <$ string "mulr", MULI <$ string "muli"
+          , BANR <$ string "banr", BANI <$ string "bani"
+          , BORR <$ string "borr", BORI <$ string "bori"
+          , SETR <$ string "setr", SETI <$ string "seti"
+          , GTIR <$ string "gtir", GTRI <$ string "gtri", GTRR <$ string "gtrr"
+          , EQIR <$ string "eqir", EQRI <$ string "eqri", EQRR <$ string "eqrr"
+          ]
+        Instruction op <$> (space *> decimal) <*> (space *> decimal) <*> (space *> decimal)
+    return (ip, listArray (0, genericLength isns - 1) isns)
+
+doOp :: (IArray a i, Bits i, Integral i, Ix i) => a i i -> Op -> i -> i -> i
+doOp r ADDR a b = r ! a + r ! b
+doOp r ADDI a b = r ! a + b
+doOp r MULR a b = r ! a * r ! b
+doOp r MULI a b = r ! a * b
+doOp r BANR a b = r ! a .&. r ! b
+doOp r BANI a b = r ! a .&. b
+doOp r BORR a b = r ! a .|. r ! b
+doOp r BORI a b = r ! a .|. b
+doOp r SETR a _ = r ! a
+doOp _ SETI a _ = a
+doOp r GTIR a b = bool 0 1 $ a > r ! b
+doOp r GTRI a b = bool 0 1 $ r ! a > b
+doOp r GTRR a b = bool 0 1 $ r ! a > r ! b
+doOp r EQIR a b = bool 0 1 $ a == r ! b
+doOp r EQRI a b = bool 0 1 $ r ! a == b
+doOp r EQRR a b = bool 0 1 $ r ! a == r ! b
+
+step :: (Monad m, IArray a1 i, IArray a2 (Instruction i), Bits i, Integral i, Ix i, Show (a1 i i)) => (i -> m ()) -> i -> a2 i (Instruction i) -> a1 i i -> m (a1 i i)
+step f ip isns regs
+  | c == 0 = fail "writing value to register 0"
+  | op == EQRR, a == 0, c /= ip = regs // [(c, 0), (ip, regs ! ip + 1)] <$ f (regs ! b)
+  | op == EQRR, b == 0, c /= ip = regs // [(c, 0), (ip, regs ! ip + 1)] <$ f (regs ! a)
+  | (op /= SETI && a == 0) || (op `elem` [ADDR, MULR, BANR, BORR, GTIR, GTRR, EQIR, EQRR] && b == 0)
+  = fail "reading from register 0"
+  | inRange (bounds isns) (base + 8)
+  , Instruction SETI 0 _ t <- isn, t `notElem` [0, ip]
+  , Instruction ADDI t' 1 u <- isns ! (base + 1), t == t', u `notElem` [0, ip, t]
+  , Instruction MULI u' n u'' <- isns ! (base + 2), u == u', n > 0, u == u''
+  , Instruction GTRR u' r u'' <- isns ! (base + 3), u == u', r `notElem` [0, ip, t], u == u''
+  , Instruction ADDR u' ip' ip'' <- isns ! (base + 4), u == u', ip == ip', ip == ip''
+  , Instruction ADDI ip' 1 ip'' <- isns ! (base + 5), ip == ip', ip == ip''
+  , Instruction SETI base' _ ip' <- isns ! (base + 6), base + 8 == base', ip == ip'
+  , Instruction ADDI t' u' t'' <- isns ! (base + 7), t == t', u == u', t == t''
+  , Instruction SETI base' _ ip' <- isns ! (base + 8), base == base', ip == ip'
+  = return $ regs // [(ip, base + 9), (t, max 0 $ regs ! r `div` n), (u, 1)]
+  | otherwise
+  = return $ regs // if ip == c then [(ip, result + 1)] else [(ip, regs ! ip + 1), (c, result)]
+  where base = regs ! ip
+        isn@Instruction {..} = isns ! base
+        result = doOp regs op a b
+
+day21a :: String -> Maybe Int
+day21a input = do
+    (ip, isns) <- parseMaybe @() (parser @Array) input
+    let regs = listArray @UArray (0, 5) $ repeat 0
+    return $ flip runCont id $ callCC $ \f -> iterateM_ (step f ip isns) regs
+
+day21b :: String -> Maybe Int
+day21b input = do
+    (ip, isns) <- parseMaybe @() (parser @Array) input
+    let regs = listArray @UArray (0, 5) $ repeat 0
+        reportDup f i = do
+            (seen, prior) <- get
+            if i `S.member` seen then f prior else put (S.insert i seen, i)
+    return $ flip evalState (S.empty, undefined) $ flip runContT return $ callCC $ \f ->
+        iterateM_ (step (reportDup f) ip isns) regs
diff --git a/src/advent22/advent22.hs b/src/advent22/advent22.hs
new file mode 100644 (file)
index 0000000..a8c44f2
--- /dev/null
@@ -0,0 +1,182 @@
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+
+import Debug.Trace
+
+-- import Prelude hiding ((++))
+
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Data.List
+
+import qualified Data.PQueue.Prio.Min as P
+import qualified Data.Set as S
+import qualified Data.Sequence as Q
+import Data.Sequence ((<|), (|>), (><))
+import Data.Foldable (toList, foldr', foldl', all)
+import Data.Maybe (fromJust)
+import Debug.Trace
+
+type Coord = (Integer, Integer)
+type Cave = M.Map Coord Integer
+
+
+data Region = Rocky | Wet | Narrow deriving (Eq, Ord, Show)
+data Tool = Rope | Torch | Neither deriving (Eq, Ord, Show)
+data Explorer = Explorer { _tool :: Tool
+                         , _coord :: Coord
+                         , _time :: Integer
+                         } deriving (Ord, Show)
+type ExploredStates = S.Set Explorer
+
+type RegionCave = M.Map Coord Region
+
+data Agendum = Agendum { _current :: Explorer
+                       , _trail :: Q.Seq Explorer
+                       , _cost :: Int} deriving (Show, Eq)
+type Agenda = P.MinPQueue Int Agendum 
+type Candidates = S.Set (Int, Agendum)
+
+
+instance Eq Explorer where
+    e1 == e2   = (_tool e1 == _tool e2) && (_coord e1 == _coord e2)
+
+
+depth :: Integer
+-- depth = 510
+depth = 10689
+
+target :: Coord
+-- target = (10, 10)
+target = (11, 722)
+
+width :: Integer
+width = fst target
+
+height :: Integer
+height = snd target
+
+
+main :: IO ()
+main = do 
+        print $ part1
+        print $ part2
+        -- print $ part2 ip instrs
+
+part1 = cave_risk_level $ erosion_levels width height
+
+part2 = _time $ _current $ fromJust result
+    where cave = region_cave $ erosion_levels (width + height + 10)  (width + height + 10)
+          result = aStar (initAgenda) cave S.empty
+
+
+
+geologic_index_mouth = 0
+geologic_index_target = 0
+geologic_index_y0 x =  x * 16807
+geologic_index_x0 y =  y * 48271
+geologic_index l u = l * u
+
+erosion_level gi = (gi + depth) `mod` 20183
+
+risk_level el = el `mod` 3
+
+region_type 0 = Rocky
+region_type 1 = Wet
+region_type 2 = Narrow
+
+erosion_levels :: Integer -> Integer -> Cave
+erosion_levels w h = M.insert (width, height) (erosion_level $ geologic_index_target) cave
+    where cave0 = M.singleton (0, 0) $ erosion_level $ geologic_index_mouth
+          cave_top = foldl' (\c x -> M.insert (x, 0) (erosion_level $ geologic_index_y0 x) c) cave0 [1..w]
+          cave_left = foldl' (\c y -> M.insert (0, y) (erosion_level $ geologic_index_x0 y) c) cave_top [1..h]
+          cave = foldl' insert_erosion_level 
+                        cave_left
+                        [ (xx, yy) | xx <- [1..w], yy <- [1..h] ]
+          insert_erosion_level c (x, y) = M.insert (x, y) (erosion_level $ geologic_index (c!((x - 1), y)) (c!(x, (y - 1)))) c
+
+cave_risk_level cave = sum $ map risk_level $ M.elems cave
+
+region_cave cave = M.map (region_type . risk_level) cave
+
+
+initAgenda :: Agenda
+initAgenda = P.singleton (estimateCost explorer) Agendum { _current = explorer, _trail = Q.empty, _cost = estimateCost explorer}
+    where explorer = Explorer { _coord = (0, 0), _tool = Torch, _time = 0 }
+
+
+aStar :: Agenda -> RegionCave -> ExploredStates -> Maybe Agendum
+-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0}
+aStar agenda cave closed 
+    -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined
+    -- | trace ("Peeping " ++ (show $ P.findMin agenda) ) False = undefined
+    | P.null agenda = Nothing
+    | otherwise = 
+        if isGoal reached then Just currentAgendum
+        else if reached `S.member` closed 
+            then aStar (P.deleteMin agenda) cave closed
+            else aStar newAgenda cave (S.insert reached closed)
+        where 
+            (_, currentAgendum) = P.findMin agenda
+            reached = _current currentAgendum
+            newAgenda = foldl' (\q a -> P.insert (_cost a) a q) (P.deleteMin agenda) $ candidates currentAgendum cave closed
+
+
+
+candidates :: Agendum -> RegionCave -> ExploredStates -> (Q.Seq Agendum)
+candidates agendum cave closed = newCandidates
+    where
+        candidate = _current agendum
+        previous = _trail agendum
+        succs = legalSuccessors cave $ successors candidate
+        nonloops = Q.filter (\s -> not $ s `S.member` closed) succs
+        newCandidates = fmap (\n -> makeAgendum n) nonloops
+        makeAgendum new = Agendum { _current = new
+                                  , _trail = candidate <| previous
+                                  , _cost = estimateCost new + (fromIntegral $ _time new)
+                                  }
+
+isGoal :: Explorer -> Bool
+isGoal explorer = (_coord explorer) == target && (_tool explorer) == Torch
+
+
+isLegal :: RegionCave -> Explorer -> Bool
+isLegal cave explorer = 
+    legalInRegion region tool
+    where region = cave!(_coord explorer)
+          tool = _tool explorer
+
+legalInRegion :: Region -> Tool -> Bool
+legalInRegion Rocky Rope = True
+legalInRegion Rocky Torch = True
+legalInRegion Wet Rope = True
+legalInRegion Wet Neither = True
+legalInRegion Narrow Torch = True
+legalInRegion Narrow Neither = True
+legalInRegion _ _ = False
+
+
+successors :: Explorer -> (Q.Seq Explorer)
+successors explorer = movingSuccessors >< switchingSuccessors
+    where time = _time explorer
+          (x, y) = _coord explorer
+          tool = _tool explorer
+          locations = filter (\(x', y') -> x' >= 0 && y' >= 0) 
+                            [(x, y + 1),  (x, y - 1), (x + 1, y), (x - 1, y)]
+          tools = [t | t <- [Rope, Torch, Neither] , t /= tool ]
+          movingSuccessors = fmap (\l -> explorer { _coord = l, _time = time + 1}) $ Q.fromList locations
+          switchingSuccessors = fmap (\t -> explorer { _tool = t, _time = time + 7}) $ Q.fromList tools
+
+
+legalSuccessors :: RegionCave -> (Q.Seq Explorer) -> (Q.Seq Explorer)
+legalSuccessors cave = Q.filter (isLegal cave)
+
+
+estimateCost :: Explorer -> Int
+estimateCost explorer = fromIntegral $ (abs (x - width)) + (abs (y - height))
+    where (x, y) = _coord explorer
+
+