I implemented W3s recommended algorithm for converting SVG-path arcs from endpoint-arcs to center-arcs and back in Haskell.
type EndpointArc = ( Double, Double, Double, Double
, Bool, Bool, Double, Double, Double )
type CenterArc = ( Double, Double, Double, Double
, Double, Double, Double )
endpointToCenter :: EndpointArc -> CenterArc
centerToEndpoint :: CenterArc -> EndpointArc
See full implementation and test-code here.
But I can't get this property to pass:
import Test.QuickCheck
import Data.AEq ((~==))
instance Arbitrary EndpointArc where
arbitrary = do
((x1,y1),(x2,y2)) <- arbitrary `suchThat` (\(u,v) -> u /= v)
rx <- arbitrary `suchThat` (>0)
ry <- arbitrary `suchThat` (>0)
phi <- choose (0,2*pi)
(fA,fS) <- arbitrary
return $ correctRadiiSize (x1, y1, x2, y2, fA, fS, rx, ry, phi)
prop_conversionRetains :: EndpointArc -> Bool
prop_conversionRetains earc =
let result = centerToEndpoint (endpointToCenter earc)
in earc ~== result
Sometimes this is due to floating point errors (which seem to exceed ieee754) but sometimes there are NaNs in the result.
(NaN,NaN,NaN,NaN,False,False,1.0314334509082723,2.732814841776921,1.2776112657142984)
Which indicates there is no solution although I think I scale rx,ry as described in F.6.6.2 in W3's document.
import Numeric.Matrix
m :: [[Double]] -> Matrix Double
m = fromList
toTuple :: Matrix Double -> (Double, Double)
toTuple = (\[[x],[y]] -> (x,y)) . toList
primed :: Double -> Double -> Double -> Double -> Double
-> (Double, Double)
primed x1 y1 x2 y2 phi = toTuple $
m [[ cos phi, sin phi]
,[-sin phi, cos phi]
]
* m [[(x1 - x2)/2]
,[(y1 - y2)/2]
]
correctRadiiSize :: EndpointArc -> EndpointArc
correctRadiiSize (x1, y1, x2, y2, fA, fS, rx, ry, phi) =
let (x1',y1') = primed x1 y1 x2 y2 phi
lambda = (x1'^2/rx^2) + (y1'^2/ry^2)
(rx',ry') | lambda <= 1 = (rx, ry)
| otherwise = ((sqrt lambda) * rx, (sqrt lambda) * ry)
in (x1, y1, x2, y2, fA, fS, rx', ry', phi)
OK, I figured this out myself. The clue was of course in W3s document:
In the case that the radii are scaled up using equation (F.6.6.3), the radicand of (F.6.5.2) is zero and there is exactly one solution for the center of the ellipse.
F.6.5.2 in my code is
(cx',cy') = (sq * rx * y1' / ry, sq * (-ry) * x1' / rx)
where sq = negateIf (fA == fS) $ sqrt
$ ( rx^2 * ry^2 - rx^2 * y1'^2 - ry^2 * x1'^2 )
/ ( rx^2 * y1'^2 + ry^2 * x1'^2 )
The radicand that it is referring to is
( rx^2 * ry^2 - rx^2 * y1'^2 - ry^2 * x1'^2 )
/ ( rx^2 * y1'^2 + ry^2 * x1'^2 )
But of course, because we are working with floats it's not exactly zero but approximately and sometimes it might be something like -6.99496644301622e-17 which is negative! The square-root of a negative number is a complex number so the calculation returns NaN.
The trick really would be to propagate the fact that rx and ry have been resized to return zero and make sq zero instead of going through the whole calculation unecessarily but the quick fix is just to take the absolute value of the radicand.
(cx',cy') = (sq * rx * y1' / ry, sq * (-ry) * x1' / rx)
where sq = negateIf (fA == fS) $ sqrt $ abs
$ ( rx^2 * ry^2 - rx^2 * y1'^2 - ry^2 * x1'^2 )
/ ( rx^2 * y1'^2 + ry^2 * x1'^2 )
After that there are some remaining floating point issues. Firstly the error exceeds what is allowed for by ieee754's ~== operator so I made my own approxEq
approxEq (x1a, y1a, x2a, y2a, fAa, fSa, rxa, rya, phia) (x1b, y1b, x2b, y2b, fAb, fSb, rxb, ryb, phib) =
abs (x1a - x1b ) < 0.001
&& abs (y1a - y1b ) < 0.001
&& abs (x2a - x2b ) < 0.001
&& abs (y2a - y2b ) < 0.001
&& abs (y2a - y2b ) < 0.001
&& abs (rxa - rxb ) < 0.001
&& abs (rya - ryb ) < 0.001
&& abs (phia - phib) < 0.001
&& fAa == fAb
&& fSa == fSb
prop_conversionRetains :: EndpointArc -> Bool
prop_conversionRetains earc =
let result = centerToEndpoint (trace ("FIRST:" ++ show (endpointToCenter earc)) (endpointToCenter earc))
in earc `approxEq` trace ("SECOND:" ++ show result) result
Which starts bringing cases where fA is getting flipped. Spot the magic number:
FIRST:(-5.988957688551294,-39.5430169665332,64.95929681921707,29.661347617532357,5.939852349879405,-1.2436798376040206,3.141592653589793)
SECOND:(4.209851895761209,-73.01839718538467,-16.18776727286379,-6.067636747681732,False,True,64.95929681921707,29.661347617532357,5.939852349879405)
*** Failed! Falsifiable (after 20 tests):
(4.209851895761204,-73.01839718538467,-16.18776781572145,-6.0676366434916655,True,True,64.95929681921707,29.661347617532357,5.939852349879405)
You got it! fA = abs dtheta > pi is in centerToEndpoint so if it's therabouts then it can go either way.
So I took out the fA condition and increased the number of tests in quickcheck
approxEq (x1a, y1a, x2a, y2a, fAa, fSa, rxa, rya, phia) (x1b, y1b, x2b, y2b, fAb, fSb, rxb, ryb, phib) =
abs (x1a - x1b ) < 0.001
&& abs (y1a - y1b ) < 0.001
&& abs (x2a - x2b ) < 0.001
&& abs (y2a - y2b ) < 0.001
&& abs (y2a - y2b ) < 0.001
&& abs (rxa - rxb ) < 0.001
&& abs (rya - ryb ) < 0.001
&& abs (phia - phib) < 0.001
-- && fAa == fAb
&& fSa == fSb
main = quickCheckWith stdArgs {maxSuccess = 50000} prop_conversionRetains
Which shows that the threshold approxEq is still not lax enough.
approxEq (x1a, y1a, x2a, y2a, fAa, fSa, rxa, rya, phia) (x1b, y1b, x2b, y2b, fAb, fSb, rxb, ryb, phib) =
abs (x1a - x1b ) < 1
&& abs (y1a - y1b ) < 1
&& abs (x2a - x2b ) < 1
&& abs (y2a - y2b ) < 1
&& abs (y2a - y2b ) < 1
&& abs (rxa - rxb ) < 1
&& abs (rya - ryb ) < 1
&& abs (phia - phib) < 1
-- && fAa == fAb
&& fSa == fSb
Which I can finally get to pass reliably with a high number of tests. Well its all just to make some funny graphics anyway... I am sure it's accurate enough :)
Related
as said in the title, for example i have this function that throws an error of course :
bhaskara a b c =
if discriminant >= 0 then (x1,x2) else str_disc
where
discriminant = (b^2 - (4*a*c))
str_disc = "the discriminant is less than zero"
x1 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
x2 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
i heard you could use custom data types so i thought doing something like this but i'm clearly doing something wrong here :
data Result = (Double, Double) | String
bhaskara :: Double -> Double -> Double -> Result
bhaskara a b c =
if discriminant >= 0 then (x1,x2) else str_disc
where
discriminant = (b^2 - (4*a*c))
str_disc = "the discriminant is less than zero"
x1 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
x2 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
could someone show how to approach this?
by the way i know i'm not including the case where the discriminant is equal to zero
data Result = (Double, Double) | String
That's not a valid usage of data. You need to specify data constructors:
data Result = Result (Double, Double) | Error String
However, you don't need a pair in Result:
data Result = Result Double Double | Error String
bhaskara :: Double -> Double -> Double -> Result
bhaskara a b c =
if discriminant >= 0 then Result x1 x2 else Error str_disc
where
discriminant = (b^2 - (4*a*c))
str_disc = "the discriminant is less than zero"
x1 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
x2 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
That being said, Result is more or less Either String (Double, Double) as we can provide an isomorphism. You probably want to reconsider using Either.
If you don't want to use an algebraic datatype (although I'd recommend it), you can also resort to the “built-in error reporting” of the Double datatype. There is a special value which indicates that the the result of a computation is not a number (short: NaN or nan). This is fully supported in Haskell:
nan :: Double
nan = (0/0)
bhaskara :: Double -> Double -> Double -> (Double, Double)
bhaskara a b c =
if discriminant >= 0.0 then (x1,x2) else (nan,nan)
where
discriminant = (b^2 - (4*a*c))
x1 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
x2 = ((-b) - sqrt (b^2 - (4*a*c))) / (2*a)
However, in this case the burden of checking for NaN (using isNaN) goes to the caller whereas with an algebraic datatype such as Either you can just pattern-match.
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.
getFloat :: IO Float
main = do
putStr "Enter question number: "
xs <- getLine
if (xs == 3)
then do
main2
else
main2
main2 =
pricePizza :: Double -> Double -> Double
pricePizza x y = priceBase x + priceTopping x y * 1.6
priceBase x = (3.14 * (x * 0.5) * x) * 0.001
priceTopping x y = ((3.14 * (x * 0.5) * x) * 0.0002) * y
Why doesn't this work?
You can't have a line like:
main2 =
on its own. It's a syntax error.
If you want to have keep some partially defined functions that you are still working on, you can use undefined:
main2 = undefined
or else put in some dummy code:
main2 =
Once that is fixed, you have two more problems:
You have a type for getFloat, but no definition. If you plan to define it later then you can give it an undefined value, otherwise you should remove it.
The type of xs is String so you can't compare it to 3, which is and Int. You can just use a string literal instead.
I think this is what you were trying to do, and compiles:
main :: IO ()
main = do
putStr "Enter question number: "
xs <- getLine
if (xs == "3")
then do
main2
else
main2
main2 = putStrLn "main 2"
pricePizza :: Double -> Double -> Double
pricePizza x y = priceBase x + priceTopping x y * 1.6
priceBase x = (3.14 * (x * 0.5) * x) * 0.001
priceTopping x y = ((3.14 * (x * 0.5) * x) * 0.0002) * y
I'm reading the Learn you some Haskell for the Greater Good book, as I was playing around with recursion in Haskell I implemented the fibonacci function, the recursive version is simple, probably can be improved:
-- recursive fibonacci numbers
rfib :: Int -> Int
rfib 0 = 0
rfib 1 = 1
rfib n = rfib (n-1) + rfib(n-2)
As I was googling to learn more I stumbled upon this article:
http://java.dzone.com/articles/what-fibonacci-taught-me-about
The author shows the fibonacci formula:
I decided to implement it in Haskell using rational numbers to avoid floating point imprecisions. My implementation looks like this:
fibMultiplier = (toRational 1) / (toRational (sqrt 5))
firstFibTerm n = (((toRational 1) + (toRational (sqrt 5))) / toRational 2) ^ n
secondFibTerm n = (((toRational 1) - (toRational (sqrt 5))) / toRational 2) ^ n
fib :: Int -> Int
fib n = truncate (fromRational (fibMultiplier * firstFibTerm n) - (fibMultiplier * secondFibTerm n))
As a beginner I am sure that the code above can be drastically improved, can you point me what can be improved or some mistakes I've made?
I apreciate the help.
UPDATE
So, after playing around with the suggestions, I found that using Data.Real.Constructible is fast and precise, with no rounding errors. My final implementation is:
fib :: Int -> Construct
fib n = ( ( (1 / (sqrt 5)) * ( (( 1 + (sqrt 5) ) / 2) ^ n ) ) -
( (1 / (sqrt 5)) * ( (( 1 - (sqrt 5) ) / 2) ^ n ) ) )::Construct
I also implemented a function that returns a list of the n fibonacci numbers:
fibList :: Int -> [Construct]
fibList n = [fib(x) | x <- [0..n]]
Using this function we can compare the results of the different implementations:
-- recursive fibonacci numbers
rfib :: Int -> Int
rfib 0 = 0
rfib 1 = 1
rfib n = rfib (n-1) + rfib(n-2)
-- recursive fibonacci sequence
rfibList :: Int -> [Int]
rfibList n = [rfib(x) | x <- [0..n]]
-- rfibList 20 returns: [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765]
-----------------------------------
-- fibonacci number using Double and truncate
doubleFib :: Integer -> Integer
doubleFib n = truncate ( ( (1 / (sqrt 5)) * ( (( 1 + (sqrt 5) ) / 2) ^ n ) ) -
( (1 / (sqrt 5)) * ( (( 1 - (sqrt 5) ) / 2) ^ n ) ) )
-- fibonacci list using Double and truncate
doubleFibList :: Integer -> [Integer]
doubleFibList n = [doubleFib(x) | x <- [0..n]]
-- doubleFibList 20 returns: [0,1,0,2,3,5,8,13,21,34,55,89,143,232,377,610,986,1597,2584,4181,6764]
-----------------------------------
-- fibonacci number using Construct
constructFib :: Int -> Construct
constructFib n = ( ( (1 / (sqrt 5)) * ( (( 1 + (sqrt 5) ) / 2) ^ n ) ) -
( (1 / (sqrt 5)) * ( (( 1 - (sqrt 5) ) / 2) ^ n ) ) )::Construct
-- fibonacci list using construct
constructFibList :: Int -> [Construct]
constructFibList n = [constructFib(x) | x <- [0..n]]
-- constructFibList 20 returns: [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765]
Notice that we get a rounding error on the doubleFibList, the 16th number should be 987 but we get 986. The recursive implementation is slow, the Double implementation is imprecise, but using Construct we can get a fast and precise fibonacci sequence, much better than my old implementation using toRational.
(You can't use your sqrt version, use Data.Real.Constructible instead)
import Data.Real.Constructible
fib :: Int -> Construct
fib n = (((1+sqrt(5))/2)^n - ((1-sqrt(5))/2)^n)/sqrt(5)
I have a unit right triangle and a value at each of the 3 vertices.
I need to interpolate to find the value at a point inside the triangle.
Hours of searching have turned up nothing that actually tells me how to do this.
Here is my closest attempt, which is actually pretty close but not quite right -
result =
v1 * (1 - x) * (1 - y) +
v2 * x * (1 - y) +
v3 * x * y;
v1, v2, and v3 are the values at the 3 vertices of the triangle.
(x, y) is the point in the triangle that you are trying to find the value of.
Any kind of method would help me here. It doesn't necessarily need to be a unit/right triangle.
Updated info:
I have a grid of evenly spaced points and a value at each point.
I make a triangle out of the nearest 3 points on the grid.
Here is a picture to illustrate it -
So I have to interpolate between 5, 3, and 7 to find the value of x.
The point could also be inside the other triangle, meaning you would interpolate between 5, 7, and the value of the bottom left corner of the square.
In the code I showed, v1 = 5, v2 = 3, v3 = 7.
x is the fractional distance (range [0-1]) in the "x" direction, and y is the fractional distance in the "y" direction.
In the picture's example, x would probably be about 0.75 and y would be about 0.2
Here are my closest attempts -
Created using -
if (x > y) //if x > y then the point is in the upper right triangle
return
v1 * (1 - x) * (1 - y) +
v2 * x * (1 - y) +
v3 * x * y;
else //bottom left triangle
return
v1 * (1 - x) * (1 - y) +
v4 * (1 - x) * y +
v3 * x * y;
And another attempt -
Created using -
if (x > y)
return
(1 - x) * v1 + (x - y) * v2 + y * v3;
else
return
(1 - y) * v1 + (y - x) * v4 + x * v3;
They're both close to what I need but obviously not quite right.
You should use barycentric coordinates. There is a very thorough write-up here that also discusses alternative solutions and why barycentric coordinates are best: CodePlea - Interpolating in a Triangle
Basically, the weights will end up looking like this:
Actually the simplest and most robust solution is based on barycentric coordinates -
http://answers.unity3d.com/questions/383804/calculate-uv-coordinates-of-3d-point-on-plane-of-m.html
I asked this 3 years ago and have still been working on a way to do this. I do believe it is impossible to do it without artifacts unless using an equilateral triangle.
Here is a decent way to do it using barycentric coordinates and then adding a technique that gets rid of most of the artifacts.
v1, v2, v3 are the values at the three points of the triangle. x, y is the point you want to find a value for.
if (x > y)
{
b1 = -(x - 1);
b2 = (x - 1) - (y - 1);
b3 = 1 - b1 - b2;
}
else
{
b1 = -(y - 1);
b2 = -((x - 1) - (y - 1));
b3 = 1 - b1 - b2;
}
float
abs = x - y;
if (abs < 0) abs *= -1;
if (abs < 0.25f)
{
abs = 0.25f - abs;
abs *= abs;
b1 -= abs;
b3 -= abs;
}
b1 *= b1;
b2 *= b2;
b3 *= b3;
float fd = 1 / (b1 + b2 + b3);
b1 *= fd;
b2 *= fd;
b3 *= fd;
return
v1 * b1 +
v2 * b2 +
v3 * b3;
Ok, so we will do a linear interpolation, assuming that the gradient is constant with respect to x and to y. d/dx = v2 - v1 and d/dy = v3 - v2, and f(0,0) = v1. We have a simple two dimensional differential equation.
d{f(x,y)} = (v2 - v1)*dx
f(x,y) = (v2 - v1)*x + g(y)
d{f(x,y)} = g'(y) = (v3 - v2)*dy
g(y) = (v3 - v2)*y + C
f(x,y) = (v2 - v1)*x + (v3 - v2)*y + C
f(0,0) = v1 = (v2 - v1)*0 + (v3 - v2)*0 + C = C
f(x,y) = (v2 - v1)*x + (v3 - v2)*y + v1
or in terms of v1 v2 and v3
f(x,y) = (1 - x)*v1 + (x - y)*v2 + y*v3
If you want to do it in a square for four vertices, as above with v4 in the bottom left at x=0 y=1, here are the conditions: d/dx = (v2 - v1) (1 - y) + (v3 - v4) y, d/dy = (v3 - v2) x + (v4 - v1) (1 - x), f(0,0) = v1
d/dx = (v2 - v1) (1 - y) + (v3 - v4) y
f(x,y) = (v2 - v1) (1 - y) x + (v3 - v4) y x + g(y)
d/dy = (v3 - v2) x + (v4 - v1) (1 - x) = -(v2 - v1) x + (v3 - v4) x + g'(y)
v3 - v2 + (v4 - v1) / x + v4 - v1 = -v2 + v1 + v3 - v4 + g'(y) / x
(v4 - v1) / x + 2*(v4 - v1) = g'(y) / x
g'(y) = (v4 - v1) + 2 x (v4 - v1)
g(y) = (v4 - v1) (1 + 2 x) y + C
f(x,y) = (v2 - v1) (1 - y) x + (v3 - v4) y x + (v4 - v1) (1 + 2 x) y + C
f(0,0) = (v2 - v1) (1 - 0) 0 + (v3 - v4) 0 0 + (v4 - v1) (1 + 2 0) 0 + C = v1
f(x,y) = (v2 - v1) (1 - y) x + (v3 - v4) y x + (v4 - v1) (1 + 2 x) y + v1
Here is some pseudocode for nearest-neighbor:
if( dist( p, p1 ) <= dist( p, p2 ) && dist( p, p1 ) <= dist( p, p3 ) )
return val( p1 )
if( dist( p, p2 ) <= dist( p, p3 ) && dist( p, p2 ) <= dist( p, p1 ) )
return val( p2 )
if( dist( p, p3 ) <= dist( p, p1 ) && dist( p, p3 ) <= dist( p, p2 ) )
return val( p3 )
I think this also generates a voronoi diagram