13-2

1 files changed, 79 insertions, 0 deletions

diff --git a/13-2.hs b/13-2.hs
new file mode 100644
index 0000000..cd4abd4
--- /dev/null
+++ b/13-2.hs
@@ -0,0 +1,79 @@
+import Data.Array
+import Data.Ratio (denominator, numerator)
+import Text.Parsec
+
+type Matrix = Array (Int,Int) Rational
+
+type Pair = (Rational,Rational)
+
+det :: Matrix -> Rational
+det m = a*d - b*c
+  where
+    a = m ! (1,1)
+    b = m ! (2,1)
+    c = m ! (1,2)
+    d = m ! (2,2)
+
+matrix :: Pair -> Pair -> Matrix
+matrix (a,c) (b,d) =
+  array ((1,1),(2,2)) [((1,1),a), ((2,1),b), ((1,2),c), ((2,2),d)]
+
+solve :: Pair -> Pair -> Pair -> Pair
+solve target a b = (solA, solB)
+  where
+    coefficients = matrix a b
+    solA = det (matrix target b) / det coefficients
+    solB = det (matrix a target) / det coefficients
+
+int :: Rational -> Bool
+int = (== 1) . denominator
+
+maybeSolve :: Pair -> Pair -> Pair -> Maybe Pair
+maybeSolve target a b =
+  let sol@(a',b') = solve target a b
+  in if int a' && int b'
+     then Just sol
+     else Nothing
+
+cost :: Pair -> Pair -> Pair -> Int
+cost target a b = case maybeSolve target a b of
+  Nothing -> 0
+  Just (a',b') -> fromIntegral . numerator $ 3*a' + b'
+
+cost' :: (Pair,Pair,Pair) -> Int
+cost' (a, b, target) = cost target a b
+
+number :: Parsec String () Rational
+number = fromInteger . read <$> many digit
+
+button :: Parsec String () Pair
+button = (,)
+  <$  string "Button "
+  <*  anyChar
+  <*  string ": X+"
+  <*> number
+  <*  string ", Y+"
+  <*> number
+  <*  newline
+
+prize :: Parsec String () Pair
+prize = (,)
+  <$  string "Prize: X="
+  <*> ((+ 10000000000000) <$> number)
+  <*  string ", Y="
+  <*> ((+ 10000000000000) <$> number)
+  <*  newline
+
+parseOne :: Parsec String () (Pair,Pair,Pair)
+parseOne = (,,) <$> button <*> button <*> prize
+
+parseInput :: Parsec String () [(Pair,Pair,Pair)]
+parseInput = sepBy parseOne newline
+
+doParse :: String -> [(Pair,Pair,Pair)]
+doParse s = case parse parseInput "" s of
+  Left e  -> error $ show e
+  Right a -> a
+
+main :: IO ()
+main = getContents >>= print . sum . map cost' . doParse