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.
During last three days I have been trying to solve Project Euler 15 in Haskell.
Here is my current state:
import Data.Map as Map
data Coord = Coord Int Int deriving (Show, Ord, Eq)
corner :: Coord -> Bool
corner (Coord x y) = (x == 0) && (y == 0)
side :: Coord -> Bool
side (Coord x y) = (x == 0) || (y == 0)
move_right :: Coord -> Coord
move_right (Coord x y) = Coord (x - 1) y
move_down :: Coord -> Coord
move_down (Coord x y) = Coord x (y - 1)
calculation :: Coord -> Integer
calculation coord
| corner coord = 0
| side coord = 1
| otherwise = (calculation (move_right coord)) + (calculation (move_down coord))
problem_15 :: Int -> Integer
problem_15 size =
calculation (Coord size size)
It works fine but it is very slow if the 'n' is getting bigger.
As I know I can use the dynamic programming and the hashtable (Data.Map, for example) to cache calculated values.
I was trying to use memoization, but don't have a success. I was trying to use Data.Map, but each next error was more scary then previous. So I ask your help: how to cache values which was already calculated ?
I know about mathematical solution of this problem (Pascal triangle), but I am interested in the algorithmic solution.
Instead of a Map, this problem is better suited for an two-dimensional array cache, since we have a bounded range for input values.
import Control.Applicative
import Data.Array
data Coord = Coord Int Int deriving (Show, Ord, Eq, Ix)
calculation :: Coord -> Integer
calculation coord#(Coord maxX maxY) = cache ! coord where
cache = listArray bounds $ map calculate coords
calculate coord
| corner coord = 0
| side coord = 1
| otherwise = cache ! move_right coord + cache ! move_down coord
zero = Coord 0 0
bounds = (zero, coord)
coords = Coord <$> [0..maxX] <*> [0..maxY]
We add deriving Ix to Coord so we can use it directly as an array index and in calculation, we initialize a two-dimensional array cache with the lower bound of Coord 0 0 and upper bound of coord. Then instead of recursively calling calculation we just refer to the values in the cache.
Now we can calculate even large values relatively quickly.
*Main> problem_15 1000
2048151626989489714335162502980825044396424887981397033820382637671748186202083755828932994182610206201464766319998023692415481798004524792018047549769261578563012896634320647148511523952516512277685886115395462561479073786684641544445336176137700738556738145896300713065104559595144798887462063687185145518285511731662762536637730846829322553890497438594814317550307837964443708100851637248274627914170166198837648408435414308177859470377465651884755146807496946749238030331018187232980096685674585602525499101181135253534658887941966653674904511306110096311906270342502293155911108976733963991149120
Since you already know the correct (efficient) solution, I'm not spoiling anything for you:
You can use an array (very appropriate here, since the domain is a rectangle)
import Data.Array
pathCounts :: Int -> Int -> Array (Int,Int) Integer
pathCounts height width = solution
where
solution =
array ((0,0),(height-1,width-1)) [((i,j), count i j) | i <- [0 .. height-1]
, j <- [0 .. width-1]]
count 0 j = 1 -- at the top, we can only come from the left
count i 0 = 1 -- on the left edge, we can only come from above
count i j = solution ! (i-1,j) + solution ! (i,j-1)
Or you can use the State monad (the previously calculated values are the state, stored in a Map):
import qualified Data.Map as Map
import Control.Monad.State.Strict
type Path = State (Map Coord Integer)
calculation :: Coord -> Path Integer
calculation coord = do
mb_count <- gets (Map.lookup coord)
case mb_count of
Just count -> return count
Nothing
| corner coord -> modify (Map.insert coord 0) >> return 0 -- should be 1, IMO
| side coord -> modify (Map.insert coord 1) >> return 1
| otherwise -> do
above <- calculation (move_down coord)
left <- calculation (move_right coord)
let count = above + left
modify (Map.insert coord count)
return count
and run that with
evalState (calculation target) Map.empty
Or you can use one of the memoisation packages on hackage, off the top of my head I remember data-memocombinators, but there are more, possibly some even better. (And there are still more possible ways of course.)