Connect-Four winner-checking algorithm

Question

I'm trying to practice some functional techniques. I haven't worked much in Haskell, so any language-specific tips would be very appreciated, but what I care for even more are general tips towards my approach that I can carry between functional languages. Performance is not a big concern of mine right now.

I implemented the winner-checking algorithm for the connect-four game. Basically, given a 6x7 grid, I need to be able to determine if a player has successfully placed four consecutive tiles down (horizontally, vertically, or diagonally). If so, I need to return which player it was.

Here is my implementation:

module Logic (Player(..), Board, getWinner) where
import qualified Control.Monad as Monad

data Player = Player1 | Player2

type BoardEntry = Maybe Player

type Board = [[BoardEntry]]

type Coord a = (a, a)

instance Eq Player where
  Player1 == Player1 = True
  Player2 == Player2 = True
  x == y = False

map2dList :: (a -> b) -> [[a]] -> [[b]]
map2dList fn = map (map fn)

getElementAt :: [a] -> Int -> Maybe a
getElementAt (el:_) 0 = Just el
getElementAt (_:rest) n = getElementAt rest (n - 1)
getElementAt [] _ = Nothing

getBoardEntryAt :: Board -> Coord Int -> Maybe BoardEntry
getBoardEntryAt board (x, y) =
  getElementAt board y >>= flip getElementAt x

getBoardDimensions :: Board -> (Int, Int)
getBoardDimensions board =
  ((length . head) board, length board)

addCoords :: Coord Int -> Coord Int -> Coord Int
addCoords (x1, y1) (x2, y2) =
  (x1 + x2, y1 + y2)

isCoordInRegion :: (Int, Int) -> Coord Int -> Bool
isCoordInRegion (width, height) (x, y) =
  x >= 0 && x < width &&
  y >= 0 && y < height

getAllCoordsInRegion :: (Int, Int) -> [Coord Int]
getAllCoordsInRegion (width, height) =
  [(x,y) | x <- [0..width-1], y <- [0..height-1]]

getWinner :: Board -> Maybe Player
getWinner board =
  let
    fourInRowsFromOrigin =
      [
        [(0, 0), (1, 0), (2, 0), (3, 0)],
        [(0, 0), (1, 1), (2, 2), (3, 3)],
        [(0, 0), (0, 1), (0, 2), (0, 3)],
        [(0, 0), (-1, 1), (-2, 2), (-3, 3)]
      ]
    playerPieceAt = Monad.join . getBoardEntryAt board
    results = concat $ do
      coord <- (getAllCoordsInRegion . getBoardDimensions) board
      fourInRow <- map2dList (addCoords coord) fourInRowsFromOrigin
      player <- [Player1, Player2]
      return [player | all ((== Just player) . playerPieceAt) fourInRow]
  in case results of
    [winner] -> Just winner
    [] -> Nothing
    _ -> undefined

And here is a sample driver, to help see that it works:

import Logic (Player(Player1, Player2), Board, getWinner)

getWinnerAsString :: Maybe Player -> [Char]
getWinnerAsString Nothing = "No one has won"
getWinnerAsString (Just Player1) = "Player 1"
getWinnerAsString (Just Player2) = "Player 2"

printWinner :: Board -> IO ()
printWinner = putStrLn . getWinnerAsString . getWinner

exampleBoard :: Board
exampleBoard =
  let
    __ = Nothing
    p1 = Just Player1
    p2 = Just Player2
  in [
    [__, __, __, __, __, __, __],
    [__, __, __, __, __, __, __],
    [__, __, p2, p1, __, __, __],
    [__, __, p1, p2, __, __, __],
    [__, p1, p1, p2, p1, __, __],
    [p1, p2, p2, p2, p1, __, __]
  ]

main :: IO ()
main = printWinner exampleBoard

Answer 1

This is very good! The other answer addresses the non-obvious algorithmic improvement, so I'll try to tackle matters of style and hopefully point you toward more FP intuition.

Since your Player type isn't fancy, just let the compiler derive your instances.

data Player = Player1 | Player2 deriving Eq

You will probably also benefit from compiling with warnings (add -Wall to your flags, in a cabal file it's ghc-options: -Wall in your executable or library sections). In this case the compiler would have warned you about “unused matches” for x and y. This can help you find definitions where you maybe mistakenly used the wrong variable somewhere. You can tell the compiler “no really, I meant not to use this” by prefixing declarations with an underscore (_x and _y). That will also help tell whoever's reading your code not to expect to see that value used in the definition.

map2dList is equivalently written as map . map. If the reason why isn't immediately obvious, try to work it out from your knowledge of precedence, you'll see weirder and more terse things as you explore higher order functions.

getElementAt is "safe".Safe.atMay :: \[a\] -> Int -> Maybe a. atMay also short circuits on negative numbers, which is a nice convenience feature and also allows you to accept infinite lists. Not relevant to your code now, but you never know what the future holds and how else your functions might be used or by whom.

getBoardEntryAt is clever, there's nothing wrong with it, but I find this version more readable. I'm easily confused whenever I see flip though.

getBoardEntryAt board (x, y) = join . fmap (`atMay` x) . (`atMay` y) $ board

getBoardDimensions is a partial function (from the use of head), you could use headMay from safe or even annotate your function with Safe.Partial.Partial like getBoardDimensions :: Partial => ....

isCoordInRegion is dead code, but I'd also write it like—

isCoordOnBoard :: Board -> Coord Int -> Bool
isCoordOnBoard board (x, y) =
  let
    (xDim, yDim) = getBoardDimensions board
    between lo v hi = lo <= v && v < hi
  in
    between 0 x xDim && between 0 y yDim

Since you're assuming the region begins at \$(0, 0)\$, I think it makes more sense to make this a function on Boards, not maximum bounds. If you were passing a lower and upper bound that would make the difference for me. I also find it convenient to define a small helper function with a name whenever I see repetition in a function like that, naming things makes the number of concepts you have to juggle in your head drop. Again, valuable for whoever comes to read your code later.

This function also exists as "base".Data.Ix.inRange :: (Ix a) => (a, a) -> a -> Bool. Pairs are instances of Ix, so you'd use it like inRange ((0, 0), (xDim, yDim)) (x, y). getAllCoordsInRegion is also in Ix as range. For that matter, you might also want to check out the array package, which isn't in base but is a part of Haskell2010 which means it's basically batteries-included into all modern Haskell compilers (uh... GHC).

getWinner I think benefits primarily from Rainer P.'s answer, I don't have anything else to add since that's overriding. I will note that it's partial in using undefined.

The only other thing I'd note is how getWinnersAsString returns [Char] instead of String. Unless I'm planning to actually fold over the characters in a String or otherwise look at it letter-wise, use String for non-parseable strings.

But a lot of the above is me being a huge tyrannical pedant, your code is very good as-is and I'd probably just wave it through an actual code review!

Answer 2

All the indexing can be deleted. You only need the transpose function plus a custom function that grabs the diagonals of a matrix (list of lists, all of the same length).

import Data.List (transpose)

-- | The 'diagonals' function returns the diagonals of a matrix
diagonals :: [[a]] -> [[a]]
diagonals matrix = lowerDiags matrix ++ upperDiags matrix
    where lowerDiags = reverse . transpose . zipWith drop [1..]
          upperDiags = transpose . zipWith drop [0..] . transpose

You can invoke it as shown below. If any of the vectors has four in a row, you have a winner.

board = ...
vectors = board ++ transpose board ++ diagonals board ++ diagonals (reverse board)