3

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.

Community
  • 1
  • 1
ceth
  • 44,198
  • 62
  • 180
  • 289

2 Answers2

8

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

shang
  • 24,642
  • 3
  • 58
  • 86
  • 1
    Thanks. What does it mean this syntax: coord@(Coord maxX maxY) – ceth Feb 24 '12 at 12:11
  • 1
    @demas It's an 'as-pattern', binding the entire value to `coord` and the parts (coordinates here) to the appropriate parts of the pattern in parentheses. – Daniel Fischer Feb 24 '12 at 12:14
  • @shang: Won't the desired result be in `cache ! zero`? Isn't `cache ! coord` always `0`? – gspr Feb 24 '12 at 15:41
  • 1
    @gspr: Nope, it's the other way around. `cache ! zero == calculate (Coord 0 0) == 0`. – shang Feb 24 '12 at 15:50
  • @shang: Oh right, my bad! I had my (mental) indexing opposite to yours. – gspr Feb 24 '12 at 15:53
  • try 100,000 and you will probably hit the recursion depth limit (as stack overflow exception or something). – Will Ness Feb 25 '12 at 05:09
6

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.)

dave4420
  • 46,404
  • 6
  • 118
  • 152
Daniel Fischer
  • 181,706
  • 17
  • 308
  • 431
  • such array solutions suffer from deep recursion causing a stack overflow for very big argument numbers (doesn't apply for the original `20` of course). I tried once a sequence of `seq`s [threaded through the indices](http://rosettacode.org/wiki/Hofstadter_Q_sequence#Haskell) at some implementation-dependent step size. Is there other way perhaps? – Will Ness Feb 25 '12 at 05:18