107 lines
3.6 KiB
Haskell
107 lines
3.6 KiB
Haskell
import Data.List
|
|
import Data.Maybe
|
|
import Data.Array
|
|
import Debug.Trace
|
|
import Data.Function.Memoize
|
|
|
|
traceOut :: Show a => a -> a
|
|
traceOut x = (traceShow x x)
|
|
|
|
addFirst :: [[a]] -> a -> [[a]]
|
|
addFirst [] x = [[x]]
|
|
addFirst (y:ys) x = ([x] ++ y) : ys
|
|
|
|
split :: Eq a => [a] -> [a] -> [[a]]
|
|
split _ [] = []
|
|
split delims (x:xs)
|
|
| elem x delims = [[]] ++ split delims xs
|
|
| otherwise = addFirst (split delims xs) x
|
|
|
|
-- y ->
|
|
-- x
|
|
-- |
|
|
-- v
|
|
|
|
data Direction = DNothing | DUp | DDown | DLeft | DRight deriving (Enum, Eq, Ord, Ix, Bounded)
|
|
instance Show Direction where
|
|
show DNothing = "A"
|
|
show DUp = "^"
|
|
show DDown = "v"
|
|
show DLeft = "<"
|
|
show DRight = ">"
|
|
instance Memoizable Direction where memoize = memoizeFinite
|
|
|
|
pathAvoid :: (Int, Int) -> (Int, Int) -> (Int, Int) -> [[Direction]]
|
|
pathAvoid (a, b) (c, d) (x, y) = if (x == c) && (abs(d-y) <= abs(d-b)) then [(take (abs (c-a)) $ repeat dx) ++ (take (abs (d-b)) $ repeat dy)]
|
|
else if (y == d) && (abs(c-x) <= abs(c-a)) then [(take (abs (d-b)) $ repeat dy) ++ (take (abs (c-a)) $ repeat dx)]
|
|
else nub [(take (abs (c-a)) $ repeat dx) ++ (take (abs (d-b)) $ repeat dy), (take (abs (d-b)) $ repeat dy) ++ (take (abs (c-a)) $ repeat dx)]
|
|
where xcomp = compare a c
|
|
ycomp = compare b d
|
|
dx = case xcomp of
|
|
EQ -> DNothing
|
|
LT -> DUp
|
|
GT -> DDown
|
|
dy = case ycomp of
|
|
EQ -> DNothing
|
|
LT -> DLeft
|
|
GT -> DRight
|
|
|
|
numpad = array ('0', 'A') [('0', (3, 1)),
|
|
('1', (2, 0)),
|
|
('2', (2, 1)),
|
|
('3', (2, 2)),
|
|
('4', (1, 0)),
|
|
('5', (1, 1)),
|
|
('6', (1, 2)),
|
|
('7', (0, 0)),
|
|
('8', (0, 1)),
|
|
('9', (0, 2)),
|
|
('A', (3, 2))]
|
|
|
|
dirpad = array (DNothing, DRight) [(DNothing, (0, 2)),
|
|
(DUp, (0, 1)),
|
|
(DDown, (1, 1)),
|
|
(DLeft, (1, 0)),
|
|
(DRight, (1, 2))]
|
|
|
|
memopath = memoize3 pathAvoid
|
|
|
|
--partial!
|
|
path :: Ix a => (Int, Int) -> Array a (Int, Int) -> a -> [a] -> [[Direction]]
|
|
path _ _ _ [] = []
|
|
path avoid pad a (x:[]) = map (++[DNothing]) $ memopath (pad!x) (pad!a) avoid
|
|
path avoid pad a (x:y:xs) = [p ++ [DNothing] ++ q | p <- memopath (pad!x) (pad!a) avoid, q <- path avoid pad x (y:xs)]
|
|
|
|
memopath2 = memoize (path (0, 0) dirpad DNothing)
|
|
|
|
path' :: Int -> [Direction] -> Int
|
|
path' 0 = length
|
|
path' n = sum . map (min1 . map (memopath' (n-1)) . memopath2) . map (\x -> x ++ [DNothing]) . memosplit
|
|
|
|
memosplit = memoize (split [DNothing])
|
|
|
|
splitInput :: String -> [String]
|
|
splitInput = split "\n"
|
|
|
|
--partial!
|
|
min1 :: Ord a => [a] -> a
|
|
min1 xs = foldl1 (\a b -> if a < b then a else b) xs
|
|
|
|
solve1 :: [(Int, [[Direction]])] -> Int
|
|
solve1 [] = 0
|
|
solve1 ((x, dirs):xs) = (min1 $ map length $ foldl (.) id (take 2 $ repeat (concat . map (path (0, 0) dirpad DNothing))) dirs)*x + solve1 xs
|
|
|
|
solve2 :: [(Int, [[Direction]])] -> Int
|
|
solve2 = sum . map (\(x, dirs) -> x*(min1 $ map (memopath' 25) dirs))
|
|
|
|
memopath' = memoize2 path'
|
|
|
|
main :: IO()
|
|
main = do
|
|
fileinp <- readFile "input.txt"
|
|
let parsed = splitInput fileinp
|
|
let dirs :: [(Int, [[Direction]])] = map (\x -> (read $ init x, path (3, 0) numpad 'A' x)) parsed
|
|
let solved1 = solve1 dirs
|
|
let solved2 = solve2 dirs
|
|
print solved1
|
|
print solved2
|