ceth
ceth

Reputation: 45335

Project Euler 15 - last attempt

During last three days I have been trying to solve Project Euler 15 in Haskell.

Here is my current state:

import Data.Map as Map

data Coord = Coord Int Int deriving (Show, Ord, Eq)

corner :: Coord -> Bool 
corner (Coord x y) = (x == 0) && (y == 0)

side :: Coord -> Bool
side (Coord x y) = (x == 0) || (y == 0)

move_right :: Coord -> Coord
move_right (Coord x y) = Coord (x - 1) y

move_down :: Coord -> Coord
move_down (Coord x y) = Coord x (y - 1)

calculation :: Coord -> Integer
calculation coord 
           | corner coord = 0
           | side coord = 1 
           | otherwise = (calculation (move_right coord)) + (calculation (move_down coord)) 

problem_15 :: Int -> Integer
problem_15 size =
           calculation (Coord size size)

It works fine but it is very slow if the 'n' is getting bigger.

As I know I can use the dynamic programming and the hashtable (Data.Map, for example) to cache calculated values.

I was trying to use memoization, but don't have a success. I was trying to use Data.Map, but each next error was more scary then previous. So I ask your help: how to cache values which was already calculated ?

I know about mathematical solution of this problem (Pascal triangle), but I am interested in the algorithmic solution.

Upvotes: 3

Views: 418

Answers (2)

Daniel Fischer
Daniel Fischer

Reputation: 183988

Since you already know the correct (efficient) solution, I'm not spoiling anything for you:

You can use an array (very appropriate here, since the domain is a rectangle)

import Data.Array

pathCounts :: Int -> Int -> Array (Int,Int) Integer
pathCounts height width = solution
  where
    solution =
        array ((0,0),(height-1,width-1)) [((i,j), count i j) | i <- [0 .. height-1]
                                                             , j <- [0 .. width-1]]
    count 0 j = 1  -- at the top, we can only come from the left
    count i 0 = 1  -- on the left edge, we can only come from above
    count i j = solution ! (i-1,j) + solution ! (i,j-1)

Or you can use the State monad (the previously calculated values are the state, stored in a Map):

import qualified Data.Map as Map
import Control.Monad.State.Strict

type Path = State (Map Coord Integer)

calculation :: Coord -> Path Integer
calculation coord = do
    mb_count <- gets (Map.lookup coord)
    case mb_count of
      Just count -> return count
      Nothing
          | corner coord -> modify (Map.insert coord 0) >> return 0 -- should be 1, IMO
          | side coord -> modify (Map.insert coord 1) >> return 1
          | otherwise -> do
              above <- calculation (move_down coord)
              left <- calculation (move_right coord)
              let count = above + left
              modify (Map.insert coord count)
              return count

and run that with

evalState (calculation target) Map.empty

Or you can use one of the memoisation packages on hackage, off the top of my head I remember data-memocombinators, but there are more, possibly some even better. (And there are still more possible ways of course.)

Upvotes: 6

shang
shang

Reputation: 24832

Instead of a Map, this problem is better suited for an two-dimensional array cache, since we have a bounded range for input values.

import Control.Applicative
import Data.Array

data Coord = Coord Int Int deriving (Show, Ord, Eq, Ix)

calculation :: Coord -> Integer
calculation coord@(Coord maxX maxY) = cache ! coord where
    cache = listArray bounds $ map calculate coords
    calculate coord
        | corner coord = 0
        | side coord   = 1
        | otherwise    = cache ! move_right coord + cache ! move_down coord

    zero  = Coord 0 0
    bounds = (zero, coord)
    coords = Coord <$> [0..maxX] <*> [0..maxY]

We add deriving Ix to Coord so we can use it directly as an array index and in calculation, we initialize a two-dimensional array cache with the lower bound of Coord 0 0 and upper bound of coord. Then instead of recursively calling calculation we just refer to the values in the cache.

Now we can calculate even large values relatively quickly.

*Main> problem_15 1000 2048151626989489714335162502980825044396424887981397033820382637671748186202083755828932994182610206201464766319998023692415481798004524792018047549769261578563012896634320647148511523952516512277685886115395462561479073786684641544445336176137700738556738145896300713065104559595144798887462063687185145518285511731662762536637730846829322553890497438594814317550307837964443708100851637248274627914170166198837648408435414308177859470377465651884755146807496946749238030331018187232980096685674585602525499101181135253534658887941966653674904511306110096311906270342502293155911108976733963991149120

Upvotes: 8

Related Questions