I just completed Project Euler Problem 81 in Haskell. I'm looking for feedback on a few specific aspects, but I appreciate general feedback and style suggestions as well. The raw file is available here. The program input is available here; the program needs to be run in the same folder as the input file.

I just completed Project Euler Problem 81 in Haskell:

In the 5 by 5 matrix below,

131   673 234 103 18
201   96  342 965 150
630   803 746 422 111
537   699 497 121 956
805   732 524 37  331

the minimal path sum from the top left to the bottom right, by only moving to the right and down, is

131 → 201 → 96 → 342 → 746 → 422 → 121 → 37 → 331

and is equal to 2427.

Find the minimal path sum, in matrix.txt, a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right by only moving right and down.

I'm looking for feedback on a few specific aspects, but I appreciate general feedback and style suggestions as well. The raw code is available here. The program input is available here; the program needs to be run in the same folder as the input file.

I just completed Project Euler Problem 81 in Haskell. I'm looking for feedback on a few specific aspects, but I appreciate general feedback and style suggestions as well.

I try to solve Project Euler problems without external dependencies, and I'm interested in learning how to do things in the general case, not just to solve this particular problem.

I just completed Project Euler Problem 81 in Haskell. I'm looking for feedback on a few specific aspects, but I appreciate general feedback and style suggestions as well. The raw file is available here. The program input is available here; the program needs to be run in the same folder as the input file.

Note that I try to solve Project Euler problems without external dependencies, and I'm interested in learning how to do things in the general case, not just to solve this particular problem. I want to hardcode as little as possible.

{-|
file:   p081.hs
title:  Path sum: two ways
author: Alexander Gosselin
email:  <[email protected]>
date:   December 09, 2018

link:   <https://projecteuler.net/problem=81>
-}

{-# LANGUAGE OverloadedStrings #-}

import           Control.Arrow     (first, (&&&), (***))
import           Control.Monad     (join, liftM, mapM)
import           Control.Monad.Zip (mzip)
import           Data.Array        (Array, Ix, array, bounds, (!))
import           Data.Function     (on)
import           Data.Ix           (inRange)
import           Data.List         (groupBy)
import           Data.Maybe        (fromJust)
import           Data.Text         (Text)
import qualified Data.Text         as Text (lines, null, splitOn)
import qualified Data.Text.IO      as TextIO (readFile)
import           Data.Text.Read    (decimal)

type Matrix a = Array (Int, Int) a

-- the shape of a matrix stored in a space-separated text file
textMatrixShape :: Text -> (Int, Int)
textMatrixShape = (length &&& length . Text.splitOn "," . head) . Text.lines

-- map over a monomorphic 2-tuple
mapTuple :: (a -> b) -> (a, a) -> (b, b)
mapTuple = join (***)

textMatrixBounds :: Text -> ((Int, Int), (Int, Int))
textMatrixBounds = (,) (0,0) . mapTuple (subtract 1) . textMatrixShape

-- from <https://hackage.haskell.org/package/either-5.0.1>
rightToMaybe :: Either a b -> Maybe b
rightToMaybe = either (const Nothing) Just

textMatrixElements :: Text -> Maybe [Int]
textMatrixElements = rightToMaybe
                   . fmap (map fst)
                   . mapM decimal
                   . concatMap (Text.splitOn ",")
                   . Text.lines

grid :: (Int, Int) -> [(Int, Int)]
grid (m, n) = [(i, j) | i <- [0..m - 1], j <- [0..n - 1]]

-- textMatrixAssocs :: Text -> Maybe [((Int, Int), Int)]
-- textMatrixAssocs t = liftM (zip ((grid . textMatrixShape) t)) (textMatrixElements t)

textMatrixAssocs :: Text -> Maybe [((Int, Int), Int)]
textMatrixAssocs = uncurry fmap . first zip
                 . (grid . textMatrixShape &&& textMatrixElements)

-- textMatrix :: Text -> Maybe (Matrix Int)
-- textMatrix t = liftM (array (textMatrixBounds t)) (textMatrixAssocs t)

textMatrix :: Text -> Maybe (Matrix Int)
textMatrix = uncurry fmap . first array . (textMatrixBounds &&& textMatrixAssocs)

rightAndDown :: Num a => Matrix a -> ((Int, Int), a) -> [((Int, Int), a)]
rightAndDown m (i, s) = [(i', s + m ! i')
                        | i' <- [fmap (+ 1) i, first (+ 1) i]
                        , inRange (bounds m) i']

-- | Blackbird combinator
(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(...) = (.) . (.)
infix 8 ...

updateFrontier :: (Num a, Ord a) => Matrix a -> [((Int, Int), a)] -> [((Int, Int), a)]
updateFrontier = map minimum . groupBy ((==) `on` fst) ... concatMap . rightAndDown

minimalPathSum :: (Num a, Ord a) => Matrix a -> a
minimalPathSum m = go [((0, 0), m ! (0, 0))]
  where
    go f = case f' of
      [] -> (minimum . map snd) f
      _  -> go f'
      where
        f' = updateFrontier m f

p081 :: IO Int
p081 = do
  t <- TextIO.readFile "p081_matrix.txt"
  return (minimalPathSum . fromJust . textMatrix $ t)

main :: IO ()
main = do
  print =<< p081

{-|
file:   p081.hs
title:  Path sum: two ways
date:   December 9, 2018

link:   <https://projecteuler.net/problem=81>
-}

{-# LANGUAGE OverloadedStrings #-}

import           Control.Arrow     (first, (&&&), (***))
import           Control.Monad     (join, liftM, mapM)
import           Data.Array        (Array, Ix, array, bounds, (!))
import           Data.Function     (on)
import           Data.Ix           (inRange)
import           Data.List         (groupBy)
import           Data.Maybe        (fromJust)
import           Data.Text         (Text)
import qualified Data.Text         as Text (lines, null, splitOn)
import qualified Data.Text.IO      as TextIO (readFile)
import           Data.Text.Read    (decimal)

type Matrix a = Array (Int, Int) a

-- the shape of a matrix stored in a space-separated text file
textMatrixShape :: Text -> (Int, Int)
textMatrixShape = (length &&& length . Text.splitOn "," . head) . Text.lines

-- map over a monomorphic 2-tuple
mapTuple :: (a -> b) -> (a, a) -> (b, b)
mapTuple = join (***)

textMatrixBounds :: Text -> ((Int, Int), (Int, Int))
textMatrixBounds = (,) (0,0) . mapTuple (subtract 1) . textMatrixShape

-- from <https://hackage.haskell.org/package/either-5.0.1>
rightToMaybe :: Either a b -> Maybe b
rightToMaybe = either (const Nothing) Just

textMatrixElements :: Text -> Maybe [Int]
textMatrixElements = rightToMaybe
                   . fmap (map fst)
                   . mapM decimal
                   . concatMap (Text.splitOn ",")
                   . Text.lines

grid :: (Int, Int) -> [(Int, Int)]
grid (m, n) = [(i, j) | i <- [0..m - 1], j <- [0..n - 1]]

-- textMatrixAssocs :: Text -> Maybe [((Int, Int), Int)]
-- textMatrixAssocs t = liftM (zip ((grid . textMatrixShape) t)) (textMatrixElements t)

textMatrixAssocs :: Text -> Maybe [((Int, Int), Int)]
textMatrixAssocs = uncurry fmap . first zip
                 . (grid . textMatrixShape &&& textMatrixElements)

-- textMatrix :: Text -> Maybe (Matrix Int)
-- textMatrix t = liftM (array (textMatrixBounds t)) (textMatrixAssocs t)

textMatrix :: Text -> Maybe (Matrix Int)
textMatrix = uncurry fmap . first array . (textMatrixBounds &&& textMatrixAssocs)

rightAndDown :: Num a => Matrix a -> ((Int, Int), a) -> [((Int, Int), a)]
rightAndDown m (i, s) = [(i', s + m ! i')
                        | i' <- [fmap (+ 1) i, first (+ 1) i]
                        , inRange (bounds m) i']

-- | Blackbird combinator
(...) :: (c -> d) -> (a -> b -> c) -> a -> b -> d
(...) = (.) . (.)
infix 8 ...

updateFrontier :: (Num a, Ord a) => Matrix a -> [((Int, Int), a)] -> [((Int, Int), a)]
updateFrontier = map minimum . groupBy ((==) `on` fst) ... concatMap . rightAndDown

minimalPathSum :: (Num a, Ord a) => Matrix a -> a
minimalPathSum m = go [((0, 0), m ! (0, 0))]
  where
    go f = case f' of
      [] -> (minimum . map snd) f
      _  -> go f'
      where
        f' = updateFrontier m f

p081 :: IO Int
p081 = do
  t <- TextIO.readFile "p081_matrix.txt"
  return (minimalPathSum . fromJust . textMatrix $ t)

main :: IO ()
main = do
  print =<< p081