sized-types 0.1 → 0.2.7.20101112
raw patch · 15 files changed
+511/−162 lines, 15 files
Files
- Data/Sized/Arith.hs +15/−76
- Data/Sized/Ix.hs +91/−7
- Data/Sized/Matrix.hs +66/−15
- Data/Sized/QC/Ix.hs +0/−12
- Data/Sized/QC/Matrix.hs +0/−12
- Data/Sized/QC/Signed.hs +0/−7
- Data/Sized/Sampled.hs +79/−0
- Data/Sized/Signed.hs +58/−8
- Data/Sized/Sparse/Matrix.hs +3/−2
- Data/Sized/Unsigned.hs +56/−8
- Data/Sized/Vector.hs +107/−0
- qc/QC.hs +21/−0
- sized-types.cabal +13/−12
- test/Example1.hs +1/−1
- test/Test1.hs +1/−2
Data/Sized/Arith.hs view
@@ -18,9 +18,8 @@ data X0 = X0 deriving (Eq,Ord) -data X0_ a = X0_ Int-data X1_ a = X1_ Int-+data X0_ a = X0_ Int -- times 2 plus 0+data X1_ a = X1_ Int -- times 2 plus 1 type family ADD a b type instance ADD N1 N1 = APP0 N1@@ -40,22 +39,34 @@ type instance ADD (X1_ a) (X0_ b) = APP1 (ADD a b) -- MIR type instance ADD (X1_ a) (X1_ b) = APP0 (SUCC (ADD a b)) + type family NOT a type instance NOT N1 = X0 type instance NOT X0 = N1 type instance NOT (X0_ a) = APP1 (NOT a) type instance NOT (X1_ a) = APP0 (NOT a) - type SUB a b = ADD a (SUCC (NOT b)) +type family MUL a b+type instance MUL x X0 = X0+type instance MUL x (X0_ b) = ADD x (MUL x (ADD (X0_ b) N1))+type instance MUL x (X1_ b) = ADD x (MUL x (ADD (X1_ b) N1))+type instance MUL x N1 = SUB X0 x + type family SUCC a type instance SUCC N1 = X0 type instance SUCC X0 = X1_ X0 type instance SUCC (X0_ a) = APP1 a type instance SUCC (X1_ a) = APP0 (SUCC a) ++type family LOG a+type instance LOG X0 = X0+type instance LOG (X0_ a) = ADD (X1_ X0) (LOG a)+type instance LOG (X1_ a) = ADD (X1_ X0) (LOG a)+ type family APP1 a type instance APP1 N1 = N1 type instance APP1 X0 = X1_ X0@@ -67,76 +78,4 @@ type instance APP0 X0 = X0 type instance APP0 (X0_ a) = X0_ (X0_ a) type instance APP0 (X1_ a) = X0_ (X1_ a)----- instances---instance Eq (X0_ a) where- (X0_ a) == (X0_ b) = a == b--instance Ord (X0_ a) where- (X0_ a) `compare` (X0_ b) = a `compare` b---instance Ix (X0_ a) where- range (X0_ a,X0_ b) = map X0_ (range (a,b))- index (X0_ a,X0_ b) (X0_ i) = index (a,b) i- inRange (X0_ a,X0_ b) (X0_ i) = inRange (a,b) i--instance Enum (X0_ a) where- toEnum n = (X0_ n)- fromEnum (X0_ n) = n--instance Num (X0_ a) where- fromInteger n = X0_ (fromInteger n) -- bounds checking needed!- abs a = a - signum (X0_ a) = if a == 0 then 0 else 1- (X0_ a) + (X0_ b) = X0_ (a + b)- (X0_ a) - (X0_ b) = X0_ (a - b)- (X0_ a) * (X0_ b) = X0_ (a * b)---instance Show (X0_ a) where- show (X0_ a) = show a- -instance Eq (X1_ a) where- (X1_ a) == (X1_ b) = a == b--instance Ord (X1_ a) where- (X1_ a) `compare` (X1_ b) = a `compare` b----instance Ix (X1_ a) where- range (X1_ a,X1_ b) = map X1_ (range (a,b))- index (X1_ a,X1_ b) (X1_ i) = index (a,b) i- inRange (X1_ a,X1_ b) (X1_ i) = inRange (a,b) i--instance Enum (X1_ a) where- toEnum n = (X1_ n)- fromEnum (X1_ n) = n--instance Num (X1_ a) where- fromInteger n = X1_ (fromInteger n) -- bounds checking needed!- abs a = a - signum (X1_ a) = if a == 0 then 0 else 1- (X1_ a) + (X1_ b) = X1_ (a + b)- (X1_ a) - (X1_ b) = X1_ (a - b)- (X1_ a) * (X1_ b) = X1_ (a * b)--instance Show (X1_ a) where- show (X1_ a) = show a--instance Bounded X0 where- minBound = error "minBound not defined"- maxBound = error "maxBound not defined"--instance Ix X0 where- range (X0,X0) = []- inRange (X0,X0) X0 = False---instance Show X0 where- show X0 = "-"-
Data/Sized/Ix.hs view
@@ -283,8 +283,8 @@ -- | A list of all possible indices. -- Unlike 'indices' in Matrix, this does not need the 'Matrix' -- argument, because the types determine the contents.-all :: (Size i) => [i]-all = range (minBound,maxBound)+all :: forall i . (Size i) => [i]+all = if size (error "all witness" :: i) == 0 then [] else range (minBound,maxBound) --- because of TH's lack of type families, will be added later. type family Index a@@ -309,7 +309,7 @@ type instance Column (a,b) = b instance (Size x, Size y) => Size (x,y) where- size (a,b) = size a * size b+ size ~(a,b) = size a * size b addIndex (a,b) (a',b') = (addIndex a a',addIndex b b') toIndex (a,b) = (toIndex a, toIndex b) seeIn2D (x,y) = (x,y)@@ -342,14 +342,24 @@ instance Size X0 where size _ = 0- addIndex X0 _n = X0 -- TODO: fix bounds issues+ addIndex X0 _n = X0 toIndex X0 = 0 seeIn2D (_,y) = y +instance Integral X0 where + toInteger a = toInteger (size a)+instance Real X0 where +instance Enum X0 where +instance Num X0 where + instance Size a => Bounded (X1_ a) where minBound = X1_ 0 maxBound = let a = X1_ (size a - 1) in a- ++instance (Size a) => Real (X1_ a) where+instance (Size a, Size (X1_ a), Integral a) => Integral (X1_ a) where + toInteger (X1_ a) = toInteger a+ type instance Index (X1_ a) = Int type instance Row (X1_ a) = X1 type instance Column (X1_ a) = X1_ a@@ -357,7 +367,7 @@ instance Size a => Size (X1_ a) where size = const s where s = 2 * size (undefined :: a) + 1- addIndex (X1_ v) n = X1_ (v + n) -- fix bounds issues+ addIndex (X1_ v) n = mkX1_ (v + n) -- fix bounds issues toIndex (X1_ v) = v seeIn2D (_,y) = y @@ -372,10 +382,84 @@ instance Size a => Size (X0_ a) where size = const s where s = 2 * size (undefined :: a) - addIndex (X0_ v) n = X0_ (v + n) -- fix bounds issues+ addIndex (X0_ v) n = mkX0_ (v + n) -- fix bounds issues toIndex (X0_ v) = v seeIn2D (_,y) = y +instance (Size a) => Real (X0_ a) where+instance (Size a, Size (X0_ a), Integral a) => Integral (X0_ a) where + toInteger (X0_ a) = toInteger a+++--- instances+instance Eq (X0_ a) where+ (X0_ a) == (X0_ b) = a == b++instance Ord (X0_ a) where+ (X0_ a) `compare` (X0_ b) = a `compare` b+++instance (Size a) => Ix (X0_ a) where+ range (X0_ a,X0_ b) = map mkX0_ (range (a,b))+ index (X0_ a,X0_ b) (X0_ i) = index (a,b) i+ inRange (X0_ a,X0_ b) (X0_ i) = inRange (a,b) i++instance (Size a) => Enum (X0_ a) where+ toEnum n = mkX0_ n+ fromEnum (X0_ n) = n++instance (Size a) => Num (X0_ a) where+ fromInteger n = mkX0_ (fromInteger n) -- bounds checking needed!+ abs a = a + signum (X0_ a) = if a == 0 then 0 else 1+ (X0_ a) + (X0_ b) = mkX0_ (a + b)+ (X0_ a) - (X0_ b) = mkX0_ (a - b)+ (X0_ a) * (X0_ b) = mkX0_ (a * b)+++instance Show (X0_ a) where+ show (X0_ a) = show a+ +instance Eq (X1_ a) where+ (X1_ a) == (X1_ b) = a == b++instance Ord (X1_ a) where+ (X1_ a) `compare` (X1_ b) = a `compare` b++instance (Size a) => Ix (X1_ a) where+ range (X1_ a,X1_ b) = map mkX1_ (range (a,b))+ index (X1_ a,X1_ b) (X1_ i) = index (a,b) i+ inRange (X1_ a,X1_ b) (X1_ i) = inRange (a,b) i++instance (Size a) => Enum (X1_ a) where+ toEnum n = mkX1_ n+ fromEnum (X1_ n) = n++instance (Size a) => Num (X1_ a) where+ fromInteger n = mkX1_ (fromInteger n) -- bounds checking needed!+ abs a = a + signum (X1_ a) = if a == 0 then 0 else 1+ (X1_ a) + (X1_ b) = mkX1_ (a + b)+ (X1_ a) - (X1_ b) = mkX1_ (a - b)+ (X1_ a) * (X1_ b) = mkX1_ (a * b)++instance Show (X1_ a) where+ show (X1_ a) = show a++instance Bounded X0 where+ minBound = error "minBound not defined for X0"+ maxBound = error "maxBound not defined for X0"++instance Ix X0 where+ range (X0,X0) = []+ inRange (X0,X0) X0 = False++instance Show X0 where+ show X0 = "-"++mkX0_ n = let r = X0_ (n `mod` size r) in r+mkX1_ n = let r = X1_ (n `mod` size r) in r+ ------ type X1 = X1_ X0
Data/Sized/Matrix.hs view
@@ -7,7 +7,7 @@ -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables, UndecidableInstances, MultiParamTypeClasses #-} module Data.Sized.Matrix ( module Data.Sized.Matrix , module Data.Sized.Ix@@ -27,30 +27,40 @@ -- | A 'Matrix' is an array with the sized determined uniquely by the -- /type/ of the index type, 'ix'. data Matrix ix a = Matrix (Array ix a)- deriving Eq+ | NullMatrix -- consider using Int as index, and keeping ix as phantom,+ -- instead of this NullMatrix.+ deriving (Eq,Ord) -- | '!' looks up an element in the matrix. (!) :: (Size n) => Matrix n a -> n -> a (!) (Matrix xs) n = xs A.! n+(!) NullMatrix _ = error "Attending to index into a Null Matrix, should *never* happen" instance (Size i) => Functor (Matrix i) where fmap f (Matrix xs) = Matrix (fmap f xs)+ fmap f NullMatrix = NullMatrix -- | 'toList' turns a matrix into an always finite list. toList :: (Size i) => Matrix i a -> [a] toList (Matrix a) = elems a+toList NullMatrix = [] -- | 'fromList' turns a finite list into a matrix. You often need to give the type of the result.-fromList :: (Size i) => [a] -> Matrix i a-fromList xs = check minBound maxBound- where - check low high | size low == L.length xs- = Matrix $ listArray (low,high) xs- | otherwise- = error $ "bad length of fromList for Matrix, "- ++ "expecting " ++ show (L.length (range (low,high))) ++ " elements"+fromList :: forall i a . (Size i) => [a] -> Matrix i a+fromList xs | size witness == 0 = NullMatrix+ | size witness == L.length xs = Matrix $ listArray (low,high) xs+ | otherwise = error $ "bad length of fromList for Matrix, "+ ++ "expecting " ++ show (size witness) ++ " elements" ++ ", found " ++ show (L.length xs) ++ " elements." + where + witness :: i+ witness = undefined+ low :: i+ low = minBound+ high :: i+ high = maxBound+ -- | 'matrix' turns a finite list into a matrix. You often need to give the type of the result. matrix :: (Size i) => [a] -> Matrix i a matrix = fromList@@ -131,6 +141,17 @@ Matrix (m, left) a -> Matrix (m, right) a -> Matrix (m, both) a beside m1 m2 = transpose (transpose m1 `above` transpose m2) +-- | append two 1-d matrixes+append ::+ (Size left,+ Size right,+ Size both+ , ADD left right ~ both+ , SUB both left ~ right+ , SUB both right ~ left+ ) => Matrix left a -> Matrix right a -> Matrix both a+append m1 m2 = fromList (toList m1 ++ toList m2)+ -- | look at a matrix through a lens to another matrix. ixmap :: (Size i, Size j) => (i -> j) -> Matrix j a -> Matrix i a ixmap f m = (\ i -> m ! f i) <$> coord@@ -198,12 +219,13 @@ -- > showMatrix :: (Size n, Size m) => Matrix (m, n) String -> String-showMatrix m = joinLines $ map showRow m_rows+showMatrix m = (joinLines $ map showRow m_rows) where m' = forEach m $ \ (x,y) a -> (x == maxBound && y == maxBound,a)- joinLines = unlines . L.zipWith (++) ("[":repeat " ") + joinLines = unlines . addTail . L.zipWith (++) ("[":repeat " ") + addTail xs = init xs ++ [last xs ++ " ]"] showRow r = concat (toList $ Data.Sized.Matrix.zipWith showEle r m_cols_size)- showEle (f,str) s = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then " ]" else ",")+ showEle (f,str) s = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then "" else ",") m_cols = columns m m_rows = toList $ rows m' m_cols_size = fmap (maximum . map L.length . toList) m_cols@@ -220,7 +242,36 @@ instance Show S where show (S s) = s -showAs :: (RealFloat a) => Int -> a -> S -showAs i a = S $ showEFloat (Just i) a ""+showAsE :: (RealFloat a) => Int -> a -> S +showAsE i a = S $ showEFloat (Just i) a "" +showAsF :: (RealFloat a) => Int -> a -> S +showAsF i a = S $ showFFloat (Just i) a "" +scanM :: (Size ix, Bounded ix, Enum ix)+ => ((left,a,right) -> (right,b,left))+ -> (left, Matrix ix a,right)+ -> (right,Matrix ix b,left)+scanM f (l,m,r) = ( fst3 (tmp ! minBound), snd3 `fmap` tmp, trd3 (tmp ! maxBound) )+ where tmp = forEach m $ \ i a -> f (prev i, a, next i)+ prev i = if i == minBound then l else (trd3 (tmp ! (pred i)))+ next i = if i == maxBound then r else (fst3 (tmp ! (succ i)))+ fst3 (a,_,_) = a+ snd3 (_,b,_) = b+ trd3 (_,_,c) = c++scanL :: (Size ix, Bounded ix, Enum ix)+ => ((a,right) -> (right,b))+ -> (Matrix ix a,right)+ -> (right,Matrix ix b)+scanL = error "to be written"++scanR :: (Size ix, Bounded ix, Enum ix)+ => ((left,a) -> (b,left))+ -> (left, Matrix ix a)+ -> (Matrix ix b,left)+scanR f (l,m) = ( fst `fmap` tmp, snd (tmp ! maxBound) )+ where tmp = forEach m $ \ i a -> f (prev i,a)+ prev i = if i == minBound then l else (snd (tmp ! (pred i)))++
− Data/Sized/QC/Ix.hs
@@ -1,12 +0,0 @@-module Data.Sized.QC.Ix where--import qualified Test.QuickCheck as QC-import Data.Sized.Ix-import Data.Sized.Matrix -import Data.Sized.Arith--instance Size n => QC.Arbitrary (X0_ n) where- arbitrary = QC.elements [minBound .. maxBound]- -instance Size n => QC.Arbitrary (X1_ n) where- arbitrary = QC.elements [minBound .. maxBound]
− Data/Sized/QC/Matrix.hs
@@ -1,12 +0,0 @@-module Data.Sized.QC.Matrix where- -import qualified Test.QuickCheck as QC-import Data.Sized.Ix-import Data.Sized.Matrix as M--instance (QC.Arbitrary ix, Size ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where- arbitrary = f $ \ ixs -> do- elems <- sequence [ QC.arbitrary | _ <- ixs ]- return $ matrix elems- where f :: (Size ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a)- f fn = fn M.all
− Data/Sized/QC/Signed.hs
@@ -1,7 +0,0 @@-module Data.Sized.QC.Signed where- -import Data.Sized.Signed-import Data.Sized.Unsigned-import Data.Sized.Ix-import Test.QuickCheck-
+ Data/Sized/Sampled.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Sized.Sampled where++import Data.Ratio+import Data.Sized.Signed as S+import Data.Sized.Matrix as M+import Data.Sized.Ix++-- A signed fixed precision number, with max value m, via n sampled bits.++-- We add an extra bit, to represent the *sign*.+data Sampled m n = Sampled (Signed n) Rational+-- deriving Show++toMatrix :: (Size n) => Sampled m n -> Matrix n Bool+toMatrix (Sampled sig _) = S.toMatrix sig++fromMatrix :: forall n m . (Size n, Size m) => Matrix n Bool -> Sampled m n+fromMatrix m = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)+ where val :: Signed n+ val = S.fromMatrix m+ scale :: Integer+ scale = fromIntegral (size (undefined :: m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (size (undefined :: n) - 1) :: Integer)+ ++mkSampled :: forall n m . (Size n, Size m) => Rational -> Sampled m n+mkSampled v = Sampled val (fromIntegral scale * fromIntegral val / fromIntegral precision)+ where scale :: Integer+ scale = fromIntegral (size (undefined :: m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (size (undefined :: n) - 1) :: Integer)+ val0 :: Rational+ val0 = v / fromIntegral scale+ val1 :: Integer+ -- Key rounding step+ val1 = round (val0 * fromIntegral precision)+ val = if val1 >= precision then maxBound+ else if val1 <= -precision then minBound+ else fromInteger val1++instance (Size ix) => Eq (Sampled m ix) where+ (Sampled a _) == (Sampled b _) = a == b+instance (Size ix) => Ord (Sampled m ix) where+ (Sampled a _) `compare` (Sampled b _) = a `compare` b+instance (Size ix) => Show (Sampled m ix) where+ show (Sampled _ s) = show (fromRational s :: Double)+instance (Size ix, Size m) => Read (Sampled m ix) where+ readsPrec i str = [ (mkSampled a,r) | (a,r) <- readsPrec i str ]++instance (Size ix, Size m) => Num (Sampled m ix) where+ (Sampled _ a) + (Sampled _ b) = mkSampled $ a + b+ (Sampled _ a) - (Sampled _ b) = mkSampled $ a - b+ (Sampled _ a) * (Sampled _ b) = mkSampled $ a * b+ abs (Sampled _ n) = mkSampled $ abs n+ signum (Sampled _ n) = mkSampled $ signum n+ fromInteger n = mkSampled (fromInteger n)++instance (Size ix, Size m) => Real (Sampled m ix) where+ toRational (Sampled _ n) = toRational n+ +instance (Size ix, Size m) => Fractional (Sampled m ix) where+ fromRational n = mkSampled n+ recip (Sampled _ n) = mkSampled $ recip n++-- This is a bit of a hack, and may generate -ve values from fromEnum.+instance (Size ix, Size m) => Enum (Sampled m ix) where+ fromEnum (Sampled n _) = fromEnum n++ toEnum n = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)+ where val :: Signed ix+ val = fromIntegral n+ scale :: Integer+ scale = fromIntegral (size (undefined :: m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (size (undefined :: ix) - 1) :: Integer)++
Data/Sized/Signed.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | Signed, fixed sized numbers. -- -- Copyright: (c) 2009 University of Kansas@@ -11,6 +13,10 @@ ( Signed , toMatrix , fromMatrix+ , S2, S3, S4, S5, S6, S7, S8, S9+ , S10, S11, S12, S13, S14, S15, S16, S17, S18, S19+ , S20, S21, S22, S23, S24, S25, S26, S27, S28, S29+ , S30, S31, S32 ) where import Data.Sized.Matrix as M@@ -21,11 +27,11 @@ newtype Signed ix = Signed Integer -- 'toMatrix' turns a sized 'Signed' value into a 'Matrix' of 'Bool's. -toMatrix :: Size ix => Signed ix -> Matrix ix Bool-toMatrix s@(Signed v) = matrix $ reverse $ take (bitSize s) $ map odd $ iterate (`div` 2) v+toMatrix :: forall ix . (Size ix) => Signed ix -> Matrix ix Bool+toMatrix s@(Signed v) = matrix $ take (size (error "toMatrix" :: ix)) $ map odd $ iterate (`div` 2) v -- 'toMatrix' turns a a 'Matrix' of 'Bool's into sized 'Signed' value. -fromMatrix :: Size ix => Matrix ix Bool -> Signed ix+fromMatrix :: (Size ix) => Matrix ix Bool -> Signed ix fromMatrix m = mkSigned $ sum [ n | (n,b) <- zip (iterate (* 2) 1)@@ -33,10 +39,10 @@ , b ] -- -mkSigned :: (Size ix) => Integer -> Signed ix+mkSigned :: forall ix . (Size ix) => Integer -> Signed ix mkSigned v = res where sz' = 2 ^ (fromIntegral bitCount :: Integer)- bitCount = bitSize res - 1+ bitCount = size (error "mkUnsigned" :: ix) - 1 res = case divMod v sz' of (s,v') | even s -> Signed v' | otherwise -> Signed (v' - sz') @@ -47,6 +53,8 @@ (Signed a) `compare` (Signed b) = a `compare` b instance (Size ix) => Show (Signed ix) where show (Signed a) = show a+instance (Enum ix, Size ix) => Read (Signed ix) where+ readsPrec i str = [ (mkSigned a,r) | (a,r) <- readsPrec i str ] instance (Size ix) => Integral (Signed ix) where toInteger (Signed m) = m quotRem (Signed a) (Signed b) = @@ -64,7 +72,7 @@ instance (Size ix) => Enum (Signed ix) where fromEnum (Signed n) = fromEnum n toEnum n = mkSigned (toInteger n) -instance (Size ix) => Bits (Signed ix) where+instance (Size ix, Integral ix) => Bits (Signed ix) where bitSize s = f s undefined where f :: (Size a) => Signed a -> a -> Int@@ -74,6 +82,48 @@ a `xor` b = fromMatrix (M.zipWith (/=) (toMatrix a) (toMatrix b)) a .|. b = fromMatrix (M.zipWith (||) (toMatrix a) (toMatrix b)) a .&. b = fromMatrix (M.zipWith (&&) (toMatrix a) (toMatrix b))- + shiftL (Signed v) i = mkSigned (v * (2 ^ i))+ shiftR (Signed v) i = mkSigned (v `div` (2 ^ i))+ rotate v i = fromMatrix (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.length m)))+ where m = toMatrix v+ testBit u idx = toMatrix u ! (fromIntegral idx) - ++instance forall ix . (Size ix) => Bounded (Signed ix) where+ minBound = Signed (- maxMagnitude)+ where maxMagnitude = 2 ^ (size (error "Bounded/Signed" :: ix) -1)+ maxBound = Signed (maxMagnitude - 1)+ where maxMagnitude = 2 ^ (size (error "Bounded/Signed" :: ix) -1)+++type S2 = Signed X2+type S3 = Signed X3+type S4 = Signed X4+type S5 = Signed X5+type S6 = Signed X6+type S7 = Signed X7+type S8 = Signed X8+type S9 = Signed X9+type S10 = Signed X10+type S11 = Signed X11+type S12 = Signed X12+type S13 = Signed X13+type S14 = Signed X14+type S15 = Signed X15+type S16 = Signed X16+type S17 = Signed X17+type S18 = Signed X18+type S19 = Signed X19+type S20 = Signed X20+type S21 = Signed X21+type S22 = Signed X22+type S23 = Signed X23+type S24 = Signed X24+type S25 = Signed X25+type S26 = Signed X26+type S27 = Signed X27+type S28 = Signed X28+type S29 = Signed X29+type S30 = Signed X30+type S31 = Signed X31+type S32 = Signed X32
Data/Sized/Sparse/Matrix.hs view
@@ -24,14 +24,15 @@ fmap f (Matrix d mp) = Matrix (f d) (fmap f mp) -- 'fromAssocList' generates a sparse matrix. -fromAssocList :: (Size i, Eq a) => a -> [(i,a)] -> Matrix i a+fromAssocList :: (Ord i, Eq a) => a -> [(i,a)] -> Matrix i a fromAssocList d xs = Matrix d (Map.fromList [ (i,a) | (i,a) <- xs, a /= d ]) +toAssocList :: (Matrix i a) -> (a,[(i,a)]) toAssocList (Matrix d mp) = (d,Map.toList mp) -- | '!' looks up an element in the sparse matrix. If the element is not found -- in the sparse matrix, '!' returns the default value.-(!) :: (Size ix) => Matrix ix a -> ix -> a+(!) :: (Ord ix) => Matrix ix a -> ix -> a (!) (Matrix d sm) id = Map.findWithDefault d id sm fill :: (Size ix) => Matrix ix a -> M.Matrix ix a
Data/Sized/Unsigned.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+ -- | Unsigned, fixed sized numbers. -- -- Copyright: (c) 2009 University of Kansas@@ -11,7 +13,10 @@ ( Unsigned , toMatrix , fromMatrix- , U1+ , U1, U2, U3, U4, U5, U6, U7, U8, U9+ , U10, U11, U12, U13, U14, U15, U16, U17, U18, U19+ , U20, U21, U22, U23, U24, U25, U26, U27, U28, U29+ , U30, U31, U32 ) where import Data.Sized.Matrix as M@@ -21,10 +26,10 @@ newtype Unsigned ix = Unsigned Integer -toMatrix :: Size ix => Unsigned ix -> Matrix ix Bool-toMatrix s@(Unsigned v) = matrix $ reverse $ take (bitSize s) $ map odd $ iterate (`div` 2) v+toMatrix :: forall ix . (Size ix) => Unsigned ix -> Matrix ix Bool+toMatrix s@(Unsigned v) = matrix $ take (size (error "toMatrix" :: ix)) $ map odd $ iterate (`div` 2) v -fromMatrix :: Size ix => Matrix ix Bool -> Unsigned ix+fromMatrix :: (Size ix) => Matrix ix Bool -> Unsigned ix fromMatrix m = mkUnsigned $ sum [ n | (n,b) <- zip (iterate (* 2) 1)@@ -32,10 +37,10 @@ , b ] -mkUnsigned :: (Size ix) => Integer -> Unsigned ix+mkUnsigned :: forall ix . (Size ix) => Integer -> Unsigned ix mkUnsigned v = res where sz' = 2 ^ (fromIntegral bitCount :: Integer)- bitCount = bitSize res+ bitCount = size (error "mkUnsigned" :: ix) res = Unsigned (v `mod` sz') instance (Size ix) => Eq (Unsigned ix) where@@ -44,6 +49,8 @@ (Unsigned a) `compare` (Unsigned b) = a `compare` b instance (Size ix) => Show (Unsigned ix) where show (Unsigned a) = show a+instance (Size ix) => Read (Unsigned ix) where+ readsPrec i str = [ (mkUnsigned a,r) | (a,r) <- readsPrec i str ] instance (Size ix) => Integral (Unsigned ix) where toInteger (Unsigned m) = m quotRem (Unsigned a) (Unsigned b) = @@ -61,7 +68,7 @@ instance (Size ix) => Enum (Unsigned ix) where fromEnum (Unsigned n) = fromEnum n toEnum n = mkUnsigned (toInteger n) -instance (Size ix) => Bits (Unsigned ix) where+instance (Size ix, Integral ix) => Bits (Unsigned ix) where bitSize s = f s undefined where f :: (Size a) => Unsigned a -> a -> Int@@ -71,7 +78,48 @@ a `xor` b = fromMatrix (M.zipWith (/=) (toMatrix a) (toMatrix b)) a .|. b = fromMatrix (M.zipWith (||) (toMatrix a) (toMatrix b)) a .&. b = fromMatrix (M.zipWith (&&) (toMatrix a) (toMatrix b))+ shiftL (Unsigned v) i = mkUnsigned (v * (2 ^ i))+ shiftR (Unsigned v) i = mkUnsigned (v `div` (2 ^ i))+ -- it might be possible to loosen the Integral requirement+ rotate v i = fromMatrix (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.length m)))+ where m = toMatrix v+ testBit u idx = toMatrix u ! (fromIntegral idx) --- | common; numerically boolean. +instance forall ix . (Size ix) => Bounded (Unsigned ix) where+ minBound = Unsigned 0+ maxBound = Unsigned (2 ^ (size (error "Bounded/Unsigned" :: ix)) - 1)++-- | common; numerically boolean. type U1 = Unsigned X1 +type U2 = Unsigned X2+type U3 = Unsigned X3+type U4 = Unsigned X4+type U5 = Unsigned X5+type U6 = Unsigned X6+type U7 = Unsigned X7+type U8 = Unsigned X8+type U9 = Unsigned X9+type U10 = Unsigned X10+type U11 = Unsigned X11+type U12 = Unsigned X12+type U13 = Unsigned X13+type U14 = Unsigned X14+type U15 = Unsigned X15+type U16 = Unsigned X16+type U17 = Unsigned X17+type U18 = Unsigned X18+type U19 = Unsigned X19+type U20 = Unsigned X20+type U21 = Unsigned X21+type U22 = Unsigned X22+type U23 = Unsigned X23+type U24 = Unsigned X24+type U25 = Unsigned X25+type U26 = Unsigned X26+type U27 = Unsigned X27+type U28 = Unsigned X28+type U29 = Unsigned X29+type U30 = Unsigned X30+type U31 = Unsigned X31+type U32 = Unsigned X32
+ Data/Sized/Vector.hs view
@@ -0,0 +1,107 @@++{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances, FlexibleInstances, OverlappingInstances #-}++module Data.Sized.Vector where++import qualified Data.Array as A+import qualified Data.List as L++data Vector ix a = Vector (A.Array ix a)+-- deriving Show++vector :: (Bounds ix) => ix -> [a] -> Vector ix a+vector ix vals = Vector (A.listArray (toBounds ix) vals)++instance (Bounds ix) => Functor (Vector ix) where+ fmap f (Vector xs) = Vector (fmap f xs)++class (A.Ix ix) => Bounds ix where+ toBounds :: ix -> (ix,ix)+ fromBounds :: (ix,ix) -> ix+ range :: (ix,ix) -> [ix]++instance Bounds Int where+ toBounds ix = (0,ix - 1)+ fromBounds (low,high) = (high - low) + 1+ range (low,high) = [low..high]++instance (Bounds a, Bounds b) => Bounds (a,b) where+ toBounds (ix1,ix2) = ((l1,l2),(h1,h2))+ where (l1,h1) = toBounds ix1+ (l2,h2) = toBounds ix2+ fromBounds ((l1,l2),(h1,h2)) = (ix1,ix2)+ where ix1 = fromBounds (l1,h1)+ ix2 = fromBounds (l2,h2)+ range ((l1,l2),(h1,h2)) = [(x,y) | x <- range (l1,h1), y <- range (l2,h2)]++(!) :: (Bounds ix) => Vector ix a -> ix -> a+(!) (Vector a) x = a A.! x++toList :: (Bounds ix) => Vector ix a -> [a]+toList (Vector a) = A.elems a++assocs :: (Bounds ix) => Vector ix a -> [(ix,a)]+assocs (Vector a) = A.assocs a++size :: Bounds ix => Vector ix a -> ix+size (Vector a) = fromBounds $ A.bounds a++bounds v = toBounds $ size v++indices :: (Bounds ix) => Vector ix a -> [ix]+indices (Vector a) = A.indices a++ixmap :: (Bounds i, Bounds j) => i -> (i -> j) -> Vector j a -> Vector i a+ixmap b f v = vector b [v ! f idx | idx <- range (toBounds b)]++transpose :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector (y,x) a+transpose v = ixmap (y',x') (\ (x,y) -> (y,x)) v+ where (x',y') = size v++identity :: (Bounds ix, Num a) => ix -> Vector (ix,ix) a+identity ix = vector (ix,ix) [if x == y then 1 else 0 | (x,y) <- range $ toBounds (ix,ix)]++rows :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector x (Vector y a)+rows v = vector xmax $ map (vector ymax) [[v ! (x,y) | y <- range (yl,yh)] | x <- range (xl,xh)]+ where (xmax,ymax) = size v+ ((xl,yl),(xh,yh)) = bounds v++cols :: (Bounds x, Bounds y) => Vector (x,y) a -> Vector y (Vector x a)+cols v = vector ymax $ map (vector xmax) [[v ! (x,y) | x <- range (xl,xh)] | y <- range (yl,yh)]+ where (xmax,ymax) = size v+ ((xl,yl),(xh,yh)) = bounds v++above :: (Bounds x, Bounds y, Num x, Num y) => Vector (x,y) a -> Vector (x,y) a -> Vector (x,y) a+above v1 v2 | numcols v1 == numcols v2 = vector (numrows v1 + numrows v2, numcols v1) xs+ | otherwise = error "Column count mismatch"+ where numcols v = snd $ size v+ numrows v = fst $ size v+ xs = toList v1 ++ toList v2++beside :: (Bounds x, Bounds y, Num x, Num y) => Vector (x,y) a -> Vector (x,y) a -> Vector (x,y) a+beside v1 v2 = transpose $ transpose v1 `above` transpose v2++show' v = showMatrix' (size v) (foo v)++foo v = toList $ fmap toList $ rows $ fmap show v+++seeIn2D :: (Bounds ix, Num ix) => Vector ix a -> Vector (ix,ix) a+seeIn2D v = vector (1,size v) (toList v)+++instance (Show a, Bounds ix) => Show (Vector (ix,ix) a) where show vector = show' vector+instance (Show a, Bounds ix, Num ix) => Show (Vector ix a) where show vector = show' $ seeIn2D vector+++--instance (Show a, Size ix,Size (Row ix), Size (Column ix)) => Show (Vector ix a) where+-- show arr = showMatrix' (fmap show (ixmap seeIn2D arr))++showMatrix' :: (Bounds ix) => (ix,ix) -> [[String]] -> String+showMatrix' (x,y) m = joinLines $ L.zipWith showRow m (map (const False) (init m) ++ [True])+ where+ joinLines = unlines . L.zipWith (++) ("[":repeat " ") + showRow r f = concat (L.zipWith3 showEle r m_cols_size (map (const False) (init r) ++ [f]))+ showEle str s f = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then " ]" else ",")+ m_cols = L.transpose m+ m_cols_size = fmap (maximum . map L.length) m_cols
+ qc/QC.hs view
@@ -0,0 +1,21 @@++-- Copy this module if you need Quick Check.+module QC where++import qualified Test.QuickCheck as QC+import Data.Sized.Ix()+import Data.Sized.Matrix as M+import Data.Sized.Arith++instance Size n => QC.Arbitrary (X0_ n) where+ arbitrary = QC.elements [minBound .. maxBound]+ +instance Size n => QC.Arbitrary (X1_ n) where+ arbitrary = QC.elements [minBound .. maxBound] ++instance (QC.Arbitrary ix, Size ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where+ arbitrary = f $ \ ixs -> do+ elems <- sequence [ QC.arbitrary | _ <- ixs ]+ return $ matrix elems+ where f :: (Size ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a)+ f fn = fn M.all
sized-types.cabal view
@@ -1,5 +1,5 @@ Name: sized-types-Version: 0.1+Version: 0.2.7.20101112 Synopsis: Sized types in Haskell. Description: Providing indices, matrixes, sparse matrixes, and signed and unsigned bit vectors. Category: Language@@ -8,14 +8,14 @@ Author: Andy Gill, Tristan Bull Maintainer: Andy Gill <andygill@ku.edu> Copyright: (c) 2009 The University of Kansas-Homepage: http://ittc.ku.edu/~andygill/sized-types.php+Homepage: http://www.ittc.ku.edu/csdl/fpg/Tools/SizedTypes Stability: alpha build-type: Simple Cabal-Version: >= 1.6 -Flag devel+Flag all Description: Enable full development tree- Default: False+ Default: True Library Build-Depends: base >= 4 && < 5, containers, array@@ -25,26 +25,27 @@ Data.Sized.Matrix, Data.Sized.Sparse.Matrix, Data.Sized.Signed,- Data.Sized.Unsigned- Ghc-Options: -Wall+ Data.Sized.Unsigned,+ Data.Sized.Vector,+ Data.Sized.Sampled + Ghc-Options: -Wall -O2+ Executable sized-types-test1- if flag(devel)+ if flag(all) Build-Depends: base, QuickCheck >= 2.0 buildable: True Other-modules:- Data.Sized.QC.Ix,- Data.Sized.QC.Matrix,- Data.Sized.QC.Signed+ QC else Build-depends: base buildable: False Main-Is: Test1.hs- Hs-Source-Dirs: ., test+ Hs-Source-Dirs: ., test, qc Ghc-Options: -Wall Executable sized-types-example1- if flag(devel)+ if flag(all) Build-Depends: base buildable: True else
test/Example1.hs view
@@ -22,7 +22,7 @@ print $ example8 print $ fmap (\ v -> if v == (0 :: Double) then S "" - else showAs 3 v) + else showAsE 3 v) $ fmap (fromIntegral) example6 let s :: [Signed X4]
test/Test1.hs view
@@ -4,8 +4,7 @@ import Data.Sized.Matrix import Test.QuickCheck as QC-import Data.Sized.QC.Ix-import Data.Sized.QC.Matrix as M+import QC import qualified Data.Sized.Sparse.Matrix as SM import Control.Applicative import Data.Sized.Arith