day8: add haskell solution

haskell: remove unused import
haskell: explicitly export functions from AoC module
2020-12-10 16:32:50 +01:00 · 2020-12-10 16:32:25 +01:00 · 2020-12-10 16:32:01 +01:00 · 2020-12-10 16:28:50 +01:00 · 2020-12-07 07:20:34 +01:00
6 changed files with 762 additions and 10 deletions
--- a/common/AoC.hs
+++ b/common/AoC.hs
@ -1,7 +1,13 @@
-module AoC where
+module AoC
    ( (.:)
    , oneCompleteResult
    , splitOnEmptyLines
    , runAoC
    )
 where
 import Data.Function (on)
-import Data.List (groupBy, intercalate)
+import Data.List (groupBy)
 import Text.ParserCombinators.ReadP
 (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
--- a/data/day8.expected
+++ b/data/day8.expected
@ -0,0 +1,2 @@
 1797
 1036
--- a/data/day8.input
+++ b/data/day8.input
@ -0,0 +1,625 @@
 acc +17
 acc +37
 acc -13
 jmp +173
 nop +100
 acc -7
 jmp +447
 nop +283
 acc +41
 acc +32
 jmp +1
 jmp +585
 jmp +1
 acc -5
 nop +71
 acc +49
 acc -18
 jmp +527
 jmp +130
 jmp +253
 acc +11
 acc -11
 jmp +390
 jmp +597
 jmp +1
 acc +6
 acc +0
 jmp +588
 acc -17
 jmp +277
 acc +2
 nop +163
 jmp +558
 acc +38
 jmp +369
 acc +13
 jmp +536
 acc +38
 acc +39
 acc +6
 jmp +84
 acc +11
 nop +517
 acc +48
 acc +47
 jmp +1
 acc +42
 acc +0
 acc +2
 acc +24
 jmp +335
 acc +44
 acc +47
 jmp +446
 nop +42
 nop +74
 acc +45
 jmp +548
 jmp +66
 acc +1
 jmp +212
 acc +18
 jmp +1
 acc +4
 acc -16
 jmp +366
 acc +0
 jmp +398
 acc +45
 jmp +93
 acc +40
 acc +38
 acc +21
 nop +184
 jmp -46
 nop -9
 jmp +53
 acc +46
 acc +36
 jmp +368
 acc +16
 acc +8
 acc -9
 acc -4
 jmp +328
 acc -15
 acc -5
 acc +21
 jmp +435
 acc -5
 acc +36
 jmp +362
 acc +26
 jmp +447
 jmp +1
 jmp +412
 acc +11
 acc +41
 nop -32
 acc +17
 jmp -63
 jmp +1
 nop +393
 jmp +62
 acc +18
 acc +30
 nop +417
 jmp +74
 acc +29
 acc +23
 jmp +455
 jmp +396
 jmp +395
 acc +33
 nop +137
 nop +42
 jmp +57
 jmp +396
 acc +7
 acc +0
 jmp +354
 acc +15
 acc +50
 jmp -12
 jmp +84
 nop +175
 acc +5
 acc -2
 jmp -82
 acc +1
 acc +26
 jmp +288
 nop -113
 nop +366
 acc +45
 jmp +388
 acc +21
 acc +38
 jmp +427
 acc +33
 jmp -94
 nop -118
 nop +411
 jmp +472
 nop +231
 nop +470
 acc +48
 jmp -124
 jmp +1
 acc +5
 acc +37
 acc +42
 jmp +301
 acc -11
 acc -17
 acc +14
 jmp +357
 acc +6
 acc +20
 acc +13
 jmp +361
 jmp -65
 acc +29
 jmp +26
 jmp +329
 acc +32
 acc +32
 acc +17
 jmp -102
 acc -6
 acc +33
 acc +9
 jmp +189
 acc +3
 jmp -128
 jmp -142
 acc +24
 acc -5
 jmp +403
 acc +28
 jmp +310
 acc +34
 acc +4
 acc +33
 acc +18
 jmp +227
 acc -8
 acc -15
 jmp +112
 jmp +54
 acc +21
 acc +23
 acc +20
 jmp +320
 acc +13
 jmp -77
 acc +15
 nop +310
 nop +335
 jmp +232
 acc -3
 nop +50
 acc +41
 jmp +112
 nop -10
 acc +29
 acc +27
 jmp +52
 acc +40
 nop -132
 acc -16
 acc +27
 jmp +309
 acc -8
 nop +147
 acc +20
 acc +46
 jmp +202
 acc +27
 jmp -43
 jmp +1
 acc +33
 acc -13
 jmp +300
 acc +1
 jmp -202
 acc -17
 acc +0
 acc +34
 jmp -5
 nop +335
 acc -16
 acc -17
 jmp -120
 acc -19
 acc -13
 acc +4
 jmp +368
 jmp +21
 acc +39
 acc +39
 acc -18
 jmp -157
 nop +280
 acc +33
 nop -37
 jmp +32
 acc -16
 acc +18
 acc +46
 jmp -121
 acc -19
 jmp +195
 acc +28
 jmp +124
 jmp +331
 jmp -228
 jmp -146
 jmp +85
 jmp +60
 acc +20
 acc -9
 jmp +303
 jmp -122
 jmp +111
 acc +32
 acc +0
 acc +39
 acc +29
 jmp -31
 nop +320
 jmp -63
 jmp +223
 nop -149
 acc -12
 acc -11
 acc +32
 jmp +309
 jmp -13
 acc -19
 jmp -123
 acc +21
 acc +18
 acc +49
 jmp +175
 acc -14
 nop -129
 acc -2
 acc +31
 jmp +79
 acc +23
 acc +50
 acc +39
 acc +7
 jmp -235
 jmp -166
 acc +9
 jmp +293
 acc -11
 jmp +76
 acc +44
 acc +3
 acc +37
 jmp +123
 nop -104
 jmp -157
 acc +14
 acc +10
 acc +28
 jmp +25
 acc +37
 jmp +188
 jmp -49
 acc -11
 jmp -90
 acc -8
 jmp +197
 acc +5
 jmp +115
 acc +44
 jmp -228
 nop -2
 acc +46
 jmp +130
 nop +183
 nop +106
 acc +27
 acc +37
 jmp -309
 acc +28
 acc -4
 acc -12
 acc +38
 jmp +93
 acc +8
 acc +23
 acc -9
 acc +6
 jmp -42
 acc +10
 acc +35
 acc +4
 jmp -231
 acc +19
 acc +7
 acc +23
 acc +11
 jmp -90
 acc +0
 nop +158
 nop -150
 acc +33
 jmp +107
 acc +48
 acc -2
 jmp -104
 acc +6
 nop -57
 nop +172
 acc -11
 jmp -7
 acc +6
 acc +50
 acc -9
 acc +12
 jmp -171
 acc +3
 jmp +26
 acc +42
 acc +31
 acc +20
 acc +32
 jmp -48
 acc +13
 jmp -6
 jmp +178
 acc +47
 jmp -153
 acc +28
 nop +74
 jmp -162
 acc -15
 nop -104
 acc -9
 jmp -227
 acc +49
 acc -19
 acc +41
 jmp -318
 acc +9
 acc +12
 acc +7
 jmp +34
 jmp +137
 nop -143
 acc -8
 acc +5
 acc +31
 jmp -20
 jmp -237
 acc +39
 acc +0
 jmp -298
 acc +45
 acc -19
 acc +11
 jmp -151
 acc +40
 acc +27
 nop +150
 nop -391
 jmp -341
 acc +1
 acc +11
 acc +18
 nop -234
 jmp +77
 nop +104
 jmp -65
 acc +32
 jmp -27
 nop -317
 nop +159
 acc +14
 acc -10
 jmp -348
 acc +29
 jmp +32
 acc +48
 acc -19
 jmp +17
 jmp -201
 jmp -224
 nop +26
 acc -7
 acc +23
 acc +46
 jmp -6
 acc +22
 acc +39
 acc +9
 acc +23
 jmp -30
 jmp -243
 acc +47
 acc -15
 jmp -298
 jmp -393
 jmp +1
 acc +3
 nop -24
 acc +7
 jmp -59
 acc -6
 acc +26
 jmp -102
 acc +34
 acc +24
 jmp -207
 acc +36
 acc +40
 acc +41
 jmp +1
 jmp -306
 jmp +57
 jmp +1
 nop +99
 acc +28
 jmp -391
 acc +50
 jmp -359
 acc -5
 jmp +9
 jmp -355
 acc +5
 acc +2
 jmp -77
 acc +40
 acc +28
 acc +22
 jmp -262
 nop -287
 acc +34
 acc -4
 nop +112
 jmp -195
 acc +29
 nop -94
 nop -418
 jmp +24
 jmp -190
 acc +2
 jmp -311
 jmp -178
 jmp -276
 acc -12
 acc -18
 jmp +62
 jmp -174
 nop +31
 acc +33
 nop -158
 jmp -417
 acc +3
 acc +21
 acc +47
 jmp +87
 acc +45
 jmp -77
 acc +6
 acc -10
 jmp +1
 jmp -240
 acc +7
 acc +47
 jmp -379
 acc -14
 acc +50
 nop -75
 acc +30
 jmp +70
 jmp -392
 jmp -430
 acc +22
 acc -2
 jmp -492
 jmp +1
 acc -6
 acc +38
 jmp -36
 nop -336
 jmp -32
 jmp +61
 acc +20
 acc -9
 acc +2
 jmp -175
 acc +21
 acc -2
 jmp -6
 jmp -527
 acc +11
 acc +16
 jmp -262
 jmp +1
 nop -327
 acc +29
 jmp -114
 acc +11
 acc +17
 acc +26
 nop -104
 jmp -428
 nop -178
 nop -242
 acc +29
 acc +5
 jmp -245
 jmp -417
 jmp -278
 acc +35
 acc +21
 jmp +1
 nop -263
 jmp +8
 acc +42
 jmp -95
 nop -312
 acc -11
 acc +34
 acc +0
 jmp +19
 acc +8
 acc -13
 acc +32
 acc +21
 jmp -208
 acc +15
 acc +39
 nop -194
 jmp -280
 jmp +24
 nop -516
 acc +21
 acc +48
 jmp -367
 jmp -121
 acc +49
 acc -16
 jmp -136
 acc +0
 jmp -148
 jmp -85
 jmp -103
 nop -446
 jmp -242
 acc -12
 acc +13
 acc +31
 acc -1
 jmp -435
 nop -420
 acc +22
 acc -5
 jmp -567
 nop -354
 acc +11
 acc +33
 acc +45
 jmp -76
 acc -2
 acc +0
 acc +25
 acc +46
 jmp -555
 acc +0
 acc +11
 nop -2
 jmp -394
 jmp -395
 acc +8
 acc +14
 acc +47
 acc +22
 jmp +1
--- a/day7/day7.py
+++ b/day7/day7.py
@ -27,24 +27,24 @@ def process_rules(rules):
    return rules_dict
-def can_contain(rules, colour):
+def parents_of(rules, colour):
    parents = set()
    for parent, children in rules.items():
        if colour in children:
            parents.add(parent)
-            parents |= can_contain(rules, parent)
+            parents |= parents_of(rules, parent)
    return parents
-def colour_contains(rules, colour):
+def children_of(rules, colour):
    children = defaultdict(lambda: 0)
    for child_colour, child_num in rules[colour].items():
        children[child_colour] += child_num
-        for col, num in colour_contains(rules, child_colour).items():
+        for col, num in children_of(rules, child_colour).items():
            children[col] += child_num * num
    return children
 if __name__ == '__main__':
    bag_rules = [rule.strip() for rule in sys.stdin.readlines()]
    rules = process_rules(bag_rules)
-    print(len(can_contain(rules, 'shiny gold')))
+    print(len(parents_of(rules, 'shiny gold')))
-    print(sum(colour_contains(rules, 'shiny gold').values()))
+    print(sum(children_of(rules, 'shiny gold').values()))
--- a/day8/day8.hs
+++ b/day8/day8.hs
@ -0,0 +1,119 @@
 {-# LANGUAGE FlexibleContexts #-}
 import AoC
 import Control.Applicative
 import Control.Monad
 import Control.Monad.ST
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
 import Data.Array.ST
 import Data.Maybe
 import Text.ParserCombinators.ReadP
 import Text.Read.Lex
 data Instruction = Nop Int | Acc Int | Jmp Int deriving (Show)
 data MemoryCell = MemoryCell { instruction :: Instruction
                             , executed :: Bool
                             }
                             deriving (Show)
 type Memory s = STArray s Int MemoryCell
 data Machine s = Machine { pc :: Int
                         , acc :: Int
                         , memory :: Memory s
                         }
 data RunError = OutOfRange | WouldLoop | Breakpoint deriving (Show)
 type MachineRunner s = Machine s -> ExceptT RunError (ST s) (Machine s)
 parseInstruction :: ReadP Instruction
 parseInstruction = choice [ Nop <$> parseIns "nop"
                          , Acc <$> parseIns "acc"
                          , Jmp <$> parseIns "jmp"
                          ]
    where parseIns name = string name >> char ' ' >> parseNumber
          parseNumber = do
              sign <- option '+' (choice $ map char $ "+-")
              num <- readDecP
              return $ case sign of
                         '+' -> num
                         '-' -> -num
 newMemory :: [Instruction] -> ST s (Memory s)
 newMemory insns = newListArray (0, length insns-1) $ [MemoryCell { instruction = ins, executed = False } | ins <- insns]
 newMachine :: [Instruction] -> ST s (Machine s)
 newMachine insns = do
    mem <- newMemory insns
    return $ Machine { pc = 0, acc = 0, memory = mem }
 stepMachine :: Machine s -> ST s (Machine s)
 stepMachine m = do
    cell <- readArray (memory m) (pc m)
    writeArray (memory m) (pc m) $ cell { executed = True }
    (pcF, accF) <- case instruction cell of
                     Nop _ -> return ((+1), id)
                     Acc i -> return ((+1), (+i))
                     Jmp i -> return ((+i), id)
    let newPc = pcF $ pc m
        newAcc = accF $ acc m
    return $ m { pc = newPc, acc = newAcc }
 runUnless :: (Machine s -> MaybeT (ST s) RunError) -> MachineRunner s -> MachineRunner s
 runUnless p stepper m = do
    res <- lift $ runMaybeT $ p m
    case res of
      Nothing -> stepper m
      Just e -> throwE e
 breakOnLoop :: MachineRunner s -> MachineRunner s
 breakOnLoop = runUnless alreadyExecuted
    where alreadyExecuted m =
            do cell <- lift $ readArray (memory m) (pc m)
               unless (executed cell) empty
               return WouldLoop
 breakOnAddr :: Int -> MachineRunner s -> MachineRunner s
 breakOnAddr addr = runUnless $ fetchFrom addr
    where fetchFrom addr m =
            do unless (pc m == addr) empty
               return Breakpoint
 runUntilError :: MachineRunner s -> Machine s -> ST s (RunError, Int, Int)
 runUntilError step m = do
    result <- runExceptT $ step m
    case result of
      Right m' -> runUntilError step m'
      Left e -> return (e, (pc m), (acc m))
 part1 :: [Instruction] -> Int
 part1 is = fromJust $ runST $ runMaybeT $ do
    (WouldLoop, _, acc) <- lift $ newMachine is >>= runUntilError stepper
    return acc
    where stepper = breakOnLoop (lift . stepMachine)
 tryTerminate :: Machine s -> MaybeT (ST s) Int
 tryTerminate m = do
    breakpoint <- fmap (\(_, max) -> max + 1) $ lift $ getBounds (memory m)
    (Breakpoint, _, acc) <- lift $ runUntilError (stepper breakpoint) m
    return acc
    where stepper b = breakOnAddr b . breakOnLoop $ (lift . stepMachine)
 jmpNopFlips :: [Instruction] -> [[Instruction]]
 jmpNopFlips [] = []
 jmpNopFlips (x:xs) = case x of
                       Jmp i -> (Nop i:xs) : rest
                       Nop i -> (Jmp i:xs) : rest
                       _ -> rest
    where rest = (x:) <$> jmpNopFlips xs
 part2 :: [Instruction] -> Int
 part2 instructions = fromJust $ msum $ runST $ mapM testInstructions possibleInstructions
    where testInstructions is = runMaybeT $ lift (newMachine is) >>= tryTerminate
          possibleInstructions = instructions : jmpNopFlips instructions
 main = runAoC (map (fromJust . oneCompleteResult parseInstruction) . lines) part1 part2
--- a/test.sh
+++ b/test.sh
@ -7,7 +7,7 @@ cd "$(dirname "${BASH_SOURCE[0]}")"
 run_solution() {
 	if [ -d "$solution" ]; then
 		runfile=$solution/run.sh
-		[ -f "$runfile" ] || { echo "Error: $runfile not found"; exit 1; }
+		[ -f "$runfile" ] || { echo "Error: $runfile not found" >&2; exit 1; }
 		"$runfile" "$input"
 	else
 		case "$(basename "$solution")" in
@ -18,7 +18,7 @@ run_solution() {
 				python "$solution" < "$input"
 				;;
 			*)
-				echo "Error: Unknown solution type: $solution"
+				echo "Error: Unknown solution type: $solution" >&2
 				exit 1
 				;;
 		esac
Author	SHA1	Message	Date
Xiretza	173bab5a0f	day8: add haskell solution	2020-12-10 16:32:50 +01:00
Xiretza	a449a49c18	haskell: remove unused import	2020-12-10 16:32:25 +01:00
Xiretza	8da62b93a5	haskell: explicitly export functions from AoC module	2020-12-10 16:32:01 +01:00
Xiretza	f477ec985d	test.sh: write errors to stdout stdout is swallowed by the result verification	2020-12-10 16:28:50 +01:00
Xiretza	ebf0723b48	day7/python: rename functions	2020-12-07 07:20:34 +01:00