packages feed

sign (empty) → 0.1.0

raw patch · 7 files changed

+460/−0 lines, 7 filesdep +HUnitdep +QuickCheckdep +algebrasetup-changed

Dependencies added: HUnit, QuickCheck, algebra, base, containers, deepseq, hashable, lattices, sign, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th

Files

+ .travis.yml view
@@ -0,0 +1,1 @@+language: haskell
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2013, Masahiro Sakai+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++   1. Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.+   2. Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.+   3. The name of the author may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING+IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,4 @@+sign+====++Arithmetic over signs (i.e. {-,0,+}) and sets of signs
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ sign.cabal view
@@ -0,0 +1,44 @@+Name:		sign+Version:	0.1.0+License:	BSD3+License-File:	LICENSE+Author:		Masahiro Sakai (masahiro.sakai@gmail.com)+Maintainer:	masahiro.sakai@gmail.com+Category:	Data, Math, Algebra+Cabal-Version:	>= 1.10+Synopsis:	Arithmetic over signs and sets of signs+Description:    Arithmetic over signs (i.e. -, 0, +) and sets of signs+Bug-Reports:	https://github.com/msakai/sign/issues+Extra-Source-Files:+   README.md+   LICENSE+   .travis.yml+Build-Type: Simple++source-repository head+  type:     git+  location: git://github.com/msakai/sign.git++Library+  Hs-source-dirs: src+  Build-Depends:+     base >=4 && <5, containers >= 0.4.2, deepseq, hashable >=1.1.2.5 && <1.3.0.0, lattices >=1.2.1.1, algebra+  Default-Language: Haskell2010+  Other-Extensions:+     FlexibleInstances+     DeriveDataTypeable+     CPP+  Exposed-Modules:+     Data.Sign++Test-suite TestSign+  Type:              exitcode-stdio-1.0+  HS-Source-Dirs:    test+  Main-is:           TestSign.hs+  Build-depends:     base >=4 && <5, containers, sign, test-framework, test-framework-th, test-framework-hunit, test-framework-quickcheck2, HUnit, QuickCheck >=2 && <3+  Default-Language: Haskell2010+  Other-Extensions:+     TemplateHaskell+     ScopedTypeVariables+     FlexibleInstances+
+ src/Data/Sign.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Sign+-- Copyright   :  (c) Masahiro Sakai 2013+-- License     :  BSD-style+-- +-- Maintainer  :  masahiro.sakai@gmail.com+-- Stability   :  provisional+-- Portability :  non-portable (FlexibleInstances, DeriveDataTypeable, CPP)+--+-- Algebra of Signs.+--+-----------------------------------------------------------------------------+module Data.Sign+  (+  -- * Algebra of Sign+    Sign (..)+  , negate+  , abs+  , mult+  , recip+  , div+  , pow+  , signOf+  , symbol+  ) where++import qualified Prelude as P+import Prelude hiding (negate, abs, recip, div)+import Algebra.Enumerable (Enumerable (..), universeBounded) -- from lattices package+import qualified Algebra.Lattice as L -- from lattices package+import Control.DeepSeq+import Data.Hashable+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Typeable+import Data.Data+import qualified Numeric.Algebra as Alg++data Sign = Neg | Zero | Pos+  deriving (Eq, Ord, Show, Read, Enum, Bounded, Typeable, Data)++instance NFData Sign++instance Hashable Sign where hashWithSalt = hashUsing fromEnum++instance Enumerable Sign where+  universe = universeBounded++instance Alg.Multiplicative Sign where+  (*)   = mult+  pow1p s n = pow s (1+n)++instance Alg.Commutative Sign++instance Alg.Unital Sign where+  one = Pos+  pow = pow++instance Alg.Division Sign where+  recip = recip+  (/)   = div+  (\\)  = flip div+  (^)   = pow++negate :: Sign -> Sign+negate Neg  = Pos+negate Zero = Zero+negate Pos  = Neg++abs :: Sign -> Sign+abs Neg  = Pos+abs Zero = Zero+abs Pos  = Pos++mult :: Sign -> Sign -> Sign+mult Pos s  = s+mult s Pos  = s+mult Neg s  = negate s+mult s Neg  = negate s+mult _ _    = Zero++recip :: Sign -> Sign+recip Pos  = Pos+recip Zero = error "Data.Sign.recip: division by Zero"+recip Neg  = Neg++div :: Sign -> Sign -> Sign+div s Pos  = s+div _ Zero = error "Data.Sign.div: division by Zero"+div s Neg  = negate s++pow :: Integral x => Sign -> x -> Sign+pow _ 0    = Pos+pow Pos _  = Pos+pow Zero _ = Zero+pow Neg n  = if even n then Pos else Neg++signOf :: Real a => a -> Sign+signOf r =+  case r `compare` 0 of+    LT -> Neg+    EQ -> Zero+    GT -> Pos++symbol :: Sign -> String+symbol Pos  = "+"+symbol Neg  = "-"+symbol Zero = "0"++instance L.MeetSemiLattice (Set Sign) where+  meet = Set.intersection++instance L.Lattice (Set Sign)++instance L.BoundedMeetSemiLattice (Set Sign) where+  top = Set.fromList universe++instance L.BoundedLattice (Set Sign)++instance Num (Set Sign) where+  ss1 + ss2 = Set.unions [f s1 s2 | s1 <- Set.toList ss1, s2 <- Set.toList ss2]+    where+      f Zero s  = Set.singleton s+      f s Zero  = Set.singleton s+      f Pos Pos = Set.singleton Pos+      f Neg Neg = Set.singleton Neg+      f _ _     = Set.fromList [Neg,Zero,Pos]+  ss1 * ss2   = Set.fromList [mult s1 s2 | s1 <- Set.toList ss1, s2 <- Set.toList ss2]+  negate      = Set.map negate+  abs         = Set.map abs+  signum      = id+  fromInteger = Set.singleton . signOf++instance Fractional (Set Sign) where+  recip        = Set.map recip+  fromRational = Set.singleton . signOf++instance Alg.Multiplicative (Set Sign) where+  (*) = (*)+  pow1p s n = Alg.pow s (1+n)++instance Alg.Commutative (Set Sign)++instance Alg.Unital (Set Sign) where+  one = Set.singleton Pos+  pow = (Alg.^)++instance Alg.Division (Set Sign) where+  recip  = P.recip+  (/)    = (/)+  (\\)   = flip (/)+  ss ^ n = Set.map (\s -> pow s n) ss++instance Alg.Additive (Set Sign) where+  (+)           = (+)+  sinnum1p _ ss = ss++instance Alg.Abelian (Set Sign)++#if !MIN_VERSION_hashable(1,2,0)+-- Copied from hashable-1.2.0.7:+-- Copyright   :  (c) Milan Straka 2010+--                (c) Johan Tibell 2011+--                (c) Bryan O'Sullivan 2011, 2012++-- | Transform a value into a 'Hashable' value, then hash the+-- transformed value using the given salt.+--+-- This is a useful shorthand in cases where a type can easily be+-- mapped to another type that is already an instance of 'Hashable'.+-- Example:+--+-- > data Foo = Foo | Bar+-- >          deriving (Enum)+-- >+-- > instance Hashable Foo where+-- >     hashWithSalt = hashUsing fromEnum+hashUsing :: (Hashable b) =>+             (a -> b)           -- ^ Transformation function.+          -> Int                -- ^ Salt.+          -> a                  -- ^ Value to transform.+          -> Int+hashUsing f salt x = hashWithSalt salt (f x)+{-# INLINE hashUsing #-}+#endif+
+ test/TestSign.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, FlexibleInstances #-}++import Control.Monad+import Data.List+import Data.Maybe+import Data.Ratio+import qualified Data.Set as Set+import Data.Set (Set)+import Test.HUnit hiding (Test)+import Test.QuickCheck+import Test.Framework (Test, defaultMain, testGroup)+import Test.Framework.TH+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2++import qualified Data.Sign as Sign+import Data.Sign (Sign (..))++{--------------------------------------------------------------------+  Sign+--------------------------------------------------------------------}++prop_mult_comm =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+    a `Sign.mult` b == b `Sign.mult` a++prop_mult_assoc =+  forAll arbitrary $ \a ->+  forAll arbitrary $ \b ->+  forAll arbitrary $ \c ->+    a `Sign.mult` (b `Sign.mult` c) == (a `Sign.mult` b) `Sign.mult` c++prop_mult_unitL =+  forAll arbitrary $ \a ->+    Pos `Sign.mult` a == a++prop_mult_unitR =+  forAll arbitrary $ \a ->+    a `Sign.mult` Pos == a++prop_mult_signOf_comm =+  forAll arbitrary $ \(a::Rational) ->+  forAll arbitrary $ \b ->+    Sign.signOf (a * b) == Sign.signOf a `Sign.mult` Sign.signOf b++prop_negate_involution =+  forAll arbitrary $ \a ->+    Sign.negate (Sign.negate a) == a++prop_negate_signOf_comm =+  forAll arbitrary $ \(a::Rational) ->+    Sign.signOf (negate a) == Sign.negate (Sign.signOf a)++prop_abs_non_neg =+  forAll arbitrary $ \a ->+    Sign.abs a /= Neg++prop_abs_mult_orig =+  forAll arbitrary $ \a ->+    Sign.abs a `Sign.mult` a == a++prop_abs_idempotent =+  forAll arbitrary $ \a ->+    Sign.abs (Sign.abs a) == Sign.abs a++prop_abs_signOf_comm =+  forAll arbitrary $ \(a::Rational) ->+    Sign.signOf (abs a) == Sign.abs (Sign.signOf a)++prop_recip_div =+  forAll arbitrary $ \a ->+    a /= Zero ==>+      Sign.recip a == Pos `Sign.div` a++prop_div_inv_mult =+  forAll arbitrary $ \a ->+    forAll arbitrary $ \b ->+      b /= Zero ==>+        a == (a `Sign.div` b) `Sign.mult` b++prop_pow =+  forAll arbitrary $ \a ->+    forAll (choose (0, 10)) $ \(i::Int) ->+      Sign.pow a i == foldl' Sign.mult Pos (replicate i a)++{--------------------------------------------------------------------+  Sign set+--------------------------------------------------------------------}++prop_SetSign_add_comm =+  forAll arbitrary $ \(a :: Set Sign) ->+  forAll arbitrary $ \b ->+    a + b == b + a++prop_SetSign_add_assoc =+  forAll arbitrary $ \(a :: Set Sign) ->+  forAll arbitrary $ \b ->+  forAll arbitrary $ \c ->+    a + (b + c) == (a + b) + c++prop_SetSign_add_unitL =+  forAll arbitrary $ \a ->+    Set.singleton Zero + a == a++prop_SetSign_add_unitR =+  forAll arbitrary $ \a ->+    a + Set.singleton Zero == a++prop_SetSign_add_signOf_comm =+  forAll arbitrary $ \(a::Rational) ->+  forAll arbitrary $ \b ->+    Sign.signOf (a+b) `Set.member` (Set.singleton (Sign.signOf a) + Set.singleton (Sign.signOf b))++prop_SetSign_mult_comm =+  forAll arbitrary $ \(a :: Set Sign) ->+  forAll arbitrary $ \b ->+    a * b == b * a++prop_SetSign_mult_assoc =+  forAll arbitrary $ \(a :: Set Sign) ->+  forAll arbitrary $ \b ->+  forAll arbitrary $ \c ->+    a * (b * c) == (a * b) * c++prop_SetSign_mult_unitL =+  forAll arbitrary $ \a ->+    Set.singleton Pos * a == a++prop_SetSign_mult_unitR =+  forAll arbitrary $ \a ->+    a * Set.singleton Pos == a++prop_SetSign_mult_signOf_comm =+  forAll arbitrary $ \(a::Rational) ->+  forAll arbitrary $ \b ->+    Sign.signOf (a*b) `Set.member` (Set.singleton (Sign.signOf a) * Set.singleton (Sign.signOf b))++prop_SetSign_negate_involution =+  forAll arbitrary $ \(a :: Set Sign) ->+    negate (negate a) == a++prop_SetSign_abs_non_neg =+  forAll arbitrary $ \(a :: Set Sign) ->+    Neg `Set.notMember` abs a++prop_SetSign_abs_mult_orig =+  forAll arbitrary $ \(a :: Set Sign) ->+    a `Set.isSubsetOf` (abs a * a)++prop_SetSign_abs_idempotent =+  forAll arbitrary $ \(a :: Set Sign) ->+    abs (abs a) == abs a++prop_SetSign_pow =+  forAll arbitrary $ \a ->+    forAll (choose (0, 10)) $ \(i::Int) ->+      Sign.pow a i == foldl' Sign.mult Pos (replicate i a)++{--------------------------------------------------------------------+  Read+--------------------------------------------------------------------}++prop_show_read_invariance =+  forAll arbitrary $ \(a::Sign) -> do+    a == read (show a)++{--------------------------------------------------------------------+  Generators+--------------------------------------------------------------------}++instance Arbitrary Sign where+  arbitrary = arbitraryBoundedEnum+  shrink    = shrinkNothing++instance CoArbitrary Sign where+  coarbitrary = coarbitraryEnum++instance Arbitrary (Set Sign) where+  arbitrary = elements $ map Set.unions $+                sequence [[Set.singleton s, Set.empty] | s <- [Neg, Zero, Pos]]+  shrink ss = [Set.delete s ss | s <- Set.toList ss]++instance CoArbitrary (Set Sign) where+  coarbitrary ss g = foldr (\s g -> variant (fromEnum s) g) g (Set.toList ss)++------------------------------------------------------------------------+-- Test harness++main :: IO ()+main = $(defaultMainGenerator)