Create an assessment directory
I've been doing a few take-home assessment recently, all of which I've attempted to solve using Haskell. I'm having a good time, and I'm noticing strong and weak points with my Haskell programming. I always attempt to apply any feedback a reviewer gives me, and I'm storing my first drafts, second attempts, and feedback here for now. This recently attempt was for a role at Jane Street.
This commit is contained in:
parent
f032eee79d
commit
6c0777aada
10 changed files with 359 additions and 0 deletions
1
assessments/dotted-squares/.envrc
Normal file
1
assessments/dotted-squares/.envrc
Normal file
|
@ -0,0 +1 @@
|
|||
use_nix
|
217
assessments/dotted-squares/Main.hs
Normal file
217
assessments/dotted-squares/Main.hs
Normal file
|
@ -0,0 +1,217 @@
|
|||
{-# 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
|
||||
|
||||
line :: ReadP String
|
||||
line = 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
|
||||
|
||||
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 <$> line :: ReadP Int
|
||||
h <- read <$> line :: ReadP Int
|
||||
locs <- read <$> line :: ReadP Int
|
||||
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 x1 y1) (Point x2 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 game ->
|
||||
case scoreGame Player1 game mempty of
|
||||
Nothing -> putStrLn "invalid"
|
||||
Just score -> print score
|
21
assessments/dotted-squares/README.md
Normal file
21
assessments/dotted-squares/README.md
Normal file
|
@ -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.
|
80
assessments/dotted-squares/Spec.hs
Normal file
80
assessments/dotted-squares/Spec.hs
Normal file
|
@ -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
|
7
assessments/dotted-squares/colliding-moves.txt
Normal file
7
assessments/dotted-squares/colliding-moves.txt
Normal file
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 R
|
||||
0 1 R
|
||||
0 1 R
|
7
assessments/dotted-squares/game.txt
Normal file
7
assessments/dotted-squares/game.txt
Normal file
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
||||
1 1 D
|
5
assessments/dotted-squares/input-a.txt
Normal file
5
assessments/dotted-squares/input-a.txt
Normal file
|
@ -0,0 +1,5 @@
|
|||
1
|
||||
1
|
||||
2
|
||||
0 0 R
|
||||
0 0 U
|
8
assessments/dotted-squares/shell.nix
Normal file
8
assessments/dotted-squares/shell.nix
Normal file
|
@ -0,0 +1,8 @@
|
|||
let
|
||||
briefcase = import /home/wpcarro/briefcase {};
|
||||
in briefcase.buildHaskell.shell {
|
||||
deps = hpkgs: with hpkgs; [
|
||||
hspec
|
||||
unordered-containers
|
||||
];
|
||||
}
|
6
assessments/dotted-squares/too-few-moves.txt
Normal file
6
assessments/dotted-squares/too-few-moves.txt
Normal file
|
@ -0,0 +1,6 @@
|
|||
1
|
||||
1
|
||||
4
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
7
assessments/dotted-squares/too-many-moves.txt
Normal file
7
assessments/dotted-squares/too-many-moves.txt
Normal file
|
@ -0,0 +1,7 @@
|
|||
1
|
||||
1
|
||||
3
|
||||
0 0 R
|
||||
0 0 U
|
||||
0 1 R
|
||||
1 1 D
|
Loading…
Reference in a new issue