Advent of Code 2020 day 1

y2020/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+y2020.cabal
+*~

y2020/ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for y2020
+
+## Unreleased changes

y2020/LICENSE

@@ -0,0 +1,30 @@
+Copyright Xavier Morel (c) 2019
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Xavier Morel nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

y2020/README.md

@@ -0,0 +1,4 @@
+# Advent of Code 2020
+https://adventofcode.com/2020
+
+A good occasion to try Haskell.

y2020/Setup.hs

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

y2020/app/Main.hs

@@ -0,0 +1,6 @@
+module Main where
+
+import DayPicker
+
+main :: IO ()
+main = dayPicker

y2020/package.yaml

@@ -0,0 +1,50 @@
+name:                y2020
+version:             0.1.0.0
+github:              "mx42/y2020"
+license:             BSD3
+author:              "Xavier Morel"
+maintainer:          "morelx42@gmail.com"
+copyright:           "2019 Xavier Morel"
+
+extra-source-files:
+- README.md
+- ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# 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/mx42/y2020#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- split
+- containers
+
+library:
+  source-dirs: src
+
+executables:
+  y2020-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - y2020
+
+tests:
+  y2020-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - y2020

y2020/src/Day01.hs

@@ -0,0 +1,38 @@
+module Day01 (day01) where
+
+import Data.Maybe
+import Data.Sort
+import Debug.Trace
+
+
+findPair :: Int -> Int -> [Int] -> Maybe (Int, Int)
+findPair target x (h:t)
+  | target == x + h = Just (x, h)
+  | target < x + h = Nothing
+  | otherwise = findPair target x t
+findPair _ _ [] = Nothing
+
+findFirstMatchingPair :: Int -> [Int] -> Maybe (Int, Int)
+findFirstMatchingPair target (x:xs)
+  | isJust res = res
+  | otherwise = findFirstMatchingPair target (xs)
+  where res = findPair target x xs
+findFirstMatchingPair _ _ = Nothing
+
+findFirstMatchingTriplet :: Int -> [Int] -> (Int, Int, Int)
+findFirstMatchingTriplet target (x:xs)
+ | isJust res = let Just (a, b) = res in (x, a, b)
+ | otherwise = findFirstMatchingTriplet target xs
+ where res = findFirstMatchingPair (target - x) xs
+
+day01 :: IO ()
+day01 = do
+  putStrLn "AoC 2020 day 1"
+  input <- getContents
+  let entries = (sort (map read (lines input))) :: [Int]
+
+  let Just (a, b) = findFirstMatchingPair 2020 entries
+  putStrLn $ "Part 1: " ++ (show (a * b))
+
+  let (x, y, z) = findFirstMatchingTriplet 2020 entries
+  putStrLn $ "Part 2: " ++ (show (x * y * z))

y2020/src/DayPicker.hs

@@ -0,0 +1,19 @@
+module DayPicker
+  ( dayPicker
+  )
+where
+
+import System.Environment
+
+import Day01
+
+-- TODO Better way?
+load :: [String] -> IO ()
+load [] = putStrLn "Usage: script [day]"
+load ("01":_) = day01
+load _ = putStrLn "Unavailable date"
+
+dayPicker :: IO ()
+dayPicker = do
+  args <- getArgs
+  load args

y2020/src/Geo/Point.hs

@@ -0,0 +1,24 @@
+module Geo.Point
+  ( Point(..),
+    origin,
+    manhattanDist,
+    add,
+    sub
+  ) where
+
+data Point = Point { x :: Double, y :: Double } deriving (Show, Eq)
+
+-- instance Eq Point where
+--   (==) (Point x1 y1) (Point x2 y2) = x1 == x2 && y1 == y2
+
+origin :: Point
+origin = Point 0 0
+
+manhattanDist :: Point -> Point -> Double
+manhattanDist a b = abs(x(b) - x(a)) + abs(y(b) - y(a))
+
+add :: Point -> Point -> Point
+add (Point xa ya) (Point xb yb) = Point (xa + xb) (ya + yb)
+
+sub :: Point -> Point -> Point
+sub (Point xa ya) (Point xb yb) = Point (xa - xb) (ya - yb)

y2020/src/Geo/Segment.hs

@@ -0,0 +1,52 @@
+module Geo.Segment
+  ( Segment(..),
+    directionalVect,
+    segmentIntersection,
+    linkVectors,
+    linkPoints,
+    onSegment
+  ) where
+
+import Geo.Point
+import Geo.Vector
+
+data Segment = Segment { src :: Point, dst :: Point } deriving (Show)
+
+directionalVect :: Segment -> Vector
+directionalVect (Segment s d) = directionalVectorFromPoint (d `sub` s)
+
+onSegment :: Point -> Segment -> Bool
+onSegment p@(Point px py) (Segment s@(Point sx sy) d@(Point dx dy))
+  | p == d = True
+  | p == s = True
+  | sx == dx && sx == px && (between py sy dy) = True
+  | sy == dy && sy == py && (between px sx dx) = True
+  | otherwise = False
+  where between p' s' d' = if s' < d' then p' >= s' && p' <= d' else p' >= d' && p' <= s'
+
+segmentIntersection :: Segment -> Segment -> Maybe Point
+segmentIntersection s1 s2 =
+  if t1 < 0 || t1 > 1 || t2 < 0 || t2 > 1
+  then Nothing
+  else Just (directionalVectorToPoint (Vector t1 t2) (src(s1)))
+  where dirS1 = directionalVect s1
+        dirS2 = directionalVect s2
+        determinant = determinantVector dirS1 dirS2
+        dirX = directionalVectorFromPoint (src(s2) `sub` src(s1))
+        t1 = (determinantVector dirX dirS2) / determinant
+        t2 = (determinantVector dirX dirS1) / determinant
+
+linkPoints :: [Point] -> [Segment]
+linkPoints pts = foldl addPointToSegments [] pts
+
+linkVectors :: [Vector] -> [Segment]
+linkVectors vectors = linkPoints (reverse points)
+  where points = foldl linkVectors' [] vectors
+
+linkVectors' :: [Point] -> Vector -> [Point]
+linkVectors' [] v = [addV2P origin v]
+linkVectors' xs@(p:_) v = (addV2P p v):xs
+
+addPointToSegments :: [Segment] -> Point -> [Segment]
+addPointToSegments [] pt = [Segment origin pt]
+addPointToSegments xs@(h:_) pt = (Segment (dst(h)) pt):xs

y2020/src/Geo/Vector.hs

@@ -0,0 +1,43 @@
+module Geo.Vector
+  ( Vector(..),
+    determinantVector,
+    directionalVectorFromPoint,
+    directionalVectorToPoint,
+    nilVector,
+    addV2P,
+    roundVecAtN,
+    roundN,
+    vec2angle
+  ) where
+
+import Geo.Point
+
+data Vector = Vector { x :: Double, y :: Double } deriving (Show, Eq)
+
+addV2P :: Point -> Vector -> Point
+addV2P (Point xp yp) (Vector xv yv) = Point (xp + xv) (yp + yv)
+
+nilVector :: Vector
+nilVector = Vector 0 0
+
+roundVecAtN :: Int -> Vector -> Vector
+roundVecAtN prec (Vector vx vy) = Vector (roundN prec vx) (roundN prec vy)
+
+-- https://stackoverflow.com/questions/12450501/round-number-to-specified-number-of-digits
+roundN :: Int -> Double -> Double
+roundN prec val = (fromInteger $ round $ val * (10 ^ prec)) / (10.0 ^^ prec)
+
+directionalVectorFromPoint :: Point -> Vector
+directionalVectorFromPoint (Point px py) = Vector (px / len) (py / len)
+  where len = sqrt(px * px + py * py)
+
+determinantVector :: Vector -> Vector -> Double
+determinantVector (Vector x1 y1) (Vector x2 y2) = (x1 * y2) - (y1 * x2)
+
+directionalVectorToPoint :: Vector -> Point -> Point
+directionalVectorToPoint (Vector vx vy) (Point px py) = Point (vx * px) (vy * py)
+
+vec2angle :: Vector -> Double
+vec2angle (Vector vx vy) = roundN 5 angle'
+ where angle = atan2 vx vy
+       angle' = pi - angle

y2020/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:
+# https://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
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-14.16
+
+# 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
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# 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: ">=2.1"
+#
+# 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

y2020/stack.yaml.lock

@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    size: 524804
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/16.yaml
+    sha256: 4d1519a4372d051d47a5eae2241cf3fb54e113d7475f89707ddb6ec06add2888
+  original: lts-14.16

y2020/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"