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:
William Carroll 2020-08-15 18:25:55 +01:00
parent f032eee79d
commit 6c0777aada
10 changed files with 359 additions and 0 deletions

View file

@ -0,0 +1 @@
use_nix

View 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

View 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.

View 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

View file

@ -0,0 +1,7 @@
1
1
4
0 0 R
0 0 R
0 1 R
0 1 R

View file

@ -0,0 +1,7 @@
1
1
4
0 0 R
0 0 U
0 1 R
1 1 D

View file

@ -0,0 +1,5 @@
1
1
2
0 0 R
0 0 U

View file

@ -0,0 +1,8 @@
let
briefcase = import /home/wpcarro/briefcase {};
in briefcase.buildHaskell.shell {
deps = hpkgs: with hpkgs; [
hspec
unordered-containers
];
}

View file

@ -0,0 +1,6 @@
1
1
4
0 0 R
0 0 U
0 1 R

View file

@ -0,0 +1,7 @@
1
1
3
0 0 R
0 0 U
0 1 R
1 1 D