project-euler/problem11.hs at master · kcharter/project-euler · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
module Main where

{-

Problem 11:

In the 20×20 grid below, four numbers along a diagonal line have been
marked in red. (With stars here)

08 02 22 97 38 15 00 40  00  75  04  05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57  60  87  17  40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29  93  71  40  67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42  69  24  68  56 01 32 56 71 37 02 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 03 45 02  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 02 62 12 20  95 *63  94  39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26  97  17 *78  78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44  20  45  35 *14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67  15  94  03  80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47  55  58  88  24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07  05  44  44  37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69  28  73  92  13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16  07  97  57  32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72  03  46  33  67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11  24  94  72  18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88  34  62  99  69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01  74  31  49  71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69  16  92  33  48 61 43 52 01 89 19 67 48

The product of these numbers is 26 × 63 × 78 × 14 = 1788696.

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

-}

{-
Solution:

We can exploit the solution for Problem 8, which can be generalized as
computing the largest product of 'k' consecutive numbers in a list of
'n' numbers. The trick here is that we will be interested in several
different lists of numbers:

- the rows of the grid

- the columns if the grid

- the diagonals of slope 1

- the diagonals of slope -1

-}

import Data.Maybe (catMaybes)
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U

import MPC

rowLists :: [[Int]]
rowLists =
 [[08,02,22,97,38,15,00,40,00,75,04,05,07,78,52,12,50,77,91,08],
  [49,49,99,40,17,81,18,57,60,87,17,40,98,43,69,48,04,56,62,00],
  [81,49,31,73,55,79,14,29,93,71,40,67,53,88,30,03,49,13,36,65],
  [52,70,95,23,04,60,11,42,69,24,68,56,01,32,56,71,37,02,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,03,45,02,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,02,62,12,20,95,63,94,39,63,08,40,91,66,49,94,21],
  [24,55,58,05,66,73,99,26,97,17,78,78,96,83,14,88,34,89,63,72],
  [21,36,23,09,75,00,76,44,20,45,35,14,00,61,33,97,34,31,33,95],
  [78,17,53,28,22,75,31,67,15,94,03,80,04,62,16,14,09,53,56,92],
  [16,39,05,42,96,35,31,47,55,58,88,24,00,17,54,24,36,29,85,57],
  [86,56,00,48,35,71,89,07,05,44,44,37,44,60,21,58,51,54,17,58],
  [19,80,81,68,05,94,47,69,28,73,92,13,86,52,17,77,04,89,55,40],
  [04,52,08,83,97,35,99,16,07,97,57,32,16,26,26,79,33,27,98,66],
  [88,36,68,87,57,62,20,72,03,46,33,67,46,55,12,32,63,93,53,69],
  [04,42,16,73,38,25,39,11,24,94,72,18,08,46,29,32,40,62,76,36],
  [20,69,36,41,72,30,23,88,34,62,99,69,82,67,59,85,74,04,36,16],
  [20,73,35,29,78,31,90,01,74,31,49,71,48,86,81,16,23,57,05,54],
  [01,70,54,71,83,51,54,69,16,92,33,48,61,43,52,01,89,19,67,48]]

type Grid = V.Vector (U.Vector Int)

grid :: Grid
grid = V.fromList $ map U.fromList rowLists

newtype Coords = Coords (Int, Int) deriving (Eq, Ord, Show)

inGrid :: Int -> Coords -> Bool
inGrid n (Coords (x,y)) = inRange x && inRange y
  where inRange m = 1 <= m && m <= n

path :: Int -> Coords -> (Coords -> Coords) -> [Coords]
path n start next = takeWhile (inGrid n) $ iterate next start

goRight :: Coords -> Coords
goRight (Coords (x,y)) = Coords (x+1,y)

goDown :: Coords -> Coords
goDown (Coords (x,y)) = Coords (x,y+1)

goUp :: Coords -> Coords
goUp (Coords (x,y)) = Coords (x,y-1)

goRightAndDown :: Coords -> Coords
goRightAndDown = goDown . goRight

goRightAndUp :: Coords -> Coords
goRightAndUp = goUp . goRight

upperLeftCorner :: Coords
upperLeftCorner = Coords (1,1)

lowerLeftCorner :: Int -> Coords
lowerLeftCorner n = Coords (1,n)

tops :: Int -> [Coords]
tops n = path n upperLeftCorner goRight

lefts :: Int -> [Coords]
lefts n = path n upperLeftCorner goDown

bottoms :: Int -> [Coords]
bottoms n = path n (lowerLeftCorner n) goRight

leftsAndTops :: Int -> [Coords]
leftsAndTops n = if n > 0 then lefts n ++ tail (tops n) else []

leftsAndBottoms :: Int -> [Coords]
leftsAndBottoms n = if n > 0 then lefts n ++ tail (bottoms n) else []

rows :: Int -> [[Coords]]
rows n = map (\i -> path n i goRight) (lefts n)

columns :: Int -> [[Coords]]
columns n = map (\i -> path n i goDown) (tops n)

upDiagonals :: Int -> [[Coords]]
upDiagonals n = map (\i -> path n i goRightAndUp) (leftsAndBottoms n)

downDiagonals :: Int -> [[Coords]]
downDiagonals n = map (\i -> path n i goRightAndDown) (leftsAndTops n)

element :: Grid -> Coords -> Int
element grid (Coords (x,y)) = (grid V.! (y-1)) U.! (x-1)

mpcOnPath :: Int -> Grid -> [Coords] -> Maybe Int
mpcOnPath k grid = mpc k . map (element grid)

mpcInGrid :: Int -> Grid -> Maybe Int
mpcInGrid k grid =
  case onPaths of
    [] -> Nothing
    _ -> Just (maximum onPaths)
    where onPaths = catMaybes $ map (mpcOnPath k grid) allPaths
          allPaths = rows n ++ columns n ++ upDiagonals n ++ downDiagonals n
          -- TODO: we assume the grid is square. This really need not
          -- be the case for this algorithm to work, and we could have
          -- a better Grid type that ensures that the width and height
          -- are observed. However, I can address that if I ever need
          -- to split this code out into its own module.
          n = V.length grid

main :: IO ()
main = print $ mpcInGrid 4 grid