diff --git a/y2020/.gitignore b/y2020/.gitignore new file mode 100644 index 0000000..d2468ef --- /dev/null +++ b/y2020/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +y2020.cabal +*~ \ No newline at end of file diff --git a/y2020/ChangeLog.md b/y2020/ChangeLog.md new file mode 100644 index 0000000..b2b7b2a --- /dev/null +++ b/y2020/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for y2020 + +## Unreleased changes diff --git a/y2020/LICENSE b/y2020/LICENSE new file mode 100644 index 0000000..e095992 --- /dev/null +++ b/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. diff --git a/y2020/README.md b/y2020/README.md new file mode 100644 index 0000000..94448b0 --- /dev/null +++ b/y2020/README.md @@ -0,0 +1,4 @@ +# Advent of Code 2020 +https://adventofcode.com/2020 + +A good occasion to try Haskell. diff --git a/y2020/Setup.hs b/y2020/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/y2020/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/y2020/app/Main.hs b/y2020/app/Main.hs new file mode 100644 index 0000000..d7565bd --- /dev/null +++ b/y2020/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import DayPicker + +main :: IO () +main = dayPicker diff --git a/y2020/package.yaml b/y2020/package.yaml new file mode 100644 index 0000000..cbcf213 --- /dev/null +++ b/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 + +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 diff --git a/y2020/src/Day01.hs b/y2020/src/Day01.hs new file mode 100644 index 0000000..7c7e335 --- /dev/null +++ b/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)) diff --git a/y2020/src/DayPicker.hs b/y2020/src/DayPicker.hs new file mode 100644 index 0000000..84111b4 --- /dev/null +++ b/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 diff --git a/y2020/src/Geo/Point.hs b/y2020/src/Geo/Point.hs new file mode 100644 index 0000000..c7650b8 --- /dev/null +++ b/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) diff --git a/y2020/src/Geo/Segment.hs b/y2020/src/Geo/Segment.hs new file mode 100644 index 0000000..d5bc35d --- /dev/null +++ b/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 diff --git a/y2020/src/Geo/Vector.hs b/y2020/src/Geo/Vector.hs new file mode 100644 index 0000000..5d8b2e3 --- /dev/null +++ b/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 diff --git a/y2020/stack.yaml b/y2020/stack.yaml new file mode 100644 index 0000000..dbba8d7 --- /dev/null +++ b/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 diff --git a/y2020/stack.yaml.lock b/y2020/stack.yaml.lock new file mode 100644 index 0000000..5e17e80 --- /dev/null +++ b/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 diff --git a/y2020/test/Spec.hs b/y2020/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/y2020/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"