semiring-num 0.1.0.2 → 0.1.0.4

raw patch · 4 files changed

+90/−3 lines, 4 files

Files

• semiring-num.cabal +2/−1
• src/Data/Semiring.hs +2/−0
• src/Data/Semiring/Free.hs +79/−0
• test/Spec.hs +7/−2

@@ -1,5 +1,5 @@ name:                semiring-num-version:             0.1.0.2+version:             0.1.0.4 synopsis:            Basic semiring class and instances description:         Adds a basic semiring class homepage:            https://github.com/oisdk/semiring-num@@ -16,6 +16,7 @@   hs-source-dirs:      src   exposed-modules:     Data.Semiring                      , Data.Semiring.Numeric+                     , Data.Semiring.Free                      , Test.Semiring   build-depends:       base >= 4.9 && < 5                      , containers >= 0.5

@@ -281,6 +281,8 @@ instance Semiring Word16 instance Semiring Word32 instance Semiring Word64+instance Semiring Float+instance Semiring Double instance Semiring CUIntMax instance Semiring CIntMax instance Semiring CUIntPtr

@@ -0,0 +1,79 @@+{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.Semiring.Free+  ( Free(..)+  , liftFree+  , unFree+  ) where++import           Control.Applicative (liftA2)++import           Data.Coerce++import           Data.Function (on)+import           Data.List (sort)++import           Data.Semiring+import           Data.Ord (comparing)++import qualified Data.Map.Strict as Map+import           Data.Map.Strict (Map)++import           Test.QuickCheck (Arbitrary(..))++-- | The free semiring. Adapted from PureScript's version, available+-- <https://pursuit.purescript.org/packages/purescript-semirings/3.0.0/docs/Data.Semiring.Free here>.+-- Only a valid semiring if treated as a multiset, as in:+--+-- >>> Free [[1],[0]] == Free [[0],[1]]+-- True+newtype Free a = Free+  { getFree :: [[a]]+  } deriving (Show, Read, Functor, Foldable, Traversable, Monoid)++instance Semiring (Free a) where+  Free xs <+> Free ys = Free (xs ++ ys)+  Free xs <.> Free ys = Free (liftA2 (++) xs ys)+  one = Free [[]]+  zero = Free []++instance Applicative Free where+  pure = Free . pure . pure+  Free fs <*> Free xs = Free (liftA2 (<*>) fs xs)++-- | Run a 'Free'.+liftFree :: Semiring s => (a -> s) -> Free a -> s+liftFree f = unFree . fmap f++-- | Run a 'Free', interpreting it in the underlying semiring.+unFree :: Semiring s => Free s -> s+unFree = getAdd .# foldMap (Add .# getMul .# foldMap Mul) . getFree++-- | Extremely slow. For testing purposes.+instance Ord a => Eq (Free a) where+  (==) = isAnagram `on` getFree++instance Ord a => Ord (Free a) where+  compare = comparing (sort . getFree)++instance Arbitrary a => Arbitrary (Free a) where+  arbitrary = Free <$> arbitrary++infixr 9 .#+(.#) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(.#) _ = coerce++isAnagram :: Ord a => [a] -> [a] -> Bool+isAnagram = go (Map.empty :: Map a Int) where+  go !m (x:xs) (y:ys) =+    go ( Map.alter (remZero . maybe (-1) pred) x+       $ Map.alter (remZero . maybe 1    succ) y+    m) xs ys+  go !m [] [] = Map.null m+  go _ _ _ = False+  remZero 0 = Nothing+  remZero n = Just n

@@ -4,23 +4,27 @@  import           Data.Proxy            (Proxy (..)) import           Data.Semiring         (Add, Mul)+import           Data.Semiring.Free import           Data.Semiring.Numeric import           Data.Set              (Set)+import           Data.Word             (Word8) import           Test.DocTest import           Test.QuickCheck import           Test.Semiring + main :: IO () main = do+  quickCheckWith (stdArgs { maxSuccess = 40, maxSize = 30} ) (semiringLaws (Proxy :: Proxy (Free Word8)))   quickCheck (semiringLaws (Proxy :: Proxy Integer))   quickCheck (semiringLaws (Proxy :: Proxy Bool))   quickCheck (semiringLaws (Proxy :: Proxy (Add Integer)))   quickCheck (semiringLaws (Proxy :: Proxy (Mul Integer)))-  quickCheck (semiringLaws (Proxy :: Proxy (Set Ordering)))   quickCheck (semiringLaws (Proxy :: Proxy (Integer,Integer)))   quickCheck (semiringLaws (Proxy :: Proxy (Integer,Integer,Integer)))   quickCheck (semiringLaws (Proxy :: Proxy (Integer,Integer,Integer,Integer)))   quickCheck (semiringLaws (Proxy :: Proxy (Integer,Integer,Integer,Integer,Integer)))+  quickCheck (semiringLaws (Proxy :: Proxy (Set (Add Word8)) ))   quickCheck (semiringLaws (Proxy :: Proxy (Division Integer)))   quickCheck (semiringLaws (Proxy :: Proxy (Bottleneck Int)))   quickCheck (semiringLaws (Proxy :: Proxy (Łukasiewicz Integer)))@@ -28,4 +32,5 @@   doctest [ "-isrc"           , "src/Data/Semiring.hs"           , "src/Data/Semiring/Numeric.hs"-          , "src/Test/Semiring.hs" ]+          , "src/Test/Semiring.hs"+          , "src/Data/Semiring/Free.hs" ]