10 files changed, 359 insertions, 0 deletions
diff --git a/assessments/dotted-squares/.envrc b/assessments/dotted-squares/.envrc
new file mode 100644
index 000000000000..4a4726a5c73f
--- /dev/null
+++ b/assessments/dotted-squares/.envrc
@@ -0,0 +1 @@
+use_nix
diff --git a/assessments/dotted-squares/Main.hs b/assessments/dotted-squares/Main.hs
new file mode 100644
index 000000000000..0e166bad2718
--- /dev/null
+++ b/assessments/dotted-squares/Main.hs
@@ -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
diff --git a/assessments/dotted-squares/README.md b/assessments/dotted-squares/README.md
new file mode 100644
index 000000000000..3d13da1cb18e
--- /dev/null
+++ b/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/assessments/dotted-squares/Spec.hs b/assessments/dotted-squares/Spec.hs
new file mode 100644
index 000000000000..b5d604085b9b
--- /dev/null
+++ b/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/assessments/dotted-squares/colliding-moves.txt b/assessments/dotted-squares/colliding-moves.txt
new file mode 100644
index 000000000000..a831fa95c08e
--- /dev/null
+++ b/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/assessments/dotted-squares/game.txt b/assessments/dotted-squares/game.txt
new file mode 100644
index 000000000000..0af71d1f5b56
--- /dev/null
+++ b/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/assessments/dotted-squares/input-a.txt b/assessments/dotted-squares/input-a.txt
new file mode 100644
index 000000000000..b9e871eced86
--- /dev/null
+++ b/assessments/dotted-squares/input-a.txt
@@ -0,0 +1,5 @@
+1
+1
+2
+0 0 R
+0 0 U
diff --git a/assessments/dotted-squares/shell.nix b/assessments/dotted-squares/shell.nix
new file mode 100644
index 000000000000..75a72cb7e0ba
--- /dev/null
+++ b/assessments/dotted-squares/shell.nix
@@ -0,0 +1,8 @@
+let
+  briefcase = import /home/wpcarro/briefcase {};
+in briefcase.buildHaskell.shell {
+  deps = hpkgs: with hpkgs; [
+    hspec
+    unordered-containers
+  ];
+}
diff --git a/assessments/dotted-squares/too-few-moves.txt b/assessments/dotted-squares/too-few-moves.txt
new file mode 100644
index 000000000000..d684679d264f
--- /dev/null
+++ b/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/assessments/dotted-squares/too-many-moves.txt b/assessments/dotted-squares/too-many-moves.txt
new file mode 100644
index 000000000000..bfcced43b930
--- /dev/null
+++ b/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