I'm new to Haskell and want to faktor an integer by trial division up to its square root.
Trying this snippet on replit.com:
firstfaktor n = head [x | x <- [2.. floor (sqrt n)], n `mod` x == 0]
main = do
print $ head [x | x <- [2.. floor (sqrt 91)], 91 `mod` x == 0]
print $ firstfaktor 91
I'd expect the second print to have the same output as the first namely 7, but it doesn't work and I don't understand the long error message.
Your firstfaktor uses n twice: once in sqrt n, where it requires the type of n to be a type of the RealFrac typeclass, and once for n `mod` x where it requires the type of n to be an instance of the Integral typeclass.
While technically possible to make a number type that is an instance of both, it does not make much sense to do that. You can make use of fromIntegral :: (Integral a, Num b) => a -> b to convert an item of a type that is a member of the Integral typeclass to any Num type, so we can use this with:
firstfaktor :: Integral a => a -> a
firstfaktor n = head [x | x <- [2.. floor (sqrt (fromIntegral n))], n `mod` x == 0]
The function will however still raise an error if it can not find any faktor for the given number.
A simpler option might however be to take items as long as the square of these items is less than or equal to n, so:
firstfaktor :: Integral a => a -> a
firstfaktor n = head [x | x <- takeWhile (\y -> y*y <= n) [2 ..], n `mod` x == 0]
Related
I tried this
recursion n x = if mod n 2 == 0
then x/n + (recursion (n-1) x)**(-1)
else n/x + (recursion (n-1) x)**(-1)
but there's a problem
Ambiguous type variable ‘a0’ arising from a use of ‘print’
prevents the constraint ‘(Show a0)’ from being solved.
Probable fix: use a type annotation to specify what ‘a0’ should be.
These potential instances exist:
instance Show Ordering -- Defined in ‘GHC.Show’
instance Show Integer -- Defined in ‘GHC.Show’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
...plus 22 others
...plus 18 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
• In a stmt of an interactive GHCi command: print it
how to solve that problem and what's wrong with my code?
The mod n 2 == 0 constraints n to be an Integral type, but then you use x/n and since the (/) function has signature (/) :: Fractional a => a -> a -> a, this means that x and n have the same Fractional type. It makes no sense that a number type is both Integral and Fractional.
You can work with fromIntegral to convert n to a Fractional type:
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x = if mod n 2 == 0
then x/fromIntegral n + (recursion (n-1) x)**(-1)
else fromIntegral n/x + (recursion (n-1) x)**(-1)
Another problem with your function is that there is no stop condition. You need to add an extra clause:
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x
| n <= 0 = 0
| mod n 2 == 0 = x/fromIntegral n + (recursion (n-1) x)**(-1)
| otherwise = fromIntegral n/x + (recursion (n-1) x)**(-1)
This then produces for example:
Prelude> recursion 10 2
0.3481658094621751
Other answers have already explained the errors here. A nice Haskell way to solve this problem is as follows:
import Data.List (scanl')
getNthApprox n x = approximations !! n where
approximations = scanl' (+) 0 $ fmap term [1..]
term n = if n `mod` 2 == 0
then x / fromIntegral n
else fromIntegral n / x
It turns out that due to the magic of laziness, getNthApprox works out to have the same performance characteristics as tail recursion. This is because elements of scanl' (+) 0 $ fmap term [1..] are constructed only as they are needed in the calculation of approximations !! n.
Probably not an answer but this one would correspond more closely to the caption:
tSumToN :: (Enum a, Fractional a) => Int -> a -> a
tSumToN n = sum . take n . tSeq
tSeq :: (Enum a, Fractional a) => a -> [a]
tSeq x =
interleave odds evens
where
odds = [ o / x | o <- [1,3..]]
evens = [ x / e | e <- [2,4..]]
interleave [] _ = []
interleave (y:ys) zs = y:interleave zs ys
example :: Double
example = tSumToN 4 1.1
btw: this one does obviously not converge mathematically so it seems rather pointless to take partial sums - but hey whatever
The errors you are seeing are because the compiler can't figure out the argument types for the function. Adding type constraints to the function takes care of this:
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x = if mod n 2 == 0
then x/fromIntegral n + (recursion (n-1) x)**(-1)
else fromIntegral n/x + (recursion (n-1) x)**(-1)
Now the function compiles but will not terminate because there is no check for a terminal condition (n==0). To fix this, add the check.
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x | n == 0 = 0.0
| mod n 2 == 0 = x/fromIntegral n + (recursion (n-1) x)**(-1)
| otherwise = fromIntegral n/x + (recursion (n-1) x)**(-1)
Now the function will terminate with an answer but the answer does not match the formula stated in the question title. To fix this, remove the **(-1) .
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x | n == 0 = 0.0
| mod n 2 == 0 = x/fromIntegral n + (recursion (n-1) x)
| otherwise = fromIntegral n/x + (recursion (n-1) x)
Now the function returns the correct values. The following main program verifies that this is the case:
main :: IO ()
main = do
print $ recursion 1 1.0
print $ 1/1.0
print $ recursion 2 1.0
print $ 1/1.0 + 1.0/2
print $ recursion 3 1.0
print $ 1/1.0 + 1.0/2 + 3/1.0
print $ recursion 4 1.0
print $ 1/1.0 + 1.0/2 + 3/1.0 + 1.0/4
The function returns the correct values but is not tail recursive. As a first step in making it tail recursive, reduce it to a single recursive call. To do this note that the terms in the formula come in pairs and group them together along with a n-2 recursion. The function now will only work for even n but that can be patched up later.
recursion :: (Integral a, Floating b) => a -> b -> b
recursion n x | n == 0 = 0.0
| otherwise = fromIntegral (n-1)/x + x/fromIntegral n + (recursion (n-2) x)
The function still is not tail recursive because there is additional processing (additions) done after the recursive call. One way to work around this is to introduce an accumumator argument to hold incomplete values.
recursion :: (Integral a, Floating b) => a -> b -> b -> b
recursion n x acc | n == 0 = acc
| otherwise = recursion (n-2) x (fromIntegral (n-1)/x + x/fromIntegral n + acc)
As a final step a wrapper function can be introduced to handle odd values of n and to hide the accumulator argument. Use an appropriately modified version of the above test code to verify.
no_recursion :: (Integral a, Floating b) => a -> b -> b
no_recursion n x = if mod n 2 == 0
then recursion n x 0.0
else fromIntegral n / x + recursion (n-1) x 0.0
What you apparently meant was
recursion n x = if snd (properFraction (n / 2)) > 0 -- isOdd
then x/n + recursion (n-1) (x**(-1))
else n/x + recursion (n-1) (x**(-1))
but there's two problems here. First of all correctness, since you start from nth term and go back to 0th, but use x as the starting value always, whereas it differs depending on whether n is even or odd. We fix problems like this by moving the actual work into the inner, "worker" function, and fixing the starting value of the iteration.
Second problem is that it is not tail recursive. We fix problems like that by introducing an accumulating parameter to the inner, "worker" function. One tool to fix two problems!
-- T = 1/x + x/2 + 3/x + x/4 + ...
recursion :: RealFrac a => a -> a -> a
recursion n x = if snd (properFraction (n / 2)) > 0 -- n is odd
then goOdd n 0
else goEven n 0
where
goOdd n acc = goEven (n-1) (acc + n/x)
goEven n acc
| n <= 0 = acc
| otherwise = goOdd (n-1) (acc + x/n)
Now it's correct, and tail recursive as you wanted.
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
Trying to implement a function for listing all prime numbers in some range of numbers, I know when I am checking for factors I do not have to check beyond the sqrt of that that number.
factors n = [x | x <- [1..(floor (sqrt n))], mod n x == 0]
prime n = factors n == [1,n]
listPrimesFromTill n z = [ xs | xs <- [n..z], prime xs == True]
I've been browsing for answers and I tried various methods like type checking using
factors :: (RealFrac b, Integral c, Floating b) => b -> c
but have had no luck.
Any help is appreciated!
It seems like you looked at the code you wrote and figured the types out after. In general, Haskell development is the other way around: First you figure out the types, then you implement the functions. What type should factors have? Well, you can only factorize integers, so something of type, so this seems sensible:
factor :: Integral a => a -> [a]
Now when trying to compile your code we get the following error:
Could not deduce (Floating a) arising from a use of `sqrt` from the context (Integral a)
and
Could not deduce (RealFrac a) arising from a use of `sqrt` from the context (Integral a)
It complains that you specified Integral a but it needs Floating a for sqrt. We can do this by usinf fromIntegral:
sqrt :: Floating a => a -> a
fromIntegral :: (Integral a, Num b) => a -> b
factors :: Integral a => a -> [a] vvvvvvvvvvvvvv
factors n = [x | x <- [1..(floor (sqrt (fromIntegral n)))], mod n x == 0]
To preserve readability,
factors n = [x | x <- [1..isqrt n], mod n x == 0]
where isqrt = floor . sqrt . fromIntegral
I have the following function to return the Factor Pairs for a given number
factorPairs:: (RealFrac a, Floating a, Integral a) => a -> [(a, a)]
factorPairs n = map(\x -> (x, div n x)) [y | y <- [1..(ceiling $ sqrt n)], n `rem` y == 0]
When I call the function in ghci factorPairs 18 I'm getting a run time error of
* Ambiguous type variable `a0' arising from a use of `it'
prevents the constraint `(Floating a0)' from being solved.
Probable fix: use a type annotation to specify what `a0' should be.
These potential instances exist:
instance Floating Double -- Defined in `GHC.Float'
instance Floating Float -- Defined in `GHC.Float'
* In the first argument of `print', namely `it'
In a stmt of an interactive GHCi command: print it
I can hard code the function in ghci
map(\x -> (x, div 18 x)) [y | y <- [1..(ceiling $ sqrt 18)], 18 `rem` y == 0]
and don't have any issues but I can't seem to figure out why my function is failing. I believe ghci is trying to tell me it can't figure out what type to call print with but am struggling to find the solution.
This has to do with the fact numeric literals are overloaded in Haskell. When you type map(\x -> (x, div 18 x)) [y | y <- [1..(ceiling $ sqrt 18)], 18 `rem` y == 0] into ghci, the 18 that is an argument to sqrt defaults to a Double and the others to Integers.
However, when you write
factorPairs:: (RealFrac a, Floating a, Integral a) => a -> [(a, a)]
factorPairs n = map(\x -> (x, div n x)) [y | y <- [1..(ceiling $ sqrt n)], n `rem` y == 0]
you force all instances of n to have only one type. Then, the problem becomes that there simply are no default number types (in fact number types in general I think) that satisfy all of these constraints, hence GHC telling you about "possible instances" it tries. The solution is to add fromIntegral and loosen the constraints:
factorPairs:: Integral a => a -> [(a, a)]
factorPairs n = map(\x -> (x, div n x)) [y | y <- [1..(ceiling $ sqrt $ fromIntegral n)], n `rem` y == 0]
Another way to get rid of the type error is to eliminate the use of sqrt. Since Haskell is lazy, you can simply iterate over [1..n], stopping when your divisor is greater than your quotient.
factorPairs :: Integral a => a -> [(a, a)]
factorPairs n = takeWhile (uncurry (>=)) [ (n `div` d, d) | d <- [1..n], n `mod` d == 0]
uncurry (>=) is just a fancy way of writing \(q, d) -> q >= d.
If you write this in monadic form, you can use divMod to get the quotient and the remainder with a single function all.
factorPairs n = takeWhile (uncurry (>=)) $ do
d <- [1..n]
let (q, r) = n `divMod` d
guard $ r == 0
return (q, d)
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.