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

Merge branch 'ratio-syntax'

parents 0911db00 903c3200

examples/valmari-fig3-rational

+8 −8
Original line number Diff line number Diff line
@@ -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

+8 −7
Original line number Diff line number Diff line
@@ -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

+10 −0
Original line number Diff line number Diff line
@@ -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

+19 −0
Original line number Diff line number Diff line
@@ -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

+19 −1
Original line number Diff line number Diff line
@@ -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
@@ -145,3 +147,19 @@ hexSpec = describe "hex" $ do 


  it "required the 0x prefix" $

    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"