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