[Haskell-cafe] Re: Implementation of scaled integers
Stefan Heinzmann
stefan_heinzmann at yahoo.com
Thu Feb 15 07:26:26 EST 2007
Stefan Heinzmann wrote:
> is there a library for Haskell that implements scaled integers, i.e.
> integers with a fixed scale factor so that the scale factor does not
> need to be stored, but is part of the type?
>
> In particular it would be useful (i.e. for signal processing) to have
> numbers based on Int scaled such that they fall into the range [-1.0 ..
> 1.0). Or other scale factors which are powers of 2. Addition and
> subtraction would then map to the ordinary operations for Int, while
> Multiplication and Division would have to apply the scale factor to
> correct the result of normal Int operations (which would be a shift
> operation).
I'm answering myself, as I've come up with a naïve and probably
embarrassing first try, which I'm presenting here below so that I can
improve my (so far very limited) Haskell skills.
Division isn't efficient yet, I just wanted some solution to allow
trying it out.
I'm sure this can be improved a lot, either in style or in efficiency.
So please comment.
Cheers
Stefan
---------------------------------------------------------------------
module ShiftedInt (Int0B31) where
import Data.Int
import Data.Bits
import Data.Ratio
data Int0B31 = Int0b31 Int32
instance Show Int0B31 where
show (Int0b31 a) = show ((fromIntegral a) * sfD)
instance Fractional Int0B31 where
fromRational a =
Int0b31(fromInteger(quot((numerator a)*sfI) (denominator a)))
(/) (Int0b31 a) (Int0b31 b) =
fromRational ((fromIntegral a) % (fromIntegral b))
instance Num Int0B31 where
negate (Int0b31 a) = Int0b31 (negate a)
abs (Int0b31 a) = Int0b31 (abs a)
signum (Int0b31 a) = Int0b31 (signum a)
fromInteger a = Int0b31 (fromInteger a)
(+) a b = a + b
(*) (Int0b31 a) (Int0b31 b) =
Int0b31 (mul64 (fromIntegral a) (fromIntegral b))
instance Ord Int0B31 where
(<=) (Int0b31 a) (Int0b31 b) = a <= b
instance Eq Int0B31 where
(==) (Int0b31 a) (Int0b31 b) = a == b
mul64 :: Int64 -> Int64 -> Int32
mul64 a b = fromIntegral ((a * b) `shift` shiftamount)
sfD = 2.0 ^^ shiftamount
sfI = 2 ^ (-shiftamount)
shiftamount = -31
---------------------------------------------------------------------
More information about the Haskell-Cafe
mailing list