Here is a simple memoization in Haskell for function f1 taking one argument (yes, Fibonacci):
f1 = [calc n | n <- [0..]]
where calc 0 = 0
calc 1 = 1
calc n = f1 !! (n-1) + f1 !! (n-2)
Now, how would this be done for a function f2 that takes 2 arguments, or f3 that takes 3?
For f2, is the best approach a list of lists? Or can a different data structure be used?
f2 = [[calc n m | n <- [0..]] | m <- [0..]]
where calc 0 0 = 0
calc a b = // ...something using (f2 !! a !! b)
Of for f3 a b c, given that max_a * max_b * max_c is manageable, how would this memoization / dynamic programming work?
I'm looking for the simplest / most straight forward approach, using standard Haskell libs if possible.
Edit
As suggest in Chris Taylor's answer, I tried using MemoCombinators.hs v0.5.1 but it fails for me, like this:
Could not find module `Data.IntTrie'
Use -v to see a list of the files searched for.
and
Illegal symbol '.' in type
Perhaps you intended -XRankNTypes or similar flag
to enable explicit-forall syntax: forall <tvs>. <type>
I need this to run in "plain" haskell, this version: GHCi, version 7.6.3
Any tips to get it going?
I can think of two approaches -
1. MemoCombinators
The easiest way to create generic memoized functions is probably to use the data-memocombinators library. Say you have the following two argument function.
f :: Int -> Int -> Integer
f 0 _ = 1
f _ 0 = 1
f a b = f (a-1) b + f a (b-1)
You can try calling f 20 20, but be prepared to wait a while. You can easily write a memoizing version with
import Data.MemoCombinators
f :: Int -> Int -> Integer
f = memo2 integral integral f'
where
f' 0 _ = 1
f' _ 0 = 1
f' a b = f (a-1) b + f a (b-1)
Note that it's important that in the helper function f' the recursive calls are not to f' but rather to the memoized function f. Calling f 20 20 now returns almost instantly.
2. Lists of Lists of ...
If you know that the arguments to your function are Int and that you will need to use all of 0..n and 0..m to compute f (n+1) (m+1) then it might make sense to use the list of lists approach. However, note that this scales badly with the number of arguments to the function (in particular, it is difficult to tell at a glance what the function is doing if you have more than 2 arguments).
flist :: [[Integer]]
flist = [[f' n m | m <- [0..]] | n <- [0..]]
where
f' _ 0 = 1
f' 0 _ = 1
f' a b = flist !! (a-1) !! b + flist !! a !! (b-1)
f :: Int -> Int -> Integer
f a b = flist !! a !! b
Since Haskell is lazy, you can memoise a function by calling it on itself.
for example, one fibonacci generator in Haskell is this:
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
(from http://www.haskell.org/haskellwiki/The_Fibonacci_sequence)
which, uses the resulting list as its own storage for state.
Related
I'm trying to solve the following problem in Haskell: given an integer return the list of its digits. The constraint is I have to only use one of the fold* functions (* = {r,l,1,l1}).
Without such constraint, the code is simple:
list_digits :: Int -> [Int]
list_digits 0 = []
list_digits n = list_digits r ++ [n-10*r]
where
r = div n 10
But how do I use fold* to, essentially grow a list of digits from an empty list?
Thanks in advance.
Is this a homework assignment? It's pretty strange for the assignment to require you to use foldr, because this is a natural use for unfoldr, not foldr. unfoldr :: (b -> Maybe (a, b)) -> b -> [a] builds a list, whereas foldr :: (a -> b -> b) -> b -> [a] -> b consumes a list. An implementation of this function using foldr would be horribly contorted.
listDigits :: Int -> [Int]
listDigits = unfoldr digRem
where digRem x
| x <= 0 = Nothing
| otherwise = Just (x `mod` 10, x `div` 10)
In the language of imperative programming, this is basically a while loop. Each iteration of the loop appends x `mod` 10 to the output list and passes x `div` 10 to the next iteration. In, say, Python, this'd be written as
def list_digits(x):
output = []
while x > 0:
output.append(x % 10)
x = x // 10
return output
But unfoldr allows us to express the loop at a much higher level. unfoldr captures the pattern of "building a list one item at a time" and makes it explicit. You don't have to think through the sequential behaviour of the loop and realise that the list is being built one element at a time, as you do with the Python code; you just have to know what unfoldr does. Granted, programming with folds and unfolds takes a little getting used to, but it's worth it for the greater expressiveness.
If your assignment is marked by machine and it really does require you to type the word foldr into your program text, (you should ask your teacher why they did that and) you can play a sneaky trick with the following "id[]-as-foldr" function:
obfuscatedId = foldr (:) []
listDigits = obfuscatedId . unfoldr digRem
Though unfoldr is probably what the assignment meant, you can write this using foldr if you use foldr as a hylomorphism, that is, building up one list while it tears another down.
digits :: Int -> [Int]
digits n = snd $ foldr go (n, []) places where
places = replicate num_digits ()
num_digits | n > 0 = 1 + floor (logBase 10 $ fromIntegral n)
| otherwise = 0
go () (n, ds) = let (q,r) = n `quotRem` 10 in (q, r : ds)
Effectively, what we're doing here is using foldr as "map-with-state". We know ahead of time
how many digits we need to output (using log10) just not what those digits are, so we use
unit (()) values as stand-ins for those digits.
If your teacher's a stickler for just having a foldr at the top-level, you can get
away with making go partial:
digits' :: Int -> [Int]
digits' n = foldr go [n] places where
places = replicate num_digits ()
num_digits | n > 0 = floor (logBase 10 $ fromIntegral n)
| otherwise = 0
go () (n:ds) = let (q,r) = n `quotRem` 10 in (q:r:ds)
This has slightly different behaviour on non-positive numbers:
>>> digits 1234567890
[1,2,3,4,5,6,7,8,9,0]
>>> digits' 1234567890
[1,2,3,4,5,6,7,8,9,0]
>>> digits 0
[]
>>> digits' 0
[0]
>>> digits (negate 1234567890)
[]
>>> digits' (negate 1234567890)
[-1234567890]
Here is non tail recursive function
alg :: Int -> Int
alg n = if n<7 then n else alg(n-1) * alg(n-2) * alg(n-4) * alg(n-6)
I've been stuck on this for a while, I get the basic idea of tail recursion, and how to do it for single call recursive function, but no clue how to do it for multi call one.
Even came up with this abomination
algT :: Int -> Int
algT n = tail1 n 0 where tail1 i r = tail1(i-1) r *
tail2 n 0 where tail2 i r = tail2(i-2) r *
tail3 n 0 where tail3 i r = tail3(i-4) r *
tail4 n 0 where tail4 i r = tail4(i-6) r
It doesnt work and obviously not how recursive function should look, had few other attempts, but all of them ended in infinite 100% cpu load loop...
Have you looked into Fibonacci in Haskell? It is a similar type of function. BTW tail recursion isn't quite the right term in Haskell, as multi-recursion functions can't really be done recursively but Haskell's lazy nature makes a similar but more powerful trick possible. Here is the standard one given:
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
Using the same trick on yours gives EDIT: As a function
alg :: Int -> Int
alg n = alg' !! (n - 1)
where alg' = 1 : 2 : 3 : 4 : 5 : 6 : zipWith4 (\a b c d -> a * b * c * d) (drop 5 alg') (drop 4 alg') (drop 2 alg') alg'
Note that you shouldn't use Int here, that isn't open ended and the 11th term will loop in an Int.
EDIT: Actually Int is even worse than I thought. Once you hit 32 2's in your result you will start returning 0 since every answer is 0 mod 2^32.
From your question it's not entirely clear what is the purpose of making your function tail-recusrive. If you are trying to reduce cpu/memory usage, then you should use memoization (mentioned in the Guvante's answer).
Meanwhile, there is a way to make almost any function tail-recursive, known as continuation-passing style. Your example written in the CPS looks like this:
alg_cps :: Integer -> (Integer->a) -> a
alg_cps n cont =
if n < 7
then cont n
else alg_cps (n - 1)
(\x1 -> alg_cps (n - 2)
(\x2 -> alg_cps (n - 4)
(\x3 -> alg_cps (n - 6)
(\x4 -> cont (x1*x2*x3*x4)))))
And to directly get the result you can call it with id as continuation:
alg_cps 20 id
Notice that this does not reduce algorithm complexity or memory usage compared to naive non-tail recursive implementation.
I think I have a solution, but it's not very elegant or pretty.
alg :: Int -> Int
alg n | n < 7 -> n
| otherwise -> alg' n (repeat 0)
alg' :: Int -> [Int] -> Int
alg' n [] = error "something has gone horribly wrong"
alg' n l#(x:y)
| n < 5 -> error "something else has gone horribly wrong"
| n == 6 -> product $ zipWith (^) [6,5..1] l
| otherwise -> alg' (n-1) $ zipWith (+) [x,x,0,x,0,x] (y ++ [0])
The idea is that you can keep track of how many times you're supposed to be multiplying each thing without actually doing any of the calculations until the very end. At any given time, you have information about how many times you've needed any of the next 6 values, and once you're below 7, you just raise 1-6 to the proper powers and take their product.
(I haven't actually tested this, but it seems right. And even if it's not I'm pretty sure the idea behind it is sound)
P.S. As #Guvante says, Int isn't a good choice here as it will quickly overflow. As a general rule I use Integer by default and only switch if I have a good reason.
Here is a possible solution.
let f = [1..6] ++ foldr1 (zipWith (*)) [f, drop 2 f, drop 4 f, drop 5 f]
or even:
let f = [1..6] ++ foldr1 (zipWith (*)) (map (flip drop $ f) [0,2,4,5])
I recently learned about Data.Function.fix, and now I want to apply it everywhere. For example, whenever I see a recursive function I want to "fix" it. So basically my question is where and when should I use it.
To make it more specific:
1) Suppose I have the following code for factorization of n:
f n = f' n primes
where
f' n (p:ps) = ...
-- if p^2<=n: returns (p,k):f' (n `div` p^k) ps for k = maximum power of p in n
-- if n<=1: returns []
-- otherwise: returns [(n,1)]
If I rewrite it in terms of fix, will I gain something? Lose something? Is it possible, that by rewriting an explicit recursion into fix-version I will resolve or vice versa create a stack overflow?
2) When dealing with lists, there are several solutions: recursion/fix, foldr/foldl/foldl', and probably something else. Is there any general guide/advice on when to use each? For example, would you rewrite the above code using foldr over the infinite list of primes?
There are, probably, other important questions not covered here. Any additional comments related to the usage of fix are welcome as well.
One thing that can be gained by writing in an explicitly fixed form is that the recursion is left "open".
factOpen :: (Integer -> Integer) -> Integer -> Integer
factOpen recur 0 = 1
factOpen recur n = n * recur (pred n)
We can use fix to get regular fact back
fact :: Integer -> Integer
fact = fix factOpen
This works because fix effectively passes a function itself as its first argument. By leaving the recursion open, however, we can modify which function gets "passed back". The best example of using this property is to use something like memoFix from the memoize package.
factM :: Integer -> Integer
factM = memoFix factOpen
And now factM has built-in memoization.
Effectively, we have that open-style recursion requires us impute the recursive bit as a first-order thing. Recursive bindings are one way that Haskell allows for recursion at the language level, but we can build other, more specialized forms.
I'd like to mention another usage of fix; suppose you have a simple language consisting of addition, negative, and integer literals. Perhaps you have written a parser which takes a String and outputs a Tree:
data Tree = Leaf String | Node String [Tree]
parse :: String -> Tree
-- parse "-(1+2)" == Node "Neg" [Node "Add" [Node "Lit" [Leaf "1"], Node "Lit" [Leaf "2"]]]
Now you would like to evaluate your tree to a single integer:
fromTree (Node "Lit" [Leaf n]) = case reads n of {[(x,"")] -> Just x; _ -> Nothing}
fromTree (Node "Neg" [e]) = liftM negate (fromTree e)
fromTree (Node "Add" [e1,e2]) = liftM2 (+) (fromTree e1) (fromTree e2)
Suppose someone else decides to extend the language; they want to add multiplication. They will have to have access to the original source code. They could try the following:
fromTree' (Node "Mul" [e1, e2]) = ...
fromTree' e = fromTree e
But then Mul can only appear once, at the top level of the expression, since the call to fromTree will not be aware of the Node "Mul" case. Tree "Neg" [Tree "Mul" a b] will not work, since the original fromTree has no pattern for "Mul". However, if the same function is written using fix:
fromTreeExt :: (Tree -> Maybe Int) -> (Tree -> Maybe Int)
fromTreeExt self (Node "Neg" [e]) = liftM negate (self e)
fromTreeExt .... -- other cases
fromTree = fix fromTreeExt
Then extending the language is possible:
fromTreeExt' self (Node "Mul" [e1, e2]) = ...
fromTreeExt' self e = fromTreeExt self e
fromTree' = fix fromTreeExt'
Now, the extended fromTree' will evaluate the tree properly, since self in fromTreeExt' refers to the entire function, including the "Mul" case.
This approach is used here (the above example is a closely adapted version of the usage in the paper).
Beware the difference between _Y f = f (_Y f) (recursion, value--copying) and fix f = x where x = f x (corecursion, reference--sharing).
Haskell's let and where bindings are recursive: same name on the LHS and RHS refer to the same entity. The reference is shared.
In the definition of _Y there's no sharing (unless a compiler performs an aggressive optimization of common subexpressions elimination). This means it describes recursion, where repetition is achieved by application of a copy of an original, like in a classic metaphor of a recursive function creating its own copies. Corecursion, on the other hand, relies on sharing, on referring to same entity.
An example, primes calculated by
2 : _Y ((3:) . gaps 5 . _U . map (\p-> [p*p, p*p+2*p..]))
-- gaps 5 == ([5,7..] \\)
-- _U == sort . concat
either reusing its own output (with fix, let g = ((3:)...) ; ps = g ps in 2 : ps) or creating separate primes supply for itself (with _Y, let g () = ((3:)...) (g ()) in 2 : g ()).
See also:
double stream feed to prevent unneeded memoization?
How to implement an efficient infinite generator of prime numbers in Python?
Or, with the usual example of factorial function,
gen rec n = n<2 -> 1 ; n * rec (n-1) -- "if" notation
facrec = _Y gen
facrec 4 = gen (_Y gen) 4
= let {rec=_Y gen} in (\n-> ...) 4
= let {rec=_Y gen} in (4<2 -> 1 ; 4*rec 3)
= 4*_Y gen 3
= 4*gen (_Y gen) 3
= 4*let {rec2=_Y gen} in (3<2 -> 1 ; 3*rec2 2)
= 4*3*_Y gen 2 -- (_Y gen) recalculated
.....
fac = fix gen
fac 4 = (let f = gen f in f) 4
= (let f = (let {rec=f} in (\n-> ...)) in f) 4
= let {rec=f} in (4<2 -> 1 ; 4*rec 3) -- f binding is created
= 4*f 3
= 4*let {rec=f} in (3<2 -> 1 ; 3*rec 2)
= 4*3*f 2 -- f binding is reused
.....
1) fix is just a function, it improves your code when you use some recursion. It makes your code prettier.For example usage visit: Haskell Wikibook - Fix and recursion.
2) You know what does foldr? Seems like foldr isn't useful in factorization (or i didn't understand what are you mean in that).
Here is a prime factorization without fix:
fact xs = map (\x->takeWhile (\y->y/=[]) x) . map (\x->factIt x) $ xs
where factIt n = map (\x->getFact x n []) [2..n]
getFact i n xs
| n `mod` i == 0 = getFact i (div n i) xs++[i]
| otherwise = xs
and with fix(this exactly works like the previous):
fact xs = map (\x->takeWhile (\y->y/=[]) x) . map (\x->getfact x) $ xs
where getfact n = map (\x->defact x n) [2..n]
defact i n =
fix (\rec j k xs->if(mod k j == 0)then (rec j (div k j) xs++[j]) else xs ) i n []
This isn't pretty because in this case fix isn't a good choice(but there is always somebody who can write it better).
I'm trying to write a hyperoperation function in haskell.
It's usually wrritten as ackermann(a,b,n) but for partial application purposes I think it makes more sense to put n first. As such I'm calling it hypOp n a b
The form I've found most natural uses folds ao replicate lists like this:
Prelude> replicate 3 5
[5,5,5]
Prelude> foldr1 (*) $ replicate 3 5
125
Depending on the function argument to the fold this can be addition, mutliplication, exponentiation, tetration, etc.
Informal Overview:
hypOp 0 a _ = succ a
hypOp 1 a b = a + b = foldr1 (succ a) (replicate b a) --OFF BY ONE ISSUES, TYPE ISSUES
hypOp 2 a b = a * b = foldr1 (+) $ replicate b a
hypOp 3 a b = a ^ b = foldr1 (*) $ replicate b a
hypOp 4 a b = = foldr1 (^)
For associative reasons I am under the impression I must use right folds, which is unfortunate because the strictness available with left folds (foldl') would be useful.
Right vs. left folds issue
Prelude> foldl1 (^) $ replicate 4 2 --((2^2)^2)^2 = (4^2)^2 = 16^2 = 256 != 2 tetra 4
256
Prelude> foldr1 (^) $ replicate 4 2 --(2^(2^(2^2))) = 2^16 = 65536 == 2 tetra 4
65536
I get an off-by-one issue when i 'start' a the very beginning with successor function. so instead im using (+) as the function for my base fold
Prelude> let add a b = foldr1 (\a b -> succ b) $ replicate b a
Prelude> add 5 4
8
Prelude> add 10 5 --always comes out short by one, so i cant build off this
14
First few n values, done 'manually':
Prelude> let mul a b = foldr1 (+) $ replicate b a
Prelude> let exp a b = foldr1 mul $ replicate b a
Prelude> let tetra a b = foldr1 exp $ replicate b a
Prelude> let pent a b = foldr1 tetra $ replicate b a
Prelude> let sixate a b = foldr1 pent $ replicate b a
Prelude> mul 2 3 --2+2+2
6
Prelude> exp 2 3 --2*2*2
8
Prelude> tetra 2 3 --2^(2^2)
16
Prelude> pent 2 3 --2 tetra (2 tetra 2)
65536
Prelude> sixate 2 3
*** Exception: stack overflow
My attempt at formal definitions thru above approach:
hypOp :: Int -> Int -> Int -> Int
hypOp 0 a b = succ a
hypOp 1 a b = (+) a b --necessary only bc off-by-one error described above
hypOp n a b = foldr1 (hypOp $ n-1) (replicate b a)
Other attemp twith recursive array (not different in any significant way):
let arr = array (0,5) ( (0, (+)) : [(i, (\a b -> foldr1 (arr!(i-1)) (replicate b a)) ) | i <- [1..5]])
-- (arr!0) a b makes a + b
-- (arr!1) a b makes a * b, etc.
So my questions are...
Any general suggestions, different appraoches to t he function? I cant seem to find a way to avoid overflows except for using a very 'imperative' style which is not my intention when using haskell and trying to code in an idiomatic style
How my off-by-one issue can be dealt with so I can start 'properly' at the very bottom with succ
Strictness and left vs. right folds. Is there a way to work in seq? Some way that I can use foldl1' instead of foldr1 and avoid the problem described above?
See point 3. Although it works to define these operations in this way, and you can do it without overflows, it is an extremely inefficient approach. Your run time is linear in the answer, because you end up doing repeated addition.
The reason why you're getting the off-by-one is basically because you're using foldr1 f instead of foldr f with an identity.
foldr (+) 0 [a, a, a] = a + (a + (a + 0)))
foldr1 (+) [a, a, a] = a + (a + a)
Notice there is one less application of + in the case of foldr1.
How about simply changing the order of arguments to (^)? That way, you can use a left fold:
Prelude Data.List> foldl1 (flip (^)) $ replicate 4 2
65536
Now you can use the strict version, foldl1'. It no longer overflows, but it is of course extremely inefficient.
I'm a C++ Programmer trying to teach myself Haskell and it's proving to be challenging grasping the basics of using functions as a type of loop. I have a large number, 50!, and I need to add the sum of its digits. It's a relatively easy loop in C++ but I want to learn how to do it in Haskell.
I've read some introductory guides and am able to get 50! with
sum50fac.hs::
fac 0 = 1
fac n = n * fac (n-1)
x = fac 50
main = print x
Unfortunately at this point I'm not entirely sure how to approach the problem.
Is it possible to write a function that adds (mod) x 10 to a value and then calls the same function again on x / 10 until x / 10 is less than 10? If that's not possible how should I approach this problem?
Thanks!
sumd 0 = 0
sumd x = (x `mod` 10) + sumd (x `div` 10)
Then run it:
ghci> sumd 2345
14
UPDATE 1:
This one doesn't generate thunks and uses accumulator:
sumd2 0 acc = acc
sumd2 x acc = sumd2 (x `div` 10) (acc + (x `mod` 10))
Test:
ghci> sumd2 2345 0
14
UPDATE 2:
Partially applied version in pointfree style:
sumd2w = (flip sumd2) 0
Test:
ghci> sumd2w 2345
14
I used flip here because function for some reason (probably due to GHC design) didn't work with accumulator as a first parameter.
Why not just
sumd = sum . map Char.digitToInt . show
This is just a variant of #ony's, but how I'd write it:
import Data.List (unfoldr)
digits :: (Integral a) => a -> [a]
digits = unfoldr step . abs
where step n = if n==0 then Nothing else let (q,r)=n`divMod`10 in Just (r,q)
This will product the digits from low to high, which while unnatural for reading, is generally what you want for mathematical problems involving the digits of a number. (Project Euler anyone?) Also note that 0 produces [], and negative numbers are accepted, but produce the digits of the absolute value. (I don't want partial functions!)
If, on the other hand, I need the digits of a number as they are commonly written, then I would use #newacct's method, since the problem is one of essentially orthography, not math:
import Data.Char (digitToInt)
writtenDigits :: (Integral a) => a -> [a]
writtenDigits = map (fromIntegral.digitToInt) . show . abs
Compare output:
> digits 123
[3,2,1]
> writtenDigits 123
[1,2,3]
> digits 12300
[0,0,3,2,1]
> writtenDigits 12300
[1,2,3,0,0]
> digits 0
[]
> writtenDigits 0
[0]
In doing Project Euler, I've actually found that some problems call for one, and some call for the other.
About . and "point-free" style
To make this clear for those not familiar with Haskell's . operator, and "point-free" style, these could be rewritten as:
import Data.Char (digitToInt)
import Data.List (unfoldr)
digits :: (Integral a) => a -> [a]
digits i = unfoldr step (abs i)
where step n = if n==0 then Nothing else let (q,r)=n`divMod`10 in Just (r,q)
writtenDigits :: (Integral a) => a -> [a]
writtenDigits i = map (fromIntegral.digitToInt) (show (abs i))
These are exactly the same as the above. You should learn that these are the same:
f . g
(\a -> f (g a))
And "point-free" means that these are the same:
foo a = bar a
foo = bar
Combining these ideas, these are the same:
foo a = bar (baz a)
foo a = (bar . baz) a
foo = bar . baz
The laster is idiomatic Haskell, since once you get used to reading it, you can see that it is very concise.
To sum up all digits of a number:
digitSum = sum . map (read . return) . show
show transforms a number to a string. map iterates over the single elements of the string (i.e. the digits), turns them into a string (e.g. character '1' becomes the string "1") and read turns them back to an integer. sum finally calculates the sum.
Just to make pool of solutions greater:
miterate :: (a -> Maybe (a, b)) -> a -> [b]
miterate f = go . f where
go Nothing = []
go (Just (x, y)) = y : (go (f x))
sumd = sum . miterate f where
f 0 = Nothing
f x = Just (x `divMod` 10)
Well, one, your Haskell function misses brackets, you need fac (n - 1). (oh, I see you fixed that now)
Two, the real answer, what you want is first make a list:
listdigits n = if n < 10 then [n] else (listdigits (n `div` 10)) ++ (listdigits (n `mod` 10))
This should just compose a list of all the digits (type: Int -> [Int]).
Then we just make a sum as in sum (listdigits n). And we should be done.
Naturally, you can generalize the example above for the list for many different radices, also, you can easily translate this to products too.
Although maybe not as efficient as the other examples, here is a different way of approaching it:
import Data.Char
sumDigits :: Integer -> Int
sumDigits = foldr ((+) . digitToInt) 0 . show
Edit: newacct's method is very similar, and I like it a bit better :-)