{- | This module provides efficient /half-integers/. That is, normal integers and integers plus or minus 1/2. These are sometimes useful for when a value can be an integer, or midway between two integers. -} module Data.HalfInteger ( HalfInteger (), half, halve, double, toHalfInteger, fromHalfInteger, isInteger ) where {- | The type of half-integers. The bounds are determined by the type variable. For example, @HalfInteger Int@ has a range half as large as @Int@ itself. (The @Bounded@ instance correctly reflects this.) Note that @HalfInteger Integer@ is unbounded, like @Integer@ itself. @HalfInteger@ values can be constructed as numeric literals (e.g., @5 :: HalfInteger Int@), by conversions such as @fromInteger@ or @fromIntegral@, or by several functions in this module. Another common pattern is to write (say) @5 + half@ to represent 5 1/2. Indeed, the @Show@ instance represents values in this way. Beware: The half-integers are /not/ closed under multiplication! For example, @half * half@ should yield 1/4, which is not a valid @HalfInteger@. (Currently it yields zero.) Addition and subtraction, however, /are/ closed, and thus yield exact results. -} newtype HalfInteger i = HalfInteger i {- | Represents 1/2 as a @HalfInteger@. You can add this to integral @HalfInteger@ values created in various ways to get the half-part in. -} half :: (Integral i) => HalfInteger i half = HalfInteger 1 {- | Take an integer and halve its value, yielding a @HalfInteger@. This conversion is always exact, and @halve . double == id@. -} halve :: (Integral i) => i -> HalfInteger i halve = HalfInteger {- | Take a @HalfInteger@ and double its value, yielding a normal integer. This conversion is always exact, and @double . halve == id@. -} double :: HalfInteger i -> i double (HalfInteger x) = x instance (Eq i) => Eq (HalfInteger i) where (HalfInteger x) == (HalfInteger y) = x == y instance (Ord i) => Ord (HalfInteger i) where compare (HalfInteger x) (HalfInteger y) = compare x y instance (Bounded i) => Bounded (HalfInteger i) where minBound = HalfInteger minBound maxBound = HalfInteger maxBound instance (Integral i) => Show (HalfInteger i) where showsPrec p (HalfInteger x) = let i = signum x * (abs x `div` 2) s = if x < 0 then "-" else "+" in showParen (p > 6) $ ("fromInteger " ++) . showsPrec 10 i . if odd x then (" " ++ ) . (s ++) . (" half" ++) else id instance (Integral i) => Num (HalfInteger i) where (HalfInteger x) + (HalfInteger y) = HalfInteger (x + y) (HalfInteger x) - (HalfInteger y) = HalfInteger (x - y) (HalfInteger x) * (HalfInteger y) = HalfInteger (x * y `div` 2) negate (HalfInteger x) = HalfInteger ( negate x) abs (HalfInteger x) = HalfInteger ( abs x) signum (HalfInteger x) = HalfInteger (2 * signum x) fromInteger x = HalfInteger (2 * fromInteger x) {- | Convert any number into a @HalfInteger@. The rounding is somewhat unpredictable, but any value exactly representable as a half integer will be converted exactly. -} toHalfInteger :: (RealFrac x, Integral i) => x -> HalfInteger i toHalfInteger x = HalfInteger (round $ 2 * x) {- | Convert a @HalfInteger@ into some other kind of number. This conversion is always exact. -} fromHalfInteger :: (Integral i, Fractional x) => HalfInteger i -> x fromHalfInteger (HalfInteger x) = fromIntegral x / 2 {- | Returns @True@ if this @HalfInteger@ can be exactly represented as an ordinary integer, and @False@ if there is a half offset. -} isInteger :: (Integral i) => HalfInteger i -> Bool isInteger (HalfInteger x) = even x