Tidying.

diff --git a/advent15/package.yaml b/advent15/package.yaml
index dd5494a737427c61c0b5aa35630861b6c9276ce3..a6c48c24eae31ae2f5b14cec2239c3c9d13bf59a 100644 (file)
--- a/advent15/package.yaml
+++ b/advent15/package.yaml
@@ -58,3 +58,13 @@ executables:
     - text
     - containers
     - intcode
+
+  advent15optics:
+    main: advent15optics.hs
+    source-dirs: src
+    dependencies:
+    - base >= 2 && < 6
+    - text
+    - containers
+    - intcode
+    - lens

diff --git a/advent15/src/advent15.hs b/advent15/src/advent15.hs
index 4aaee02bc5a2f9ab2ef09566dd2deb1bea699afe..4038d07538d17782dd0e2fb24a50718f68bc004b 100644 (file)
--- a/advent15/src/advent15.hs
+++ b/advent15/src/advent15.hs
@@ -46,7 +46,7 @@ main = do
         print $ part2 mem
 
 part1 mem = _fromStart $ snd $ M.findMin $ M.filter (containsGoal) hull
-    where hull = fst $ head $ searchHull $ initialHullBoundary mem
+    where hull = searchHull $ initialHullBoundary mem
 
 
 part2 mem = fillTime hull S.empty [(start, 0)] 0
@@ -85,24 +85,14 @@ initialHullBoundary mem = (hull, [(0, 0)])
           hull = M.singleton (0, 0) (Empty {_droid = droid, _fromStart = 0, _isGoal = False})
 
 
-searchHull :: (Hull, Boundary) -> [(Hull, Boundary)]
-searchHull hullBoundary = dropWhile goalNotFound $ iterate searchHullStep hullBoundary
+searchHull :: (Hull, Boundary) -> Hull
+searchHull hullBoundary = fst $ head $ dropWhile goalNotFound $ iterate searchHullStep hullBoundary
 
 
 completeHull :: (Hull, Boundary) -> Hull
 completeHull hullBoundary = fst $ head $ dropWhile incomplete $ iterate searchHullStep hullBoundary
 
 
-fillTime _ _ [] t = t
-fillTime hull closed ((here, t):boundary) maxt
-    | hull!here == Wall = fillTime hull closed boundary maxt
-    | S.member here closed = fillTime hull closed boundary maxt
-    | otherwise = fillTime hull closed' (boundary ++ neighbours) (max maxt t)
-    where closed' = S.insert here closed
-          neighbours = map (\d -> (step here d, t + 1)) directions
-          directions = [North, East, South, West] :: [Direction]
-
-
 searchHullStep :: (Hull, Boundary) -> (Hull, Boundary)
 -- searchHullStep (hull, _) | trace (showHull hull) False = undefined
 searchHullStep (hull, []) = (hull, [])
@@ -123,6 +113,16 @@ searchHullDirection here (hull, boundary) direction
                           , _isGoal = (found == Goal)
                           }
 
+fillTime :: Hull -> (S.Set Position) -> [(Position, Integer)] -> Integer -> Integer
+fillTime _ _ [] t = t
+fillTime hull closed ((here, t):boundary) maxt
+    | hull!here == Wall = fillTime hull closed boundary maxt
+    | S.member here closed = fillTime hull closed boundary maxt
+    | otherwise = fillTime hull closed' (boundary ++ neighbours) (max maxt t)
+    where closed' = S.insert here closed
+          neighbours = map (\d -> (step here d, t + 1)) directions
+          directions = [North, East, South, West] :: [Direction]
+
 goalNotFound :: (Hull, Boundary) -> Bool
 goalNotFound (hull, _boundary) = M.null $ M.filter containsGoal hull
 

diff --git a/advent15/src/advent15optics.hs b/advent15/src/advent15optics.hs
new file mode 100644 (file)
index 0000000..b1b8d10
--- /dev/null
+++ b/advent15/src/advent15optics.hs
@@ -0,0 +1,180 @@
+import Debug.Trace
+
+import Intcode
+
+import qualified Data.Text.IO as TIO
+
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import Data.List
+import qualified Data.Set as S
+import Control.Lens
+import Data.Map.Lens
+import Data.Maybe
+
+type Position = (Integer, Integer) -- x, y
+type Boundary = [Position]
+data Direction = North | East | South | West deriving (Show, Eq, Ord)
+data ReturnValue = Static | Moved | Goal deriving (Show, Eq, Ord)
+
+data Droid = Droid
+    { _machine :: Machine
+    , _executionState :: ExecutionState
+    , _currentInput :: [Integer]
+    , _machineOutput :: [Integer]
+    } deriving (Eq)
+makeLenses ''Droid
+
+instance Show Droid where
+  show d = "Droid {<m>, _executionState = " ++ show (_executionState d) ++
+           ", _currentInput = " ++ show (_currentInput d) ++
+           ", _machineOutput = " ++ show (_machineOutput d) ++
+           " }"
+
+data Cell = Vacant { _droid :: Droid 
+                  , _fromStart :: Integer
+                  , _isGoal :: Bool
+                  } 
+                  | Wall 
+                  | Unknown
+                  deriving (Show, Eq)
+makeLenses ''Cell
+makePrisms ''Cell
+
+type Hull = M.Map Position Cell
+
+
+main :: IO ()
+main = do 
+        text <- TIO.readFile "data/advent15.txt"
+        let mem = parseMachineMemory text
+        -- print mem
+        print $ part1 mem
+        print $ part2 mem
+
+part1 mem = _fromStart $ snd $ M.findMin $ M.filter (containsGoal) hull
+    where hull = fst $ head $ searchHull $ initialHullBoundary mem
+
+
+part2 mem = fillTime hull S.empty [(start, 0)] 0
+    where hull = completeHull $ initialHullBoundary mem
+          start = fst $ M.findMin $ M.filter (containsGoal) hull
+
+
+step :: Position -> Direction -> Position
+step (x, y) North = (x, y + 1)
+step (x, y) East  = (x + 1, y)
+step (x, y) South = (x, y - 1)
+step (x, y) West  = (x - 1, y)
+
+commandOf :: Direction -> Integer
+commandOf North = 1
+commandOf South = 2
+commandOf West  = 3
+commandOf East  = 4
+
+returnValue 0 = Static
+returnValue 1 = Moved
+returnValue 2 = Goal
+
+
+buildDroid :: [Integer] -> Droid
+buildDroid mem = Droid
+    { _machine = makeMachine mem
+    , _executionState = Runnable
+    , _currentInput = []
+    , _machineOutput = []
+    }
+
+initialHullBoundary :: [Integer] -> (Hull, Boundary)
+initialHullBoundary mem = (hull, [(0, 0)])
+    where robot = buildDroid mem
+          hull = M.singleton (0, 0) (Vacant {_droid = robot, _fromStart = 0, _isGoal = False})
+
+
+searchHull :: (Hull, Boundary) -> [(Hull, Boundary)]
+searchHull hullBoundary = dropWhile goalNotFound $ iterate searchHullStep hullBoundary
+
+
+completeHull :: (Hull, Boundary) -> Hull
+completeHull hullBoundary = fst $ head $ dropWhile incomplete $ iterate searchHullStep hullBoundary
+
+
+searchHullStep :: (Hull, Boundary) -> (Hull, Boundary)
+-- searchHullStep (hull, _) | trace (showHull hull) False = undefined
+searchHullStep (hull, []) = (hull, [])
+searchHullStep (hull, (here:boundary)) = foldl' (searchHullDirection here) (hull, boundary) directions
+    where directions = [North, East, South, West] :: [Direction]
+
+searchHullDirection :: Position -> (Hull, Boundary) -> Direction -> (Hull, Boundary)
+searchHullDirection here (hull, boundary) direction
+    | there `M.member` hull = (hull, boundary)
+    | found == Static = (M.insert there Wall hull, boundary)
+    | otherwise = (M.insert there newCell hull, boundary ++ [there])
+    where there = step here direction
+          robot = _droid $ hull!here
+          -- robot = hull ^.(at here) . _Just . droid
+          -- robot = view ((at here) . droid) hull
+          distance = _fromStart $ hull!here
+          (robot', found) = runDroid robot direction
+          newCell = Vacant { _droid = robot'
+                          , _fromStart = distance + 1
+                          , _isGoal = (found == Goal)
+                          }
+
+fillTime :: Hull -> (S.Set Position) -> [(Position, Integer)] -> Integer -> Integer
+fillTime _ _ [] t = t
+fillTime hull closed ((here, t):boundary) maxt
+    | hull!here == Wall = fillTime hull closed boundary maxt
+    | S.member here closed = fillTime hull closed boundary maxt
+    | otherwise = fillTime hull closed' (boundary ++ neighbours) (max maxt t)
+    where closed' = S.insert here closed
+          neighbours = map (\d -> (step here d, t + 1)) directions
+          directions = [North, East, South, West] :: [Direction]
+
+goalNotFound :: (Hull, Boundary) -> Bool
+goalNotFound (hull, _boundary) = M.null $ M.filter containsGoal hull
+
+containsGoal :: Cell -> Bool
+containsGoal Wall = False
+containsGoal c = _isGoal c
+
+incomplete (_, []) = False
+incomplete (_, (_:_)) = True
+
+
+runDroid :: Droid -> Direction -> (Droid, ReturnValue)
+runDroid robot direction = (robot', found)
+    where   ci = _currentInput robot
+            robot' = runDroidMachine (robot {_currentInput = ci ++ [commandOf direction]})
+            found = returnValue $ last $ _machineOutput robot'
+
+
+runDroidMachine :: Droid -> Droid
+runDroidMachine d = d { _machine = machine'
+                      , _executionState = halted
+                      , _machineOutput = output
+                      }
+    where   machine = _machine d
+            input = _currentInput d
+            (halted, machine', output) = runMachine input machine
+
+
+showHull :: Hull -> String
+showHull screen = unlines rows
+    where   minX = minimum $ map fst $ M.keys screen
+            minY = minimum $ map snd $ M.keys screen
+            maxX = maximum $ map fst $ M.keys screen
+            maxY = maximum $ map snd $ M.keys screen
+            rows = [showHullRow screen minX maxX y | y <- [minY..maxY]]
+
+showHullRow :: Hull -> Integer -> Integer -> Integer -> String
+showHullRow screen minX maxX y = [showHullCell screen x y | x <- [minX..maxX]] 
+
+showHullCell :: Hull -> Integer -> Integer -> Char
+showHullCell screen x y = 
+    case (M.findWithDefault Unknown (x, y) screen) of 
+        Vacant _ _ True -> 'O'
+        Vacant _ _ _ -> '.'
+        Wall -> '\x2588'
+        Unknown -> ' '