I am trying to solve the Codewars problem called: Number of trailing zeros of N! with Haskell.
I know that I don't need to calculate the factorial to know the trailing zeros and in fact I am just counting how many many numbers are divisible by 5 and how many times for each.
I have written 2 version, one that uses memoization when defactoring a number in order to get how many times is divisible by 5 and another one that do not use memoization.
What surprise me is that the supposed DP approach takes longer than the trivial recursive one. I am probably doing something very stupid in my code.
These are the functions:
zeros x = helperZeros [1..x]
helperZeros :: [Integer] -> Integer
helperZeros = sumArrayTuple . filter (\x -> x `mod` 5 == 0)
sumArrayTuple = foldl (\acc x -> acc + (fastDef x)) 0
data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)
index :: Tree Integer -> Integer -> Integer
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n-1) `divMod` 2 of
(q,0) -> index l q
(q,1) -> index r q
nats = go 0 1
where
go n s = Tree (go l s') n (go r s' )
where
l = n + s
r = l + s
s' = s * 2
fastDef:: Integer -> Integer
fastDef x = trace (show x) index memTreetDef x
memTreetDef = fmap (defact fastDef) nats
defact f n
| n `mod` 5 /= 0 = 0
| otherwise = 1 + f (n `div` 5)
zeros' x = helperZeros' [1..x]
helperZeros' :: [Integer] -> Integer
helperZeros' = sumArrayTuple' . filter (\x -> x `mod` 5 == 0)
sumArrayTuple' = foldl (\acc x -> acc + (def x)) 0
def n
| n `mod` 5 /= 0 = 0
| otherwise = 1 + def (n `div` 5)
What I am trying to memoize is the result of the defact function, for example if I have already calculate defact 200, then it would reuse this result to calculate defact 1000.
I am fairly new to DP in Haskell.
If you are tested your code performance with trace and show here, that is the issue: they are very slow compared to the main code. If not, performance of variants must be about the same.
The def function is a poor candidate for memoization. The average depth of recursion is not very different from 1. The rest of the complexity is reduced to the operation mod, that is, the division that is hardly more expensive than table look up (and division by constant can be optimized to multiplication).
Related
I am given the assignment of coding a hailstone sequence in Haskell. I must be given an integer and create a list of integers ending with the last number 1, eg.
-- > hailstone 4
-- [4,2,1]
-- > hailstone 6
-- [6,3,10,5,16,8,4,2,1]
-- > hailstone 7
-- [7,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]
My answer should have just one 1 at the end, however I do not know how to break out of the loop once reaching 1.
hailstone :: Integer -> [Integer]
hailstone = takeWhile (>=1) . (iterate collatz)
where collatz n = if n == 1
then 1
else if even n
then n `div` 2
else 3*n+1
I end up with infinite 1's at the end of this. How can I fix this?
You can use a function like takeUntil :: (a -> Bool) -> [a] -> [a] from the utility-ht package [hackage]. This function will:
Take all elements until one matches. The matching element is returned, too. This is the key difference to takeWhile (not . p). It holds takeUntil p xs == fst (breakAfter p xs).
So we can use that to include the 1:
import Data.List.HT(takeUntil)
hailstone :: Integer -> [Integer]
hailstone = takeUntil (== 1) . iterate collatz
where collatz 1 = 1
collatz n | even n = div n 2
| otherwise = 3 * n + 1
or we can implment takeUntil ourself:
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = go
where go [] = []
go (x:xs) | p x = [x]
| otherwise = x : go xs
or with a fold:
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = foldr (\x y -> x : if p x then [] else y) []
For negative numbers, the collatz can get stuck in an infinite loop:
Prelude> hailstone (-7)
[-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,-7,-20,-10,-5,-14,
We thus might want to change the condition for all numbers less than or equal to 1:
hailstone :: Integer -> [Integer]
hailstone = takeUntil (<= 1) . iterate collatz
where collatz 1 = 1
collatz n | even n = div n 2
| otherwise = 3 * n + 1
All this use of takeUntil, iterate, breaking out has a very imperative feel for me (do something with the numbers until you reach 1 - and then how the hell do I stop? what is the Haskell equivalent of a break statement.....?)
There is nothing wrong with that, and it wil work eventually, but when using Haskell, is often better to think a bit more declaratively: the tail of a hailstone sequence (other than [1]) is another (shorter) hailstone sequence, so hailstone n = n : hailstone (f n) for some f
Thus:
hailstone n
| n == 1 = [1]
| even n = n : hailstone (n `div` 2)
| otherwise = n : hailstone (3*n + 1)
The sole classic library function that seems to offer some hope is unfoldr. It uses the Maybe monad, and returning Nothing is what stops the recursion.
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
You have to pick the proper function argument:
import Data.List
hailstone :: Integer -> [Integer]
hailstone n =
let next nn = if (even nn) then (div nn 2) else (3*nn+1)
unfn nn = if (nn==1) then Nothing else let nx = next nn in Just (nx,nx)
in
n : (unfoldr unfn n)
main = do
putStrLn $ "hailstone 7 is: " ++ show (hailstone 7)
That way, the stopping criterion is clearly separated from the successor function.
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
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.
I am trying to build a data-structure in Haskell which functions can use to avoid re-computing values. For example, say I had the function:
f :: Int -> Int -> Int
f 1 1 == 1
f m n
| abs m > n = 0
| OTHERWISE if value of f m n has already been computed by another recursive branch, return that value and add it to the "database"
| OTHERWISE return f (m-1) (n-1) + f (m - 1) n
I have already looked at memoization, but haven't been able to implement a solution :\
Suggestions? :)
A great explanation is here.
I love memoize package :)
Example (solving the "A frog is jumping up the staircase..." problem):
import Data.Function.Memoize
ladder :: Integer -> Integer -> Integer
ladder n k = g n
where g = memoize f
f 0 = 1
f x = sum [g (x - y) | y <- [1..if x < k then x else k]]
Background
For fun, I'm trying to write a property for quick-check that can test the basic idea behind cryptography with RSA.
Choose two distinct primes, p and q.
Let N = p*q
e is some number relatively prime to (p-1)(q-1) (in practice, e is usually 3 for fast encoding)
d is the modular inverse of e modulo (p-1)(q-1)
For all x such that 1 < x < N, it is always true that (x^e)^d = x modulo N
In other words, x is the "message", raising it to the eth power mod N is the act of "encoding" the message, and raising the encoded message to the dth power mod N is the act of "decoding" it.
(The property is also trivially true for x = 1, a case which is its own encryption)
Code
Here are the methods I have coded up so far:
import Test.QuickCheck
-- modular exponentiation
modExp :: Integral a => a -> a -> a -> a
modExp y z n = modExp' (y `mod` n) z `mod` n
where modExp' y z | z == 0 = 1
| even z = modExp (y*y) (z `div` 2) n
| odd z = (modExp (y*y) (z `div` 2) n) * y
-- relatively prime
rPrime :: Integral a => a -> a -> Bool
rPrime a b = gcd a b == 1
-- multiplicative inverse (modular)
mInverse :: Integral a => a -> a -> a
mInverse 1 _ = 1
mInverse x y = (n * y + 1) `div` x
where n = x - mInverse (y `mod` x) x
-- just a quick way to test for primality
n `divides` x = x `mod` n == 0
primes = 2:filter isPrime [3..]
isPrime x = null . filter (`divides` x) $ takeWhile (\y -> y*y <= x) primes
-- the property
prop_rsa (p,q,x) = isPrime p &&
isPrime q &&
p /= q &&
x > 1 &&
x < n &&
rPrime e t ==>
x == (x `powModN` e) `powModN` d
where e = 3
n = p*q
t = (p-1)*(q-1)
d = mInverse e t
a `powModN` b = modExp a b n
(Thanks, google and random blog, for the implementation of modular multiplicative inverse)
Question
The problem should be obvious: there are way too many conditions on the property to make it at all usable. Trying to invoke quickCheck prop_rsa in ghci made my terminal hang.
So I've poked around the QuickCheck manual a bit, and it says:
Properties may take the form
forAll <generator> $ \<pattern> -> <property>
How do I make a <generator> for prime numbers? Or with the other constraints, so that quickCheck doesn't have to sift through a bunch of failed conditions?
Any other general advice (especially regarding QuickCheck) is welcome.
Here's one way to make a QuickCheck-compatible prime-number generator (stealing a Sieve of Eratosthenes implementation from http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)):
import Test.QuickCheck
newtype Prime = Prime Int deriving Show
primes = sieve [2..]
where
sieve (p:xs) = Prime p : sieve [x | x <- xs, x `mod` p > 0]
instance Arbitrary Prime where
arbitrary = do i <- arbitrary
return $ primes!!(abs i)
It can be used in QuickCheck like so:
prop_primes_dont_divide (Prime x) (Prime y) = x == y || x `mod` y > 0
For your use, you'd replace p and q with (Prime p) and (Prime q) in your property.
OK so here's what I did.
Top of file
{-# LANGUAGE NoMonomorphismRestriction #-}
import Test.QuickCheck
import Control.Applicative
All code as given in the question, except for prop_rsa. That was (obviously) heavily modified:
prop_rsa = forAll primePair $ \(p,q) ->
let n = p*q
in forAll (genUnder n) $ \x ->
let e = 3
t = (p-1)*(q-1)
d = mInverse e t
a `powModN` b = modExp a b n
in p /= q &&
rPrime e t ==>
x == (x `powModN` e) `powModN` d
The type for primePair is Gen (Int, Int), and the type for genUnder is Int -> Gen Int. I'm not exactly sure what the magic is behind forAll but I'm pretty sure this is correct. I've done some ad-hoc adjustments to 1) make sure it fails if I mess up the conditions and 2) make sure the nested forAll is varying the value of x across test cases.
So here's how to write those generators. Once I realized that <generator> in the documentation just meant something of type Gen a, it was cake.
genNonzero = (\x -> if x == 0 then 1 else x) `fmap` arbitrary
genUnder :: Int -> Gen Int
genUnder n = ((`mod` n) . abs) `fmap` genNonzero
genSmallPrime = ((\x -> (primes !! (x `mod` 2500))) . abs) `fmap` arbitrary
primePair :: Gen (Int, Int)
primePair = (,) <$> genSmallPrime <*> genSmallPrime
primePair took some trial and error for me to get right; I knew that some combinators like that should work, but I'm still not as familiar with fmap, <$> and <*> as I'd like to be. I restricted the computation to only select from among the first 2500 primes; otherwise it apparently wanted to pick some really big ones that took forever to generate.
Random thing to note
Thanks to laziness, d = mInverse e t isn't computed unless the conditions are met. Which is good, because it's undefined when the condition rPrime e t is false. In English, an integer a only has a multiplicative inverse (mod b) when a and b are relatively prime.