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

Merge branch 'ratio-syntax'

parents 0911db00 903c3200
......@@ -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"
......@@ -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
......
......@@ -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).
......
......@@ -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)]
......@@ -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