From 64e7414bf1a3d2391383c4d5c55180d2c7950c9d Mon Sep 17 00:00:00 2001
From: Neil Smith <neil.git@njae.me.uk>
Date: Thu, 12 Dec 2019 13:26:46 +0000
Subject: [PATCH] Moving to another machine

---
 advent12/package.yaml    |  61 ++++++++++++++++++++++++
 advent12/src/advent12.hs | 100 +++++++++++++++++++++++++++++++++++++++
 data/advent12.txt        |   4 ++
 data/advent12a.txt       |   4 ++
 stack.yaml               |   1 +
 5 files changed, 170 insertions(+)
 create mode 100644 advent12/package.yaml
 create mode 100644 advent12/src/advent12.hs
 create mode 100644 data/advent12.txt
 create mode 100644 data/advent12a.txt

diff --git a/advent12/package.yaml b/advent12/package.yaml
new file mode 100644
index 0000000..faab90b
--- /dev/null
+++ b/advent12/package.yaml
@@ -0,0 +1,61 @@
+# This YAML file describes your package. Stack will automatically generate a
+# Cabal file when you run `stack build`. See the hpack website for help with
+# this file: <https://github.com/sol/hpack>.
+
+name: advent12
+synopsis: Advent of Code
+version: '0.0.1'
+
+default-extensions:
+- AllowAmbiguousTypes
+- ApplicativeDo
+- BangPatterns
+- BlockArguments
+- DataKinds
+- DeriveFoldable
+- DeriveFunctor
+- DeriveGeneric
+- DeriveTraversable
+- EmptyCase
+- FlexibleContexts
+- FlexibleInstances
+- FunctionalDependencies
+- GADTs
+- GeneralizedNewtypeDeriving
+- ImplicitParams
+- KindSignatures
+- LambdaCase
+- MonadComprehensions
+- MonoLocalBinds
+- MultiParamTypeClasses
+- MultiWayIf
+- NegativeLiterals
+- NumDecimals
+- OverloadedLists
+- OverloadedStrings
+- PartialTypeSignatures
+- PatternGuards
+- PatternSynonyms
+- PolyKinds
+- RankNTypes
+- RecordWildCards
+- ScopedTypeVariables
+- TemplateHaskell
+- TransformListComp
+- TupleSections
+- TypeApplications
+- TypeInType
+- TypeOperators
+- ViewPatterns
+
+
+executables:
+  advent12:
+    main: advent12.hs
+    source-dirs: src
+    dependencies:
+    - base >= 2 && < 6
+    - text
+    - megaparsec
+    - containers
+    - linear
diff --git a/advent12/src/advent12.hs b/advent12/src/advent12.hs
new file mode 100644
index 0000000..b847d28
--- /dev/null
+++ b/advent12/src/advent12.hs
@@ -0,0 +1,100 @@
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+
+import Data.Void (Void)
+
+import Text.Megaparsec hiding (State)
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+import qualified Control.Applicative as CA
+
+import Linear (V3(..), (^+^), (^-^))
+
+import qualified Data.Set as S
+
+-- import Data.List (foldl')
+-- import Data.Set ((\\))
+-- import qualified Data.Map.Strict as M
+-- import Data.Map.Strict ((!))
+
+
+type Vec = V3 Integer
+data Planet = Planet { _pos :: Vec, _vel :: Vec} deriving (Show, Eq, Ord)
+type Planets = S.Set Planet
+
+
+main :: IO ()
+main = do 
+        text <- TIO.readFile "data/advent12a.txt"
+        let planetsT = successfulParse text
+        let planets = enplanet planetsT
+        print planets
+        print $ part1 planets
+
+
+part1 planets = take 12 $ simulate planets
+
+
+enplanet  = S.fromList . map (\p -> Planet {_pos = p, _vel = (V3 0 0 0)} )
+
+_x (V3 x _ _) = x
+_y (V3 _ y _) = y
+_z (V3 _ _ z) = z
+
+
+gravity (V3 x y z) = V3 (signum x) (signum y) (signum z)
+
+
+simulate = iterate simulationStep 
+
+simulationStep planets = planets''
+    where   planets' = applyGravity planets
+            planets'' = applyVelocity planets'
+
+
+applyGravity planets = S.map (applyGravityHere planets) planets
+
+applyGravityHere planets here = S.foldl' updateGravity here planets
+
+updateGravity here there = here { _vel = vel'}
+    where   vel = _vel here
+            vel' = vel ^+^ gravity ((_pos there) ^-^ (_pos here))
+
+
+applyVelocity = S.map applyVelocityHere
+
+applyVelocityHere here = here {_pos = (_pos here) ^+^ (_vel here)}
+
+
+
+-- Parse the input file
+type Parser = Parsec Void Text
+
+sc :: Parser ()
+sc = L.space (skipSome spaceChar) CA.empty CA.empty
+-- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
+
+lexeme  = L.lexeme sc
+integer = lexeme L.decimal
+signedInteger = L.signed sc integer
+symb = L.symbol sc
+equalP = symb "="
+commaP = symb ","
+identifierP = some alphaNumChar <* sc
+openBracketP = symb "<"
+closeBracketP = symb ">"
+
+planetsP = many planetP
+
+planetP = (between openBracketP closeBracketP) coordsP
+
+coordsP = envector <$> (coordP `sepBy` commaP)
+    where envector [x, y, z] = V3 x y z
+coordP = identifierP *> equalP *> signedInteger
+
+
+successfulParse :: Text -> [Vec]
+successfulParse input = 
+        case parse planetsP "input" input of
+                Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+                Right planets -> planets
\ No newline at end of file
diff --git a/data/advent12.txt b/data/advent12.txt
new file mode 100644
index 0000000..1754c6a
--- /dev/null
+++ b/data/advent12.txt
@@ -0,0 +1,4 @@
+<x=15, y=-2, z=-6>
+<x=-5, y=-4, z=-11>
+<x=0, y=-6, z=0>
+<x=5, y=9, z=6>
diff --git a/data/advent12a.txt b/data/advent12a.txt
new file mode 100644
index 0000000..89cc805
--- /dev/null
+++ b/data/advent12a.txt
@@ -0,0 +1,4 @@
+<x=-1, y=0, z=2>
+<x=2, y=-10, z=-7>
+<x=4, y=-8, z=8>
+<x=3, y=5, z=-1>
diff --git a/stack.yaml b/stack.yaml
index 70ad0dd..aa87edf 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -49,6 +49,7 @@ packages:
 - advent09
 - advent10
 - advent11
+- advent12
 
 
 # Dependency packages to be pulled from upstream that are not in the resolver.
-- 
2.34.1