2
\$\begingroup\$

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.

\$\endgroup\$
1
  • \$\begingroup\$ Just wanted to mention, I'm using ormolu for formatting and hlint for linting. \$\endgroup\$ Jul 16 at 15:48

1 Answer 1

3
\$\begingroup\$

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!

\$\endgroup\$
3
  • \$\begingroup\$ How exactly is Grid different from [[Int]]? I thought that they were essentially doing the same thing. Am I missing something? \$\endgroup\$ Jul 16 at 19:15
  • 1
    \$\begingroup\$ @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]]. \$\endgroup\$
    – Quelklef
    Jul 16 at 19:39
  • 1
    \$\begingroup\$ I see. Thank you so much for the explanation. I understand the code much better now! \$\endgroup\$ Jul 16 at 19:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.