Why does GHCi give incorrect answer below?
GHCi
λ> ((-20.24373193905347)^12)^2 - ((-20.24373193905347)^24)
4.503599627370496e15
Python3
>>> ((-20.24373193905347)**12)**2 - ((-20.24373193905347)**24)
0.0
UPDATE
I would implement Haskell's (^) function as follows.
powerXY :: Double -> Int -> Double
powerXY x 0 = 1
powerXY x y
| y < 0 = powerXY (1/x) (-y)
| otherwise =
let z = powerXY x (y `div` 2)
in if odd y then z*z*x else z*z
main = do
let x = -20.24373193905347
print $ powerXY (powerXY x 12) 2 - powerXY x 24 -- 0
print $ ((x^12)^2) - (x ^ 24) -- 4.503599627370496e15
Although my version doesn't appear any more correct than the one provided below by #WillemVanOnsem, it strangely gives the correct answer for this particular case at least.
Python is similar.
def pw(x, y):
if y < 0:
return pw(1/x, -y)
if y == 0:
return 1
z = pw(x, y//2)
if y % 2 == 1:
return z*z*x
else:
return z*z
# prints 0.0
print(pw(pw(-20.24373193905347, 12), 2) - pw(-20.24373193905347, 24))
Short answer: there is a difference between (^) :: (Num a, Integral b) => a -> b -> a and (**) :: Floating a => a -> a -> a.
The (^) function works only on integral exponents. It will normally make use of an iterative algorithm that will each time check if the power is divisible by two, and divide the power by two (and if non-divisible multiply the result with x). This thus means that for 12, it will perform a total of six multiplications. If a multiplication has a certain rounding-off error, that error can "explode". As we can see in the source code, the (^) function is implemented as:
(^) :: (Num a, Integral b) => a -> b -> a
x0 ^ y0 | y0 < 0 = errorWithoutStackTrace "Negative exponent"
| y0 == 0 = 1
| otherwise = f x0 y0
where -- f : x0 ^ y0 = x ^ y
f x y | even y = f (x * x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x * x) (y `quot` 2) x -- See Note [Half of y - 1]
-- g : x0 ^ y0 = (x ^ y) * z
g x y z | even y = g (x * x) (y `quot` 2) z
| y == 1 = x * z
| otherwise = g (x * x) (y `quot` 2) (x * z) -- See Note [Half of y - 1]
The (**) function is, at least for Floats and Doubles implemented to work on the floating point unit. Indeed, if we take a look at the implementation of (**), we see:
instance Floating Float where
-- …
(**) x y = powerFloat x y
-- …
This thus redirect to the powerFloat# :: Float# -> Float# -> Float# function, which will, normally be linked to the corresponding FPU operation(s) by the compiler.
If we use (**) instead, we obtain zero as well for a 64-bit floating point unit:
Prelude> (a**12)**2 - a**24
0.0
We can for example implement the iterative algorithm in Python:
def pw(x0, y0):
if y0 < 0:
raise Error()
if y0 == 0:
return 1
return f(x0, y0)
def f(x, y):
if (y % 2 == 0):
return f(x*x, y//2)
if y == 1:
return x
return g(x*x, y // 2, x)
def g(x, y, z):
if (y % 2 == 0):
return g(x*x, y//2, z)
if y == 1:
return x*z
return g(x*x, y//2, x*z)
If we then perform the same operation, I get locally:
>>> pw(pw(-20.24373193905347, 12), 2) - pw(-20.24373193905347, 24)
4503599627370496.0
Which is the same value as what we get for (^) in GHCi.
I am trying to reason how to convert an imperative style program into a functional one like Haskell.
The function is:
void calcPerim(point polycake[], int v, int y, double *perim1, double *perim2){
int next = 0;
int index = 0;
point points[2];
*perim1 = 0.0;
*perim2 = 0.0;
for(int i = 0; i < v; i++)
{
next = (i + 1) % v;
if(polycake[i].y < y && polycake[next].y < y)
(*perim1) += distance(polycake[i], polycake[next]);
else if(polycake[i].y > y && polycake[next].y > y)
(*perim2) += distance(polycake[i], polycake[next]);
else
{
points[index] = intersectPoint(polycake[i], polycake[next], y);
if(polycake[i].y < y)
{
(*perim1) += distance(polycake[i], points[index]);
(*perim2) += distance(polycake[next],points[index]);
}
else
{
(*perim2) += distance(polycake[i], points[index]);
(*perim1) += distance(polycake[next],points[index]);
}
index++;
}
}
(*perim1) += distance(points[0], points[1]);
(*perim2) += distance(points[0], points[1]);
}
I am finding it difficult to understand how I can turn this into a functional approach when it is updating two variables at the same time in some cases. Would it make sense when translating this into recursion to pass in a tuple (perim1, perim2)?
It might be a good idea to not translate it straight to Haskell but rather first to C++, which already allows to you structure it in a much more functional way.
First thing, as Cirdec commented, this function doesn't really take perim1 as arguments – those are “output arguments” as Fortran people would say, i.e. they're really results. Also, the v parameter seems to be basically just length of the input array. So in C++ you can reduce it to:
std::pair<double, double> calcPerim(std::vector <point> polycake, int y){
double perim1 = 0, perim2 = 0;
...
return std::make_pair(perim1, perim2);
}
Now, you have this mutating for loop. In a functional language, the general approach would be to replace that with recursion. For this, you need to make all mutable-state variables function parameters. That includes i, index, points and the perim accumulators (so they're back, in a way... but now as input arguments). You don't need next (which is anyways re-computed from scratch in each iteration).
std::pair<double, double> calcPerim_rec
( std::vector<point> polycake, int y
, int i, int index, std::array<point,2> points
, double perim1Acc, double perim2Acc ){
...
}
...to be used by
std::pair<double, double> calcPerim(std::vector<point> polycake, int y){
return calcPerim_rec(polycake, y, 0, 0, {}, 0, 0);
}
The recursive function looks very similar to your original loop body; you just need to phrase the end condition:
std::pair<double, double> calcPerim_rec
( std::vector<point> polycake, int y
, int i, int index, std::array<point,2> points
, double perim1Acc, double perim2Acc ){
if (i < polycake.length()) {
int next = (i + 1) % polycake.length();
if(polycake[i].y < y && polycake[next].y < y)
perim1Acc += distance(polycake[i], polycake[next]);
else if(polycake[i].y > y && polycake[next].y > y)
perim2Acc += distance(polycake[i], polycake[next]);
else
{
points[index] = intersectPoint(polycake[i], polycake[next], y);
if(polycake[i].y < y)
{
perim1Acc += distance(polycake[i], points[index]);
perim2Acc += distance(polycake[next],points[index]);
}
else
{
perim2Acc += distance(polycake[i], points[index]);
perim1Acc += distance(polycake[next],points[index]);
}
++index;
}
++i;
return calcPerim_rec
( polycake, y, i, index, points, perim1Acc, perim2Acc );
} else {
perim1Acc += distance(points[0], points[1]);
perim2Acc += distance(points[0], points[1]);
return std::make_pair(perim1Acc, perim2Acc);
}
}
There's still quite a bit of mutability going on, but we've already encapsulated it to happen all on local variables of the recursion function call, instead of variables lying around during the loop execution. And each of these variables is only updated once, followed by the recursive call, so you can just skip the mutation and simply pass a value plus update to the recursive call:
std::pair<double, double> calcPerim_rec
( std::vector<point> polycake, int y
, int i, int index, std::array<point,2> points
, double perim1Acc, double perim2Acc ){
if (i < polycake.length()) {
int next = (i + 1) % polycake.length();
if(polycake[i].y < y && polycake[next].y < y)
return calcPerim_rec
( polycake, y, i+1, index, points
, perim1Acc + distance(polycake[i], polycake[next])
, perim2Acc
);
else if(polycake[i].y > y && polycake[next].y > y)
return calcPerim_rec
( polycake, y, i+1, index, points
, perim1Acc
, perim2Acc + distance(polycake[i], polycake[next])
);
else
{
points[index] = intersectPoint(polycake[i], polycake[next], y);
if(polycake[i].y < y)
{
return calcPerim_rec
( polycake, y, i+1, index+1
, points
, perim1Acc + distance(polycake[i], points[index])
, perim2Acc + distance(polycake[next],points[index])
);
}
else
{
return calcPerim_rec
( polycake, y, i+1, index+1
, points
, perim1Acc + distance(polycake[i], points[index])
, perim2Acc + distance(polycake[next],points[index])
);
}
}
} else {
return std::make_pair( perim1Acc + distance(points[0], points[1])
, perim2Acc + distance(points[0], points[1]) );
}
}
Well, quite a bit of awkward passing-on of parameters, and we still have a mutation of points – but essentially, the code can now be translated to Haskell.
import Data.Vector (Vector, (!), length) as V
calcPerim_rec :: Vector Point -> Int -> Int -> Int -> Int -> [Point] -> (Double, Double) -> (Double, Double)
calcPerim_rec polycake y i index points (perim1Acc, perim2Acc)
= if i < V.length polycake
then
let next = (i + 1) `mod` V.length polycake
in if yCoord (polycake!i) < y && yCoord (polycake!next) < y
then calcPerim_rec polycake v y (i+1) index points
(perim1Acc + distance (polycake!i) (polycake!next)
perim2Acc
else
if yCoord (polycake!i) > y && yCoord (polycake!next) > y)
then calcPerim_rec polycake v y (i+1) index points
perim1Acc
(perim2Acc + distance (polycake!i) (polycake!next))
else
let points' = points ++ [intersectPoint (polycake!i) (polycake!next) y]
in if yCoord (polycake!i) < y
then calcPerim_rec polycake v y (i+1) (index+1)
points'
(perim1Acc + distance (polycake!i) (points!!index))
(perim2Acc + distance (polycake!next) (points!!index))
else calcPerim_rec polycake v y (i+1) (index+1)
points'
(perim1Acc + distance (polycake!i) points!!index))
(perim2Acc + distance (polycake!next) points!!index))
else ( perim1Acc + distance (points!!0) (points!!1)
, perim2Acc + distance (points!!0) (points!!1) )
There's a lot here that could be stylistically improved, but it should in essence work.
A good first thing to actually make it idiomatic is to try and get rid of indices. Indices are strongly eschewed in Haskell, and can often be avoided when you properly work with lists instead of arrays.
It's rarely a good idea to first write a C version and then try to translate it to Haskell.
Instead, consider what you're trying to do, rather than how you're trying to do it.
It appears that given a series of point representing a polygon
and a horizontal line at height y, you want to divide it into two polygons at line y and return the perimeter of both. The algorithm assumes the polygon is convex on the vertical axis:
You're doing this by:
Dividing the segments into those entirely over and entirely under y
Segments that cross y are split into two parts, the one above and the one below y, indicated by red dots.
Adding the intersection line between the two split points (cyan) to both polygons.
We can just implement that logic directly, rather than trying to emulate the iterative approach. Here's an example:
type Length = Double
type Point = (Double, Double)
type Segment = (Point, Point)
-- Check whether a segment is over, under or on the line given by y
segmentCompare :: Double -> Segment -> Ordering
segmentCompare y (p,q) =
case () of
_ | all (`isUnder` y) [p,q] -> LT
_ | all (`isOver` y) [p,q] -> GT
_ -> EQ
-- Partition a list into (lt, eq, gt) based on f
partition3 :: (Segment -> Ordering) -> [Segment] -> ([Segment], [Segment], [Segment])
partition3 f = p' ([], [], [])
where
p' (lt, eq, gt) (x:xs) =
case f x of
LT -> p' (x:lt, eq, gt) xs
EQ -> p' (lt, x:eq, gt) xs
GT -> p' (lt, eq, x:gt) xs
p' result [] = result
-- Split a crossing segment into an under part and over part, and return middle
divvy :: Double -> Segment -> (Segment, Segment, Point)
divvy y (start, end) =
if start `isUnder` y
then ((start, middle), (middle, end), middle)
else ((middle, end), (start, middle), middle)
where
middle = intersectPoint y (start, end)
-- Split a polygon in two, or Nothing if it's not convex enough
splitPolygon :: Double -> [Point] -> Maybe ([Segment], [Segment])
splitPolygon y list = do
let (under, crossing, over) = partition3 (segmentCompare y) pairs
case crossing of
-- No lines cross. Simple.
[] -> return (under, over)
-- Two segments cross. Divide them up.
[(p1,p2),(q1,q2)] ->
let (u1, o1, mid1) = divvy y (p1,p2)
(u2, o2, mid2) = divvy y (q1, q2)
split = (mid1, mid2) :: Segment
in return (split:u1:u2:under, split:o1:o2:over)
-- More segments cross. Algorithm doesn't work.
rest -> fail "Can't split polygons concave at y"
where
pairs = zip list (drop 1 $ cycle list) :: [Segment]
-- Your original function that sums the perimeter of both polygons
calcPerim :: Double -> [Point] -> Maybe (Length, Length)
calcPerim y list = do
(under, over) <- (splitPolygon y list :: Maybe ([Segment], [Segment]))
return (sumSegments under, sumSegments over)
-- Self explanatory helpers
distance :: Segment -> Length
distance ((ax, ay), (bx, by)) = sqrt $ (bx-ax)^2 + (by-ay)^2
intersectPoint :: Double -> Segment -> Point
intersectPoint y ((px, py), (qx, qy)) =
let slope = (qx-px)/(qy-py)
intercept = qy - slope*qx
x = (y - intercept)/slope
in
if slope /= 0
then (x,y)
else (px, y)
sumSegments :: [Segment] -> Length
sumSegments = sum . map distance
isUnder :: Point -> Double -> Bool
isUnder (_, py) y = py < y
isOver (_, py) y = py > y
You can give this a try, it is a direct translation of your C algorithm to Haskell
data Point = Point {x :: Float, y :: Float}
calcPerim :: [Point] -> Int -> Int -> (Float, Float)
calcPerim ls v some_y =
let (x:xs) = take v ls
r = zip (x:xs) (xs ++ [x])
(u, c, o, _) = foldl someFunction (0, 0, [], fromIntegral some_y :: Float) r
points_0 = last o
points_1 = o !! ((length o) - 2)
answer = (u + (distance points_0 points_1), c + (distance points_0 points_1))
in answer
someFunction :: (Float, Float, [Point], Float) -> (Point, Point) -> (Float, Float, [Point], Float)
someFunction (perim_1, perim_2, points, some_y) (i, nxt)
| y i < some_y && y nxt < some_y = (perim_1 + (distance i nxt), perim_2, points, some_y)
| y i > some_y && y nxt > some_y = (perim_1, perim_2 + (distance i nxt), points, some_y)
| y i < some_y = (perim_1 + (distance i temp_pt), perim_2 + (distance nxt temp_pt), temp_pt:points, some_y)
| otherwise = (perim_1 + (distance nxt temp_pt), perim_2 + (distance i temp_pt), temp_pt:points, some_y)
where temp_pt = intersection i nxt some_y
distance :: Point -> Point -> Float
distance p q = undefined
intersection :: Point -> Point -> Float -> Point
intersection p q f = undefined
I didn't run it. Not sure if I used the right fold.
Let's say I have a function:
isOne :: Int -> Int -> Int
isOne x y =
Then if x == 1 and y != 1 then it returns 1 (one of the parameters equals 1), if x == 1 and y == 1 it returns 2 (because both are 1), if x != 1 and y != 1 it returns 0 etc.
I can't figure out how to do more than a single check with an if statement (or using cases).
Why, you just need to translate your english to Haskell:
if (x==1) && (y /= 1) then 1
else if (x/=1) && (y==1) then 1
...
But you really want:
isOne 1 1 = 2
isOne 1 _ = 1
isOne _ 1 = 1
isOne _ _ = 0
or, even shorter:
isOne x y = fromEnum (x==1) + fromEnum (y==1)
The easiest way to this is with pattern matches. You can define a function by cases, which are interpreted in the order at which they occur
isOne 1 1 = 2
isOne 1 _ = 1
isOne _ 1 = 1
isOne _ _ = 0
alternatively, you can use guards
isOne x y | (x == 1) && (y == 1) = 2
| (x == 1) && (y != 1) = 1
| (x != 1) && (y == 1) = 1
| otherwise = 0
again, these are checked from top to bottom. That is, if the first guard matches then it goes with the first equation, otherwise it tries the second, and so on. This can also be written
isOne x y | (x == 1) && (y == 1) = 2
isOne x y | (x == 1) && (y != 1) = 1
isOne x y | (x != 1) && (y == 1) = 1
isOne x y | otherwise = 0
or
isOne x y | (x == 1) && (y == 1) = 2
isOne x y | (x == 1) || (y == 1) = 1
isOne x y | otherwise = 0
another way of doing it would be to use an if then else expression.
isOne x y = if (x == 1) && (y == 1)
then 2
else if (x == 1) || (y == 1) then 1 else 0
or perhaps you could try doing
isOne x y = (go x) + (go y) where
go 1 = 1
go _ = 0
or any of dozens of other ways...
Method 1
Use paired case statements
isOne x y = case (x, y) of
(1, 1) -> 2
(1, _) -> 1
(0, 0) -> 0
...
Method 2
Use nested if statements
isOne x y = if x == 1 then (if y == 1 then 2 else 1) else 0
I'd second using either direct pattern matching in the function definition, or case on tuples.
But the most readable alternative would IMO be length [ q | q<-[x,y], q==1 ].