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

• Naitik Mundra: Just wanted to mention, I'm using ormolu for formatting and hlint for linting.

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!

• Naitik Mundra: How exactly is Grid different from [[Int]]? I thought that they were essentially doing the same thing. Am I missing something?
• Quelklef: @NaitikMundra A grid of integers can be represented with an [[Int]]. But it can also be represented as an (Int, [Int]), where the Int is the grid width and the [Int] is the rows, concatenated. It could also be represented as an (Int, Int, Map (Int, Int) Int) where the first two numbers are the dimensions and the Map is a mapping from coordinates to non-zero values. Point being, "grid" is a concept distinct from [[Int]].
• Naitik Mundra: I see. Thank you so much for the explanation. I understand the code much better now!