Haskell numerical integration via Trapezoidal rule results in wrong sign - haskell

I've written some code that's meant to integrate a function numerically using the trapezoidal rule. It works, but the answer it produces has a wrong sign. Why might that be?
The code is:
integration :: (Double -> Double) -> Double -> Double -> Double
integration f a b = h * (f a + f b + partial_sum)
where
h = (b - a) / 1000
most_parts = map f (points (1000-1) h)
partial_sum = sum most_parts
points :: Double -> Double -> [Double]
points x1 x2
| x1 <= 0 = []
| otherwise = (x1*x2) : points (x1-1) x2
Trapezoidal rule
The code is probably inelegant, but I'm only a student of Haskell and would like to deal with the current problem first and coding style matters after that.

Note: This answer is written in literate Haskell. Save it with .lhs as extension and load it in GHCi to test the solution.
Finding the culprit
First of all, let's take a look at integration. In its current form, it contains only summation of function values f x. Even though the factors aren't correct at the moment, the overall approach is fine: you evaluate f at the grid points. However, we can use the following function to verify that there's something wrong:
ghci> integration (\x -> if x >= 10 then 1 else (-1)) 10 15
-4.985
Wait a second. x isn't even negative in [10,15]. This suggests that you use the wrong grid points.
Grid points revisited
Even though you've linked the article, let's have a look at an exemplary use of the trapezoidal rule (public domain, original file by Oleg Alexandrov):
Although this doesn't use a uniform grid, let's suppose that the 6 grid points are equidistant with grid distance h = (b - a) / 5. What are the x coordinates of those points?
x_0 = a + 0 * h (== a)
x_1 = a + 1 * h
x_2 = a + 2 * h
x_3 = a + 3 * h
x_4 = a + 4 * h
x_5 = a + 5 * h (== b)
If we use set a = 10 and b = 15 (and therefore h = 1), we should end up with [10, 11, 12, 13, 14, 15]. Let's check your points. In this case, you would use points 5 1 and end up with [5,4,3,2,1].
And there's the error. points doesn't respect the boundary. We can easily fix this by using pointsWithOffset:
> points :: Double -> Double -> [Double]
> points x1 x2
> | x1 <= 0 = []
> | otherwise = (x1*x2) : points (x1-1) x2
>
> pointsWithOffset :: Double -> Double -> Double -> [Double]
> pointsWithOffset x1 x2 offset = map (+offset) (points x1 x2)
That way, we can still use your current points definition to generate grid points from x1 to 0 (almost). If we use integration with pointsWithOffset, we end up with
integration :: (Double -> Double) -> Double -> Double -> Double
integration f a b = h * (f a + f b + partial_sum)
where
h = (b - a) / 1000
most_parts = map f (pointsWithOffset (1000-1) h a)
partial_sum = sum most_parts
Tying up loose ends
However, this doesn't take into account that you use all inner points twice in the trapezoid rule. If we add the factors, we end up with
> integration :: (Double -> Double) -> Double -> Double -> Double
> integration f a b =
> h / 2 * (f a + f b + 2 * partial_sum)
> -- ^^^ ^^^
> where
> h = (b - a) / 1000
> most_parts = map f (pointsWithOffset (1000-1) h a)
> partial_sum = sum most_parts
Which yields the correct value for our test function above.
Exercise
Your current version only supports 1000 grid points. Add an Int argument so that one can change the number of grid points:
integration :: Int -> (Double -> Double) -> Double -> Double -> Double
integration n f a b = -- ...
Furthermore, try to write points in different ways, for example go from a to b, use takeWhile and iterate, or even a list comprehension.

Yes it indeed was the points plus you had some factors wrong (the inner points are multiplied by 2) - this is the fixed version of your code:
integration :: (Double -> Double) -> Double -> Double -> Double
integration f a b = h * (f a + f b + innerSum) / 2
where
h = (b - a) / 1000
innerPts = map ((2*) . f . (a+)) (points (1000-1) h)
innerSum = sum innerPts
points :: Double -> Double -> [Double]
points i x
| i <= 0 = []
| otherwise = (i*x) : points (i-1) x
which gives sensible approximations (to 1000 points):
λ> integration (const 2) 1 2
2.0
λ> integration id 1 2
1.5
λ> integration (\x -> x*x) 1 2
2.3333334999999975
λ> 7/3
2.3333333333333335

Related

How to create a function that generates an infinite list of an integer-sequence that is defined recursively with two initial numbers X_0 and X_1

Let's say I have the recursive definition for the following sequence of integers: a_0 = 5, a_n = 2a_0+3 -> 5,13,29,61,125...
I want to use the iterate function in Haskell to generate an infinite list of this sequence. To do that I could write the following code:
intSequence :: Integer -> Integer -> [Integer]
intSequence a0 m = iterate nextNum a0
where nextNum a = 2*a + m
ghci> let an = intSequence 5 3
ghci> take 5 a
[5,13,29,61,125]
Now let's say I instead have the following:
X_n = X_n-1 * m_1 + X_n-2 * m_2 + a
Now I want to create a function called in the following way:
intSequence x0 x1 m1 m2 a
that returns an infinite list of a sequence that adheres to the rules of the definition above.
For example: For parameters X0=1, X1=2, m1=2, m2=0, a=0 we get Xn=X_n-1 * 2 + X_n-2 * 0 + 0 = X_n-1 * 2 which gives us [1,2,4,8,16,...]
Another example: For parameters X0=0, X1=1, m1=1, m2=1, a=0 we get the Fibonacci-sequence X_n = X_n-1 * 1 + X_n-2 * 1 + 0 = X_n-1 + X_n-2 which gives us [0,1,1,2,3,5,8,...]
How can I implement this intSequence function using iterate?
I tried the following which does not work as intended:
intSequence :: Integer -> Integer -> Integer -> Integer -> Integer -> [Integer]
intSequence x0 x1 m1 m2 a = x0:x1:iterate (nextNum x0) x1
where
nextNum x0' x1' = x1'*m1 + x0'*m2 + a
ghci> a = intSequence 0 1 1 1 0
ghci> take 10 a
[0,1,1,1,1,1,1,1,1,1]
Which obviously is incorrect and logically so as I never change what x0 and x1 are. I think I need to use recursion somehow but I just can't figure out how. Should I maybe not use iterate at all?
This is much easier to do with recursion:
-- helper function for recursion
intSequence' :: (Integral a) => (a, a) -> a -> a -> a -> [a]
-- p2 is X_n-2 and p1 is X_n-1
intSequence' (p2, p1) m1 m2 a =
-- recurse using X_n-1 as new X_n-2 and current term as new X_n-1
cur:intSequence' (p1, cur) m1 m2 a
-- calculate the current term in the sequence
where cur = p1 * m1 + p2 * m2 + a
-- set previous terms correctly and prepend them to the sequence
intSequence :: (Integral a) => a -> a -> a -> a -> a -> [a]
intSequence x0 x1 m1 m2 a = x0:x1:intSequence' (x0, x1) m1 m2 a

Coordinates for clockwise outwards spiral

I'm trying to make what I think is called an Ulam spiral using Haskell.
It needs to go outwards in a clockwise rotation:
6 - 7 - 8 - 9
| |
5 0 - 1 10
| | |
4 - 3 - 2 11
|
..15- 14- 13- 12
For each step I'm trying to create coordinates, the function would be given a number and return spiral coordinates to the length of input number eg:
mkSpiral 9
> [(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
(-1, 1) - (0, 1) - (1, 1)
|
(-1, 0) (0, 0) - (1, 0)
| |
(-1,-1) - (0,-1) - (1,-1)
I've seen Looping in a spiral solution, but this goes counter-clockwise and it's inputs need to the size of the matrix.
I also found this code which does what I need but it seems to go counterclock-wise, stepping up rather than stepping right then clockwise :(
type Spiral = Int
type Coordinate = (Int, Int)
-- number of squares on each side of the spiral
sideSquares :: Spiral -> Int
sideSquares sp = (sp * 2) - 1
-- the coordinates for all squares in the given spiral
coordinatesForSpiral :: Spiral -> [Coordinate]
coordinatesForSpiral 1 = [(0, 0)]
coordinatesForSpiral sp = [(0, 0)] ++ right ++ top ++ left ++ bottom
where fixed = sp - 1
sides = sideSquares sp - 1
right = [(x, y) | x <- [fixed], y <- take sides [-1*(fixed-1)..]]
top = [(x, y) | x <- reverse (take sides [-1*fixed..]), y <- [fixed]]
left = [(x, y) | x <- [-1*fixed], y <- reverse(take sides [-1*fixed..])]
bottom = [(x, y) | x <- take sides [-1*fixed+1..], y <- [-1*fixed]]
-- an endless list of coordinates (the complete spiral)
mkSpiral :: Int -> [Coordinate]
mkSpiral x = take x endlessSpiral
endlessSpiral :: [Coordinate]
endlessSpiral = endlessSpiral' 1
endlessSpiral' start = coordinatesForSpiral start ++ endlessSpiral' (start + 1)
After much experimentation I can't seem to change the rotation or starting step direction, could someone point me in the right way or a solution that doesn't use list comprehension as I find them tricky to decode?
Let us first take a look at how the directions of a spiral are looking:
R D L L U U R R R D D D L L L L U U U U ....
We can split this in sequences like:
n times n+1 times
_^_ __^__
/ \ / \
R … R D … D L L … L U U … U
\_ _/ \__ __/
v v
n times n+1 times
We can repeat that, each time incrementing n by two, like:
data Dir = R | D | L | U
spiralSeq :: Int -> [Dir]
spiralSeq n = rn R ++ rn D ++ rn1 L ++ rn1 U
where rn = replicate n
rn1 = replicate (n + 1)
spiral :: [Dir]
spiral = concatMap spiralSeq [1, 3..]
Now we can use Dir here to calculate the next coordinate, like:
move :: (Int, Int) -> Dir -> (Int, Int)
move (x, y) = go
where go R = (x+1, y)
go D = (x, y-1)
go L = (x-1, y)
go U = (x, y+1)
We can use scanl :: (a -> b -> a) -> a -> [b] -> [a] to generate the points, like:
spiralPos :: [(Int, Int)]
spiralPos = scanl move (0,0) spiral
This will yield an infinite list of coordinates for the clockwise spiral. We can use take :: Int -> [a] -> [a] to take the first k items:
Prelude> take 9 spiralPos
[(0,0),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1),(0,1),(1,1)]
The idea with the following solution is that instead of trying to generate the coordinates directly, we’ll look at the directions from one point to the next. If you do that, you’ll notice that starting from the first point, we go 1× right, 1× down, 2× left, 2× up, 3× right, 3× down, 4× left… These can then be seperated into the direction and the number of times repeated:
direction: > v < ^ > v < …
# reps: 1 1 2 2 3 3 4 …
And this actually gives us two really straightforward patterns! The directions just rotate > to v to < to ^ to >, while the # of reps goes up by 1 every 2 times. Once we’ve made two infinite lists with these patterns, they can be combined together to get an overall list of directions >v<<^^>>>vvv<<<<…, which can then be iterated over to get the coordinate values.
Now, I’ve always thought that just giving someone a bunch of code as the solution is not the best way to learn, so I would highly encourage you to try implementing the above idea yourself before looking at my solution below.
Welcome back (if you did try to implement it yourself). Now: onto my own solution. First I define a Stream data type for an infinite stream:
data Stream a = Stream a (Stream a) deriving (Show)
Strictly speaking, I don’t need streams for this; Haskell’s predefined lists are perfectly adequate for this task. But I happen to like streams, and they make some of the pattern matching a bit easier (because I don’t have to deal with the empty list).
Next, I define a type for directions, as well as a function specifying how they interact with points:
-- Note: I can’t use plain Left and Right
-- since they conflict with constructors
-- of the ‘Either’ data type
data Dir = LeftDir | RightDir | Up | Down deriving (Show)
type Point = (Int, Int)
move :: Dir -> Point -> Point
move LeftDir (x,y) = (x-1,y)
move RightDir (x,y) = (x+1, y)
move Up (x,y) = (x,y+1)
move Down (x,y) = (x,y-1)
Now I go on to the problem itself. I’ll define two streams — one for the directions, and one for the number of repetitions of each direction:
dirStream :: Stream Dir
dirStream = Stream RightDir $ Stream Down $ Stream LeftDir $ Stream Up dirVals
numRepsStream :: Stream Int
numRepsStream = go 1
where
go n = Stream n $ Stream n $ go (n+1)
At this point we’ll need a function for replicating each element of a stream a specific number of times:
replicateS :: Stream Int -> Stream a -> Stream a
replicateS (Stream n ns) (Stream a as) = conss (replicate n a) $ replicateS ns as
where
-- add more than one element to the beginning of a stream
conss :: [a] -> Stream a -> Stream a
conss [] s = s
conss (x:xs) s = Stream x $ appends xs s
This gives replicateS dirStream numRepsStream for the stream of directions. Now we just need a function to convert those directions to coordinates, and we’ve solved the problem:
integrate :: Stream Dir -> Stream Point
integrate = go (0,0)
where
go p (Stream d ds) = Stream p (go (move d p) ds)
spiral :: Stream Point
spiral = integrate $ replicateS numRepsStream dirStream
Unfortunately, it’s somewhat inconvenient to print an infinite stream, so the following function is useful for debugging and printing purposes:
takeS :: Int -> Stream a -> [a]
takeS 0 _ = []; takeS n (Stream x xs) = x : (takeS (n-1) xs)

Function type mismatch

I have a function with function type :
newtonRootSequence' :: Double -> Double -> [Double]
and function definition:
newtonRootSequence' xn d = [(xn + (d * (1/xn))) div 2] ++ newtonRootSequence' ((xn + (d * (1/xn))) div 2) d
upon receiving two values xn and d it should calculate the results for the given function
[(xn + (d * (1/xn))) div 2]
But for some reason on launch the compilator is not accepting the function with an error:
Couldnt match expected type '(Integer->Integer->Integer->) ->Integer
->Double with actual type double the function (xn + (d * (1/xn))) div 2) is applied to two arguments
This error occurs to the part where I try to send the result of the equation into the recursive step
++ newtonRootSequence' ((xn + (d * (1/xn))) div 2) d
As already mentioned in the comments:
if you want to use div as an infix function, you have to enclose it in backticks
div is for integral division with truncation towards negative infinity, not for dividing Double
These two points are the cause for your error message.
To divide Doubles, use the / operator like you already did in your expression 1/xn.
With this your code should work. For clarity it could be transformed:
Extract the duplicated expression to compute the next xn in the sequence into a where clause. The expression can also be slightly simplified. Adding a single element in front of a list can simply be done with the cons operator (:):
newtonRootSequence' xn d = xn' : newtonRootSequence' xn' d
where xn' = (xn + (d / xn)) / 2
You could use iterate :: (a -> a) -> a -> [a] from the Prelude to separate the computation for a single step from the generation of the list of intermediate steps (note the flipped arguments):
sequenceStep :: Double -> Double -> Double
sequenceStep s xn = (xn + (s / xn)) / 2
newtonRootSequence' :: Double -> Double -> [Double]
newtonRootSequence' s x0 = iterate (sequenceStep s) x0

Assigning special cases when certain variables have certain values?

for my functional programming homework I am instructed to write a function that gives back the real solutions of a quadratic equation in a list, I used the discriminant to find them out.
So, my code looks something like this:
quadSols::Double->Double->Double->[Double]
quadSols a b c = [x1,x2]
where
x1 = (-b - sqrt d) / (2 * a)
x2 = (-b + sqrt d) / (2 * a)
d = (b * b) - 4 * a * c
Now, the problem is in the case a = 0, for which the solution would be simply x = -c / b.
I tried something like this, it sounds completely wrong but I don't really know what to do.
if a == 0 then quadSols a b c = [x]
and then added to the "where" part:
x = -c / b
when trying to load it with ghci I get:
parse error on input ‘=’
Failed, modules loaded: none.
Can anyone provide me with some guidance?
You can simply pattern match for the case where a == 0:
quadSols :: Double -> Double-> Double-> [Double]
quadSols 0 b c = [x]
where x = -c / b
quadSols a b c = [x1,x2]
where
x1 = (-b - sqrt d) / (2 * a)
x2 = (-b + sqrt d) / (2 * a)
d = (b * b) - 4 * a * c
Note that you must include the first case before the second, since cases are matched in the order they are declared.
You can add another equation to quadSols:
quadSols 0 b c = [x]
where
x = (-c) / b
quadSols a b c = [x1,x2]
where
…
Or use a guard:
quadSols a b c
| a == 0 = [x]
| otherwise = [x1,x2]
where
x = (-c) / b
…
Due to laziness, the definitions in the where clause won’t be evaluated unless necessary to produce a result.

Is it possible to generalise equations in Haskell?

Apologies for my poor wording of the question. I've tried searching for an answer but not knowing what to search is making it very difficult to find one.
Here is a simple function which calculates the area of a triangle.
triangleArea :: Float -> Float -> Float -> Float
triangleArea a b c
| (a + b) <= c = error "Not a triangle!"
| (a + c) <= b = error "Not a triangle!"
| (b + c) <= a = error "Not a triangle!"
| otherwise = sqrt (s * (s - a) * (s - b) * (s - c))
where s = (a + b + c) / 2
Three lines of the function have been taken up for the purposes of error checking. I was wondering if these three lines could be condensed into one generic line.
I was wondering if something similar to the following would be possible
(arg1 + arg2) == arg3
where Haskell knows to check each possible combination of the three arguments.
I think #behzad.nouri's comment is the best. Sometimes doing a little math is the best way to program. Here's a somewhat overdone expansion on #melpomene's solution, which I thought would be fun to share. Let's write a function similar to permutations but that computes combinations:
import Control.Arrow (first, second)
-- choose n xs returns a list of tuples, the first component of each having
-- n elements and the second component having the rest, in all combinations
-- (ignoring order within the lists). N.B. this would be faster if implemented
-- using a DList.
choose :: Int -> [a] -> [([a],[a])]
choose 0 xs = [([], xs)]
choose _ [] = []
choose n (x:xs) =
map (first (x:)) (choose (n-1) xs) ++
map (second (x:)) (choose n xs)
So..
ghci> choose 2 [1,2,3]
[([1,2],[3]),([1,3],[2]),([2,3],[1])]
Now you can write
triangleArea a b c
| or [ x + y <= z | ([x,y], [z]) <- choose 2 [a,b,c] ] = error ...
This doesn't address the question of how to shorten your error checking code, but you may be able to limit how often you repeat it by defining some new types with invariants. This function needs error checking because you can't trust the user to supply Float triples that make a reasonable triangle, and if you continue to define functions this way then every triangle-related function you write would need similar error checks.
However, if you define a Triangle type, you can check your invariants only once, when a triangle is created, and then all other functions will be guaranteed to receive valid triangles:
module Triangle (Triangle(), mkTriangle, area) where
data Triangle a = Triangle a a a deriving Show
mkTriangle :: (Num a, Ord a) => a -> a -> a -> Either String (Triangle a)
mkTriangle a b c
| a + b <= c = wrong
| a + c <= b = wrong
| b + c <= a = wrong
| otherwise = Right $ Triangle a b c
where wrong = Left "Not a triangle!"
area :: Floating a => Triangle a -> a
area (Triangle a b c) = sqrt (s * (s - a) * (s - b) * (s - c))
where s = (a + b + c) / 2
Here we export the Triangle type, but not its constructor, so that the client must use mkTriangle instead, which can do the required error checking. Then area, and any other triangle functions you write, can omit the checks that they are receiving a valid triangle. This general pattern is called "smart constructors".
Here are two ideas.
Using existing tools, you can generate all the permutations of the arguments and check that they all satisfy a condition. Thus:
import Data.List
triangleArea a b c
| any (\[x, y, z] -> x + y <= z) (permutations [a,b,c])
= error "Not a triangle!"
| otherwise = {- ... -}
This doesn't require writing very much additional code; however, it will search some permutations you don't care about.
Use the usual trick for choosing an element from a list and the left-overs. The zippers function is one I use frequently:
zippers :: [a] -> [([a], a, [a])]
zippers = go [] where
go b [] = []
go b (v:e) = (b, v, e) : go (v:b) e
We can use it to build a function which chooses only appropriate triples of elements:
triples :: [a] -> [(a, a, a)]
triples xs = do
(b1, v1, e1) <- zippers xs
(b2, v2, e2) <- zippers e1
v3 <- b1 ++ b2 ++ e2
return (v1, v2, v3)
Now we can write our guard like in part (1), but it will only consider unique pairings for the addition.
triangleArea a b c
| any (\(x, y, z) -> x + y <= z) (triples [a,b,c])
= error "Not a triangle!"
| otherwise = {- ... -}

Resources