Project Euler 11 Haskell - Largest product in a grid

Question

Intro

I have been learning haskell and functional programming using random Project Euler problems. Currently, I have solved Problem 11.

What is the greatest product of four adjacent numbers in the same direction (up, down, left, right, or diagonally) in the 20×20 grid?

My solution

My solution consists of 4 parts.

1. Finding the rows, columns and diagonals
2. Flattening them to a single list
3. Finding the product of sublists of 4, storing them in a list.
4. Returning the maximum product

module Main where

import Data.List (nub, transpose)

-- | Grid is just a 2-D List.
type Grid = [[Int]]

grid :: Grid
grid =
  [ [8, 2, 22, 97, 38, 15, 0, 40, 0, 75, 4, 5, 7, 78, 52, 12, 50, 77, 91, 8],
    [49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 4, 56, 62, 0],
    [81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 3, 49, 13, 36, 65],
    [52, 70, 95, 23, 4, 60, 11, 42, 69, 24, 68, 56, 1, 32, 56, 71, 37, 2, 36, 91],
    [22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
    [24, 47, 32, 60, 99, 3, 45, 2, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
    [32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
    [67, 26, 20, 68, 2, 62, 12, 20, 95, 63, 94, 39, 63, 8, 40, 91, 66, 49, 94, 21],
    [24, 55, 58, 5, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
    [21, 36, 23, 9, 75, 0, 76, 44, 20, 45, 35, 14, 0, 61, 33, 97, 34, 31, 33, 95],
    [78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 3, 80, 4, 62, 16, 14, 9, 53, 56, 92],
    [16, 39, 5, 42, 96, 35, 31, 47, 55, 58, 88, 24, 0, 17, 54, 24, 36, 29, 85, 57],
    [86, 56, 0, 48, 35, 71, 89, 7, 5, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
    [19, 80, 81, 68, 5, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 4, 89, 55, 40],
    [4, 52, 8, 83, 97, 35, 99, 16, 7, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
    [88, 36, 68, 87, 57, 62, 20, 72, 3, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
    [4, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 8, 46, 29, 32, 40, 62, 76, 36],
    [20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 4, 36, 16],
    [20, 73, 35, 29, 78, 31, 90, 1, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 5, 54],
    [1, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 1, 89, 19, 67, 48]
  ]

main :: IO ()
main = do
  print $ maximum products
  where
    seqs = concatMap ($ grid) [rows, cols, diag]
    products = subLists $ concat seqs
      where
        -- Function to operate on sublists of four
        subLists :: [Int] -> [Int]
        subLists xs
          | null xs = []
          | otherwise = (product . take 4 $ xs) : subLists (tail xs)

rows, cols, diag :: Grid -> Grid

-- | Rows returns all rows of Grid.
rows = id

-- | Columns can be defined as the transposition of rows
cols = Data.List.transpose

-- | Diagnoals of a Grid. (All directions: Up & Right, Down & Right, Up & Left, Down & Left)
diag grid =
  Data.List.nub allDiags -- Deduplicate list of diagonals to reduce computation of products.
  where
    -- Concatenate all 4 Directions
    allDiags =
      (diags . rows) grid
        ++ (diags . cols) grid
        ++ (diags . rows) gridMirror
        ++ (diags . cols) gridMirror

    gridMirror = mirror grid

    -- Mirror of a grid just reflects it about its columns.
    mirror :: Grid -> Grid
    mirror = reverse . Data.List.transpose

    -- Main logic to get Diagonals of a grid.
    -- How this works is basically explained here: https://stackoverflow.com/a/2792547
    -- Imagine this grid.
    -- [X . . . . .]
    -- [. X . . . .]
    -- [. . X . . .]
    -- [. . . X . .]
    -- [. . . . X .]
    -- [. . . . . X]
    -- When you drop 0 elems from row 0, 1 elem from row 1 ...: You get:
    -- [X . . . . .]
    -- [X . . . .]
    -- [X . . . ]
    -- [X . .]
    -- [X .]
    -- [X]
    -- Each of the columns is a diagonal. Repeat this for mirror, tranpose of mirror and transpose and you got all diagonals from all mirrors.

    diags :: Grid -> Grid
    diags [] = []
    diags (xs : xss)
      | null xs = []
      | otherwise = getDiag (xs : xss) : diags (map (drop 1) (xs : xss))

    getDiag :: Grid -> [Int]
    getDiag [] = []
    getDiag xss
      | null $ head xss = []
      | otherwise = (head . head) xss : getDiag ((map (drop 1) . drop 1) xss)

What I woud like for review

1. As I said, I am new to haskell, therefore I would appreicate if somebody could tell me how idiomatic this code was and how to improve it.
2. Conciseness - I have seen some absolutely elegant 1-liners in haskell. Is there any way to make my diag function more concise?

Performance

On my system (i5-6200u), This particular grid takes 0.00s in user to execute according to time when compiled with -O2. Therefore, I have no qualms about that, althogh if I could reduce memory usage, I would gladly take it.

Answer 1

Remarks

• Your code works! Software is hard, and working software deserves celebration

• It is pretty easy to read

• The code is reasonably-well structured and you make use of medium-level features (destructuring, where-clauses, etc)

Suggestions

In no particular order

• The type Grid = [[Int]] should be a newtype Grid = Grid { rows :: [[Int]] }. A Grid is semantically distinct from an [[Int]], and therefore deserves its own type

• I found some of your function name choices confusing. I would recommend renaming:

  • diags to upperFallingDiags, for clarity/precision
  • getDiag to fallingDiag, for clarity/precision
  • mirror to reflectHoriz, for clarity/precision
  • diag to diags, because it returns multiple diags, and to match the naming scheme of rows and cols

• I could be wrong, but I don't think your comment explaining your diagonal-getting algorithm works is correct. The algorithm implemented seems to differ from the algorithm described. I've replaced the comment in the edited code (below)

• You write that the diagonal-getting algorithm returns all directions: up & right, .... This strikes me as misleading. When applied to the grid

  0 1 2
  4 5 6
  7 8 9
  

  your algorithm does not produce both [1, 6] and [6, 1], but only one of these. More accurate is that your algorithm produces both the up-left/down-right direction (falling diagonals) and the up-right/down-left direction (rising diagonals)

• I don't think the application of Data.List.nub is worth it. I'd only expect two diagonals to be repeated (the two longest diagonals), and I don't think that's worth the O(n^2) runtime of nub. I could be wrong, though.

• subLists can be implemented as

  fmap product . filter (length >>> (== 4)) . fmap (take 4) . tails
  

  or just

  fmap product . fmap (take 4) . tails
  

  since all the numbers are positive (so filter does not effect the final maximum)

• Since you've imported Data.List (nub, transpose), you can refer to them simply as nub and transpose instead of as Data.List.nub and Data.List.transpose

• Scoping: I would move mirror (renamed to reflectHoriz) outside of the where-clause, since it's a very generic operation not specific to the implementation of the diagonal-getting algorithm. Also, I would move the assignment of gridMirror inwards, to communicate that it's only used for a small part of the where block.

• Indent where-blocks with only one level of indentation. Using two is just a waste of a level. (Admission: this is my preference; typically in Haskell where-blocks use two levels)

• The code

  diags [] = []
  diags (xs : xss)
    | null xs = []
    | otherwise = ...
  

  can be written more clearly as

  diags [] = []
  diags ([] : _) = []
  diags grid = ...
  

Edited code

This code implements all the suggestions I've given as well as a small handful of other changes

Brownie points to you if you can figure out how fallingDiags works :-)

module Main where

import Data.List (nub, tails)
import qualified Data.List as List

newtype Grid = Grid { rows :: [[Int]] }

reflectHoriz :: Grid -> Grid
reflectHoriz = Grid . reverse . List.transpose . rows

-- | Columns can be defined as the transposition of rows
transpose :: Grid -> Grid
transpose = Grid . List.transpose . rows

cols :: Grid -> [[Int]]
cols = rows . transpose

-- | Rising and falling diagnoals of a Grid
diags :: Grid -> [[Int]]
diags = \grid -> risingDiags grid ++ fallingDiags grid

  where

  risingDiags :: Grid -> [[Int]]
  risingDiags = fallingDiags . reflectHoriz

  fallingDiags :: Grid -> [[Int]]
  fallingDiags = upperFallingDiags <> (upperFallingDiags . transpose)

  -- Main logic to get Diagonals of a grid.
  -- Imagine this grid.
  -- [X . . . . .]
  -- [. X . . . .]
  -- [. . X . . .]
  -- [. . . X . .]
  -- [. . . . X .]
  -- [. . . . . X]
  -- When you drop 1 elem from all rows, the diagonal shifts:
  -- [  X . . . .]
  -- [  . X . . .]
  -- [  . . X . .]
  -- [  . . . X .]
  -- [  . . . . X]
  -- [  . . . . .]
  -- Repeat to produce every upper falling diagonal of the grid
  upperFallingDiags :: Grid -> [[Int]]
  upperFallingDiags (Grid []) = []
  upperFallingDiags (Grid ([] : _)) = []
  upperFallingDiags grid = fallingDiag grid : upperFallingDiags (Grid $ map (drop 1) (rows grid))

  fallingDiag :: Grid -> [Int]
  fallingDiag (Grid []) = []
  fallingDiag (Grid ([] : _)) = []
  fallingDiag (Grid xss) = (head . head) xss : fallingDiag (Grid $ (map (drop 1) . drop 1) xss)


main :: IO ()
main = do
  print $ maximum products
  print $ maximum products == 70600674

  where
    seqs = concatMap ($ grid) [rows, cols, diags]
    products = fmap product . fmap (take 4) . tails $ concat seqs

    grid :: Grid
    grid = Grid
      [ [8, 2, 22, 97, 38, 15, 0, 40, 0, 75, 4, 5, 7, 78, 52, 12, 50, 77, 91, 8],
        [49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 4, 56, 62, 0],
        [81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 3, 49, 13, 36, 65],
        [52, 70, 95, 23, 4, 60, 11, 42, 69, 24, 68, 56, 1, 32, 56, 71, 37, 2, 36, 91],
        [22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
        [24, 47, 32, 60, 99, 3, 45, 2, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
        [32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
        [67, 26, 20, 68, 2, 62, 12, 20, 95, 63, 94, 39, 63, 8, 40, 91, 66, 49, 94, 21],
        [24, 55, 58, 5, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
        [21, 36, 23, 9, 75, 0, 76, 44, 20, 45, 35, 14, 0, 61, 33, 97, 34, 31, 33, 95],
        [78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 3, 80, 4, 62, 16, 14, 9, 53, 56, 92],
        [16, 39, 5, 42, 96, 35, 31, 47, 55, 58, 88, 24, 0, 17, 54, 24, 36, 29, 85, 57],
        [86, 56, 0, 48, 35, 71, 89, 7, 5, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
        [19, 80, 81, 68, 5, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 4, 89, 55, 40],
        [4, 52, 8, 83, 97, 35, 99, 16, 7, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
        [88, 36, 68, 87, 57, 62, 20, 72, 3, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
        [4, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 8, 46, 29, 32, 40, 62, 76, 36],
        [20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 4, 36, 16],
        [20, 73, 35, 29, 78, 31, 90, 1, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 5, 54],
        [1, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 1, 89, 19, 67, 48]
      ]

Closing

I had many suggestions, because your code had many rooms for improvement. This is not to say it was bad. It was not! I was impressed. But Haskell is an extremely featureful language, and there's almost always something more to be learned.

Cheers!