From f471b8b86fb78499870b911cfa853b52259e4aa7 Mon Sep 17 00:00:00 2001
From: Jordan Doyle <jordan@doyle.la>
Date: Sat, 23 Dec 2023 23:43:50 +0000
Subject: [PATCH] Add day 18

---
 2023/10.hs | 10 +---------
 2023/18.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 aoc.hs     |  9 +++++++++
 3 files changed, 72 insertions(+), 9 deletions(-)
 create mode 100755 2023/18.hs

diff --git a/2023/10.hs b/2023/10.hs
index 39d22ba..969bef7 100755
--- a/2023/10.hs
+++ b/2023/10.hs
@@ -1,7 +1,7 @@
 #!/usr/bin/env nix-shell
 #!nix-shell --pure -i "runghc -- -i../" -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"
 
-import Aoc (readAndParseStdin)
+import Aoc (readAndParseStdin, shoelace)
 import Data.List
 import Data.Maybe (listToMaybe)
 import qualified Data.Set as Set
@@ -46,14 +46,6 @@ countBoundaryPoints vertices = sum (zipWith boundaryPoints vertices (tail vertic
 picksTheorem :: Double -> Int -> Double
 picksTheorem area boundaryPoints = area - (fromIntegral boundaryPoints / 2) + 1
 
--- calculates the area for the polygon described by the set of
--- verticies using the shoelace formula
-shoelace :: [(Int, Int)] -> Double
-shoelace vertices =
-  let pairs = zip vertices $ tail vertices
-      sumProd (x1, y1) (x2, y2) = x1 * y2 - x2 * y1
-   in fromIntegral (abs . sum $ zipWith sumProd vertices (tail vertices)) / 2
-
 -- builds the list of directions that forms the pipe loop
 buildPipeLoop :: [[Tile]] -> [Direction]
 buildPipeLoop grid =
diff --git a/2023/18.hs b/2023/18.hs
new file mode 100755
index 0000000..1b40680
--- /dev/null
+++ b/2023/18.hs
@@ -0,0 +1,62 @@
+#!/usr/bin/env nix-shell
+#!nix-shell --pure -i "runghc -- -i../" -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [ ])"
+
+import Aoc (readAndParseStdin, shoelace)
+import Text.Parsec (char, choice, count, digit, hexDigit, many1, sepBy, spaces, string)
+import Text.Parsec.String (Parser)
+
+main = do
+  input <- readAndParseStdin parse
+  print $ (score . map fst) input
+  print $ (score . map snd) input
+
+score :: [(Direction, Int)] -> Int
+score input = round $ shoelace (calculateVertices input) + fromIntegral (perimiter input `div` 2) + 1
+
+perimiter :: [(Direction, Int)] -> Int
+perimiter = sum . map snd
+
+calculateVertices :: [(Direction, Int)] -> [(Int, Int)]
+calculateVertices input = go input 0 0
+  where
+    go [] hAcc vAcc = []
+    go ((d, c) : xs) hAcc vAcc =
+      let (newHAcc, newVAcc) = calcAcc d c hAcc vAcc
+       in (newHAcc, newVAcc) : go xs newHAcc newVAcc
+
+calcAcc :: Direction -> Int -> Int -> Int -> (Int, Int)
+calcAcc U c hAcc vAcc = (hAcc, vAcc - c)
+calcAcc D c hAcc vAcc = (hAcc, vAcc + c)
+calcAcc L c hAcc vAcc = (hAcc - c, vAcc)
+calcAcc R c hAcc vAcc = (hAcc + c, vAcc)
+
+parse :: Parser [((Direction, Int), (Direction, Int))]
+parse = parseLine `sepBy` char '\n'
+
+parseLine :: Parser ((Direction, Int), (Direction, Int))
+parseLine = do
+  p1d <- parseDirection <* spaces
+  p1c <- read <$> many1 digit <* spaces
+  p2c <- string "(#" *> count 5 hexDigit
+  p2d <- parseNumericDirection <* char ')'
+  return ((p1d, p1c), (p2d, read ("0x" ++ p2c)))
+
+parseDirection :: Parser Direction
+parseDirection =
+  choice
+    [ U <$ char 'U',
+      D <$ char 'D',
+      L <$ char 'L',
+      R <$ char 'R'
+    ]
+
+parseNumericDirection :: Parser Direction
+parseNumericDirection =
+  choice
+    [ U <$ char '3',
+      D <$ char '1',
+      L <$ char '2',
+      R <$ char '0'
+    ]
+
+data Direction = U | D | L | R deriving (Show, Enum)
diff --git a/aoc.hs b/aoc.hs
index 551e349..1474b56 100644
--- a/aoc.hs
+++ b/aoc.hs
@@ -57,3 +57,12 @@ printMultiChoiceGrid xs = putStrLn $ unlines $ (map . map) multiChoiceGridTileCh
     multiChoiceGridTileChar (Just True) = 'O'
     multiChoiceGridTileChar (Just False) = '#'
     multiChoiceGridTileChar Nothing = '.'
+
+-- calculates the area for a polygon described by the set of
+-- verticies using the shoelace formula
+shoelace :: [(Int, Int)] -> Double
+shoelace vertices =
+  let pairs = zip vertices $ tail vertices
+      sumProd (x1, y1) (x2, y2) = x1 * y2 - x2 * y1
+   in fromIntegral (abs . sum $ zipWith sumProd vertices (tail vertices)) / 2
+
--
libgit2 1.7.2