I have the following problem:
I want to calculate the sum of the first n numbers and keep the count of each added number on every iteration. Therefore i defined a type:
data Avg = Avg { sum :: Int, count :: Int }
I need to use a seed of type Avg in a foldl' but i need it decomposed inside the aggregator function:
bang :: [Int] -> IO ()
bang ls#(x:xs) = printAvg $ foldl ' (\x y -> (x sum+y count+1) ) (Avg 0 0) ls
printAvg :: Avg -> IO ()
printAvg av = putStrLn . show (fromIntegral $ sum av / fromIntegral $ count av)
So my question is:
Given a type data T = T { a :: Int, b :: Int } and given a variable myvar of type T, how can I place it for pattern matching instead of its data constructor?
In my example the foldl' takes an Avg which is the seed and one element from the list.
I need (\x y-> (x sum+y count+1)) instead of (\x y-> (Avg sum+y count+1)).
A few possible solutions:
(\ (Avg s c) y -> Avg (s + y) (c + 1))
-- equivalent to the longer
(\ x y -> case x of Avg s c -> Avg (s + y) (c + 1))
-- mentioning the fields name explicitly
(\ Avg{sum=s, count=c} y -> Avg (s + y) (c + 1))
-- using the RecordWildCards extension
(\ Avg{..} y -> Avg (sum + y) (count + 1))
-- using the two projections
(\ x y -> Avg (sum x + y) (count x + 1))
or even, adapting your code
bang::[Int]->IO()
bang ls#(x:xs) = printAvg $ foldl' foo (Avg 0 0) ls
where
foo (Avg s c) y = Avg (s + y) (c+ 1)
(using let foo .. in .. is also possible)
Since data Avg = Avg { sum :: Int, count :: Int } is isomorphic to (Int, Int), you could also fold with a tuple:
average :: Fractional r => [Int] -> r
average = uncurry (/) . foldr (\x (sum, count) -> (sum+x, count+1)) (0,0)
bang :: [Int] -> IO ()
bang = putStrLn . show . average
And if you want to keep the average running, you could use a newtype wrapper:
newtype Count = Count (Int, Int)
accumulate :: [Int] -> Count
accumulate = foldr accum (Count (0, 0))
where
accum :: Int -> Count -> Count
accum x (Count (sum, count)) = Count (sum+x, count+1)
average :: Fractional r => Count -> r
average (Count (x, y)) = x / y
bang :: [Int] -> IO ()
bang = putStrLn . show . average . accumulate
You might risk overflows in both cases.
Consider finding a moving average (Haskell).
Related
I am new to Haskell and I am struggling to get this concept to work.
I have to use a list of integers as a parameter and count the number of perfect squares (1,4,9,etc) in the list and output that value. So for example, if I entered myfunction[1,5,9] the output would be 2.
So far I have only got one function to work:
myfunction list = map per list
where per y = floor(sqrt (y) * sqrt (y))
Takes the square root of the element multiplied by the square root of the element. My mindset with the above is that I could set the above result equal to the original element. And if they are equal to each other, that would mean they are perfect squares. And then I would increment a value.
My issue is that my book doesn't give me any ideas for how to increment a variable or how to incorporate more than 1 function at a time. And as a result, I've been aimlessly working on this over the course of 3 days.
Thank you in advance for any help, advice, or resources!
fixing your version
first completed your version could look like this:
myfunction list = length $ filter per list
where
per y = floor(sqrt y * sqrt y) == y
this would even type-check but it would not work (try it)
that's because there is a small little problem - let's make it obvious by giving some types:
myfunction :: [Int] -> Int
myfunction list = length $ filter per list
where
per :: Int -> Bool
per y = floor(sqrt y * sqrt y) == y
you get an error:
No instance for (Floating Int) arising from a use of ‘sqrt’
it is trying to say to you that it does not know how to use sqrt for an Int - an easy fix is using fromIntegral and let it convert the Int into something that can:
myfunction :: [Int] -> Int
myfunction list = length $ filter per list
where
per :: Int -> Bool
per y = floor(sqrt (fromIntegral y) * sqrt (fromIntegral y)) == y
this kind of works (wrong answer) but gives an warning - we could get rid of with
myfunction :: [Int] -> Int
myfunction list = length $ filter per list
where
per :: Int -> Bool
per y = floor(sqrt (fromIntegral y :: Double) * sqrt (fromIntegral y)) == y
were we tell Haskell what type to use for the conversion (the warning would tell you that you default to this anyway).
So there is the wrong answer still.
#jpmarinier already told why - the way you test/sqr is sadly not cutting it (at least as I thought you wanted) - here is a fix:
myfunction :: [Int] -> Int
myfunction list = length $ filter per list
where
per :: Int -> Bool
per y = let y' = (fromIntegral y :: Double) in sqrt y' ** 2 == y'
where we first convert y to a Double value y' and test this.
Another option is using a integer-sqr as #jpmarinier mentioned:
myfunction :: [Int] -> Int
myfunction list = length $ filter per list
where
per :: Int -> Bool
per y = squareRoot y * squareRoot y == y
squareRoot :: Int -> Int
squareRoot = floor . sqrt . (fromIntegral :: Int -> Double)
that should finally work.
without floor and sqr:
ok this is maybe a bit to grok for you but here is how you can do this by sieving out the values.
Let's start by creating a (ascending) list of all perfect squares - I don't know which type you want those numbers to be so let's stay generic as well:
-- need later
import Data.List (sort)
perfectSquares :: Enum a => Num a => [a]
perfectSquares = [ n*n | n <- [1..] ]
no let's make a function counting elements from two lists - if the lists are sorted this can be done recursively by walking alongside the lists - I don't know if your input lists are always sorted so let's sort it before:
countOccurances :: (Enum a, Num a, Ord a) => [a] -> [a] -> a
countOccurances from list =
countAlong from $ sort list
where
countAlong [] _ = 0
countAlong _ [] = 0
countAlong allXs#(x:xs) allYs#(y:ys)
| x < y = countAlong xs allYs
| x > y = countAlong allXs ys
| otherwise = 1 + countAlong allXs ys
having both we can combine them for the answer:
import Data.List (sort)
countPerfectSquares :: (Enum a, Num a, Ord a) => [a] -> a
countPerfectSquares = countOccurances perfectSquares
countOccurances :: (Enum a, Num a, Ord a) => [a] -> [a] -> a
countOccurances from list =
countAlong from $ sort list
where
countAlong [] _ = 0
countAlong _ [] = 0
countAlong allXs#(x:xs) allYs#(y:ys)
| x < y = countAlong xs allYs
| x > y = countAlong allXs ys
| otherwise = 1 + countAlong allXs ys
perfectSquares :: Enum a => Num a => [a]
perfectSquares = [ n*n | n <- [1..] ]
Example:
> countPerfectSquares [1,5,9] :: Int
2
I'm calculating the sum of a list after applying someFunction to every element of it like so:
sum (map someFunction myList)
someFunction is very resource heavy so to optimise it I want to stop calculating the sum if it goes above a certain threshold.
It seems like I need to use fold but I don't know how to break out if it if the accumulator reaches the threshold. My guess is to somehow compose fold and takeWhile but I'm not exactly sure how.
Another technique is to use a foldM with Either to capture the early termination effect. Left signals early termination.
import Control.Monad(foldM)
sumSome :: (Num n,Ord n) => n -> [n] -> Either n n
sumSome thresh = foldM f 0
where
f a n
| a >= thresh = Left a
| otherwise = Right (a+n)
To ignore the exit status, just compose with either id id.
sumSome' :: (Num n,Ord n) => n -> [n] -> n
sumSome' n = either id id . sumSome n
One of the options would be using scanl function, which returns a list of intermediate calculations of foldl.
Thus, scanl1 (+) (map someFunction myList) will return the intermediate sums of your calculations. And since Haskell is a lazy language it won't calculate all the values of myList until you need it. For example:
take 5 $ scanl1 (+) (map someFunction myList)
will calculate someFunction 5 times and return the list of these 5 results.
After that you can use either takeWhile or dropWhile and stop the calculation, when a certain condition is True. For example:
head $ dropWhile (< 1000) $ scanl1 (+) [1..1000000000]
will stop the calculation, when sum of the numbers reaches 1000 and returns 1035.
This will do what you ask about without building the intermediate list as scanl' would (and scanl would even cause a thunks build-up on top of that):
foldl'Breaking break reduced reducer acc list =
foldr cons (\acc -> acc) list acc
where
cons x r acc | break acc x = reduced acc x
| otherwise = r $! reducer acc x
cf. related wiki page.
Use a bounded addition operator instead of (+) with foldl.
foldl (\b a -> b + if b > someThreshold then 0 else a) 0 (map someFunction myList)
Because Haskell is non-strict, only calls to someFunction that are necessary to evaluate the if-then-else are themselves evaluated. fold still traverses the entire list.
> foldl (\b a -> b + if b > 10 then 0 else a) 0 (map (trace "foo") [1..20])
foo
foo
foo
foo
foo
15
sum [1..5] > 10, and you can see that trace "foo" only executes 5 times, not 20.
Instead of foldl, though, you should use the strict version foldl' from Data.Foldable.
You could try making your own sum function, maybe call it boundedSum that takes
an Integer upper bound
an [Integer] to sum over
a "sum up until this point" value to be compared with the upper bound
and returns the sum of the list.
boundedSum :: Integer -> [Integer] -> Integer -> Integer
boundedSum upperBound (x : xs) prevSum =
let currentSum = prevSum + x
in
if currentSum > upperBound
then upperBound
else boundedSum upperBound xs currentSum
boundedSum upperBound [] prevSum =
prevSum
I think this way you won't "eat up" more of the list if the sum up until the current element exceeds upperBound.
EDIT: The answers to this question suggest better techniques than mine and the question itself looks rather similar to yours.
This is a possible solution:
last . takeWhile (<=100) . scanl (+) 0 . map (^2) $ [1..]
Dissected:
take your starting list ([1..] in the example)
map your expensive function ((^2))
compute partial sums scanl (+) 0
stop after the partial sums become too large (keep those (<=100))
take the last one
If performance matters, also try scanl', which might improve it.
Something like this using until :: (a -> Bool) -> (a -> a) -> a -> a from the Prelude
sumUntil :: Real a => a -> [a] -> a
sumUntil threshold u = result
where
(_, result) = until stopCondition next (u, 0)
next :: Real a => ([a], a) -> ([a], a)
next ((x:xs), y) = (xs, x + y)
stopCondition :: Real a => ([a], a) -> Bool
stopCondition (ls, x) = null ls || x > threshold
Then apply
sumUntil 10 (map someFunction myList)
This post is already a bit older but I'd like to mention a way to generalize the nice code of #trevor-cook above to break fold with the additional possibility to return not only a default value or the accumulator but also the index and element of the list where the breaking condition was satisfied:
import Control.Monad (foldM)
breakFold step initialValue list exitCondition exitFunction =
either id (exitFunction (length list) (last list))
(foldM f initialValue (zip [0..] list))
where f acc (index,x)
| exitCondition index x acc
= Left (exitFunction index x acc)
| otherwise = Right (step index x acc)
It also only requires to import foldM. Examples for the usage are:
mysum thresh list = breakFold (\i x acc -> x + acc) 0 list
(\i x acc -> x + acc > thresh)
(\i x acc -> acc)
myprod thresh list = breakFold (\i x acc -> x * acc) 1 list
(\i x acc -> acc == thresh)
(\i x acc -> (i,x,acc))
returning
*myFile> mysum 42 [1,1..]
42
*myFile> myprod 0 ([1..5]++[0,0..])
(6,0,0)
*myFile> myprod 0 (map (\n->1/n) [1..])
(178,5.58659217877095e-3,0.0)
In this way, one can use the index and the last evaluated list value as input for further functions.
Despite the age of this post, I'll add a possible solution. I like continuations because I find them very useful in terms of flow control.
breakableFoldl
:: (b -> a -> (b -> r) -> (b -> r) -> r)
-> b
-> [a]
-> (b -> r)
-> r
breakableFoldl f b (x : xs) = \ exit ->
f b x exit $ \ acc ->
breakableFoldl f acc xs exit
breakableFoldl _ b _ = ($ b)
breakableFoldr
:: (a -> b -> (b -> r) -> (b -> r) -> r)
-> b
-> [a]
-> (b -> r)
-> r
breakableFoldr f b l = \ exit ->
fix (\ fold acc xs next ->
case xs of
x : xs' -> fold acc xs' (\ acc' -> f x acc' exit next)
_ -> next acc) b l exit
exampleL = breakableFoldl (\ acc x exit next ->
( if acc > 15
then exit
else next . (x +)
) acc
) 0 [1..9] print
exampleR = breakableFoldr (\ x acc exit next ->
( if acc > 15
then exit
else next . (x +)
) acc
) 0 [1..9] print
I'm trying to debug an issue with an implementation of a threshold encryption scheme. I've posted this question on crypto to get some help with the actual scheme but was hoping to get a sanity check on the simplified code I am using.
Essentially the the crypto system uses Shamir's Secret Sharing to combine the shares of a key. The polynomial is each member of the list 'a' multiplied by a increasing power of the parameter of the polynomial. I've left out the mod by prime to simplify the code as the actual implementation uses PBC via a Haskell wrapper.
I have for the polynomial
poly :: [Integer] -> Integer -> Integer
poly as xi = (f 1 as)
where
f _ [] = 0
f 0 _ = 0
f s (a:as) = (a * s) + f (s * xi) as
The Lagrange interpolation is:
interp0 :: [(Integer, Integer)] -> Integer
interp0 xys = round (sum $ zipWith (*) ys $ fmap (f xs) xs)
where
xs = map (fromIntegral .fst) xys
ys = map (fromIntegral .snd) xys
f :: (Eq a, Fractional a) => [a] -> a -> a
f xs xj = product $ map (p xj) xs
p :: (Eq a, Fractional a) => a -> a -> a
p xj xm = if xj == xm then 1 else negate (xm / (xj - xm))
and the split and combination code is
execPoly as#(a0:_) = do
let xs = zipWith (,) [0..] (fmap (poly as) [0..100])
let t = length as + 1
let offset = 1
let shares = take t (drop offset xs)
let sm2 = interp0 shares
putText ("poly and interp over " <> show as <> " = " <> show sm2 <> ". Should be " <> show a0)
main :: IO ()
main = do
execPoly [10,20,30,40,50,60,70,80,90,100,110,120,130,140,150] --1
execPoly [10,20,30,40,50,60,70,80] -- 2
execPoly(1) fails to combine to 10 but execPoly(2) combines correctly. The magic threshold seems to be 8.
Is my code correct? I am missing something in the implementation that limits the threshold size to 8?
As MathematicalOrchid said it was a precision problem.
Updated the code to:
f :: (Eq a, Integral a) => [a] -> a -> Ratio a
f xs xj = product $ map (p xj) xs
p :: (Eq a, Integral a)=> a -> a -> Ratio a
p xj xm = if xj == xm then (1 % 1) else (negate xm) % (xj - xm)
And it works as expected.
module Main where
import System.Random
import Data.Foldable
import Control.Monad
import qualified Data.Map as M
import qualified Data.Vector as V
import Debug.Trace
import Data.Maybe
import Data.Ord
-- Represents the maximal integer. maxBound is no good because it overflows.
-- Ideally should be something like a billion.
maxi = 1000
candies :: V.Vector Int -> Int --M.Map (Int, Int) Int
candies ar = ff [l (V.length ar - 1) x | x <- [0..maxi]]
where
go :: Int -> Int -> Int
go _ 0 = maxi
go 0 j = j
go i j =
case compare (ar V.! (i-1)) (ar V.! i) of
LT -> ff [l (i-1) x + j | x <- [0..j-1]]
GT -> ff [l (i-1) x + j | x <- [j+1..maxi]]
EQ -> ff [l (i-1) x + j | x <- [0..maxi]]
l :: Int -> Int -> Int
l i j = fromMaybe maxi (M.lookup (i,j) cs)
ff l = --minimum l
case l of
l:ls -> if l < maxi then l else ff ls
[] -> maxi
-- I need to make this lazy somehow.
cs :: M.Map (Int, Int) Int
cs = M.fromList [((i,j), go i j) | i <- [0..V.length ar - 1], j <- [0..maxi]]
main :: IO ()
main = do
--ar <- fmap (V.fromList . map read . tail . words) getContents
g <- fmap (V.fromList . take 5 . randomRs (1,50)) getStdGen
print $ candies g
The above code is for the HackerRank Candies challenge. I think the code is correct in essence even though it gives me runtime errors on submission. HackerRank does not say what those errors are, but most likely it is because I ran out allotted memory.
To make the above work, I need to rewrite the above so the fromList gets lazily evaluated or something to that effect. I like the above form and rewriting the functions so they pass along the map as a parameter is something I would very much like to avoid.
I know Haskell has various memoization libraries on Hackage, but the online judge does not allow their use.
I might have coded myself into a hole due to Haskell's purity.
Edit:
I did some experimenting in order to figure out how those folds and lambda's work. I think this is definitely linked to continuation passing after all, as the continuations are being built up along the fold. To show what I mean, I'll demonstrate it with a simple program.
module Main where
trans :: [Int] -> [Int]
trans m =
foldr go (\_ -> []) m 0 where
go x f y = (x + y) : f x
main = do
s <- return $ trans [1,2,3]
print s
One thing that surprised me was that when I inserted a print, it got executed in a reverse manner, from left to right, which made me think at first that I misunderstood how foldr works. That turned out to not be the case.
What the above does is print out [1,3,5].
Here is the explanation how it executes. Trying to print out f x in the above will not be informative and will cause it to just all around the place.
It starts with something like this. The fold obviously executes 3 go functions.
go x f y = (x + y) : f x
go x f y = (x + y) : f x
go x f y = (x + y) : f x
The above is not quite true. One has to keep in mind that all fs are separate.
go x f'' y = (x + y) : f'' x
go x f' y = (x + y) : f' x
go x f y = (x + y) : f x
Also for clarity one it should also be instructive to separate out the lambdas.
go x f'' = \y -> (x + y) : f'' x
go x f' = \y -> (x + y) : f' x
go x f = \y -> (x + y) : f x
Now the fold starts from the top. The topmost statement gets evaluated as...
go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) 3
This reduces to:
go 3 (\_ -> []) = (\y -> (3 + y) : [])
The result is the unfinished lambda above. Now the fold evaluates the second statement.
go 2 (\y -> (3 + y) : []) = \y -> (2 + y) : (\y -> (3 + y) : []) 2
This reduces to:
go 2 (\y -> (3 + y) : []) = (\y -> (2 + y) : 5 : [])
The the fold goes to the last statement.
go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : (\y -> (2 + y) : 5 : []) 1
This reduces to:
go 1 (\y -> (2 + y) : 5 : []) = \y -> (1 + y) : 3 : 5 : []
The the 0 outside the fold gets applied and the final lambda gets reduced to
1 : 3 : 5 : []
This is just the start of it. The case gets more interesting when f x is replaced with f y.
Here is a similar program to the previous.
module Main where
trans :: [Int] -> [Int]
trans m =
foldr go (\_ -> []) m 1 where
go x f y = (x + y) : f (2*y+1)
main = do
s <- return $ trans [1,2,3]
print s
Let me once again go from top to bottom.
go x f'' = \y -> (x + y) : f'' (2*y+1)
go x f' = \y -> (x + y) : f' (2*y+1)
go x f = \y -> (x + y) : f (2*y+1)
The top statement.
go 3 (\_ -> []) = \y -> (3 + y) : (\_ -> []) (2*y+1)
The middle statement:
go 2 (\y -> (3 + y) : (\_ -> []) (2*y+1)) = \y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)
The last statement:
go 1 (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) = \y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1
Notice how the expressions build up because ys cannot be applied. Only after the 0 gets inserted can the whole expression be evaluated.
(\y -> (1 + y) : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 2*y+1) 1
2 : (\y -> (2 + y) : (\y -> (3 + y) : (\_ -> []) (2*y+1)) (2*y+1)) 3
2 : 5 : (\y -> (3 + y) : (\_ -> []) (2*y+1)) 7
2 : 5 : 10 : (\_ -> []) 15
2 : 5 : 10 : []
There is a buildup due to the order of evaluation.
Edit: So...
go (candy, score) f c s = (candy', score): f candy' score
where candy' = max candy $ if s < score then c + 1 else 1
The above in fact does 3 passes across the list in each iteration.
First foldr has to travel to back of the list before it can begin. Then as candi' depends on s and c variables which cannot be applied immediately this necessitates building up the continuations as in that last example.
Then when the two 0 0 are fed into at the end of the fold, the whole thing only then gets evaluated.
It is a bit hard to reason about.
The problem you have linked to has a clean Haskell solution using right folds. In other words, you can skip worrying about lazy fromList, memoization and all that by just using a more functional style.
The idea is that you maintain a list of (candy, score) pairs where candy is zero initially for all (repeat 0 in bellow code). Then you go once from left to right and bump up candy values if this item score exceeds the one before:
-- s is the score and c is the candy of the guy before
-- if s < score then this guy should get at least c + 1 candies
candy' = max candy $ if s < score then c + 1 else 1
and do the same thing again going in the other direction:
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
solve :: [Int] -> Int
solve = sum . map fst . loop . reverse . loop . zip (repeat 0)
where
loop cs = foldr go (\_ _ -> []) cs 0 0
go (candy, score) f c s = (candy', score): f candy' score
where candy' = max candy $ if s < score then c + 1 else 1
main = do
n <- read <$> getLine
solve . fmap read <$> replicateM n getLine >>= print
This performs linearly, and passes all tests on HackerRank.
Well, regarding my own question at the top, probably the way to make the thing lazy would be to just use a list (a list of lists or a vector of lists.) The reason why the above is impossible to make lazy is because the Map type is lazy in the values and strict in the keys.
More importantly, my analysis that the fold is doing essentially two passes was completely right. The way those built up continuations are being executed in reverse completely tripped me up at first, but I've adapted #behzad.nouri code to work with only a single loop.
module Main where
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Debug.Trace
solve :: [Int] -> Int
solve = sum . loop
where
loop :: [Int] -> [Int]
loop = (\(_,_,x) -> x 0 0) . foldr go (0, 0, \_ _ -> [])
go :: Int -> (Int, Int, Int -> Int -> [Int]) -> (Int, Int, Int -> Int -> [Int])
go score (candyP,scoreP,f) =
let
candyP' = if scoreP < score then candyP + 1 else 1
in
(candyP', score,
\candyN scoreN ->
let
candy' = max candyP' $ if scoreN < score then candyN + 1 else 1
in candy' : f candy' score) -- This part could be replaced with a sum
main = do
n <- read <$> getLine
solve . fmap read <$> replicateM n getLine >>= print
The above passes all tests, no problem, and that is convincing proof that the above analysis is correct.
I'm trying to memoize the following function:
gridwalk x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Looking at this I came up with the following solution:
gw :: (Int -> Int -> Int) -> Int -> Int -> Int
gw f x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (f (x - 1) y) + (f x (y - 1))
gwlist :: [Int]
gwlist = map (\i -> gw fastgw (i `mod` 20) (i `div` 20)) [0..]
fastgw :: Int -> Int -> Int
fastgw x y = gwlist !! (x + y * 20)
Which I then can call like this:
gw fastgw 20 20
Is there an easier, more concise and general way (notice how I had to hardcode the max grid dimensions in the gwlist function in order to convert from 2D to 1D space so I can access the memoizing list) to memoize functions with multiple parameters in Haskell?
You can use a list of lists to memoize the function result for both parameters:
memo :: (Int -> Int -> a) -> [[a]]
memo f = map (\x -> map (f x) [0..]) [0..]
gw :: Int -> Int -> Int
gw 0 _ = 1
gw _ 0 = 1
gw x y = (fastgw (x - 1) y) + (fastgw x (y - 1))
gwstore :: [[Int]]
gwstore = memo gw
fastgw :: Int -> Int -> Int
fastgw x y = gwstore !! x !! y
Use the data-memocombinators package from hackage. It provides easy to use memorization techniques and provides an easy and breve way to use them:
import Data.MemoCombinators (memo2,integral)
gridwalk = memo2 integral integral gridwalk' where
gridwalk' x y
| x == 0 = 1
| y == 0 = 1
| otherwise = (gridwalk (x - 1) y) + (gridwalk x (y - 1))
Here is a version using Data.MemoTrie from the MemoTrie package to memoize the function:
import Data.MemoTrie(memo2)
gridwalk :: Int -> Int -> Int
gridwalk = memo2 gw
where
gw 0 _ = 1
gw _ 0 = 1
gw x y = gridwalk (x - 1) y + gridwalk x (y - 1)
If you want maximum generality, you can memoize a memoizing function.
memo :: (Num a, Enum a) => (a -> b) -> [b]
memo f = map f (enumFrom 0)
gwvals = fmap memo (memo gw)
fastgw :: Int -> Int -> Int
fastgw x y = gwvals !! x !! y
This technique will work with functions that have any number of arguments.
Edit: thanks to Philip K. for pointing out a bug in the original code. Originally memo had a "Bounded" constraint instead of "Num" and began the enumeration at minBound, which would only be valid for natural numbers.
Lists aren't a good data structure for memoizing, though, because they have linear lookup complexity. You might be better off with a Map or IntMap. Or look on Hackage.
Note that this particular code does rely on laziness, so if you wanted to switch to using a Map you would need to take a bounded amount of elements from the list, as in:
gwByMap :: Int -> Int -> Int -> Int -> Int
gwByMap maxX maxY x y = fromMaybe (gw x y) $ M.lookup (x,y) memomap
where
memomap = M.fromList $ concat [[((x',y'),z) | (y',z) <- zip [0..maxY] ys]
| (x',ys) <- zip [0..maxX] gwvals]
fastgw2 :: Int -> Int -> Int
fastgw2 = gwByMap 20 20
I think ghc may be stupid about sharing in this case, you may need to lift out the x and y parameters, like this:
gwByMap maxX maxY = \x y -> fromMaybe (gw x y) $ M.lookup (x,y) memomap