How do i define a Binary instance for Data.Number.BigFloat?
I've defined an instance for LongDouble by writing:
instance Binary LongDouble where
put d = put (decodeFloat d)
get = do
x <- get
y <- get
return $! encodeFloat x y
However trying the following doesn't work:
instance Binary (BigFloat e) where
put d = put (decodeFloat d )
get = do
x <- get
y <- get
return $! encodeFloat x y
GHC gives this error message:
/home/usr/Documents/src/Lib.hs:27:18: error:
• No instance for (Epsilon e) arising from a use of ‘decodeFloat’
Possible fix:
add (Epsilon e) to the context of the instance declaration
• In the first argument of ‘put’, namely ‘(decodeFloat d)’
In the expression: put (decodeFloat d)
In an equation for ‘put’: put d = put (decodeFloat d)
|
27 | put d = put (decodeFloat d )
| ^^^^^^^^^^^^^
/home/usr/Documents/src/Lib.hs:31:19: error:
• No instance for (Epsilon e) arising from a use of ‘encodeFloat’
Possible fix:
add (Epsilon e) to the context of the instance declaration
• In the second argument of ‘($!)’, namely ‘encodeFloat x y’
In a stmt of a 'do' block: return $! encodeFloat x y
In the expression:
do x <- get
y <- get
return $! encodeFloat x y
|
31 | return $! encodeFloat x y
If I provide a specific type for e, such as Prec500, i get this message :
• Illegal instance declaration for ‘Binary (BigFloat Prec500)’
(All instance types must be of the form (T a1 ... an)
where a1 ... an are *distinct type variables*,
and each type variable appears at most once in the instance head.
Use FlexibleInstances if you want to disable this.)
• In the instance declaration for ‘Binary (BigFloat Prec500)’
And using FlexibleInstances compiles, but doesn't result in correctly encoded numbers.
The following also compiles but doesn't encode correctly either:
instance Epsilon e => Binary (BigFloat e) where
put d = put (decodeFloat d )
get = do
x <- get
y <- get
return $! encodeFloat x y
This BigFloat seems to be not super-well-done. The problem lies here:
> floatDigits (0 :: BigFloat Prec500)
-9223372036854775808
(The correct answer should be 500.) I admit I don't fully understand why that is happening; but from the source, the way floatDigits is computed is by taking the log of the precision -- but log is a thing that happens on Doubles and Double doesn't have enough precision to represent 1e-500. So that method of computing the digit count seems doomed from the start.
Why do I say I don't fully understand? Well, I see the following in the source:
floatDigits (BF m _) =
floor $ logBase base $ recip $ fromRational $ precision m
From my reading, fromRational should produce 0 :: Double. But if that were true, the final value would be 0, not minBound:
> floor $ logBase 10 $ recip $ (0 :: Double) :: Int
0
So perhaps there is some dodgy rewriting going on or something.
Anyway, a proper implementation of this type should work differently -- e.g. by having a more informative class than Epsilon that can report the precision as a base and exponent. (Another possible idea would be to have floatRadix return recip precision and floatDigits return 1, but that has some oddities around what should happen if the precision is not the reciprocal of a whole number.)
Related
I am trying to import a custom module into main using ghci and I am getting this error I don't really understand.
Main.hs
module Main where
import Newton (my_sqrt)
main = my_sqrt 25
Newton.hs
module Newton where
deriv f x = (f(x + dx) - f(x))/dx
where dx = 0.0001
newton f = until satis improve
where satis y = abs(f y) < eps
eps = 0.0001
improve y = y - (f y/deriv f y)
my_sqrt x = newton f x
where f y = y^2 - x
my_cubrt x = newton f x
where f y = y**3 - x
I try to load these into ghci using
:l Main.hs
I get this error
Main.hs:9:8: error:
• No instance for (Fractional (IO t0))
arising from a use of ‘my_sqrt’
• In the expression: my_sqrt 25
In an equation for ‘main’: main = my_sqrt 25
Main.hs:9:16: error:
• No instance for (Num (IO t0)) arising from the literal ‘25’
• In the first argument of ‘my_sqrt’, namely ‘25’
In the expression: my_sqrt 25
In an equation for ‘main’: main = my_sqrt 25
Failed, modules loaded: Newton.
How do I solve this issue?
The type of main is required to be IO ().
The type of sqrt 25 is, apparently, Fractional t => t (it is really advisable to always include type signatures for your top-level entities in the program; you miss those).
To reconcile the two you can define e.g.
main :: IO ()
main = print (sqrt 25)
because the type of print is print :: Show a => a -> IO ().
Im trying to solve this kind of equatin: e^x + sqrt(x) = d, when d is known. It does not have analytic solution so I use variation of binary search to solve it:
helper x = exp x + sqrt x
ex2 c0 c1 x
| abs (h0 - h1) < 10 ^^ (-6) = c0
| hm < x = ex2 m c1 x
| hm >= x = ex2 c0 m x
where h0 = helper c0
h1 = helper c1
m = c0 + (c1 - c0)/2
hm = helper m
This works fine from ghci (c0 and c1 is min and max value for search) but i have problems reading argument x from stdio:
main = do
seed <- getLine
let output = show ex2 0 6 (read seed :: Floating) -- Result is somewhere between helper(0) and helper(6)
in putStrLn output
This breaks my code. It does not compile or load in ghci. I got this error message:
ex2.hs:14:46:
Expecting one more argument to ‘Floating’
Expected a type, but ‘Floating’ has kind ‘* -> Constraint’
In an expression type signature: Floating
In the fourth argument of ‘show’, namely ‘(read seed :: Floating)’
In the expression: show ex2 0 6 (read seed :: Floating)
Can someone explain what it means and how to fix my main function?
There was parentheses missing in let.. line:
Another error: show (ex2 ... (read seed :: Double)) requires parentheses. – chi
I would like to ask question. I am biginner in Hakskell and I have some diffictulties with very simple program, which should tell me if divident % divider == 0.
I have this code:
f::Integer -> Integer -> Bool
f x y = if ((x `mod` y) == 0) then True
else False
main = do putStrLn "Set up dividend"
x <- getLine
putStrLn "Set Up divider"
y <- getLine
f read x::Int read y::Int
but when I want to run it, I've got an error:
Couldn't match expected type `Int' with actual type `m0 b0'
Expected type: m0 a0 -> m0 b0 -> Int
Actual type: m0 a0 -> m0 b0 -> m0 b0
In a stmt of a 'do' block: putStrLn "Set up dividend"
In the expression:
do { putStrLn "Set up dividend";
x <- getLine;
putStrLn "Set Up divider";
y <- getLine;
.... } ::
Int
and I have really no idea, what is wrong. I've also tried f x y (not f read x::Int .....) without any results. I must do something wrong. I know there are many topics about this problem, but nothing helped me. I am missing something.
The problem is in your final line:
f read x::Int read y::Int
This code is basically saying f read x read y, which is of type Int and where f read x is also of type Int. You have to add parentheses so that f is applied properly and that the type annotations are used on the correct terms. You get:
f ((read x) :: Int) ((read y) :: Int)
-- or with fewer parentheses, but meaning the same thing:
f (read x :: Int) (read y :: Int)
Also the if-statement in your definition of f is unnecessary, why not use:
f x y = (x `mod` y) == 0
f read x::Int read y::Int
This applies the function f to the arguments read, x, read and y. It's also saying that the result of f read y should be an Int and that result of the whole thing should be an Int as well. That's obviously not what you want. What you want is to apply f to the results of read x and read y, so you need parentheses around those.
Another problem is that f takes Integers as arguments, but you're telling read to give you Ints. You can fix that by changing Int to Integer or you can remove the type annotations altogether as they can be inferred. You could also change the type of f to accept any type of Integral, so that it works with both Int and Integer.
Lastly the type of main needs to be IO (), but your definition evaluates to a Bool. Maybe you want to print the Bool?
The combination of getLine and read can be simplified to readLine by the way.
So you could do:
main = do putStrLn "Set up dividend"
x <- readLine
putStrLn "Set Up divider"
y <- readLine
print $ f x y
On a first glance you need to use f (read x::Int) (read y::Int) because in your case you are passing functions to you f. I suggest you to take a look at Learn you Haskell for gread good, the input/output chapter in detail. It is one of the best, newbie friendly ressources out there as far as I know.
I have a function with the following type signature
rndListIndex :: Double -> Double -> Double -> Double
rndListIndex maxIdx r1 r2 = …
the first input should be a value coming from a non-negative strictly positive integer
the second and third input are required to be within the closed interval [0.0,1.0] otherwise the function makes no sense
the function has the property of
prop_alwaysLessThanMaxIdx idx r1 r2 = (rndListIndex idx r1 r2 <= idx)
how do I generate random data for maxIdx and r1,r2 separately; I know of the function choosebut do not know how to use it with more than one input variable.
For now I have tested the Property with fixed idx, which is not the way it should be tested.
You have to use the forAll function from QuickCheck. It has the following type:
forAll :: (Show a, Testable prop)
=> Gen a -- ^ The generator to use for generating values
-> (a -> prop) -- ^ A function which returns a testable property
-> Property
forAll takes two arguments:
The generator describes how to generate values. Examples of generators are choose, arbitrary, oneof, ...
The function tests the property for the given input. It must return a value that is an instance of Testable, for example another Property, Bool or a function.
Example of a nested forAll with the choose and elements generators:
-- This generates a Property p for all x's in the closed interval [1,3]
-- The property p in turn generates a property q for all y ∈ [4,5]
-- The property q is True if x < y.
prop_choose = forAll (choose (1,3)) $ \x ->
forAll (elements [4,5]) $ \y -> x < y
For your test property, you can use forAll with choose for the second and third argument.
For the first argument, there is the Positive a type in QuickCheck which can be used to generate arbitrary positive values of type a (It has an Arbitrary instance when a is a Num):
prop_alwayLessThanMaxIdx :: Positive Integer -> Property
prop_alwaysLessThanMaxIdx (Positive idx) =
forAll (choose (0,1)) $ \r1 ->
forAll (choose (0,1)) $ \r2 ->
(rndListIndex idx r1 r2) < idx
I would suggest defining your own type that wraps Double and give it an Arbitrary instance that only generates numbers between 0 and 1. Something like:
import Test.QuickCheck
newtype UnitInterval = Unit Double deriving Show
instance Arbitrary UnitInterval where
arbitrary = fmap Unit (choose (0, 1))
shrink (Unit x) = [ Unit y | y <- shrink x, 0 <= y && y <= 1 ]
For generating idx, you can use QuickCheck's Positive modifier, as #bennoffs suggested (you will have to import Test.QuickCheck.Modifiers). This is similar to the UnitInterval type I defined above, but generates positive numbers instead of numbers between 0 and 1. Your property will then look like:
prop_alwaysLessThanMaxIdx (Positive idx) (Unit r1) (Unit r2) =
rndListIndex idx r1 r2 <= idx
So I'm writing a program which returns a procedure for some given arithmetic problem, so I wanted to instance a couple of functions to Show so that I can print the same expression I evaluate when I test. The trouble is that the given code matches (-) to the first line when it should fall to the second.
{-# OPTIONS_GHC -XFlexibleInstances #-}
instance Show (t -> t-> t) where
show (+) = "plus"
show (-) = "minus"
main = print [(+),(-)]
returns
[plus,plus]
Am I just committing a mortal sin printing functions in the first place or is there some way I can get it to match properly?
edit:I realise I am getting the following warning:
Warning: Pattern match(es) are overlapped
In the definition of `show': show - = ...
I still don't know why it overlaps, or how to stop it.
As sepp2k and MtnViewMark said, you can't pattern match on the value of identifiers, only on constructors and, in some cases, implicit equality checks. So, your instance is binding any argument to the identifier, in the process shadowing the external definition of (+). Unfortunately, this means that what you're trying to do won't and can't ever work.
A typical solution to what you want to accomplish is to define an "arithmetic expression" algebraic data type, with an appropriate show instance. Note that you can make your expression type itself an instance of Num, with numeric literals wrapped in a "Literal" constructor, and operations like (+) returning their arguments combined with a constructor for the operation. Here's a quick, incomplete example:
data Expression a = Literal a
| Sum (Expression a) (Expression a)
| Product (Expression a) (Expression a)
deriving (Eq, Ord, Show)
instance (Num a) => Num (Expression a) where
x + y = Sum x y
x * y = Product x y
fromInteger x = Literal (fromInteger x)
evaluate (Literal x) = x
evaluate (Sum x y) = evaluate x + evaluate y
evaluate (Product x y) = evaluate x * evaluate y
integer :: Integer
integer = (1 + 2) * 3 + 4
expr :: Expression Integer
expr = (1 + 2) * 3 + 4
Trying it out in GHCi:
> integer
13
> evaluate expr
13
> expr
Sum (Product (Sum (Literal 1) (Literal 2)) (Literal 3)) (Literal 4)
Here's a way to think about this. Consider:
answer = 42
magic = 3
specialName :: Int -> String
specialName answer = "the answer to the ultimate question"
specialName magic = "the magic number"
specialName x = "just plain ol' " ++ show x
Can you see why this won't work? answer in the pattern match is a variable, distinct from answer at the outer scope. So instead, you'd have to write this like:
answer = 42
magic = 3
specialName :: Int -> String
specialName x | x == answer = "the answer to the ultimate question"
specialName x | x == magic = "the magic number"
specialName x = "just plain ol' " ++ show x
In fact, this is just what is going on when you write constants in a pattern. That is:
digitName :: Bool -> String
digitName 0 = "zero"
digitName 1 = "one"
digitName _ = "math is hard"
gets converted by the compiler to something equivalent to:
digitName :: Bool -> String
digitName x | x == 0 = "zero"
digitName x | x == 1 = "one"
digitName _ = "math is hard"
Since you want to match against the function bound to (+) rather than just bind anything to the symbol (+), you'd need to write your code as:
instance Show (t -> t-> t) where
show f | f == (+) = "plus"
show f | f == (-) = "minus"
But, this would require that functions were comparable for equality. And that is an undecidable problem in general.
You might counter that you are just asking the run-time system to compare function pointers, but at the language level, the Haskell programmer doesn't have access to pointers. In other words, you can't manipulate references to values in Haskell(*), only values themselves. This is the purity of Haskell, and gains referential transparency.
(*) MVars and other such objects in the IO monad are another matter, but their existence doesn't invalidate the point.
It overlaps because it treats (+) simply as a variable, meaning on the RHS the identifier + will be bound to the function you called show on.
There is no way to pattern match on functions the way you want.
Solved it myself with a mega hack.
instance (Num t) => Show (t -> t-> t) where
show op =
case (op 6 2) of
8 -> "plus"
4 -> "minus"
12 -> "times"
3 -> "divided"