Commit b6d12102 authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Implement true rationals

Rationals were already supported, but their input syntax was the same as for
reals: Decimal fixed point notation. This is now fixed and the functor X^-
allows weights to be written as either integers or ratios of integers, separated
by a slash.
parent 0911db00
......@@ -3,11 +3,11 @@
{B1, B2, B345, B6}x(Q^X)
# elements of the same block are numbered from top to bottom
b6_1: (B6 , { b3_2: 1.0 })
b6_2: (B6 , { b4: 1.0 })
b3_1: (B345, { b1: 1.0 })
b3_2: (B345, { b1: 1.0 })
b4: (B345, { b2: 0.5, b5: 0.5 })
b5: (B345, { b5: 1.0 })
b1: (B1 , { b1: 1.0 })
b2: (B2 , { b2: 1.0 })
b6_1: (B6 , { b3_2: 1 })
b6_2: (B6 , { b4: 1 })
b3_1: (B345, { b1: 1 })
b3_2: (B345, { b1: 1 })
b4: (B345, { b2: 1/2, b5: 1/2 })
b5: (B345, { b5: 1 })
b1: (B1 , { b1: 1 })
b2: (B2 , { b2: 1 })
......@@ -22,6 +22,7 @@ module Copar.Functors.GroupValued
import Control.Monad (when)
import Data.Complex
import Control.DeepSeq (NFData)
import Data.Ratio
import Data.Vector (Vector)
import qualified Data.Vector as V
......@@ -86,7 +87,7 @@ realHelp =
<> Doc.annotate Doc.bold "Coalgebra syntax:"
<+> Doc.reflow "'{' X ':' real, ... '}'"
rationalValued :: FunctorDescription (GroupValued Rational)
rationalValued :: FunctorDescription (GroupValued (Ratio Int))
rationalValued = FunctorDescription
{ name = "Rational-valued"
, syntaxExample = "Q^X | ℚ^X"
......@@ -162,8 +163,8 @@ instance IsGroupF3 OrderedComplex where
f3ToSub (OrderedComplexGroupF3 _ x) = x
mkGroupF3 = OrderedComplexGroupF3
instance IsGroupF3 Rational where
data GroupF3 Rational = RationalGroupF3 {-# UNPACK #-} !Rational {-# UNPACK #-} !Rational
instance IsGroupF3 (Ratio Int) where
data GroupF3 (Ratio Int) = RationalGroupF3 {-# UNPACK #-} !(Ratio Int) {-# UNPACK #-} !(Ratio Int)
f3ToCompound (RationalGroupF3 x _) = x
f3ToSub (RationalGroupF3 _ x) = x
mkGroupF3 = RationalGroupF3
......@@ -234,9 +235,9 @@ instance ParseMorphism (GroupValued OrderedComplex) where
parseMorphismPointHelper inner (OrderedComplex <$> L.complex L.adouble)
=<< (not <$> noSanityChecks)
instance ParseMorphism (GroupValued Rational) where
instance ParseMorphism (GroupValued (Ratio Int)) where
parseMorphismPoint (GroupValued inner) =
parseMorphismPointHelper inner (toRational <$> (L.signed L.float))
parseMorphismPointHelper inner (L.signed (L.fraction L.decimal))
=<< (not <$> noSanityChecks)
instance (IsGroupF3 m, Ord m, Num m) => RefinementInterface (GroupValued m) where
......
......@@ -24,6 +24,7 @@ module Copar.Parser.Lexer
, adouble
, complex
, hex
, fraction
) where
import Data.Char
......@@ -32,6 +33,7 @@ import Data.Complex
import Control.Applicative
import Data.Maybe (fromMaybe)
import Data.Tuple (swap)
import Data.Ratio
import Data.Text (Text)
import qualified Data.Text as T
......@@ -184,6 +186,14 @@ complex inner =
sumOf p1 p2 = (,) <$> signed p1 <*> optionalNum (mandatorySigned p2)
{-# INLINE complex #-}
-- | Parse a fraction consisting of either a single integral number or a
-- numerator and divisor separated by @/@
fraction :: (MonadParser m, Integral a) => m a -> m (Ratio a)
fraction inner = (%) <$> inner <*> denom
where
denom = ((symbol "/" *> notZero) <|> pure 1)
notZero = inner >>= \x -> if x == 0 then fail "division by zero" else pure x
{-# INLINE fraction #-}
-- | Parse a hexadecimal number consisting of the prefix "0x" followed by
-- hexadecimal digits (both upper and lower case).
......
......@@ -4,6 +4,7 @@ import Test.Hspec
import Test.Hspec.Megaparsec
import Data.Complex
import Data.Ratio
import Text.Megaparsec
......@@ -14,6 +15,7 @@ spec = do
spaceSpec
complexSpec
hexSpec
fractionSpec
spaceSpec :: Spec
spaceSpec = describe "whitespace" $ do
......@@ -144,4 +146,20 @@ hexSpec = describe "hex" $ do
p "0xdeadBEEF" `shouldParse` (0xdeadbeef :: Word)
it "required the 0x prefix" $
p `shouldFailOn` "deadbeef"
p `shouldFailOn` "deadbeef"
fractionSpec :: Spec
fractionSpec = describe "fraction" $ do
let p = parse (L.fraction L.decimal <* eof) ""
it "parses simple decimals" $ do
p "0" `shouldParse` (0 :: Ratio Int)
p "1" `shouldParse` (1 :: Ratio Int)
it "parses actual fractions" $ do
p "1 / 2" `shouldParse` (1%2 :: Ratio Int)
p "3/5" `shouldParse` (3%5 :: Ratio Int)
it "refuses to parse division by zero" $
p `shouldFailOn` "2 / 0"
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment