Memoization of Haskell Function - haskell

I wrote a function in Haskell to compute the determinant of a Matrix, it works just fine but is horribly slow so I tried to memoize it just like the Haskell Wiki does with the Fibonacci function.
But somehow my memoized function takes slightly longer than the non-memoized version, even when computing the determinant for the identity matrix, which should benefit very much from memoization.
I also tried using a Map for caching results but found no way to pass the modified Map to the next iteration of the recursive function.
How can I fix this?
-- Non-Memoized version
det :: (Num a, Eq a) => [[a]] -> a
det x
| fst s == 0 = 0
| fst s == 1 = head $ head x
| fst s == 2 = (head (head x) * ((x !! 1) !! 1))
- ((head x !! 1) * head (x !! 1))
| F.allEqual x = 0
| otherwise = sum [((-1) ^ (i + 1)) * head (x !! (i - 1))
* det (sub x i 1)
| i <- [1..(fst s)]]
where
s = shape x
-- Memoized version
mDet :: (Num a, Eq a) => [[a]] -> a
mDet x = sum [((-1) ^ (i + 1)) * head (x !! (i - 1))
* det' (sub x i 1)
| i <- [1..(fst $ shape x)]]
where
det' y
| fst s == 0 = 0
| fst s == 1 = head $ head y
| fst s == 2 = (head (head y) * ((y !! 1) !! 1))
- ((head y !! 1) * head (y !! 1))
| F.allEqual y = 0
| otherwise = mDet y
where
s = shape y

There are much more efficient algorithms to compute the determinant via factorization.
Even with memoization, there are an exponential number of submatrices involved in the naive determinant formula so that's a little pointless.

Just for reference, your function re-written to avoid the !! access becomes
-- Non-Memoized version
det :: (Num a, Eq a) => [[a]] -> a
det [] = 0
det [r] = head r
det [r,q] = case [r,q] of
[[a,b],[c,d]] -> a*d - b*c -- error out on wrong shape
det x | or [ or [a==b | b <- bs] -- quadratic test
| (a:bs) <- tails x ] -- (must be "collinear",
= 0 -- "any", not "all"! -- not "==", anyway)
det x = sum $ [s * head r * det ([reverse a,b] >>= map tail)
| (a,r,b) <- picks3 x
| s <- cycle [1,-1]]
picks3 :: [a] -> [([a], a, [a])]
picks3 xs = unfoldr (\case { (_,[]) -> Nothing ;
(a,x:xs) -> Just ((a,x,xs), (x:a,xs)) })
([],xs)
There's nothing to be memoized here that's immediately apparent.

Related

What's the difference between tail and guarded recursion?

In my exercise I have to decide what kind of recursion the functions are.
We have to choose from linear recursion, tail recursion and guarded recursion
but I don't really understand the difference between the last two.
Can some one explain the difference between guarded and tail recursion?
The functions we have to differentiate for reference:
pow2 0 = 1
pow2 n = 2 * pow2 (n-1)
factAux r i n
| i <= n = factAux (i * r) (i + 1) n | otherwise = r
factorial = factAux 1 1
init [x] = []
init (x:xs) = x : init xs
binom n 0 = 1
binom n k
| n == k = 1
| otherwise = binom (n - 1) k + binom (n - 1) (k - 1)
negList [] = []
negList (x : xs) = if x > 0 then negList (-x : xs) else x : negList xs
I won't solve your homework as it would be counter-educative.
Instead, I will answer the question in the post's title:
Tail recursion
A call is tail-recursive when
It's recursive
The result of that call is returned immediately, without any modification or action done after it
For example:
-- This is tail-rec
f x = if x == 0
then 0
else f (x + 1)
-- This is not
g x = if x == 0
then 0
else g (x + 1) - 1
-- And this is not too
h x = h (h x)
For more info, check this thread.
Guarded recursion
This occurs when a recursive call is positioned under a lazy parameter to a data constructor:
-- This is guarded-rec
f x = if x == 0
then []
else x : f (x - 1) -- (:) is lazy on both operands
-- And this is not
g x = if x == 0
then []
else g (x - 1)
-- And this is not too
data StrictList a = SNil | SCons !a !(StrictList a)
h x = if x == 0
then SNil
SCons x (h x)
Cross-examples
This link may help you seeing the difference. Also check out this, although it gives examples in Prolog.
Tail rec and guard rec
This is contradictory, as guarding a recursive call with a constructor breaks the "doing nothing to the result" requirement of tail recursion.
Tail rec and not guard rec
f x = f x
Not tail rec and guard rec
f x = x : f x
Not tail rec and not guard rec
f x = f x + 1

Haskell: How to find the number of integer solutions to equation for use in Sieve of Atkin?

I am currently trying to implement the Sieve of Atkin in Haskell
In step 3 on the Wikipedia article on the Sieve of Atkin I need to find the number of Integer solutions to multiple equations.
However my solution to the first of these equations (4x² + y² = n, x > 0, y > 0
with n being a entry in a list of positive Integers) produces an infinite loop upon a query with any n.
This is my code for this part of the problem so far:
eq1 :: Integer -> Integer
eq1 n = eq1_ n []
eq1_ :: Integer -> [(Integer, Integer)] -> Integer
eq1_ n list | (x > 0) && (y > 0) && (n == 4*(x^2) + (y^2)) && (notElem ((x,y)) list) = eq1_ n ([(x, y)] ++ list)
| otherwise = toInteger (length list)
where
x = floor (sqrt (fromIntegral ((n - y^2) `div` 4)))
y = floor (sqrt (fromIntegral (n - 4*(x^2))))
It is loaded just fine by WinGHCi, but when I query e.g. eq1 0 it just stays in an infinite loop and has to be interrupted before producing an answer. I suspect it goes in a loop between the two assignments of x and y.
How can I prevent this? Is this even possible?
Edit: Realised where the infinite loop must be.
I'm going to start by reformatting your code a tad to make it more readable. Line breaks are helpful! Also, the order of operations can reduce the weight of parentheses. Side note:
f x | e1 && e2 && e3 = e4
can also be written
f x | e1
, e2
, e3
= e4
which may be easier on the eyes.
eq1 :: Integer -> Integer
eq1 n = eq1_ n []
eq1_ :: Integer -> [(Integer, Integer)] -> Integer
eq1_ n list
| x > 0 &&
y > 0 &&
n == 4*x^2 + y^2 &&
notElem (x,y) list
= eq1_ n ([(x, y)] ++ list)
| otherwise
= toInteger (length list)
where
isqrt = floor . sqrt . fromIntegral
x = isqrt $ (n - y^2) `div` 4
y = isqrt $ n - 4*(x^2)
Now I can immediately see that the logic is wonky. Given n, you calculate x and y. Then you either stop or call the function recursively. On the recursive call, however, you're guaranteed to stop! So even if you were otherwise right, you'd definitely have a semantic problem, always returning 0 or 1.
But as you've seen, that's not the only problem. You're also defining x in terms of y and y in terms of x. Now there are important situations where such mutual recursion is useful. But when the mutually recursive values are "atomic" things like integers, you're sure to get an infinite loop. Haskell won't solve the equations for you; that's your job!
Here's my suggestion:
Start with a brute force list comprehension solution:
sols n
= [(x,y)
|x <- takeWhile (\p -> 4 * p^2 < n) [1..]
,y <- takeWhile (\q -> f x y <= n) [1..]
,f x y = n]
where
f x y = 4*x^2+y^2
Next, you can use an approximate integer square root to narrow the search space for y:
sols n
= [(x,y)
|x <- takeWhile (\p -> 4 * p^2 < n) [1..]
,y <- takeWhile
(\q -> f x y <= n)
[floor(sqrt(fromIntegral(n-4*x^2)))..]
,f x y = n]
where
f x y = 4*x^2+y^2

Number of loops in recursion

I would like to count the number of positive integers/elements in the list. This returns the elements with positive values, how can I count the elements? would like to construct something like count(array(...)).
I would like to see a version with i++ and foldl. That would be very helpful.
countPositivesRec :: [Int] -> [Int]
countPositivesRec [] = []
countPositivesRec (x:xs) | x >= 0 = x : tl
| otherwise = tl
where tl = countPositivesRec xs
Here's a hint: follow the same recursion scheme as before, but return an int at every step.
countPositivesRec :: [Int] -> Int
---
countPositivesRec [] = 0 -- no positives in the empty list
countPositivesRec (x:xs) | x >= 0 = ??
| otherwise = ??
where tl = countPositivesRec xs
One you solve this, it can be rewritten using foldr, if you want.
If you really want to use foldl instead, I would suggest you start by defining a function f such that
f (f (f 0 x0) x1) x2
evaluates to the number of positives in x0,x1,x2. Then you can use foldl f 0 inputList
The function you've written is filter (>=0). As Paul pointed out, the only step remaining is to count and length does that. We can transform the function step by step:
countPositivesRec :: [Int] -> [Int]
countPositivesRec [] = []
countPositivesRec (x:xs) | x >= 0 = x : tl
| otherwise = tl
where tl = countPositivesRec xs
Observe that xs is only used in the transformed form tl. That's what makes this a right fold.
onlypos1 = foldr maybekeep []
where maybekeep x tl | x >= 0 = x : tl
| otherwise = tl
This operation is known as a filter, keeping only some parts:
onlypos2 = filter dowekeep
where dowekeep x = x >= 0
onlypos3 = filter (\x -> x >= 0)
onlypos4 = filter (>= 0)
But this is of course only one of many possible approaches. For instance, strictness analysis can lead to the conclusion that length is better implemented as foldl' (\a _ -> succ a) 0 than foldr (\_ a -> succ a) 0. Indeed, that is its basic form in the Prelude:
length = foldl' (\c _ -> c+1) 0
We see that the combining function of length ignores the value of one argument, merely requires it to be there. This can naturally be merged with our condition that only some elements count:
lengthFilter1 = length . filter
lengthFilter2 pred = foldl' predCount 0
where predCount c x = if pred x then c+1 else c
countNonNegative = lengthFilter2 nonNegative
where nonNegative x = x >= 0
Incidentally, 0 isn't positive. It's non-negative.
In the end, Haskell's lazy lists mean we can use them to fuse traversals; length . filter (>=0) will only read the input list once, because the only reason it's processing results from filter is that length consumes them. The filtered list never exists as a fully expanded structure, unlike e.g. Python or PHP. This form is likely one of the most readable, but others exist, e.g.:
countNonNegatives xs = sum [1 | x <- xs, x >= 0]
You have
filtering p cons x r = if | p x -> cons x r | otherwise -> r
countPositives = length
. filter (> 0)
= foldr (\x r -> r + 1) 0 -- r++
. foldr (filtering (> 0) (:) ) []
= foldr (filtering (> 0) (\x r -> r + 1)) 0
(since folds fuse by composing their reducer transformers, a-la "fold replaces the cons with a reducer operation, so why create the cons in the first place if it gonna be replaced anyway"), and
filtering (> 0) (\x r -> r + 1) x r
= if | (> 0) x -> (\x r -> r + 1) x r | otherwise -> r
= if | x > 0 -> r + 1 | otherwise -> r
and thus, a version with fold and increment that you wanted,
countPositives = foldr (\x r -> if | x > 0 -> r + 1 | otherwise -> r) 0 -- r++
You can take it from here.

Least common multiple without using gcd

With gcd its fairly easy but i do not understand how to tie in all the functions to make it happen without.
kgv :: Int -> Int -> Int
kgv x y = abs ((x `quot` (gcd x y)) * y)
I got this function to find the prime factors which works (prime_factors) and I am working on making a function that takes the maximum number from one list and checks if its on the other list (comp):
prime_factors :: Int -> [Int]
prime_factors 1 = []
prime_factors n
| factors == [] = [n]
| otherwise = factors ++ prime_factors (n `div` (head factors))
where factors = take 1 $ filter (\x -> (n `mod` x) == 0) [2 .. n-1]
comp :: [Int]->Int
comp (ys)(x:xs)
|maximum prime_factors xs elem prime_factors ys == x
|otherwise tail x
kgv :: Int -> Int -> Int
kgv x y = abs ((x `quot` (comp x y)) * y)
Here's an absurdly simple and obscenely inefficient solution:
lcm m n = head [x | x <- [1..], x `rem` m == 0, x `rem` n == 0]
Of course, this relies on two different notions of "least" coinciding under the circumstances, which they do. A fully naive solution doesn't seem possible.
here is the (very) naive algorithm I was talking about:
kgv :: (Ord a, Num a) => a -> a -> a
kgv x y = find x y
where find i j
| i == j = i
| i < j = find (i+x) j
| i > j = find i (j+y)
it's basically what a school-child would do ;)
caution I ignored negative numbers and 0 - you'll probably have to handle those
perhaps another easy way is
import Data.List(intersect)
lcm m n = head $ intersect (series m n) (series n m)
where series a b = take a $ map (*b) [1..]
I figured it out myself mostly. Thanks for the ideas and pointers.
ggt n m | n > m = maximum [t | t <- [1 .. m], gt n m t]
| otherwise = maximum [t | t <- [1 .. n], gt n m t]
gt n m c = t n c && t m c
t n c | n >= c = (mod n c == 0)
| otherwise = False
kgv :: Int -> Int -> Int
kgv x y |x==0=0|y==0=0 |otherwise = abs ((x `quot` (ggt x y)) * y)

How to express {2n+3m+1|n,m∈N} in list comprehension form? (N is the set of natural numbers including 0)

How do I express {2n+3m+1|n,m∈N} in list comprehension form? N is the set of natural numbers, including 0.
Shortly:
1:[3..]
Isn't {2n+3m+1|n,m ∈ ℕ} = ℕ - {0,2}?
The following Haskell function will give you all pairs from two lists, even if one or both is infinite. Each pair appears exactly once:
allPairs :: [a] -> [b] -> [(a, b)]
allPairs _ [] = []
allPairs [] _ = []
allPairs (a:as) (b:bs) =
(a, b) : ([(a, b) | b <- bs] `merge`
[(a, b) | a <- as] `merge`
allPairs as bs)
where merge (x:xs) l = x : merge l xs
merge [] l = l
You could then write your list as
[2 * n + 3 * m + 1 | (n,m) <- allPairs [0..] [0..] ]
To get a feel for how it works, draw an infinite quarter-plane, and look at the results of
take 100 $ allPairs [0..] [0..]
[2*n + 3*m +1 | m <- [0..], n <- [0..]] won't work because it starts with m = 0 and goes through all the n, and then has m = 1 and goes through all the n, etc. But just the m = 0 part is infinite, so you will never get to m = 1 or 2 or 3, etc. So [2*n + 3*m +1 | m <- [0..], n <- [0..]] is exactly the same as [2*n + 3*0 +1 | n <- [0..]].
To generate all of them, you either need to realize, like users vartec and Hynek -Pichi- Vychodil, that the set of numbers you want is just the natural numbers - {0,2}. Or you need to somehow enumerate all the pairs (m,n) such that m,n are nonnegative. One way to do that is to go along each of the "diagonals" where m + n is the same. So we start with the numbers where m + n = 0, and then the ones where m + n = 1, etc. Each of these diagonals has a finite number of pairs, so you will always go on to the next one, and all the pairs (m,n) will eventually be counted.
If we let i = m + n and j = m, then [(m, n) | m <- [0..], n <- [0..]] becomes [(j, i - j) | i <- [0..], j <- [0..i]]
So for you, you can just do
[2*(i-j) + 3*j +1 | i <- [0..], j <- [0..i]]
(Of course this method will also produce duplicates for you because there are multiple (m,n) pairs that generate the same number in your expression.)
my 0.2:
trans = concat [ f n | n <- [1..]]
where
mklst x = (\(a,b) -> a++b).unzip.(take x).repeat
f n | n `mod` 2 == 0 = r:(mklst n (u,l))
| otherwise = u:(mklst n (r,d))
u = \(a,b)->(a,b+1)
d = \(a,b)->(a,b-1)
l = \(a,b)->(a-1,b)
r = \(a,b)->(a+1,b)
mkpairs acc (f:fs) = acc':mkpairs acc' fs
where acc' = f acc
allpairs = (0,0):mkpairs (0,0) trans
result = [2*n + 3*m + 1 | (n,m) <- allpairs]
You can try enumerating all pairs of integers.
This code is based in the enumeration described at University of California Berkeley (doesn't include 0)
data Pair=Pair Int Int deriving Show
instance Enum Pair where
toEnum n=let l k=truncate (1/2 + sqrt(2.0*fromIntegral k-1))
m k=k-(l k-1)*(l k) `div` 2
in
Pair (m n) (1+(l n)-(m n))
fromEnum (Pair x y)=x+((x+y-1)*(x+y-2)) `div` 2
But you can use another enumeration.
Then you can do:
[2*n+3*m+1|Pair n m<-map toEnum [1..]]

Resources