diff options
Diffstat (limited to 'users/wpcarro/assessments/dotted-squares')
11 files changed, 362 insertions, 0 deletions
diff --git a/users/wpcarro/assessments/dotted-squares/.envrc b/users/wpcarro/assessments/dotted-squares/.envrc new file mode 100644 index 0000000000..a4a62da526 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/.envrc @@ -0,0 +1,2 @@ +source_up +use_nix diff --git a/users/wpcarro/assessments/dotted-squares/.ghci b/users/wpcarro/assessments/dotted-squares/.ghci new file mode 100644 index 0000000000..b100af4432 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/.ghci @@ -0,0 +1 @@ +:set -Wall diff --git a/users/wpcarro/assessments/dotted-squares/Main.hs b/users/wpcarro/assessments/dotted-squares/Main.hs new file mode 100644 index 0000000000..44f91e2b23 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/Main.hs @@ -0,0 +1,218 @@ +{-# LANGUAGE DeriveGeneric #-} +-------------------------------------------------------------------------------- +module Main where +-------------------------------------------------------------------------------- +import Data.Hashable +import Data.Function ((&)) +import GHC.Generics +import Text.ParserCombinators.ReadP +import Control.Applicative + +import qualified Data.HashSet as HS +-------------------------------------------------------------------------------- + +data Direction + = DirLeft + | DirRight + | DirUp + | DirDown + deriving (Eq, Show) + +data Point = Point Int Int + deriving (Eq, Show, Ord, Generic) +instance Hashable Point + +data Orientation + = Horizontal + | Vertical + deriving (Eq, Show) + +data Anchor + = Beg + | End + deriving (Eq, Show) + +data Rotation + = CW + | CCW + deriving (Eq, Show) + +data Line = Line Point Point + deriving (Show, Generic) +instance Hashable Line + +instance Eq Line where + Line begA endA == Line begB endB = + (begA == begB && endA == endB) || + (begA == endB && endA == begB) + +data Game = Game (HS.HashSet Line) [Line] + deriving (Eq, Show) + +data Scoreboard = Scoreboard Int Int + deriving (Eq) + +instance Semigroup Scoreboard where + (Scoreboard a b) <> (Scoreboard x y) = + Scoreboard (a + x) (b + y) + +instance Monoid Scoreboard where + mempty = Scoreboard 0 0 + +data Turn + = Player1 + | Player2 + deriving (Eq, Show) + +next :: Turn -> Turn +next Player1 = Player2 +next Player2 = Player1 + +instance Show Scoreboard where + show (Scoreboard p1 p2) = + "Player 1: " ++ show (p1) ++ " Player 2: " ++ show (p2) + +digit :: ReadP Char +digit = satisfy (\c -> c >= '0' && c <= '9') + +int :: ReadP Int +int = read <$> many1 digit + +inputLine :: ReadP String +inputLine = manyTill get (char '\n') + +direction :: ReadP Direction +direction = do + c <- char 'L' <|> char 'R' <|> char 'U' <|> char 'D' + case c of + 'L' -> pure DirLeft + 'R' -> pure DirRight + 'U' -> pure DirUp + 'D' -> pure DirDown + _ -> fail $ "Unexpected direction: " ++ show c + +validMove :: Int -> Int -> ReadP Line +validMove w h = do + x <- int + skipSpaces + y <- int + skipSpaces + dir <- direction + _ <- char '\n' + if x >= 0 && x <= w && y >= 0 && y <= h then do + let beg = Point x y + pure $ mkLine beg (shiftPoint dir beg) + else + fail "Expected a move on the game board" + +game :: ReadP Game +game = do + w <- read <$> inputLine + h <- read <$> inputLine + locs <- read <$> inputLine + moves <- count locs (validMove w h) + eof + pure $ Game mempty moves + +parseInput :: String -> Maybe Game +parseInput x = do + case readP_to_S game x of + [(res, "")] -> Just res + _ -> Nothing + +-- | Smart constructor to ensure that beg is always < end. +mkLine :: Point -> Point -> Line +mkLine beg end = + if beg < end then Line beg end else Line end beg + +mkLineDir :: Int -> Int -> Direction -> Line +mkLineDir x y dir = + let beg = Point x y + in mkLine beg (shiftPoint dir beg) + +mkLineDir' :: Point -> Direction -> Line +mkLineDir' (Point x y) dir = mkLineDir x y dir + +shiftPoint :: Direction -> Point -> Point +shiftPoint DirLeft (Point x y) = Point (x - 1) y +shiftPoint DirRight (Point x y) = Point (x + 1) y +shiftPoint DirUp (Point x y) = Point x (y + 1) +shiftPoint DirDown (Point x y) = Point x (y - 1) + +shiftLine :: Direction -> Line -> Line +shiftLine dir (Line beg end) = + mkLine (shiftPoint dir beg) (shiftPoint dir end) + +rotateLine :: Anchor -> Rotation -> Line -> Line +rotateLine anchor rotation line = + doRotateLine (classifyOrientation line) anchor rotation line + +doRotateLine :: Orientation -> Anchor -> Rotation -> Line -> Line +doRotateLine Horizontal Beg CW (Line beg _) = mkLineDir' beg DirDown +doRotateLine Horizontal Beg CCW (Line beg _) = mkLineDir' beg DirUp +doRotateLine Horizontal End CW (Line _ end) = mkLineDir' end DirUp +doRotateLine Horizontal End CCW (Line _ end) = mkLineDir' end DirDown +doRotateLine Vertical Beg CW (Line beg _) = mkLineDir' beg DirRight +doRotateLine Vertical Beg CCW (Line beg _) = mkLineDir' beg DirLeft +doRotateLine Vertical End CW (Line _ end) = mkLineDir' end DirLeft +doRotateLine Vertical End CCW (Line _ end) = mkLineDir' end DirRight + +classifyOrientation :: Line -> Orientation +classifyOrientation (Line (Point _ y1) (Point _ y2)) = + if y1 == y2 then Horizontal else Vertical + +closesAnySquare :: HS.HashSet Line -> Line -> Bool +closesAnySquare allMoves line = do + let alreadyDrawn x = HS.member x allMoves + case classifyOrientation line of + Horizontal -> + all alreadyDrawn + [ shiftLine DirUp line + , rotateLine Beg CCW line + , rotateLine End CW line + ] || + all alreadyDrawn + [ shiftLine DirDown line + , rotateLine Beg CW line + , rotateLine End CCW line + ] + Vertical -> + all alreadyDrawn + [ shiftLine DirLeft line + , rotateLine Beg CCW line + , rotateLine End CW line + ] || + all alreadyDrawn + [ shiftLine DirRight line + , rotateLine Beg CW line + , rotateLine End CCW line + ] + +incScoreboard :: Turn -> Scoreboard -> Scoreboard +incScoreboard Player1 score = score <> Scoreboard 1 0 +incScoreboard Player2 score = score <> Scoreboard 0 1 + +scoreGame :: Turn -> Game -> Scoreboard -> Maybe Scoreboard +scoreGame _ (Game _ []) score = Just $ score +scoreGame player (Game allMoves (line:rest)) score = + if HS.member line allMoves then + Nothing + else do + let allMoves' = HS.insert line allMoves + score' = if closesAnySquare allMoves line then + incScoreboard player score + else score + scoreGame (next player) (Game allMoves' rest) score' + +(|>) :: a -> (a -> b) -> b +(|>) = (&) + +main :: IO () +main = do + input <- readFile "game.txt" + case parseInput input of + Nothing -> putStrLn "invalid" + Just parsedGame -> + case scoreGame Player1 parsedGame mempty of + Nothing -> putStrLn "invalid" + Just score -> print score diff --git a/users/wpcarro/assessments/dotted-squares/README.md b/users/wpcarro/assessments/dotted-squares/README.md new file mode 100644 index 0000000000..3d13da1cb1 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/README.md @@ -0,0 +1,21 @@ +# Dotted Squares + +This is my second attempt at solving this problem. I had an hour to solve it the +first time, and I unfortunately came up short although I made good progress. + +The problem asks to read input from a text file that looks like this: + +``` +1 -- board width +1 -- board height +4 -- number of lines of "moves" (below) +0 0 R -- create a unit vector (0,0) facing right +0 0 U -- create a unit vector (0,0) facing up +0 1 L -- create a unit vector (0,1) facing left +1 1 D -- create a unit vector (1,1) facing down +``` + +After parsing and validating the input, score the outcome a game where players +one and two alternatively take turns drawing lines on a board. Anytime one of +the players draws a line that creates a square from existing lines, they get a +point. diff --git a/users/wpcarro/assessments/dotted-squares/Spec.hs b/users/wpcarro/assessments/dotted-squares/Spec.hs new file mode 100644 index 0000000000..b5d604085b --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/Spec.hs @@ -0,0 +1,80 @@ +-------------------------------------------------------------------------------- +module Spec where +-------------------------------------------------------------------------------- +import Test.Hspec +import Main hiding (main) +import qualified Data.HashSet as HS +-------------------------------------------------------------------------------- + +main :: IO () +main = hspec $ do + describe "dotted-squares" $ do + describe "parseInput" $ do + it "works as expected" $ do + input <- readFile "input-a.txt" + parseInput input `shouldBe` Just (Game mempty [ mkLine (Point 0 0) (Point 1 0) + , mkLine (Point 0 0) (Point 0 1) + ]) + + it "fails when the game has too many user moves" $ do + input <- readFile "too-many-moves.txt" + parseInput input `shouldBe` Nothing + + it "fails when the game has too few user moves" $ do + input <- readFile "too-few-moves.txt" + parseInput input `shouldBe` Nothing + + describe "shiftLine" $ do + let horizontal = mkLineDir 1 1 DirRight + vertical = mkLineDir 1 1 DirUp + it "can move a horizontal line up" $ + shiftLine DirUp horizontal `shouldBe` mkLineDir 1 2 DirRight + it "can move a horizontal line down" $ + shiftLine DirDown horizontal `shouldBe` mkLineDir 1 0 DirRight + it "can move a horizontal line left" $ + shiftLine DirLeft horizontal `shouldBe` mkLineDir 0 1 DirRight + it "can move a horizontal line right" $ + shiftLine DirRight horizontal `shouldBe` mkLineDir 2 1 DirRight + it "can move a vertical line up" $ + shiftLine DirUp vertical `shouldBe` mkLineDir 1 2 DirUp + it "can move a vertical line down" $ + shiftLine DirDown vertical `shouldBe` mkLineDir 1 0 DirUp + it "can move a vertical line left" $ + shiftLine DirLeft vertical `shouldBe` mkLineDir 0 1 DirUp + it "can move a vertical line right" $ + shiftLine DirRight vertical `shouldBe` mkLineDir 2 1 DirUp + + describe "rotateLine" $ do + let horizontal = mkLineDir 1 1 DirRight -- 1,1;2,1 + vertical = mkLineDir 1 1 DirUp -- 1,1;1,2 + it "can rotate a horizontal line CW anchored at its beginning" $ + rotateLine Beg CW horizontal `shouldBe` mkLineDir 1 1 DirDown + it "can rotate a horizontal line CCW anchored at its beginning" $ + rotateLine Beg CCW horizontal `shouldBe` mkLineDir 1 1 DirUp + it "can rotate a horizontal line CW anchored at its end" $ + rotateLine End CW horizontal `shouldBe` mkLineDir 2 1 DirUp + it "can rotate a horizontal line CCW anchored at its end" $ + rotateLine End CCW horizontal `shouldBe` mkLineDir 2 1 DirDown + + it "can rotate a vertical line CW anchored at its beginning" $ + rotateLine Beg CW vertical `shouldBe` mkLineDir 1 1 DirRight + it "can rotate a vertical line CCW anchored at its beginning" $ + rotateLine Beg CCW vertical `shouldBe` mkLineDir 1 1 DirLeft + it "can rotate a vertical line CW anchored at its end" $ + rotateLine End CW vertical `shouldBe` mkLineDir 1 2 DirLeft + it "can rotate a vertical line CCW anchored at its end" $ + rotateLine End CCW vertical `shouldBe` mkLineDir 1 2 DirRight + + describe "closesAnySquare" $ do + let threeSides = [ (0, 0, DirRight) + , (0, 0, DirUp) + , (0, 1, DirRight) + ] + |> fmap (\(x, y, dir) -> mkLineDir x y dir) + |> HS.fromList + it "returns true the line we supply makes a square" $ + closesAnySquare threeSides (mkLineDir 1 1 DirDown) `shouldBe` True + it "returns false the line we supply doesn't make a square" $ + closesAnySquare threeSides (mkLineDir 1 1 DirUp) `shouldBe` False + it "returns false when we have no existing lines" $ + closesAnySquare mempty (mkLineDir 1 1 DirUp) `shouldBe` False diff --git a/users/wpcarro/assessments/dotted-squares/colliding-moves.txt b/users/wpcarro/assessments/dotted-squares/colliding-moves.txt new file mode 100644 index 0000000000..a831fa95c0 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/colliding-moves.txt @@ -0,0 +1,7 @@ +1 +1 +4 +0 0 R +0 0 R +0 1 R +0 1 R diff --git a/users/wpcarro/assessments/dotted-squares/game.txt b/users/wpcarro/assessments/dotted-squares/game.txt new file mode 100644 index 0000000000..0af71d1f5b --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/game.txt @@ -0,0 +1,7 @@ +1 +1 +4 +0 0 R +0 0 U +0 1 R +1 1 D diff --git a/users/wpcarro/assessments/dotted-squares/input-a.txt b/users/wpcarro/assessments/dotted-squares/input-a.txt new file mode 100644 index 0000000000..b9e871eced --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/input-a.txt @@ -0,0 +1,5 @@ +1 +1 +2 +0 0 R +0 0 U diff --git a/users/wpcarro/assessments/dotted-squares/shell.nix b/users/wpcarro/assessments/dotted-squares/shell.nix new file mode 100644 index 0000000000..868668ca50 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/shell.nix @@ -0,0 +1,8 @@ +{ depot, ... }: + +depot.users.wpcarro.buildHaskell.shell { + deps = hpkgs: with hpkgs; [ + hspec + unordered-containers + ]; +} diff --git a/users/wpcarro/assessments/dotted-squares/too-few-moves.txt b/users/wpcarro/assessments/dotted-squares/too-few-moves.txt new file mode 100644 index 0000000000..d684679d26 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/too-few-moves.txt @@ -0,0 +1,6 @@ +1 +1 +4 +0 0 R +0 0 U +0 1 R diff --git a/users/wpcarro/assessments/dotted-squares/too-many-moves.txt b/users/wpcarro/assessments/dotted-squares/too-many-moves.txt new file mode 100644 index 0000000000..bfcced43b9 --- /dev/null +++ b/users/wpcarro/assessments/dotted-squares/too-many-moves.txt @@ -0,0 +1,7 @@ +1 +1 +3 +0 0 R +0 0 U +0 1 R +1 1 D |