From c3a235494fa4e2aca91cadf94b3c5890baa7734e Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Mon, 17 Sep 2018 17:25:25 +0100 Subject: [PATCH] Haskell version using megaparsec --- src/task1/task1-mpc.hs | 113 +++++++++++++++++++++++++++++++++++++ src/task1/task1.hs | 9 +-- stack.yaml | 74 ++---------------------- summerofcode2018soln.cabal | 8 +++ 4 files changed, 131 insertions(+), 73 deletions(-) create mode 100644 src/task1/task1-mpc.hs diff --git a/src/task1/task1-mpc.hs b/src/task1/task1-mpc.hs new file mode 100644 index 0000000..a8a3ccb --- /dev/null +++ b/src/task1/task1-mpc.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Data.List (foldl') -- import the strict fold + +import Data.Text (Text) +-- import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Data.Void (Void) + +import Text.Megaparsec -- hiding (State) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + + +-- number of steps +type Distance = Int +type Position = (Int, Int) + +-- the directions. See below for functions for turning +data Direction = North | East | South | West + deriving (Enum, Show, Bounded, Eq) + +-- direction, easting, northing +data Mowmaster = Mowmaster { direction :: Direction + , position :: Position + } deriving (Show, Eq) + +-- one instruction for the mowmaster +data Instruction = Forward Distance + | Clockwise + | Anticlockwise + | Comment String + deriving (Show, Eq) + + +main :: IO () +main = do + instruction_text <- TIO.readFile "data/01-mowmaster.txt" + let instructions = successfulParse instruction_text + print $ part1 instructions + print $ part2 instructions + +part1 :: [Instruction] -> Int +part1 = length + +part2 :: [Instruction] -> Int +part2 instructions = finalDistance $ executeAll instructions + where executeAll = foldl' execute initialMowmaster + +initialMowmaster = Mowmaster North (0, 0) + + +-- Calculate manhattan distance from start to this state +finalDistance :: Mowmaster -> Int +finalDistance m = (abs e) + (abs n) + where (e, n) = position m + + +-- Make one move +execute :: Mowmaster -> Instruction -> Mowmaster +execute m (Forward s) = m {position = forward s (direction m) (position m)} +execute m Clockwise = m {direction = turnCW (direction m)} +execute m Anticlockwise = m {direction = turnACW (direction m)} +execute m _ = m + +-- Move in the current direction +forward :: Int -> Direction -> Position -> Position +forward s North (e, n) = (e, n+s) +forward s South (e, n) = (e, n-s) +forward s West (e, n) = (e-s, n) +forward s East (e, n) = (e+s, n) + + +-- | a `succ` that wraps +turnCW :: (Bounded a, Enum a, Eq a) => a -> a +turnCW dir | dir == maxBound = minBound + | otherwise = succ dir + +-- | a `pred` that wraps +turnACW :: (Bounded a, Enum a, Eq a) => a -> a +turnACW dir | dir == minBound = maxBound + | otherwise = pred dir + + +-- Parse the input file + +type Parser = Parsec Void Text + +-- treat comment lines as whitespace +sc :: Parser () +sc = L.space space1 lineComment CA.empty + where lineComment = L.skipLineComment "#" + +lexeme = L.lexeme sc +integer = lexeme L.decimal +symb = L.symbol sc + +-- instructions is some optional space followed by many instructions +instrsP = optional sc *> many instrP +instrP = forwardP <|> cwP <|> acwP + +-- parse each instruction +forwardP = Forward <$> (symb "F" *> integer) +cwP = Clockwise <$ symb "C" +acwP = Anticlockwise <$ symb "A" + +successfulParse :: Text -> [Instruction] +successfulParse input = + case parse instrsP "input" input of + Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right instrs -> instrs \ No newline at end of file diff --git a/src/task1/task1.hs b/src/task1/task1.hs index 200d538..071fe68 100644 --- a/src/task1/task1.hs +++ b/src/task1/task1.hs @@ -1,9 +1,10 @@ import Data.List (foldl') -- import the strict fold -- number of steps -type Step = Int +type Distance = Int type Position = (Int, Int) +-- the directions. See below for functions for turning data Direction = North | East | South | West deriving (Enum, Show, Bounded, Eq) @@ -12,7 +13,8 @@ data Mowmaster = Mowmaster { direction :: Direction , position :: Position } deriving (Show, Eq) -data Instruction = Forward Step +-- one instruction for the mowmaster +data Instruction = Forward Distance | Clockwise | Anticlockwise | Comment String @@ -35,7 +37,6 @@ part2 instruction_text = finalDistance $ executeAll instructions executeAll = foldl' execute initialMowmaster - -- Is this line a comment? isComment :: String -> Bool isComment ('#':_) = True @@ -70,6 +71,7 @@ execute m Clockwise = m {direction = turnCW (direction m)} execute m Anticlockwise = m {direction = turnACW (direction m)} execute m (Comment _) = m + -- Move in the current direction forward :: Int -> Direction -> Position -> Position forward s North (e, n) = (e, n+s) @@ -77,7 +79,6 @@ forward s South (e, n) = (e, n-s) forward s West (e, n) = (e-s, n) forward s East (e, n) = (e+s, n) - -- | a `succ` that wraps turnCW :: (Bounded a, Enum a, Eq a) => a -> a turnCW dir | dir == maxBound = minBound diff --git a/stack.yaml b/stack.yaml index e67f48d..1fdb8a1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,71 +1,7 @@ -# 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 -# resolver: ghcjs-0.1.0_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-12.9 - -# 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 -# subdirs: -# - auto-update -# - wai +flags: {} +ghc-options: + $locals: -O2 -Wall -Wno-missing-signatures -threaded -rtsopts -with-rtsopts=-N packages: - . -# Dependency packages to be pulled from upstream that are not in the resolver -# using the same syntax as the packages field. -# (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.7" -# -# 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 - -ghc-options: - ! '$locals': -O2 -Wall -Wno-missing-signatures -threaded -rtsopts -with-rtsopts=-N - -extra-deps: -- parsec-numbers-0.1.0 \ No newline at end of file +extra-deps: [] +resolver: lts-12.9 diff --git a/summerofcode2018soln.cabal b/summerofcode2018soln.cabal index 77423a3..715e6cb 100644 --- a/summerofcode2018soln.cabal +++ b/summerofcode2018soln.cabal @@ -32,3 +32,11 @@ executable task1 main-is: task1.hs default-language: Haskell2010 build-depends: base >= 4.7 && < 5 + +executable task1-mpc + hs-source-dirs: src/task1 + main-is: task1-mpc.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , text + , megaparsec -- 2.34.1