add archived 2017 solutions

2017/.gitignore

@@ -0,0 +1 @@
+.stack-work/

2017/README.md

@@ -0,0 +1,19 @@
+# Advent of Code 2017
+
+I haven't run these solutions in a very long time. I've pulled them from a private archive.
+
+|  S  |  M  |  T  |  W  |  T  |  F  |  S   |
+| :-: | :-: | :-: | :-: | :-: | :-: | :--: |
+|     |     |     |     |     |  [1]  |   [2]  |
+|  [3]  |  [4]  |  [5]  |  [6]  |  [7]  |  8  |   9  |
+| 10  | 11  | 12  | 13  | 14  | 15  |  16  |
+| 17  | 18  | 19  | 20  | 21  | 22  |  23  |
+| 23  | 24  |  25 |     |     |     |      |
+
+[1]: ./src/AdventOfCode.hs
+[2]: ./src/AdventOfCode.hs
+[3]: ./src/AdventOfCode.hs
+[4]: ./src/AdventOfCode.hs
+[5]: ./src/AdventOfCode.hs
+[6]: ./src/AdventOfCode/Day6.hs
+[7]: ./src/AdventOfCode/Day7.hs

2017/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

2017/aoc2017.cabal

@@ -0,0 +1,51 @@
+name:                aoc2017
+version:             0.1.0.0
+synopsis:            Short description of your package
+homepage:            https://github.com/githubuser/aoc2017#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          example@example.com
+copyright:           2017 Author name here
+category:            Web
+build-type:          Simple
+extra-source-files:  README.md
+cabal-version:       >=1.10
+
+-- To avoid duplicated efforts in documentation and dealing with the
+-- complications of embedding Haddock markup inside cabal files, it is
+-- common to point users to the README.md file.
+description:         Please see the README on Github at <https://github.com/githubuser/aoc2017#readme>
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     AdventOfCode
+                     , AdventOfCode.Day6
+                     , AdventOfCode.Day7
+  build-depends:       base >= 4.7 && < 5
+                     , Unique
+                     , array
+                     , containers
+  default-language:    Haskell2010
+
+executable aoc2017-exe
+  hs-source-dirs:      app
+  main-is:             Main.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  build-depends:       base
+                     , aoc2017
+  default-language:    Haskell2010
+
+test-suite aoc2017-test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       base
+                     , aoc2017
+                     , hspec
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/githubuser/aoc2017

2017/app/Main.hs

@@ -0,0 +1,20 @@
+module Main where
+
+import System.Environment
+import AdventOfCode
+
+unknown args = \_ -> "No program for arguments: " ++ show args
+
+selectProgram ["1", "1"] = captcha1
+selectProgram ["1", "2"] = captcha2
+selectProgram ["2", "1"] = checksum
+selectProgram ["2", "2"] = sumEvenlyDivisibleValues
+selectProgram ["3", "1"] = distanceToAddress
+selectProgram ["4", "1"] = day41
+selectProgram ["4", "2"] = day42
+selectProgram ["5", "1"] = day51
+selectProgram args = unknown args
+
+main = do
+  args <- getArgs
+  interact $ selectProgram args

2017/src/AdventOfCode.hs

@@ -0,0 +1,98 @@
+module AdventOfCode where
+
+import Data.Char
+import Data.List
+import Data.List.Unique (allUnique)
+import Data.Maybe
+import Data.Array
+
+-- Day 1
+pairs j xs = take (length xs) $ zip (cycle xs) $ drop j (cycle xs)
+hash = sum . map fst . filter (uncurry (==))
+captcha j = show . hash . pairs j . map digitToInt
+captcha1 = captcha 1
+captcha2 ds = captcha (length ds `div` 2) ds
+
+-- Day 2
+readCells :: String -> [[Int]]
+readCells = map (map read) . map words . lines
+
+minmax xs = (minimum xs, maximum xs)
+checksum buff = show $ sum $ map (uncurry . flip $ (-)) . map minmax $ readCells buff
+
+-- Day 2
+calculateRow row = result
+  where
+    sorted = reverse . sort $ row
+    result = fromJust $
+      fmap (uncurry div) $
+      find ((==) 0 . uncurry rem) [ (i, j) | i <- sorted, j <- tail sorted, j < i ]
+sumEvenlyDivisibleValues buff = show $ sum . map calculateRow $ readCells buff
+
+
+-- Day 3
+chunk (b, t) =
+  let seq = [(t-1), (t-2)..(b)] ++ [(b+1)..(t+1)] in
+    concat . replicate 4 $ take (length seq - 1) seq
+memory = [0,0,1,2,1,2,1,2,1,2] ++ (concatMap chunk $ zip [2..] [4,6..])
+distanceToAddress buff = show $ memory !! (read buff)
+
+-- Day 4
+readDay4 :: String -> [[String]]
+readDay4 = map words . lines
+
+both fn gn x = fn x && gn x
+
+validPassPhrase1 = allUnique
+boolToInt True = 1
+boolToInt False = 0
+
+validPassPhrase2 = both allUnique noPermutations
+
+noPermutations :: [String] -> Bool
+noPermutations phrase = all noPermutations' phrase
+  where
+    noPermutations' word =
+      all ((flip notElem) (filter ((/=) word) phrase)) (permutations word)
+
+day41 buff = show $ sum . map (boolToInt . validPassPhrase1) $ readDay4 buff
+day42 buff = show $ sum . map (boolToInt . validPassPhrase2) $ readDay4 buff
+
+-- Day 5
+
+type Program = (Array Int Int, Int)
+data Solution = Partial Program Int | Complete Int
+
+inBounds (a, b) x = a <= x && x <= b
+
+-- Part 1
+-- runProgram (Complete jumps) = jumps
+-- runProgram (Partial (instructions, pointer) jumps) =
+--   if inBounds bounds' next
+--   then runProgram $ Partial ((instructions // update), next) jumps'
+--   else runProgram $ Complete jumps'
+--   where
+--     instruction = instructions ! pointer
+--     next = pointer + instruction
+--     bounds' = bounds instructions
+--     jumps' = jumps + 1
+--     update = [(pointer, instruction + 1)]
+
+-- Part 2
+runProgram (Complete jumps) = jumps
+runProgram (Partial (instructions, pointer) jumps) =
+  if inBounds bounds' next
+  then runProgram $ Partial ((instructions // update), next) jumps'
+  else runProgram $ Complete jumps'
+  where
+    instruction = instructions ! pointer
+    next = pointer + instruction
+    bounds' = bounds instructions
+    jumps' = jumps + 1
+    updatedInstruction = if instruction > 2 then instruction - 1 else instruction + 1
+    update = [(pointer, updatedInstruction)]
+
+makeProgram xs = Partial (listArray (0, length xs - 1) xs, 0) 0
+
+day51 = show . runProgram . makeProgram . map read . lines
+

2017/src/AdventOfCode/Day6.hs

@@ -0,0 +1,48 @@
+module AdventOfCode.Day6 (findFirstDuplicateAllocation, findSizeOfLoopOfDuplicateAllocation) where
+
+import Data.List
+import Data.Maybe
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+
+type Memory = [Int]
+
+set i y xs = set' i y xs
+  where
+    set' i y []     = []
+    set' 0 y (_:xs) = y:xs
+    set' i y (x:xs) = x:set' (i-1) y xs
+
+over f i xs = set i (f (xs !! i)) xs
+incrementIdx = over ((+) 1)
+
+
+distribute :: Int -> Int -> Memory -> Memory
+distribute 0 _ ms = ms
+distribute x i ms = distribute (x-1) (cyclicIdx+1) (incrementIdx cyclicIdx ms)
+  where cyclicIdx = i `mod` (length ms)
+
+reallocate :: Memory -> Memory
+reallocate ms = distribute max (maxIdx+1) zeroed
+  where
+    max = maximum ms
+    maxIdx = fromJust . findIndex ((==) max) $ ms
+    zeroed = set maxIdx 0 ms
+
+findFirstDuplicateAllocation :: Memory -> Int
+findFirstDuplicateAllocation ms = length $ takeWhile (uncurry (/=)) zipped
+  where
+    allocations = iterate reallocate ms
+    sets = scanl (flip Set.insert) Set.empty allocations
+    sizes = map Set.size sets
+    zipped = zip sizes (tail sizes)
+
+
+findSizeOfLoopOfDuplicateAllocation :: Memory -> Int
+findSizeOfLoopOfDuplicateAllocation ms = (+) 1 $ length $ takeWhile ((/=) $ head allocationsFromFirstDuplication) $ tail allocationsFromFirstDuplication
+  where
+    allocations = iterate reallocate ms
+    firstDuplicationIdx = findFirstDuplicateAllocation ms
+    allocationsFromFirstDuplication = drop firstDuplicationIdx allocations
+

2017/src/AdventOfCode/Day7.hs

@@ -0,0 +1,12 @@
+module AdventOfCode.Day7 (readInput) where
+
+
+readInput = map readLine . lines
+  where
+    normalize = words . (filter $ flip notElem $ "()->,")
+    parse :: [String] -> (String, Int, [String])
+    parse [name, weightStr] = (name, read weightStr, [])
+    parse (name:weightStr:children) = (name, read weightStr, children)
+    readLine = parse . normalize
+    
+

2017/stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-9.14
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+#
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- '.'
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.4"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

2017/test/Spec.hs

@@ -0,0 +1,60 @@
+import Test.Hspec
+
+import AdventOfCode
+
+main :: IO ()
+main = hspec $ do
+  describe "Day 1" $ do
+    describe "captcha1" $ do
+      it "works for the first example" $ do
+        captcha1 "1122" `shouldBe` "3"
+
+      it "works for the second example" $ do
+        captcha1 "1111" `shouldBe` "4"
+
+      it "works for the third example" $ do
+        captcha1 "1234" `shouldBe` "0"
+
+      it "works for the fourth example" $ do
+        captcha1 "91212129" `shouldBe` "9"
+
+    describe "captcha2" $ do
+      it "works for the first example" $ do
+        captcha2 "1212" `shouldBe` "6"
+
+      it "works for the second example" $ do
+        captcha2 "1221" `shouldBe` "0"
+
+      it "works for the third example" $ do
+        captcha2 "123425" `shouldBe` "4"
+
+      it "works for the fourth example" $ do
+        captcha2 "123123" `shouldBe` "12"
+
+      it "works for the fifth example" $ do
+        captcha2 "12131415" `shouldBe` "4"
+  describe "Day 2" $ do
+    describe "checksum" $ do
+      it "works for the given example" $ do
+        checksum "5 1 9 5\n7 5 3\n2 4 6 8" `shouldBe` "18"
+    describe "calculateRow" $ do
+      it "works for the first row" $ do
+        calculateRow [5, 9, 2, 8] `shouldBe` 4
+      it "works for the second row" $ do
+        calculateRow [9, 4, 7, 3] `shouldBe` 3
+      it "works for the third row" $ do
+        calculateRow [3, 8, 6, 5] `shouldBe` 2
+    describe "sumEvenlyDivisibleValues" $ do
+      it "works for the example input" $ do
+        sumEvenlyDivisibleValues "5 9 2 8\n9 4 7 3\n3 8 6 5" `shouldBe` "9"
+  describe "Day 3" $ do
+    describe "memory" $ do
+      it "contains the right values of distance" $ do
+        memory !! 2 `shouldBe` 1
+        memory !! 11 `shouldBe` 2
+        memory !! 28 `shouldBe` 3
+        memory !! 53 `shouldBe` 4
+        memory !! 86 `shouldBe` 5
+        memory !! 77 `shouldBe` 4
+        memory !! 75 `shouldBe` 6
+

README.md

@@ -8,7 +8,7 @@
 
 1. [2015] **36/50** 🌟
 1. 2016
-1. 2017 **18/50** 🌟
+1. [2017] **18/50** 🌟
 1. 2018 
 1. 2019
 1. [2020] **17/50** 🌟
@@ -16,6 +16,7 @@
 1. [2022] **8/50** 🌟
 
 [2015]: ./2015
+[2017]: ./2017
 [2020]: ./2020
 [2021]: ./2021
 [2022]: ./2022