Merge branch 'ratio-syntax'

examples/valmari-fig3-rational

@@ -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 })

src/Copar/Functors/GroupValued.hs

@@ -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"
@@ -105,8 +106,8 @@ rationalHelp =
   <> Doc.annotate Doc.bold "Coalgebra syntax:"
   <+> Doc.reflow "'{' X ':' rational, ... '}'"
   <> Doc.line
-  <> Doc.reflow "  Note that rationals currently have the same syntax as reals \
-                \and proper fractions are not supported."
+  <> Doc.reflow "where 'rational' is either an integer or of the form a/b, \
+                \where a and b are integers."
 
 newtype OrderedComplex = OrderedComplex (Complex EqDouble)
   deriving (Eq, Num, NFData, Show)
@@ -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

src/Copar/Parser/Lexer.hs

@@ -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).

tests/Copar/Functors/GroupValuedSpec.hs

@@ -5,6 +5,7 @@ import           Test.Hspec.Megaparsec
 import           TestHelpers
 
 import           Data.Complex
+import           Data.Ratio
 
 import           Copar.Functors.GroupValued
 import           Copar.Coalgebra.Parser
@@ -18,6 +19,7 @@ spec = do
   parseMorphismPointIntSpec
   parseMorphismPointDoubleSpec
   parseMorphismPointComplexSpec
+  parseMorphismPointRationalSpec
 
 
 parseMorphismPointIntSpec :: Spec
@@ -97,3 +99,20 @@ parseMorphismPointComplexSpec = describe "parseMorphismPoint (Complex)" $ do
     [(0, Sorted 1 (c (-2.3) 0), 0)]
 
   where c a b = OrderedComplex (a :+ b)
+
+parseMorphismPointRationalSpec :: Spec
+parseMorphismPointRationalSpec = describe "parseMorphismPoint (Rational)" $ do
+  let p = fmap snd . parseMorphisms
+        (Functor 1 (GroupValued @(Ratio Int) Variable))
+        EnableSanityChecks
+        ""
+
+  it "parses a simple example"
+    $ p "x: {x: 1/5, y: 3/7}\ny: {}"
+    `shouldParse` encoding [(Sorted 1 (22%35)), (Sorted 1 0)]
+                           [(0, (Sorted 1 (1%5)), 0), (0, (Sorted 1 (3%7)), 1)]
+
+  it "parses negative values"
+    $ p "x: {x: -1/5, y: -3/7}\ny: {}"
+    `shouldParse` encoding [(Sorted 1 (-22%35)), (Sorted 1 0)]
+                           [(0, (Sorted 1 (-1%5)), 0), (0, (Sorted 1 (-3%7)), 1)]

tests/Copar/Parser/LexerSpec.hs

@@ -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"