Euler problems/81 to 90

import Data.List (unfoldr)
 
columns s = unfoldr f s
    where
        f [] = Nothing
        f xs = Just $ (\(a,b) -> (read a, drop 1 b)) $ break (==',') xs
 
firstLine ls = scanl1 (+) ls
 
nextLine pl [] = pl
nextLine pl (n:nl) = nextLine p' nl
    where
        p' = nextCell (head pl) pl n
        nextCell _ [] [] = []
        nextCell pc (p:pl) (n:nl) = pc' : nextCell pc' pl nl
            where pc' = n + min p pc
 
minSum (p:nl) = last $ nextLine p' nl
    where
        p' = firstLine p
 
problem_81 c = minSum $ map columns $ lines c

problem_82 = undefined

import Array (Array, listArray, bounds, inRange, assocs, (!))
import qualified Data.Map as M (fromList, Map, foldWithKey, lookup, null, delete, insert, empty, update)
import Data.List (unfoldr)
import Control.Monad.State (State, execState, get, put)
import Data.Maybe (fromJust, fromMaybe)
 
type Weight  = Integer
 
data Distance = D Weight | Infinity
    deriving (Show)
 
instance Eq Distance where
    (==) Infinity Infinity = True
    (==) (D a) (D b) = a == b
    (==) _ _ = False
 
instance Ord Distance where
    compare Infinity Infinity = EQ
    compare Infinity (D _) = GT
    compare (D _) Infinity = LT
    compare (D a) (D b) = compare a b
 
data (Eq n, Num w) => Arc n w = A {node :: n, weight :: w}
    deriving (Show)
 
type Index   = (Int, Int)
type NodeMap = M.Map Index Distance
type Matrix  = Array Index Weight
type Path    = Arc Index Weight
type PathMap  = M.Map Index [Path]
 
data Queues = Q {input :: NodeMap, output :: NodeMap, pathMap :: PathMap}
    deriving (Show)
 
listToMatrix :: [[Weight]] -> Matrix
listToMatrix xs = listArray ((1,1),(cols,rows)) $ concat $ xs
    where
        cols = length $ head xs
        rows = length xs
 
directions :: [Index]
directions = [(0,-1), (0,1), (-1,0), (1,0)]
 
add :: (Num a) => (a, a) -> (a, a) -> (a, a)
add (a,b) (a', b') = (a+a',b+b')
 
arcs :: Matrix -> Index -> [Path]
arcs a idx = do
    d <- directions
    let n = add idx d
    if (inRange (bounds a) n) then
        return $ A n (a ! n)
        else
            fail "out of bounds"
 
paths :: Matrix -> PathMap
paths a = M.fromList $ map (\(idx,_) -> (idx, arcs a idx)) $ assocs a
 
nodes :: Matrix -> NodeMap
nodes a = M.fromList $ (\((i,_):xs) -> (i, D (a ! (1,1))):xs) $ map (\(idx,_) -> (idx, Infinity)) $ assocs a
 
extractMin :: NodeMap -> (NodeMap, (Index, Distance))
extractMin m = (M.delete (fst minNode) m, minNode)
    where
        minNode = M.foldWithKey mini ((0,0), Infinity) m
        mini i' v' (i,v)
            | v' < v    = (i', v')
            | otherwise = (i,v)
 
dijkstra :: State Queues ()
dijkstra = do
    Q i o am <- get
    let (i', n) = extractMin i
    let o' = M.insert (fst n) (snd n) o
    let i'' = updateNodes n am i'
    put $ Q i'' o' am
    if M.null i'' then return () else dijkstra
 
updateNodes :: (Index, Distance) -> PathMap -> NodeMap -> NodeMap
updateNodes (i, D d) am nm = foldr f nm ds
    where
        ds = fromJust $ M.lookup i am
        f :: Path -> NodeMap -> NodeMap
        f (A i' w) m = fromMaybe m val
            where
                val = do
                    v <- M.lookup i' m
                    if (D $ d+w) < v then
                        return $ M.update (const $ Just $ D (d+w)) i' m
                        else return m
 
shortestPaths :: Matrix -> NodeMap
shortestPaths xs = output $ dijkstra `execState` (Q n M.empty a)
    where
        n = nodes xs
        a = paths xs
 
problem_83 :: [[Weight]] -> Weight
problem_83 xs = jd $ M.lookup idx $ shortestPaths matrix
    where
        matrix = listToMatrix xs
        idx = snd $ bounds matrix
        jd (Just (D d)) = d

problem_84 = undefined

problem_85 = undefined

problem_86 = undefined

import List
 
problem_87 = length expressible
    where limit = 50000000
          squares = takeWhile (<limit) (map (^2) primes)
          cubes   = takeWhile (<limit) (map (^3) primes)
          fourths = takeWhile (<limit) (map (^4) primes)
          choices = [[s,c,f] | s <- squares, c <- cubes, f <- fourths]
          unique  = map head . group . sort
          expressible = filter (<limit) . unique . map sum $ choices

problem_88 = undefined

problem_89 = undefined

problem_90 = undefined