Converting Haskell Polymorphic Cosine function to F# - haskell

I'm trying to convert some Haskell code to F# but I'm having some trouble since Haskell is lazy by default and F# is not. I'm also still learning my way around F#. Below is a polymorphic cosine function in Haskell with pretty good performance. I want to try and keep the same or better performance parameters in F#. I would like to see a F# List version and a F# Seq version since the Seq version would be more like the lazy Haskell but the List version would probably perform better. Thanks for any help.
Efficiency: number of arithmetic operations used proportional to number of terms in series
Space: uses constant space, independent of number of terms
takeThemTwoByTwo xs =
takeWhile (not . null) [take 2 ys | ys <- iterate (drop 2) xs]
products xss = [product xs | xs <- xss]
pairDifferences xs =
[foldr (-) 0 adjacentPair | adjacentPair <- takeThemTwoByTwo xs]
harmonics x = [x/(fromIntegral k) | k <- [1 ..]]
cosineTerms = scanl (*) 1 . products . takeThemTwoByTwo . harmonics
cosine = foldl (+) 0 . pairDifferences .
take numberOfTerms . cosineTerms

Here is my attempt in case you're lazy to read:
let harmonics x =
Seq.initInfinite(fun i -> - x*x/(float ((2*i+1)*(2*i+2))))
let cosineTerms = Seq.scan (*) 1.0 << harmonics
let cosine numberOfTerms = Seq.sum << Seq.take numberOfTerms << cosineTerms
I have a hard time finding out that you're calculating cosine in radian using Taylor series:
cosine(x) = 1 - x2/2! + x4/4! - x6/6! +
...
Let me describe what you're doing:
Create an infinite sequence of x/k where k is an integer starting from 1.
Split above sequence into chunks of two and scan by multiplying with a seed of 1 to have a sequence of x2/((2k-1)*(2k)) (with an exception of 1 at the beginning).
Split the new sequence into blocks of two again to have differences in the form of x4k-4/((4k-4)!) - x4k-2/((4k-2)!) and sum all of them to get final result.
Because it's likely to be inefficient to split sequences in F# and takeThemTwoByTwo function is not essential, I chose another approach:
Create an infinite sequence of - x2/((2k-1)*(2k)) where k is an integer starting from 1.
Scan the sequence by multiplying with a seed of 1; we get a sequence of (-1)k * x2k/((2k)!).
Sum all elements to obtain final result.
Above program is a direct translation of my description, succinct and simple. Computing cosine with numberOfTerms = 200000 iterations takes 0.15 seconds on my machine; I suppose it is efficient enough for your purpose.
Furthermore, a List version should be easy to translate from this one.
UPDATE:
Ok, my fault was to underestimate the polymorphism part of the question. I focused more on the performance part. Here is a polymorphic version (keeping closely to the float version):
let inline cosine n (x: ^a) =
let one: ^a = LanguagePrimitives.GenericOne
Seq.initInfinite(fun i -> LanguagePrimitives.DivideByInt (- x*x) ((2*i+1)*(2*i+2)))
|> Seq.scan (*) one
|> Seq.take n
|> Seq.sum
Seq.initInfinite is less powerful than Seq.unfold in #kvb 's answer. I keep it to make things simple because n is in int range anyway.

Pad's answer is good, but not polymorphic. In general, it's significantly less common to create such definitions in F# than in Haskell (and a bit of a pain). Here's one approach:
module NumericLiteralG =
let inline FromZero() = LanguagePrimitives.GenericZero
let inline FromOne() = LanguagePrimitives.GenericOne
module ConstrainedOps =
let inline (~-) (x:^a) : ^a = -x
let inline (+) (x:^a) (y:^a) : ^a = x + y
let inline (*) (x:^a) (y:^a) : ^a = x * y
let inline (/) (x:^a) (y:^a) : ^a = x / y
open ConstrainedOps
let inline cosine n x =
let two = 1G + 1G
Seq.unfold (fun (twoIp1, t) -> Some(t, (twoIp1+two, -t*x*x/(twoIp1*(twoIp1+1G))))) (1G,1G)
|> Seq.take n
|> Seq.sum

As Pad wrote, this appears to be the Taylor series expansion of cos(x) about x=0:
cosine(x) = 1 - x²/2! + x⁴/4! - x⁶/6! + ...
So your question is an XY question: you presented a solution rather than posing the problem. Presenting the problem instead makes it much easier to solve it differently.
Let's start by writing a float-specific version in F#:
let cosine n x =
let rec loop i q t c =
if i=n then c else
loop (i + 1) (q + 10 + 8*i) (-t * x * x / float q) (c + t)
loop 0 2 1.0 0.0
For example, we can compute 1M terms of the expansion of x=0.1:
cosine 1000000 0.1
The best way to make this polymorphic in F# is to parameterize the function over the operators it uses and mark it as inline in order to remove the performance overhead of this parameterization:
let inline cosine zero one ofInt ( ~-. ) ( +. ) ( *. ) ( /. ) n x =
let rec loop i q t c =
if i=n then c else
loop (i + 1) (q + 10 + 8*i) (-.t *. x *. x /. ofInt q) (c +. t)
loop 0 2 one zero
Now we can compute 1M terms using float like this, which is just as fast as before:
cosine 0.0 1.0 float ( ~- ) (+) (*) (/) 1000000 0.1
But we can also do single-precision float:
cosine 0.0f 1.0f float32 ( ~- ) (+) (*) (/) 1000000 0.1f
And arbitrary-precision rational:
cosine 0N 1N BigNum.FromInt (~-) (+) (*) (/) 10 (1N / 10N)
And even symbolic:
type Expr =
| Int of int
| Var of string
| Add of Expr * Expr
| Mul of Expr * Expr
| Pow of Expr * Expr
static member (~-) f = Mul(Int -1, f)
static member (+) (f, g) = Add(f, g)
static member (*) (f, g) = Mul(f, g)
static member (/) (f, g) = Mul(f, Pow(g, Int -1))
cosine (Int 0) (Int 1) Int (~-) (+) (*) (/) 3 (Var "x")
To make it faster, hoist the common subexpression -x*x out of loop.

Related

How to tell if a number is a square number with recursion?

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

Unresolved top level overloading

Task is to find all two-valued numbers representable as the sum of the sqrt's of two natural numbers.
I try this:
func = [sqrt (x) + sqrt (y) | x <- [10..99], y <- [10..99], sqrt (x) `mod` 1 == 0, sqrt (y) `mod` 1 == 0]
Result:
Unresolved top-level overloading Binding : func
Outstanding context : (Integral b, Floating b)
How can I fix this?
This happens because of a conflict between these two types:
sqrt :: Floating a => a -> a
mod :: Integral a => a -> a -> a
Because you write mod (sqrt x) 1, and sqrt is constrained to return the same type as it takes, the compiler is left trying to find a type for x that simultaneously satisfies the Floating constraint of sqrt and the Integral constraint of mod. There are no types in the base library that satisfy both constraints.
A quick fix is to use mod' :: Real a => a -> a -> a:
import Data.Fixed
func = [sqrt (x) + sqrt (y) | x <- [10..99], y <- [10..99], sqrt (x) `mod'` 1 == 0, sqrt (y) `mod'` 1 == 0]
However, from the error you posted, it looks like you may not be using GHC, and mod' is probably a GHC-ism. In that case you could copy the definition (and the definition of the helper function div') from here.
But I recommend a more involved fix. The key observation is that if x = sqrt y, then x*x = y, so we can avoid calling sqrt at all. Instead of iterating over numbers and checking if they have a clean sqrt, we can iterate over square roots; their squares will definitely have clean square roots. A straightforward application of this refactoring might look like this:
sqrts = takeWhile (\n -> n*n <= 99)
. dropWhile (\n -> n*n < 10)
$ [0..]
func = [x + y | x <- sqrts, y <- sqrts]
Of course, func is a terrible name (it's not even a function!), and sqrts is a constant we could compute ourselves, and is so short we should probably just inline it. So we might then simplify to:
numberSums = [x + y | x <- [4..9], y <- [4..9]]
At this point, I would be wondering whether I really wanted to write this at all, preferring just
numberSums = [8..18]
which, unlike the previous iteration, doesn't have any duplicates. It has lost all of the explanatory power of why this is an interesting constant, though, so you would definitely want a comment.
-- sums of pairs of numbers, each of whose squares lies in the range [10..99]
numberSums = [8..18]
This would be my final version.
Also, although the above definitions were not parameterized by the range to search for perfect squares in, all the proposed refactorings can be applied when that is a parameter; I leave this as a good exercise for the reader to check that they have understood each change.

ruby while loop translated to haskell

I've just started learning a bit of Haskell and functional programming, but I find it very difficult getting a hang of it :)
I am trying to translate a small piece of ruby code to Haskell (because I like the concept functional programming and Haskell proposes and even more because I come from a mathematics field and Haskell seems very mathematical):
class Integer
def factorial
f = 1; for i in 1..self; f *= i; end; f
end
end
boundary = 1000
m = 0
# Brown Numbers - pair of integers (m,n) where n factorial is equal with square root of m
while m <= boundary
n = 0
while n <= boundary
puts "(#{m},#{n})" if ((n.factorial + 1) == (m ** 2))
n += 1
end
m += 1
end
I could only figure out how to do factorials:
let factorial n = product [1..n]
I cannot figure out how to do the while loops or equivalent in Haskell, even though I found some examples that were far to confusing for me.
The idea is that the loops start from 0 (or 1) and continue (with an increment of 1) until it reaches a boundary (in my code is 1000). The reason there is a boundary is because I was thinking of starting parallel tasks that do the same operation but on different intervals so the results that I expect are returned faster (one operation would be done on 1 to 10000, another on 10000 to 100000, etc.).
I would really appreciate it if anyone could help out with this :)
Try this:
let results = [(x,y) | x <- [1..1000], y <- [1..1000] ,1 + fac x == y*y]
where fac n = product [1..n]
This is a list comprehension. More on that here.
To map it to your Ruby code,
The nested loops in m and n are replaced with x and y. Basically there is iteration over the values of x and y in the specified ranges (1 to 1000 inclusive in this case).
The check at the end is your filter condition for getting Brown numbers.
where allows us to create a helper function to calculate the factorial.
Note that instead of a separate function, we could have computed the factorial in place, like so:
(1 + product[1..x]) == y * y
Ultimately, the (x,y) on the left side means that it returns a list of tuples (x,y) which are your Brown numbers.
OK, this should work in your .hs file:
results :: [(Integer, Integer)] --Use instead of `Int` to fix overflow issue
results = [(x,y) | x <- [1..1000], y <- [1..1000] , fac x == y*y]
where fac n = product [1..n]
To add to shree.pat18's answer, maybe an exercise you could try is to translate the Haskell solution back into Ruby. It should be possible, because Ruby has ranges, Enumerator::Lazy and Enumerable#flat_map. The following rewritten Haskell solution should perhaps help:
import Data.List (concatMap)
results :: [(Integer, Integer)]
results = concatMap (\x -> concatMap (\y -> test x y) [1..1000]) [1..1000]
where test x y = if fac x == y*y then [(x,y)] else []
fac n = product [1..n]
Note that Haskell concatMap is more or less the same as Ruby Enumerable#flat_map.

Infinite lazy lists of digits

So I'm trying to do some number theory work, and I was using Mathematica but thought that Haskell would be more suited to dealing with infinite lists (as AFAIK Mathematica doesn't have lazy evaluation). What I want to do is have Haskell store all the digits of 1/x in an infinite lazy list. So far my searching has not turned up a way to split a ratio into its digits that returns a list of digits rather than an actual floating point number.
We can also implement this as a simple stream producer:
divDigits :: Int -> Int -> [Int]
divDigits x y = x `div` y : divDigits (10 * (x `mod` y)) y
There are actually libraries for this kind of "infinite"-precision number representation using lazy lists, see Haskell Wiki.
Big thanks to Sam Yonnou, the link he provided had the right formula
The formula used:
the nth digit of x/y is the 1st digit of (10^(n-1)*x mod y)/y = floor(10 * (10^(n-1)*x mod y) / y) mod 10
The ending code looked like this:
nDigRat :: Int -> Int -> Int -> Int
nDigRat num denom n = floor (fromIntegral (10*(10^(n-1)*num `rem` denom)) /
fromIntegral denom)
`rem` 10
decExpansionRecipRat :: Int -> [Int]
decExpansionRecipRat n = map (nDigRat 1 n) [1..]

Logarithm in functional language with addition and multiplication only

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.

Resources