I'm learning Haskell and I have been practising doing some functions by myself, in this functions are included the calculus of sine using recursion, but I get strange results.
The formula I'm using to calculate the sine is this one:
And my code is this:
--Returns n to power p
pow :: Float->Integer->Float
pow n p =
if p == 0 then
1
else
if p == 1 then
n
else
n * (pow n (p-1))
--Finds a number's factorial
f :: Integer->Integer
f n =
if n == 1 then
n
else
n * (f (n-1))
--TODO: Trigonometric functions ( :v I'll do diz 2)
sinus :: Float->Char->Float
sinus n deg =
if(deg == 'd')then
sinusr 0 (normalize (torad n)) 0
else
sinusr 0 (normalize n) 0
--Get the value equivalent to radians of the presented degrees
torad :: Float->Float
torad v = ( (v * pi) / 180 )
--Recursive to get the value of the entering radians
sinusr :: Integer->Float->Float->Float
sinusr k x result =
if k == 130 then
result + ( ((pow (-1) k ) * ((pow x ((2*k)+1))) / (fromIntegral (f ((2*k)+1)))))
else
result + (sinusr (k+1) x ( ((pow (-1) k ) * ((pow x ((2*k)+1))) / (fromIntegral (f ((2*k)+1))))))
--Subtracts pi/2 the necessary times to get a value minor or equals to pi/2 :v
normalize :: Float->Float
normalize a = a - (fromIntegral (truncate (a / (pi*2)))*(pi*2))
For example, the output it's this:
*Main> sinus 1 'd'
1.7452406e-2
*Main> sinus 1 's'
0.84147096
*Main> sinus 2 's'
NaN
*Main> sinus 2 'd'
3.4899496e-2
Can someone tell me why it is showing me that?
I have worked the same logic with Lisp, and it runs perfectly, I just had to figure out the Haskell syntax, but as you can see, it is not working as it must be.
Beforehand, thank you very much.
Single point arithmetic isn't accurate enough for to calculate a trigonometric function. The exponent doesn't have enough bits for the large, intermediate numbers in sinusr. Or, to be blunt, the following number doesn't fit a Float:
ghci> 2 ^ 130 :: Float
Infinity
As soon as you hit the boundaries of floating point numbers (-Infinity, Infinity) you usually end up with either those or NaN.
Use Double instead. Your implementation of lisp probably uses double point precision floating point numbers too. Even better, don't recalculate the whole fraction in every step, instead update the nominator and denominator, then your values won't get too large for Float.
Related
My factorial function seems to work for numbers between 1 and 6, but not for numbers much bigger than 6, for example starting with 21! the results are negative.
I cannot figure out why. Here's my function:
factorial :: Int -> Int
factorial 0 = 1
factorial 1 = 1
factorial num = num * factorial( num - 1)
And here's my binomial coefficient function that calls my factorial function (maybe the problem comes from this one ?):
binomialCoef :: Int -> Int -> Int
binomialCoef n 1 = n
binomialCoef n k = factorial n `div`
((factorial k) * factorial (n - k))
(…) realized my factorial function returns negative numbers starting at 21!, and I can't figure out why.
Because an Int has a fixed number of bits. An Int should at least represent all numbers between -2-29 and 229-1, and on a 64-bit system, typically it will represent numbers between -2-63 and 263-1, but regardless what bounds it represents, it will eventually run out of bits to represent such number.
You can work with Integer to represent arbitrary large numbers:
factorial :: Integer -> Integer
factorial 0 = 1
factorial 1 = 1
factorial num = num * factorial (num-1)
For example:
Prelude> factorial 21
51090942171709440000
Prelude> factorial 22
1124000727777607680000
The binomial coefficient is where ln(gamma) really shines:
Bi(n, k) = n!/(k!*(n-k)!)
Taking the natural log of both sides:
ln(Bi(n, k)) = ln(n!) - ln(k!) - ln((n-k)!)
But
gamma(n) = (n-1)!
Or
gamma(n+1) = n!
Substituting
ln(Bi(n, k)) = lngamma(n+1) - lngamma(k+1) -lngamma(n-k+1)
Taking the exponential of both sides gives the final result:
Bi(n, k) = exp(lngamma(n+1) - lngamma(k+1) - lngamma(n-k+1))
There's a Haskell implementation. I haven't looked at it, but it should return a Double instead of an Integer. You won't have overflow problems because of that fact. It'll also be better behaved because you will be subtracting logarithms instead of dividing a large numerator by a large product in the denominator.
Of course best way to avoid integer overflow and wrap-around while calculating a big factorial is not to calculate the factorial in the first place. Instead, since
factorial n = product [1..n]
keeping [1..n] as the representation of the factorial of n is as good -- or even much better -- as calculating the actual number. Postponing an action until absolutely unavoidable we get to pre-optimize it before post-calculating:
bincoef :: Int -> Int -> Int
bincoef n k = factorial n `div`
((factorial k) * factorial (n - k))
= product [1 .. n] `div`
(product [1 .. k] * product [1 .. n-k])
= product [n-k+1 .. n] `div`
product [1 .. k]
= foldl' g 1 $ zip [n, n-1 .. n-k+1] [1 .. k]
where g !acc (a,b) = (acc * a) `div` b
So now,
> mapM_ (\n -> print $ map (bincoef n) [5,10..n]) [20,30..60]
[15504,184756,15504,1]
[142506,30045015,155117520,30045015,142506,1]
[658008,847660528,40225345056,137846528820,40225345056,847660528,658008,1]
[2118760,10272278170,2250829575120,47129212243960,126410606437752,47129212243960,
2250829575120,10272278170,2118760,1]
[5461512,75394027566,53194089192720,4191844505805495,51915437974328292,1182645815
64861424,51915437974328292,4191844505805495,53194089192720,75394027566,5461512,1]
> head . filter (not . snd) $ map (\n -> (n, all (> 0) $ map (bincoef n) [1..n])) [1..]
(62,False)
the Int wrap-around error makes its first appearance at n=62. But it's still working at n=60, and we can see there are more than 16 digits in those numbers, so no Double-based calculation has a hope of working correctly, there.
To get into yet higher ranges still with the Int-based operations only, the next logical step is keeping the lists of integers as originally proposed, or better yet as their prime factorizations which are easy to multiply and divide; but at that point we'd be getting pretty close to re-implementing the bignum arithmetic ourselves, so might as well just use the simple Integer-based code,
bc :: Integer -> Integer -> Integer
bc n k = product [n-k+1 .. n] `div` product [1 .. k]
which "just works".
> bc 600 199
124988418115780688528958442419612410733294315465732363826979722360319899409241320138
666379143574138790334901309769571503484430553926248548697640619977793300443439200
I am trying to write a program in Haskell that returns 'e' (Euler's number) to a given decimal place. Here is my code so far:
factorial 0 = 1
factorial n = n * factorial (n - 1)
calculateE a
| a == 0 = 1
| otherwise = nextLevel
where nextLevel = (1 / (factorial a)) + calculateE (a-1)
Whenever I call calculateE I only get back 16 decimal places. Is this a limitation of Haskell/My computer? Is there a way to get back any number of decimal places?
This code already works to arbitrary precision. You just need to use an arbitrary precision type and not the standard Float/Double. Haskell's standard library has Rational for this purpose, which represents rational numbers as pairs of integers.
ghci> calculateE 100 :: Rational
4299778907798767752801199122242037634663518280784714275131782813346597523870956720660008227544949996496057758175050906671347686438130409774741771022426508339 % 1581800261761765299689817607733333906622304546853925787603270574495213559207286705236295999595873191292435557980122436580528562896896000000000000000000000000
The issue now is getting a sequence of digits out of it. I'm not aware of anything in the standard library that does it, so here's a stupid simple (might still be buggy!) implementation:
import Data.List(unfoldr)
import Data.List.NonEmpty(NonEmpty((:|)))
import Data.Ratio
-- first element is integral part (+ sign), rest are positive and < 10 and are digits
-- after the decimal point (for negative numbers, these digits should be seen as having negative value)
longDivision :: Integral a => Ratio a -> NonEmpty a
longDivision x = hi :| unfoldr go (abs lo)
where (hi, lo) = numerator x `quotRem` denominator x
go 0 = Nothing
go lo = Just $ (lo * 10) `quotRem` denominator x
printDigits :: Show a => NonEmpty a -> String
printDigits (x :| xs) = show x ++ "." ++ concatMap show xs
So
ghci> take 100 $ printDigits $ longDivision $ calculateE 100
"2.71828182845904523536028747135266249775724709369995957496696762772407663035354759457138217852516642"
This approximation actually seems to be good to ~160 digits after the decimal point.
I solved the following exercise, but I'm not a fan of the solution:
Write the function isPerfectSquare using recursion, to tell if an
Int is a perfectSquare
isPerfectSquare 1 -> Should return True
isPerfectSquare 3 -> Should return False
the num+1 part is for the case for isPerfectSquare 0 and isPerfectSquare 1, one of the parts I don't like one bit, this is my solutiuon:
perfectSquare 0 1 = [0] ++ perfectSquare 1 3
perfectSquare current diff = [current] ++ perfectSquare (current + diff) (diff + 2)
isPerfectSquare num = any (==num) (take (num+1) (perfectSquare 0 1))
What is a more elegant solution to this problem? of course we can't use sqrt, nor floating point operations.
#luqui you mean like this?
pow n = n*n
perfectSquare pRoot pSquare | pow(pRoot) == pSquare = True
| pow(pRoot)>pSquare = perfectSquare (pRoot-1) pSquare
| otherwise = False
--
isPerfectSquare number = perfectSquare number number
I can't believe I didn't see it xD thanks a lot! I must be really tired
You can perform some sort of "binary search" on some implicit list of squares. There is however a problem of course, and that is that we first need an upper bound. We can use as upper bound the number itself, since for all integral squares, the square is larger than the value we square.
So it could look like:
isPerfectSquare n = search 0 n
where search i k | i > k = False
| j2 > n = search i (j-1)
| j2 < n = search (j+1) k
| otherwise = True
where j = div (i+k) 2
j2 = j * j
To verify that a number n is a perfect square, we thus have an algorithm that runs in O(log n) in case the integer operations are done in constant time (for example if the number of bits is fixed).
Wikipedia suggests using Newton's method. Here's how that would look. We'll start with some boilerplate. ensure is a little combinator I've used fairly frequently. It's written to be very general, but I've included a short comment that should be pretty explanatory for how we'll plan to use it.
import Control.Applicative
import Control.Monad
ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p x = x <$ guard (p x)
-- ensure p x | p x = Just x
-- | otherwise = Nothing
Here's the implementation of the formula given by Wikipedia for taking one step in Newton's method. x is our current guess about the square root, and n is the number we're taking the square root of.
stepApprox :: Integer -> Integer -> Integer
stepApprox x n = (x + n `div` x) `div` 2
Now we can recursively call this stepping function until we get the floor of the square root. Since we're using integer division, the right termination condition is to watch for the next step of the approximation to be equal or one greater to the current step. This is the only recursive function.
iterateStepApprox :: Integer -> Integer -> Integer
iterateStepApprox x n = case x' - x of
0 -> x
1 -> x
_ -> iterateStepApprox x' n
where x' = stepApprox x n
To wrap the whole development up in a nice API, to check if a number is a square we can just check that the floor of its square root squares to it. We also need to pick a starting approximation, but we don't have to be super smart -- Newton's method converges very quickly for square roots. We'll pick half the number (rounded up) as our approximation. To avoid division by zero and other nonsense, we'll make zero and negative numbers special cases.
isqrt :: Integer -> Maybe Integer
isqrt n | n < 0 = Nothing
isqrt 0 = Just 0
isqrt n = ensure (\x -> x*x == n) (iterateStepApprox ((n+1)`div`2) n)
Now we're done! It's pretty fast even for large numbers:
> :set +s
> isqrt (10^10000) == Just (10^5000)
True
(0.58 secs, 182,610,408 bytes)
Yours would spend rather a longer time than the universe has got left computing that. It is also marginally faster than the binary search algorithm in my tests. (Of course, not hand-rolling it yourself is several orders of magnitude faster still, probably in part because it uses a better, but more complicated, algorithm based on Karatsuba multiplication.)
If the function is recursive then it is primitive recursive as are 90% of all recursive functions. For these folds are fast and effective. Considering the programmers time, while keeping things simple and correct is important.
Now, that said, it might be fruitful to cinsider text patterns of functions like sqrt. sqrt return a floating point number. If a number is a perfect square then two characters are ".0" at the end. The pattern might occur, however, at the start of any mantissa. If a string goes in, in reverse, then "0." is at the top of the list.
This function takes a Number and returns a Bool
fps n = (take 2.reverse.show $ (n / (sqrt n))) == "0."
fps 10000.00001
False
fps 10000
True
I am trying to write a function that calculates all odd prime numbers from 1..n using the "Sieve of Sundaram" algorithm.
Here is my try:
sSund :: Integer -> [Integer]
sSund n = [ i * 2 + 1 | i <- [1..n], j <- [f i], (i + j + 2 * i * j) > n ]
where f 1 = 1
f y = y + 1 --use function f because i don't know how insert 1 into j's list
But it gives some wrong numbers like 9,15,21,25, etc.
*Main> sSund 30
[7,9,11,13,15,17,19,21,23,25,27,29,31,33,35,37,39,41,43,45,47,49,51,53,55,57,59,61]
What am I doing wrong?
How it works
Sundaram's seive works by focussing on the odd numbers 2n+1, and excluding those that are the product of numbers.
If two numbers multiply to make an odd number, they must both be odd, so our number 2n+1 = (2i+1)(2j+1). If we multiply that out we get 2n+1 = 4ij + 2i +2j + 1, which we can simplify to 2n=4ij+2i+2j, which again simplifies to n=2ij+i+j. So we don't want n if we can write it as 2ij+i+j. This is true for any numbers i and j, but it's OK to just get rid of the ones where i<=j, because otherwise you're definitely excluding the same number twice.
Fixing your code
In your code, you generate some numbers i + j + 2 * i * j to be excluded, but you in fact just exclude the i instead of the i + j + 2 * i * j. The j<-[f i] just gives you a single j value in a list instead all the numbers from i up to n, which you should write as [i..n].
It's much simpler to just generate the exclusion list first:
sSundDelete :: Integer -> [Integer]
sSundDelete n = [i+j+2*i*j|i<-[1..n], j<-[i..n]]
Here I've decided to just allow i and j to be between 1 and n, because otherwise 2ij+i+j is definitely bigger than n.
Now we can make a list of numbers x which don't include these numbers, and then make them odd with the formula 2*n+1:
sSund :: Integer -> [Integer]
sSund n = let del = sSundDelete n in
2:[2*x+1 | x <- [1..n], not (x `elem` del)]
Which correctly gives you
> sSund 30
[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61]
Speeding things up
It's not as fast as it could be, though, because if you look at
> sSundDelete 10
[4,7,10,13,16,19,22,25,28,31,12,17,22,27,32,37,42,47,52,24,31,38,45,52,59,66,73,40,49,58,67,76,85,94,60,71,82,93,104,115,84,97,110,123,136,112,127,142,157,144,161,178,180,199,220]
it has numbers much bigger than we need - sSund 10 only goes as far as 2*10+1=21. This means we're checking our numbers again and again against numbers that we didn't consider anyway!
The simplest thing to do about this is to rewrite sSundDelete to say
sSundDelete n = [i+j+2*i*j|i<-[1..n], j<-[i..n],i+j+2*i*j<=n]
very much as you did, or
sSundDelete n = filter (<= n) [i+j+2*i*j|i<-[1..n], j<-[i..n]]
Using a bit of maths to speed things up
The problem with these is that they generate too many numbers and then throw them away. It would be faster to generate only the numbers we need.
Actually, I think it's best to calculate how far to go. the smallest j we will ever use is i, so the smallest that 2ij+i+j can be is 2i2+2i. If we don't want that to be over n, we want 2i2+2i<=n, which we can rewrite as 2i(i+1)<=n. Correctness is more important than efficiency, so it's OK to go over n a bit, but it's important not to miss out numbers below n, so we're OK to say 2i2<=n. This can be expressed as i <= floor (sqrt (fromIntegral n / 2)) (floor truncates decimals, so floor 35.7 is 35, and fromIntegral is used here to convert n to a floating point number (allowing non-integers) so we can do division and square roots.
That was a lot of working out, but now we can just calculate once how big i should go:
sSundDelete n = filter (<= n) [i+j+2*i*j|i<-[1..floor (sqrt (fromIntegral n / 2))], j<-[i..n]]
We can do a similar job on j. We want 2ij+i+j<=n, which we can rearrange to say (2i+1)j<=n-i which can be done as j<=floor( (n'-i')/(2*i'+1)) where i'=fromIntegral i and n'=fromIntegral n. This gives us
sSundDelete n = [i+j+2*i*j|let n'=fromIntegral n,
i<-[1..floor (sqrt (n' / 2))],
let i' = fromIntegral i,
j<-[i..floor( (n'-i')/(2*i'+1))]]
This makes it fast enough for me to not give up waiting for sSund 5000 to calculate the second prime number!
While learning for an exam, I've just found the following task in an exercise:
Write a function that gives the integer logarithm to base 2 (rounded up) while only using multiplication and addition.
I tried, immediately, but couldn't come to any solution. I thought that would be an easy task but I could only find a solution when using integer division (e.g. in Haskell):
log2 :: Int -> Int
log2 1 = 0
log2 2 = 1
log2 x = 1 + log2 (x `div` 2)
Is this task possible with multiplication only at all? Using multiplication on the left side (pattern) always results in compiler errors. And using it on the right side, how can I trace the solution back to lower numbers?
And using it on the right side, how can I trace the solution back to lower numbers?
Recursion. Since it's easier to compute the floor, we use the fact that
ceiling (log_2 n) == floor (log_2 (2*n-1))
as can easily be seen. Then to find the logarithm to the base b, we compute the logarithm to base b² and adjust:
log2 :: Int -> Int
log2 1 = 0
log2 2 = 1
log2 n
| n < 1 = error "Argument of logarithm must be positive"
| otherwise = fst $ doLog 2 1
where
m = 2*n-1
doLog base acc
| base*acc > m = (0, acc)
| otherwise = case doLog (base*base) acc of
(e, a) | base*a > m -> (2*e, a)
| otherwise -> (2*e+1,a*base)
A simpler algorithm that needs more steps would be to simply iterate, multiplying with 2 in each step, and count, until the argument value is reached or surpassed:
log2 :: Int -> Int
log2 n
| n < 1 = error "agument of logarithm must be positive"
| otherwise = go 0 1
where
go exponent prod
| prod < n = go (exponent + 1) (2*prod)
| otherwise = exponent
How about:
log2 n = length (takeWhile (<n) (iterate (*2) 1))
?
I assume you can use functions from the Prelude (like error, fst and the comparison operators). If that's not allowed on the exam, you could theoretically use the definitions of length, takeWhile and iterate and end up with something relatively close (in spirit, probably not in the letter!) to Daniel's answer.
Maybe you can use series expansion to approximate the log function. Especially Taylor’s ones.