sized-types 0.3.5.2 → 0.5.1
raw patch · 17 files changed
Files
- CHANGELOG.md +3/−0
- Data/Sized/Arith.hs +0/−84
- Data/Sized/Fin.hs +100/−0
- Data/Sized/Ix.hs +0/−742
- Data/Sized/Matrix.hs +122/−191
- Data/Sized/Sampled.hs +56/−60
- Data/Sized/Signed.hs +129/−105
- Data/Sized/Sparse/Matrix.hs +64/−60
- Data/Sized/Unsigned.hs +137/−110
- Data/Sized/Vector.hs +0/−107
- README.md +19/−0
- Setup.hs +0/−4
- qc/QC.hs +0/−21
- sized-types.cabal +50/−53
- test/Example1.hs +56/−41
- test/QC/QC.hs +19/−0
- test/Test1.hs +37/−22
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 0.5.1+* Support for `singletons-1.1`+* Fixed warnings on GHC 7.10
− Data/Sized/Arith.hs
@@ -1,84 +0,0 @@--- | Basic type-level arithmetic, using base two.--- --- Copyright: (c) 2009 University of Kansas--- License: BSD3------ Maintainer: Andy Gill <andygill@ku.edu>--- Stability: unstable--- Portability: ghc---{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances #-}-module Data.Sized.Arith where--import Data.Ix--data N1--data X0 = X0- deriving (Eq,Ord)--data X0_ a = X0_ Integer -- times 2 plus 0-data X1_ a = X1_ Integer -- times 2 plus 1--type family ADD a b-type instance ADD N1 N1 = APP0 N1---type instance ADD N1 X0 = N1-type instance ADD N1 (X0_ b) = APP1 (ADD N1 b)-type instance ADD N1 (X1_ b) = APP0 b-type instance ADD X0 N1 = N1 -- MIR---type instance ADD X0 X0 = X0---type instance ADD X0 (X0_ b) = X0_ b---type instance ADD X0 (X1_ b) = APP1 b-type instance ADD (X0_ a) N1 = APP1 (ADD a N1) -- MIR---type instance ADD (X0_ a) X0 = APP0 a -- MIR-type instance ADD (X0_ a) (X0_ b) = APP0 (ADD a b)-type instance ADD (X0_ a) (X1_ b) = APP1 (ADD a b)-type instance ADD (X1_ a) N1 = APP0 a -- MIR---type instance ADD (X1_ a) X0 = APP1 a -- MIR-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 instance ADD a X0 = a-type instance ADD X0 a = a---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-type instance APP1 (X0_ a) = X1_ (X0_ a)-type instance APP1 (X1_ a) = X1_ (X1_ a)--type family APP0 a-type instance APP0 N1 = X0_ N1-type instance APP0 X0 = X0-type instance APP0 (X0_ a) = X0_ (X0_ a)-type instance APP0 (X1_ a) = X0_ (X1_ a)-
+ Data/Sized/Fin.hs view
@@ -0,0 +1,100 @@+-- | Fin types+--+-- Copyright: (c) 2013 University of Kansas+-- License: BSD3+--+-- Maintainer: Andy Gill <andygill@ku.edu>+-- Stability: unstable+-- Portability: ghc+{-# LANGUAGE TypeFamilies, ScopedTypeVariables, UndecidableInstances, FlexibleInstances, GADTs, DeriveDataTypeable #-}+{-# LANGUAGE DataKinds, KindSignatures, TypeOperators, CPP #-}+module Data.Sized.Fin+ ( -- TNat+ Fin+ , fromNat+ , corners+ , universe+ , size+ , module Data.Singletons+ , Nat+ )+ where++import Data.Ix+#if __GLASGOW_HASKELL__ >= 708+import Data.Typeable+#endif+import Data.Singletons+import Data.Singletons.TypeLits++--type TNat (a::Nat) = Sing a++newtype Fin (n :: Nat) = Fin Integer+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ )++fromNat :: Sing (n :: Nat) -> Integer+fromNat = fromSing++-- A finite (bounding) corners of an finite indexed entity+corners :: forall i . (Bounded i) => (i,i)+corners = (minBound :: i,maxBound)++-- | A list of all possible values of a type.+universe :: (Bounded ix, Ix ix) => [ix]+universe = range corners++-- property:length (universe :: [a]) == size a+size :: forall ix . (Bounded ix, Ix ix) => ix -> Int+size _ = rangeSize (corners :: (ix,ix))++mkFin :: forall x . SingI x => Integer -> Fin x+mkFin n | m == 0 = error "<<Fin 0>>"+ | n < 0 = error $ show n ++ " (:: Fin " ++ show m ++ ") is below upper bound"+ | n >= m = error $ show n ++ " (:: Fin " ++ show m ++ ") is above upper bound"+ | otherwise = Fin n+ where m = fromNat (sing :: Sing x)++instance Show (Fin a) where+ show (Fin a) = show a++instance SingI a => Read (Fin a) where+ readsPrec i str0 = [ (mkFin v,str1) | (v,str1) <- readsPrec i str0 ]++instance SingI a => Num (Fin a) where+ (Fin a) + (Fin b) = mkFin (a + b)+ (Fin a) * (Fin b) = mkFin (a * b)+ (Fin a) - (Fin b) = mkFin (a - b)+ abs (Fin a) = mkFin (abs a)+ signum (Fin a) = mkFin (signum a)+ fromInteger n = mkFin (fromInteger n)++instance (SingI a) => Ix (Fin a) where+ range (Fin n, Fin m) = [ mkFin x | x <- range (n,m) ]+ index (Fin n, Fin m) (Fin i) = index (n,m) i+ inRange (Fin n, Fin m) (Fin i) = inRange (n,m) i+ rangeSize (Fin n, Fin m) = fromIntegral $ max ((m - n) + 1) 0++instance SingI a => Bounded (Fin a) where+ minBound = mkFin 0+ maxBound = n where n = mkFin (fromSing (sing :: Sing a) - 1)++instance Enum (Fin a) where+ fromEnum (Fin n) = fromIntegral n+ toEnum n = Fin (fromIntegral n)++instance (SingI a) => Real (Fin a) where+ toRational (Fin n) = toRational n++instance (SingI a) => Integral (Fin a) where+ quot (Fin n) (Fin m) = mkFin (n `quot` m)+ rem (Fin n) (Fin m) = mkFin (n `rem` m)+ div (Fin n) (Fin m) = mkFin (n `div` m)+ mod (Fin n) (Fin m) = mkFin (n `mod` m)+ quotRem a b = (a `quot` b,a `rem` b)+ divMod a b = (a `div` b,a `mod` b)+ toInteger (Fin n) = n
− Data/Sized/Ix.hs
@@ -1,742 +0,0 @@--- | Sized types X0 to X256.--- --- Copyright: (c) 2009 University of Kansas--- License: BSD3------ Maintainer: Andy Gill <andygill@ku.edu>--- Stability: unstable--- Portability: ghc--{-# LANGUAGE TypeFamilies, EmptyDataDecls, UndecidableInstances, ScopedTypeVariables #-}-module Data.Sized.Ix - ( X0- , X1- , X2- , X3- , X4- , X5- , X6- , X7- , X8- , X9- , X10- , X11- , X12- , X13- , X14- , X15- , X16- , X17- , X18- , X19- , X20- , X21- , X22- , X23- , X24- , X25- , X26- , X27- , X28- , X29- , X30- , X31- , X32- , X33- , X34- , X35- , X36- , X37- , X38- , X39- , X40- , X41- , X42- , X43- , X44- , X45- , X46- , X47- , X48- , X49- , X50- , X51- , X52- , X53- , X54- , X55- , X56- , X57- , X58- , X59- , X60- , X61- , X62- , X63- , X64- , X65- , X66- , X67- , X68- , X69- , X70- , X71- , X72- , X73- , X74- , X75- , X76- , X77- , X78- , X79- , X80- , X81- , X82- , X83- , X84- , X85- , X86- , X87- , X88- , X89- , X90- , X91- , X92- , X93- , X94- , X95- , X96- , X97- , X98- , X99- , X100- , X101- , X102- , X103- , X104- , X105- , X106- , X107- , X108- , X109- , X110- , X111- , X112- , X113- , X114- , X115- , X116- , X117- , X118- , X119- , X120- , X121- , X122- , X123- , X124- , X125- , X126- , X127- , X128- , X129- , X130- , X131- , X132- , X133- , X134- , X135- , X136- , X137- , X138- , X139- , X140- , X141- , X142- , X143- , X144- , X145- , X146- , X147- , X148- , X149- , X150- , X151- , X152- , X153- , X154- , X155- , X156- , X157- , X158- , X159- , X160- , X161- , X162- , X163- , X164- , X165- , X166- , X167- , X168- , X169- , X170- , X171- , X172- , X173- , X174- , X175- , X176- , X177- , X178- , X179- , X180- , X181- , X182- , X183- , X184- , X185- , X186- , X187- , X188- , X189- , X190- , X191- , X192- , X193- , X194- , X195- , X196- , X197- , X198- , X199- , X200- , X201- , X202- , X203- , X204- , X205- , X206- , X207- , X208- , X209- , X210- , X211- , X212- , X213- , X214- , X215- , X216- , X217- , X218- , X219- , X220- , X221- , X222- , X223- , X224- , X225- , X226- , X227- , X228- , X229- , X230- , X231- , X232- , X233- , X234- , X235- , X236- , X237- , X238- , X239- , X240- , X241- , X242- , X243- , X244- , X245- , X246- , X247- , X248- , X249- , X250- , X251- , X252- , X253- , X254- , X255- , X256- , Size(..)- , all- , Index--- , Row--- , Column- , coerceSize- , ADD- , SUB- ) where- -import Prelude hiding (all)-import Data.Ix-import Data.Sized.Arith---- | A list of all possible indices.--- Unlike 'indices' in Matrix, this does not need the 'Matrix'--- argument, because the types determine the contents.-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---type family Row a---type family Column a--class (Eq ix, Ord ix, Show ix, Ix ix, Bounded ix) => Size ix where- -- | return the size (number of possible elements) in type 'ix'.- size :: ix -> Int- -- | add an arbitary index to a specific 'ix' position.- addIndex :: ix -> Index ix -> ix- -- | look at an 'ix' as an 'Index', typically just an 'Int'.- toIndex :: ix -> Index ix--type instance Index () = ()--instance Size () where- size () = 1- addIndex () () = ()- toIndex () = ()---type instance Index (a,b) = (Index a,Index b)---type instance Row (a,b) = a---type instance Column (a,b) = b--instance (Size x, Size y) => Size (x,y) where- 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)- -type instance Index (a,b,c) = (Index a,Index b,Index c)--- type instance Row (a,b,c) = a---type instance Column (a,b,c) = (b,c)--instance (Size x, Size y, Size z) => Size (x,y,z) where- size (a,b,c) = size a * size b * size c- addIndex (a,b,c) (a',b',c') = (addIndex a a',addIndex b b',addIndex c c')- toIndex (a,b,c) = (toIndex a, toIndex b,toIndex c)--- seeIn2D (_a,_b) = error "Can not display 3D matrix in 2D"- -type instance Index (a,b,c,d) = (Index a,Index b,Index c,Index d)--instance (Size x, Size y, Size z,Size z2) => Size (x,y,z,z2) where- size (a,b,c,d) = size a * size b * size c * size d- addIndex (a,b,c,d) (a',b',c',d') = (addIndex a a',addIndex b b',addIndex c c',addIndex d d')- toIndex (a,b,c,d) = (toIndex a, toIndex b,toIndex c,toIndex d)--- seeIn2D (_a,_b) = error "Can not display 4D matrix in 2D"---- | A good way of converting from one index type to another index type, typically in another base.-coerceSize :: (Index ix1 ~ Index ix2, Size ix1, Size ix2, Num ix2) => ix1 -> ix2-coerceSize ix = addIndex 0 (toIndex ix)--type instance Index X0 = Int---type instance Row X0 = X1---type instance Column X0 = X0--instance Size X0 where- size _ = 0- 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_ (fromIntegral (size a) - 1) in a--instance (Size a) => Real (X1_ a) where-instance (Size a, Size (X1_ a), Integral a) => Integral (X1_ a) where - quotRem (X1_ a) (X1_ b) = (X1_ (a `quot` b),X1_ (a `rem` b))- divMod (X1_ a) (X1_ b) = (X1_ (a `div` b),X1_ (a `mod` b))- toInteger (X1_ a) = toInteger a--type instance Index (X1_ a) = Int---type instance Row (X1_ a) = X1---type instance Column (X1_ a) = X1_ a--instance Size a => Size (X1_ a) where- size = const s- where s = 2 * size (undefined :: a) + 1- addIndex (X1_ v) n = mkX1_ (v + fromIntegral n) -- fix bounds issues- toIndex (X1_ v) = fromIntegral v--- seeIn2D (_,y) = y--type instance Index (X0_ a) = Int---type instance Row (X0_ a) = X1---type instance Column (X0_ a) = X0_ a--instance Size a => Bounded (X0_ a) where- minBound = X0_ 0- maxBound = let a = X0_ (fromIntegral (size a) - 1) in a--instance Size a => Size (X0_ a) where- size = const s- where s = 2 * size (undefined :: a) - addIndex (X0_ v) n = mkX0_ (v + fromIntegral n) -- fix bounds issues- toIndex (X0_ v) = fromIntegral v--- seeIn2D (_,y) = y- -instance (Size a) => Real (X0_ a) where-instance (Size a, Size (X0_ a), Integral a) => Integral (X0_ a) where - quotRem (X0_ a) (X0_ b) = (X0_ (a `quot` b),X0_ (a `rem` b))- divMod (X0_ a) (X0_ b) = (X0_ (a `div` b),X0_ (a `mod` b))- toInteger (X0_ a) = 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_ (fromIntegral n)- fromEnum (X0_ n) = fromIntegral 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_ . fromIntegral) (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_ (fromIntegral n)- fromEnum (X1_ n) = fromIntegral 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_ :: forall a . Size a => Integer -> X0_ a-mkX0_ n | n < 0 = error $ "out of range: ((" ++ show n ++ ") :: X" ++ show s ++ ") < 0"- | n >= s = error $ "out of range: (" ++ show n ++ " :: X" ++ show s ++ ") >= " ++ show s- | otherwise = r- where- r :: X0_ a- r = X0_ n- s = fromIntegral (size r)--mkX1_ :: forall a . Size a => Integer -> X1_ a-mkX1_ n | n < 0 = error $ "out of range: ((" ++ show n ++ ") :: X" ++ show s ++ ") < 0"- | n >= s = error $ "out of range: (" ++ show n ++ " :: X" ++ show s ++ ") >= " ++ show s- | otherwise = r- where- r :: X1_ a- r = X1_ n- s = fromIntegral (size r)---------type X1 = X1_ X0-type X2 = X0_ (X1_ X0)-type X3 = X1_ (X1_ X0)-type X4 = X0_ (X0_ (X1_ X0))-type X5 = X1_ (X0_ (X1_ X0))-type X6 = X0_ (X1_ (X1_ X0))-type X7 = X1_ (X1_ (X1_ X0))-type X8 = X0_ (X0_ (X0_ (X1_ X0)))-type X9 = X1_ (X0_ (X0_ (X1_ X0)))-type X10 = X0_ (X1_ (X0_ (X1_ X0)))-type X11 = X1_ (X1_ (X0_ (X1_ X0)))-type X12 = X0_ (X0_ (X1_ (X1_ X0)))-type X13 = X1_ (X0_ (X1_ (X1_ X0)))-type X14 = X0_ (X1_ (X1_ (X1_ X0)))-type X15 = X1_ (X1_ (X1_ (X1_ X0)))-type X16 = X0_ (X0_ (X0_ (X0_ (X1_ X0))))-type X17 = X1_ (X0_ (X0_ (X0_ (X1_ X0))))-type X18 = X0_ (X1_ (X0_ (X0_ (X1_ X0))))-type X19 = X1_ (X1_ (X0_ (X0_ (X1_ X0))))-type X20 = X0_ (X0_ (X1_ (X0_ (X1_ X0))))-type X21 = X1_ (X0_ (X1_ (X0_ (X1_ X0))))-type X22 = X0_ (X1_ (X1_ (X0_ (X1_ X0))))-type X23 = X1_ (X1_ (X1_ (X0_ (X1_ X0))))-type X24 = X0_ (X0_ (X0_ (X1_ (X1_ X0))))-type X25 = X1_ (X0_ (X0_ (X1_ (X1_ X0))))-type X26 = X0_ (X1_ (X0_ (X1_ (X1_ X0))))-type X27 = X1_ (X1_ (X0_ (X1_ (X1_ X0))))-type X28 = X0_ (X0_ (X1_ (X1_ (X1_ X0))))-type X29 = X1_ (X0_ (X1_ (X1_ (X1_ X0))))-type X30 = X0_ (X1_ (X1_ (X1_ (X1_ X0))))-type X31 = X1_ (X1_ (X1_ (X1_ (X1_ X0))))-type X32 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))-type X33 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))-type X34 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))-type X35 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))-type X36 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))-type X37 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))-type X38 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))-type X39 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))-type X40 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))-type X41 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))-type X42 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))-type X43 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))-type X44 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))-type X45 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))-type X46 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))-type X47 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))-type X48 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))-type X49 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))-type X50 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))-type X51 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))-type X52 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))-type X53 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))-type X54 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))-type X55 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))-type X56 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))-type X57 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))-type X58 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))-type X59 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))-type X60 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))-type X61 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))-type X62 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))-type X63 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))-type X64 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X65 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X66 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X67 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X68 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X69 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X70 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X71 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0))))))-type X72 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X73 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X74 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X75 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X76 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X77 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X78 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X79 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0))))))-type X80 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X81 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X82 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X83 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X84 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X85 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X86 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X87 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0))))))-type X88 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X89 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X90 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X91 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X92 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X93 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X94 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X95 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0))))))-type X96 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X97 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X98 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X99 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X100 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X101 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X102 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X103 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0))))))-type X104 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X105 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X106 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X107 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X108 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X109 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X110 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X111 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0))))))-type X112 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X113 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X114 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X115 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X116 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X117 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X118 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X119 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0))))))-type X120 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X121 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X122 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X123 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X124 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X125 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X126 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X127 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0))))))-type X128 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X129 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X130 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X131 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X132 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X133 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X134 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X135 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X136 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X137 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X138 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X139 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X140 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X141 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X142 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X143 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ X0)))))))-type X144 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X145 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X146 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X147 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X148 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X149 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X150 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X151 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X152 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X153 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X154 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X155 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X156 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X157 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X158 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X159 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ X0)))))))-type X160 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X161 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X162 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X163 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X164 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X165 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X166 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X167 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X168 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X169 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X170 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X171 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X172 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X173 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X174 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X175 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ X0)))))))-type X176 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X177 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X178 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X179 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X180 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X181 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X182 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X183 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X184 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X185 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X186 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X187 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X188 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X189 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X190 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X191 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ X0)))))))-type X192 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X193 = X1_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X194 = X0_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X195 = X1_ (X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X196 = X0_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X197 = X1_ (X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X198 = X0_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X199 = X1_ (X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X200 = X0_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X201 = X1_ (X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X202 = X0_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X203 = X1_ (X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X204 = X0_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X205 = X1_ (X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X206 = X0_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X207 = X1_ (X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ X0)))))))-type X208 = X0_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X209 = X1_ (X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X210 = X0_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X211 = X1_ (X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X212 = X0_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X213 = X1_ (X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X214 = X0_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X215 = X1_ (X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X216 = X0_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X217 = X1_ (X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X218 = X0_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X219 = X1_ (X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X220 = X0_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X221 = X1_ (X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X222 = X0_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X223 = X1_ (X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ X0)))))))-type X224 = X0_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X225 = X1_ (X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X226 = X0_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X227 = X1_ (X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X228 = X0_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X229 = X1_ (X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X230 = X0_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X231 = X1_ (X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X232 = X0_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X233 = X1_ (X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X234 = X0_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X235 = X1_ (X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X236 = X0_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X237 = X1_ (X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X238 = X0_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X239 = X1_ (X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ X0)))))))-type X240 = X0_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X241 = X1_ (X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X242 = X0_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X243 = X1_ (X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X244 = X0_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X245 = X1_ (X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X246 = X0_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X247 = X1_ (X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X248 = X0_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X249 = X1_ (X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X250 = X0_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X251 = X1_ (X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X252 = X0_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X253 = X1_ (X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X254 = X0_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X255 = X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ (X1_ X0)))))))-type X256 = X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X0_ (X1_ X0))))))))-
Data/Sized/Matrix.hs view
@@ -1,216 +1,173 @@ -- | Sized matrixes.--- --- Copyright: (c) 2009 University of Kansas+--+-- Copyright: (c) 2013 University of Kansas -- License: BSD3 -- -- Maintainer: Andy Gill <andygill@ku.edu> -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables, UndecidableInstances, MultiParamTypeClasses #-}-module Data.Sized.Matrix - ( module Data.Sized.Matrix- , module Data.Sized.Ix- ) where+{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, ScopedTypeVariables,+ UndecidableInstances, MultiParamTypeClasses, TypeOperators, DataKinds,+ FlexibleContexts, DeriveDataTypeable, CPP, NoImplicitPrelude #-}+module Data.Sized.Matrix where -import Data.Array as A hiding (indices,(!), ixmap, assocs)-import qualified Data.Array as A-import Prelude as P hiding (all)-import Control.Applicative+import Prelude.Compat as P hiding (all) import qualified Data.Traversable as T import qualified Data.Foldable as F-import qualified Data.List as L -import Numeric +import qualified Data.List as L hiding (all)+import Data.Array.Base as B+import Data.Array.IArray as I+import GHC.TypeLits (type (+))+#if __GLASGOW_HASKELL__ >= 708+import Data.Typeable+#endif+import Numeric -import Data.Sized.Ix+import Data.Sized.Fin --- | 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)- | NullMatrix -- consider using Int as index, and keeping ix as phantom,- -- instead of this NullMatrix.- deriving (Eq,Ord)+-- | A 'Matrix' is an array with the size determined uniquely by the+-- /type/ of the index type, 'ix', with every type in 'ix' used.+newtype Matrix ix a = Matrix (Array ix a)+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) --- | '!' 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"+-- | A 'Vector' is a 1D Matrix, using a TypeNat to define its length.+type Vector (ix :: Nat) a = Matrix (Fin ix) a -instance (Size i) => Functor (Matrix i) where- fmap f (Matrix xs) = Matrix (fmap f xs)- fmap f NullMatrix = NullMatrix+-- | A 'Vector2' is a 2D Matrix, using a TypeNat's to define its size.+type Vector2 (ix :: Nat) (iy :: Nat) a = Matrix (Fin ix,Fin iy) a --- | 'toList' turns a matrix into an always finite list.-toList :: (Size i) => Matrix i a -> [a]-toList (Matrix a) = elems a-toList NullMatrix = []+instance (Ix ix) => Functor (Matrix ix) where+ fmap f (Matrix xs) = Matrix (fmap f xs) --- | 'fromList' turns a finite list into a matrix. You often need to give the type of the result.-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."+instance IArray Matrix a where+ bounds (Matrix arr) = B.bounds arr+ numElements (Matrix arr) = B.numElements arr+ unsafeArray (a,b) ass = Matrix $ B.unsafeArray (a,b) ass+ unsafeAt (Matrix arr) i = B.unsafeAt arr i - where - witness :: i- witness = undefined- low :: i- low = minBound- high :: i- high = maxBound+instance (Bounded i, Ix i) => Applicative (Matrix i) where+ pure a = fmap (const a) coord -- possible because we are a fixed size+ -- Also why use use newtype here.+ a <*> b = forAll $ \ i -> (a ! i) (b ! i) -- | '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---- | 'indices' is a version of 'Data.Sized.Ix.all' that takes a type, for forcing the result type using the Matrix type.-indices :: (Size i) => Matrix i a -> [i]-indices _ = all---- | what is the length of a matrix?-length :: (Size i) => Matrix i a -> Int-length = size . zeroOf+matrix :: forall i a . (Bounded i, Ix i) => [a] -> Matrix i a+matrix xs | size' == fromIntegral (L.length xs) = I.listArray (low,high) xs+ | otherwise = error $ "bad length of fromList for Matrix, "+ ++ "expecting " ++ show size' ++ " elements"+ ++ ", found " ++ show (L.length xs) ++ " elements." --- | 'assocs' extracts the index/value pairs.-assocs :: (Size i) => Matrix i a -> [(i,a)]-assocs (Matrix a) = A.assocs a-assocs NullMatrix = []+ where+ size' = rangeSize (low,high)+ low :: i+ low = minBound+ high :: i+ high = maxBound -(//) :: (Size i) => Matrix i e -> [(i, e)] -> Matrix i e-(//) (Matrix arr) ixs = Matrix (arr A.// ixs)-(//) (NullMatrix) _ = NullMatrix+-- | what is the population of a matrix?+population :: forall i a . (Bounded i, Ix i) => Matrix i a -> Int+population _ = rangeSize (minBound :: i,maxBound) -accum :: (Size i) => (e -> a -> e) -> Matrix i e -> [(i, a)] -> Matrix i e-accum f (Matrix arr) ixs = Matrix (A.accum f arr ixs)+allIndices :: (Bounded i, Ix i) => Matrix i a -> [i]+allIndices _ = universe -- | 'zeroOf' is for use to force typing issues, and is 0.-zeroOf :: (Size i) => Matrix i a -> i+zeroOf :: (Bounded i, Ix i) => Matrix i a -> i zeroOf _ = minBound -- | 'coord' returns a matrix filled with indexes.-coord :: (Size i) => Matrix i i-coord = fromList all+coord :: (Bounded i, Ix i) => Matrix i i+coord = matrix universe -- | Same as for lists.-zipWith :: (Size i) => (a -> b -> c) -> Matrix i a -> Matrix i b -> Matrix i c+zipWith :: (Bounded i, Ix i) => (a -> b -> c) -> Matrix i a -> Matrix i b -> Matrix i c zipWith f a b = forAll $ \ i -> f (a ! i) (b ! i) -- | 'forEach' takes a matrix, and calls a function for each element, to give a new matrix of the same size.-forEach :: (Size i) => Matrix i a -> (i -> a -> b) -> Matrix i b+forEach :: (Bounded i, Ix i) => Matrix i a -> (i -> a -> b) -> Matrix i b forEach a f = Data.Sized.Matrix.zipWith f coord a -- | 'forAll' creates a matrix out of a mapping from the coordinates.-forAll :: (Size i) => (i -> a) -> Matrix i a+forAll :: (Bounded i, Ix i) => (i -> a) -> Matrix i a forAll f = fmap f coord -instance (Size i) => Applicative (Matrix i) where- pure a = fmap (const a) coord -- possible because we are a fixed size- a <*> b = forAll $ \ i -> (a ! i) (b ! i)- -- | 'mm' is the 2D matrix multiply.-mm :: (Size m, Size n, Size m', Size n', n ~ m', Num a) => Matrix (m,n) a -> Matrix (m',n') a -> Matrix (m,n') a-mm a b = forAll $ \ (i,j) -> sum [ a ! (i,r) * b ! (r,j) | r <- all ]- +mm :: (Bounded m, Ix m, Bounded n, Ix n, Bounded o, Ix o, Num a) => Matrix (m,n) a -> Matrix (n,o) a -> Matrix (m,o) a+mm a b = forAll $ \ (i,j) -> sum [ a ! (i,r) * b ! (r,j) | r <- universe ]+ -- | 'transpose' a 2D matrix.-transpose :: (Size x, Size y) => Matrix (x,y) a -> Matrix (y,x) a-transpose = ixmap $ \ (x,y) -> (y,x)+transpose :: (Bounded x, Ix x, Bounded y, Ix y) => Matrix (x,y) a -> Matrix (y,x) a+transpose = ixmap corners $ \ (x,y) -> (y,x) -- | return the identity for a specific matrix size.-identity :: (Size x, Num a) => Matrix (x,x) a+identity :: (Bounded x, Ix x, Num a) => Matrix (x,x) a identity = (\ (x,y) -> if x == y then 1 else 0) <$> coord +-- | append to 1D vectors+append :: (SingI left, SingI right, SingI (left + right))+ => Vector left a -> Vector right a -> Vector (left + right) a+append m1 m2 = matrix (I.elems m1 ++ I.elems m2)++-- TODO. Is the type constraint for 'both' sufficient ?+-- In an earlier version we had:+-- , ADD top bottom ~ both+-- , SUB both top ~ bottom+-- , SUB both bottom ~ top+ -- | stack two matrixes 'above' each other.-above :: (Size m, Size top, Size bottom, Size both- , ADD top bottom ~ both- , SUB both top ~ bottom- , SUB both bottom ~ top - ) - => Matrix (top,m) a -> Matrix (bottom,m) a -> Matrix (both,m) a-above m1 m2 = fromList (toList m1 ++ toList m2) +above :: (SingI top, SingI bottom, SingI y, SingI (top + bottom))+ => Vector2 top y a -> Vector2 bottom y a -> Vector2 (top + bottom) y a+above m1 m2 = matrix (I.elems m1 ++ I.elems m2)+ -- | stack two matrixes 'beside' each other.-beside- :: (Size m,- Size left,- Size right,- Size both- , ADD left right ~ both- , SUB both left ~ right- , SUB both right ~ left- ) =>- Matrix (m, left) a -> Matrix (m, right) a -> Matrix (m, both) a+beside :: (SingI left, SingI right, SingI x, SingI (left + right))+ => Vector2 x left a -> Vector2 x right a -> Vector2 x (left + right) 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- -- | look at a matrix through a functor lens, to another matrix.-ixfmap :: (Size i, Size j, Functor f) => (i -> f j) -> Matrix j a -> Matrix i (f a)+ixfmap :: (Bounded i, Ix i, Bounded j, Ix j, Functor f) => (i -> f j) -> Matrix j a -> Matrix i (f a) ixfmap f m = (fmap (\ j -> m ! j) . f) <$> coord +-- FIXME. This is difficult to do with the simplifications appearing Sized.+-- The Index class no longer exists (which required addIndex)+-- Is this required ???+ -- | grab /part/ of a matrix.-cropAt :: (Index i ~ Index ix, Size i, Size ix) => Matrix ix a -> ix -> Matrix i a-cropAt m corner = ixmap (\ i -> (addIndex corner (toIndex i))) m+--cropAt :: (Index i ~ Index ix, Bounded i, Ix i, Bounded ix, Ix ix) => Matrix ix a -> ix -> Matrix i a+--cropAt m corner = ixmap (\ i -> (addIndex corner (toIndex i))) m -- | slice a 2D matrix into rows.-rows :: (Bounded n, Size n, Bounded m, Size m) => Matrix (m,n) a -> Matrix m (Matrix n a)-rows a = (\ m -> matrix [ a ! (m,n) | n <- all ]) <$> coord+rows :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix (m,n) a -> Matrix m (Matrix n a)+rows a = (\ m -> matrix [ a ! (m,n) | n <- universe ]) <$> coord -- | slice a 2D matrix into columns.-columns :: (Bounded n, Size n, Bounded m, Size m) => Matrix (m,n) a -> Matrix n (Matrix m a)+columns :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix (m,n) a -> Matrix n (Matrix m a) columns = rows . transpose -- | join a matrix of matrixes into a single matrix.-joinRows :: (Bounded n, Size n, Bounded m, Size m) => Matrix m (Matrix n a) -> Matrix (m,n) a+joinRows :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix m (Matrix n a) -> Matrix (m,n) a joinRows a = (\ (m,n) -> (a ! m) ! n) <$> coord -- | join a matrix of matrixes into a single matrix.-joinColumns :: (Bounded n, Size n, Bounded m, Size m) => Matrix n (Matrix m a) -> Matrix (m,n) a+joinColumns :: (Bounded n, Ix n, Bounded m, Ix m) => Matrix n (Matrix m a) -> Matrix (m,n) a joinColumns a = (\ (m,n) -> (a ! n) ! m) <$> coord --- | generate a 2D single row from a 1D matrix.-unitRow :: (Size m, Bounded m) => Matrix m a -> Matrix (X1, m) a-unitRow = ixmap snd---- | generate a 1D matrix from a 2D matrix.-unRow :: (Size m, Bounded m) => Matrix (X1, m) a -> Matrix m a-unRow = ixmap (\ n -> (0,n))---- | generate a 2D single column from a 1D matrix.-unitColumn :: (Size m, Bounded m) => Matrix m a -> Matrix (m, X1) a-unitColumn = ixmap fst---- | generate a 1D matrix from a 2D matrix.-unColumn :: (Size m, Bounded m) => Matrix (m, X1) a -> Matrix m a-unColumn = ixmap (\ n -> (n,0))---- | very general; required that m and n have the same number of elements, rebundle please.-squash :: (Size n, Size m) => Matrix m a -> Matrix n a-squash = fromList . toList+instance (Bounded ix, Ix ix) => T.Traversable (Matrix ix) where+ traverse f a = matrix <$> (T.traverse f $ I.elems a) -instance (Size ix) => T.Traversable (Matrix ix) where- traverse f a = matrix <$> (T.traverse f $ toList a)- -instance (Size ix) => F.Foldable (Matrix ix) where- foldMap f m = F.foldMap f (toList m)+instance (Bounded ix, Ix ix) => F.Foldable (Matrix ix) where+ foldMap f m = F.foldMap f (I.elems m) --- | 'showMatrix' displays a 2D matrix, and is the worker for 'show'.--- --- > GHCi> matrix [1..42] :: Matrix (X7,X6) Int+-- | 'show2D' displays a 2D matrix, and is the worker for 'show'.+--+-- > GHCi> matrix [1..42] :: Matrix (Fin 7, Fin 6) Int -- > [ 1, 2, 3, 4, 5, 6, -- > 7, 8, 9, 10, 11, 12, -- > 13, 14, 15, 16, 17, 18,@@ -220,21 +177,23 @@ -- > 37, 38, 39, 40, 41, 42 ] -- > -showMatrix :: (Size n, Size m) => Matrix (m, n) String -> String-showMatrix m = (joinLines $ map showRow m_rows)- where- m' = forEach m $ \ (x,y) a -> (x == maxBound && y == maxBound,a)- 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 ",")- m_cols = columns m- m_rows = toList $ rows m'- m_cols_size = fmap (maximum . map L.length . toList) m_cols+show2D :: (Bounded n, Ix n, Bounded m, Ix m, Show a) => Matrix (m, n) a -> String+show2D m0 = (joinLines $ map showRow m_rows)+ where+ m = fmap show m0+ m' = forEach m $ \ (x,y) a -> (x == maxBound && y == maxBound,a)+ joinLines = unlines . addTail . L.zipWith (++) ("[":repeat " ")+ addTail xs = init xs ++ [last xs ++ " ]"]+ showRow r = concat (I.elems $ Data.Sized.Matrix.zipWith showEle r m_cols_size)+ showEle (f,str) s = take (s - L.length str) (cycle " ") ++ " " ++ str ++ (if f then "" else ",")+ m_cols = columns m+ m_rows = I.elems $ rows m'+ m_cols_size = fmap (maximum . map L.length . I.elems) m_cols +instance (Show a, Show ix, Bounded ix, Ix ix) => Show (Matrix ix a) where+ show m = "matrix " ++ show (I.bounds m) ++ " " ++ show (I.elems m) -instance (Show a, Size ix) => Show (Matrix ix a) where- show = showMatrix . fmap show . unitRow+-- TODO: read instance -- | 'S' is shown as the contents, without the quotes. -- One use is a matrix of S, so that you can do show-style functions@@ -242,38 +201,10 @@ newtype S = S String instance Show S where- show (S s) = s+ show (S s) = s -showAsE :: (RealFloat a) => Int -> a -> S +showAsE :: (RealFloat a) => Int -> a -> S showAsE i a = S $ showEFloat (Just i) a "" -showAsF :: (RealFloat a) => Int -> a -> S +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/Sampled.hs view
@@ -1,79 +1,75 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, ExistentialQuantification #-} module Data.Sized.Sampled where -import Data.Ratio import Data.Sized.Signed as S import Data.Sized.Matrix as M-import Data.Sized.Ix+import Data.Sized.Fin -- 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+data Sampled (m :: Nat) (n :: Nat) = Sampled (Signed n) Rational -- deriving Show -toMatrix :: (Size n) => Sampled m n -> Matrix n Bool-toMatrix (Sampled sig _) = S.toMatrix sig+toVector :: (SingI m, SingI n) => Sampled m n -> Vector n Bool+toVector (Sampled sig _) = S.toVector 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)- +fromVector :: forall n m . (SingI n, SingI m) => Vector n Bool -> Sampled m n+fromVector v = mkSampled (fromIntegral scale * fromIntegral val / fromIntegral precision)+ where val :: Signed n+ val = S.fromVector v+ scale :: Integer+ scale = fromIntegral (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing n) - 1) :: Integer) -mkSampled :: forall n m . (Size n, Size m) => Rational -> Sampled m n+mkSampled :: forall n m . (SingI n, SingI 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 ]+ where scale :: Integer+ scale = fromIntegral (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing 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, 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 (SingI ix) => Eq (Sampled m ix) where+ (Sampled a _) == (Sampled b _) = a == b+instance (SingI ix) => Ord (Sampled m ix) where+ (Sampled a _) `compare` (Sampled b _) = a `compare` b+instance (SingI ix) => Show (Sampled m ix) where+ show (Sampled _ s) = show (fromRational s :: Double)+instance (SingI ix, SingI m) => Read (Sampled m ix) where+ readsPrec i str = [ (mkSampled a,r) | (a,r) <- readsPrec i str ] -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+instance (SingI ix, SingI 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) --- 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+instance (SingI ix, SingI m) => Real (Sampled m ix) where+ toRational (Sampled _ n) = toRational 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)+instance (SingI ix, SingI 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 (SingI ix, SingI 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 (fromNat (sing :: Sing m))+ precision :: Integer+ precision = 2 ^ (fromIntegral (fromNat (sing :: Sing ix) - 1) :: Integer)
Data/Sized/Signed.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable, CPP #-} -- | Signed, fixed sized numbers. --@@ -10,119 +10,143 @@ -- Portability: ghc module Data.Sized.Signed- ( 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+ ( Signed+ , toVector+ , fromVector+ , 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.Array.IArray(elems, (!)) import Data.Sized.Matrix as M-import Data.Sized.Ix-import Data.List as L+import Data.Sized.Fin import Data.Bits+#if __GLASGOW_HASKELL__ >= 708+import Data.Typeable+#endif -newtype Signed ix = Signed Integer+newtype Signed (ix :: Nat) = Signed Integer+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) --- 'toMatrix' turns a sized 'Signed' value into a 'Matrix' of 'Bool's.-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+-- 'toVector' turns a sized 'Signed' value into a 'Vector' of 'Bool's.+toVector :: forall ix . (SingI ix) => Signed ix -> Vector ix Bool+toVector (Signed v) = matrix $ take (fromIntegral $ fromSing (sing :: Sing 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 m = mkSigned $- sum [ n- | (n,b) <- zip (iterate (* 2) 1)- (M.toList m)- , b- ]+-- 'fromVector' turns a 'Vector' of 'Bool's into a sized 'Signed' value.+fromVector :: (SingI ix) => Vector ix Bool -> Signed ix+fromVector m = mkSigned $+ sum [ n+ | (n,b) <- zip (iterate (* 2) 1)+ (elems m)+ , b+ ] ---mkSigned :: forall ix . (Size ix) => Integer -> Signed ix+mkSigned :: forall ix . (SingI ix) => Integer -> Signed ix mkSigned v = res- where sz' = 2 ^ (fromIntegral bitCount :: Integer)- bitCount = size (error "mkUnsigned" :: ix) - 1- res = case divMod v sz' of- (s,v') | even s -> Signed v'- | otherwise -> Signed (v' - sz')+ where sz' = 2 ^ bitCount+ bitCount :: Integer+ bitCount = fromIntegral (fromNat (sing :: Sing ix) - 1)+ res = case divMod v sz' of+ (s,v') | even s -> Signed v'+ | otherwise -> Signed (v' - sz') -instance (Size ix) => Eq (Signed ix) where- (Signed a) == (Signed b) = a == b-instance (Size ix) => Ord (Signed ix) where- (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) =- case quotRem a b of- (q,r) -> (mkSigned q,mkSigned r)-instance (Size ix) => Num (Signed ix) where- (Signed a) + (Signed b) = mkSigned $ a + b- (Signed a) - (Signed b) = mkSigned $ a - b- (Signed a) * (Signed b) = mkSigned $ a * b- abs (Signed n) = mkSigned $ abs n- signum (Signed n) = mkSigned $ signum n- fromInteger n = mkSigned n-instance (Size ix) => Real (Signed ix) where- toRational (Signed n) = toRational n-instance (Size ix) => Enum (Signed ix) where- fromEnum (Signed n) = fromEnum n- toEnum n = mkSigned (toInteger n)-instance (Size ix, Integral ix) => Bits (Signed ix) where- bitSize s = size (undefined :: ix)- bitSizeMaybe = Just . bitSize- complement = fromMatrix . fmap not . toMatrix- isSigned _ = True- 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 (Size ix, Integral ix) => FiniteBits (Signed ix) where- finiteBitSize s = size (undefined :: ix)+instance (SingI ix) => Show (Signed ix) where+ show (Signed a) = show a -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)+instance (SingI ix) => Read (Signed ix) where+ readsPrec i str = [ (mkSigned a,r) | (a,r) <- readsPrec i str ] +instance (SingI ix) => Integral (Signed ix) where+ toInteger (Signed m) = m+ quotRem (Signed a) (Signed b) =+ case quotRem a b of+ (q,r) -> (mkSigned q,mkSigned r) -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+instance (SingI ix) => Num (Signed ix) where+ (Signed a) + (Signed b) = mkSigned $ a + b+ (Signed a) - (Signed b) = mkSigned $ a - b+ (Signed a) * (Signed b) = mkSigned $ a * b+ abs (Signed n) = mkSigned $ abs n+ signum (Signed n) = mkSigned $ signum n+ fromInteger n = mkSigned n++instance (SingI ix) => Real (Signed ix) where+ toRational (Signed n) = toRational n++instance (SingI ix) => Enum (Signed ix) where+ fromEnum (Signed n) = fromEnum n+ toEnum n = mkSigned (toInteger n)++instance (SingI ix) => Bits (Signed ix) where+#if MIN_VERSION_base(4,7,0)+ bitSizeMaybe = return . finiteBitSize+#endif+ bitSize = finiteBitSize+ complement (Signed v) = Signed (complement v)+ isSigned _ = True+ a `xor` b = fromVector (M.zipWith (/=) (toVector a) (toVector b))+ a .|. b = fromVector (M.zipWith (||) (toVector a) (toVector b))+ a .&. b = fromVector (M.zipWith (&&) (toVector a) (toVector b))+ shiftL (Signed v) i = mkSigned (v * (2 ^ i))+ shiftR (Signed v) i = mkSigned (v `div` (2 ^ i))+ rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))+ where m = toVector v+ mLeng = size $ M.zeroOf m+ testBit u idx = toVector u ! (fromIntegral idx)+ -- new is 7.6?+ bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)+ popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n++#if MIN_VERSION_base(4,7,0)+instance (SingI ix) => FiniteBits (Signed ix) where+ finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#else+finiteBitSize :: forall (ix :: Nat). SingI ix => Signed ix -> Int+finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#endif++instance forall ix . (SingI ix) => Bounded (Signed ix) where+ minBound = Signed (- maxMagnitude)+ where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1)+ maxBound = Signed (maxMagnitude - 1)+ where maxMagnitude = 2 ^ (fromNat (sing :: Sing ix) - 1)+++type S2 = Signed 2+type S3 = Signed 3+type S4 = Signed 4+type S5 = Signed 5+type S6 = Signed 6+type S7 = Signed 7+type S8 = Signed 8+type S9 = Signed 9+type S10 = Signed 10+type S11 = Signed 11+type S12 = Signed 12+type S13 = Signed 13+type S14 = Signed 14+type S15 = Signed 15+type S16 = Signed 16+type S17 = Signed 17+type S18 = Signed 18+type S19 = Signed 19+type S20 = Signed 20+type S21 = Signed 21+type S22 = Signed 22+type S23 = Signed 23+type S24 = Signed 24+type S25 = Signed 25+type S26 = Signed 26+type S27 = Signed 27+type S28 = Signed 28+type S29 = Signed 29+type S30 = Signed 30+type S31 = Signed 31+type S32 = Signed 32
Data/Sized/Sparse/Matrix.hs view
@@ -1,5 +1,5 @@ -- | Sparse Matrix.--- +-- -- Copyright: (c) 2009 University of Kansas -- License: BSD3 --@@ -7,89 +7,93 @@ -- Stability: unstable -- Portability: ghc -{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}+{-# LANGUAGE NoImplicitPrelude, TypeFamilies, RankNTypes, FlexibleInstances,+ ScopedTypeVariables, UndecidableInstances, MultiParamTypeClasses,+ TypeOperators, DataKinds #-} module Data.Sized.Sparse.Matrix where- -import Data.Sized.Ix as X++import Data.Array.Base as B+import Data.Ix+import Data.Sized.Fin as X import qualified Data.Sized.Matrix as M import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Set as Set import Data.Set (Set) import Control.Applicative- -data Matrix ix a = Matrix a (Map ix a)+import Prelude.Compat -instance Functor (Matrix ix) where- fmap f (Matrix d mp) = Matrix (f d) (fmap f mp)+data SpMatrix ix a = SpMatrix a (Map ix a) --- 'fromAssocList' generates a sparse matrix. -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 ])+instance Functor (SpMatrix ix) where+ fmap f (SpMatrix d mp) = SpMatrix (f d) (fmap f mp) -toAssocList :: (Matrix i a) -> (a,[(i,a)])-toAssocList (Matrix d mp) = (d,Map.toList mp)+-- 'fromAssocList' generates a sparse matrix.+fromAssocList :: (Ord i, Eq a) => a -> [(i,a)] -> SpMatrix i a+fromAssocList d xs = SpMatrix d (Map.fromList [ (i,a) | (i,a) <- xs, a /= d ]) --- | '!' looks up an element in the sparse matrix. If the element is not found--- in the sparse matrix, '!' returns the default value.-(!) :: (Ord ix) => Matrix ix a -> ix -> a-(!) (Matrix d sm) ix = Map.findWithDefault d ix sm +toAssocList :: (SpMatrix i a) -> (a,[(i,a)])+toAssocList (SpMatrix d mp) = (d,Map.toList mp) -fill :: (Size ix) => Matrix ix a -> M.Matrix ix a-fill sm = M.forAll $ \ i -> sm ! i+-- | 'getElem' looks up an element in the sparse matrix. If the element is not found+-- in the sparse matrix, 'getElem' returns the default value.+getElem :: (Ord ix) => SpMatrix ix a -> ix -> a+getElem (SpMatrix d sm) ix = Map.findWithDefault d ix sm +fill :: (Bounded ix, Ix ix) => SpMatrix ix a -> M.Matrix ix a+fill sm = M.forAll $ \ i -> getElem sm i+ -- Might be just internal, because nothing else leaks defaults.-prune :: (Size ix, Eq a) => a -> Matrix ix a -> Matrix ix a-prune d sm@(Matrix d' m) | d == d' = Matrix d (Map.filter (/= d) m)- | otherwise = sparse d (fill sm) -- it might be possible to do better; think about it+prune :: (Bounded ix, Ix ix, Eq a) => a -> SpMatrix ix a -> SpMatrix ix a+prune d sm@(SpMatrix d' m) | d == d' = SpMatrix d (Map.filter (/= d) m)+ | otherwise = sparse d (fill sm) -- it might be possible to do better; think about it -- | Make a Matrix sparse, with a default 'zero' value.-sparse :: (Size ix, Eq a) => a -> M.Matrix ix a -> Matrix ix a-sparse d other = Matrix d (Map.fromList [ (i,v) | (i,v) <- M.assocs other, v /= d ])+sparse :: (Bounded ix, Ix ix, Eq a) => a -> M.Matrix ix a -> SpMatrix ix a+sparse d other = SpMatrix d (Map.fromList [ (i,v) | (i,v) <- assocs other, v /= d ]) -mm :: (Size m, Size n, Size m', Size n', n ~ m', Eq a, Num a) => Matrix (m,n) a -> Matrix (m',n') a -> Matrix (m,n') a-mm s1 s2 = Matrix 0 mp+mm :: (Bounded m, Ix m, Bounded n, Ix n, Bounded m', Ix m', Bounded n', Ix n', n ~ m', Num a, Eq a) =>+ SpMatrix (m,n) a -> SpMatrix (m',n') a -> SpMatrix (m,n') a+mm s1 s2 = SpMatrix 0 mp where- mp = Map.fromList [ ((x,y),v)- | (x,y) <- X.all- , let s = (rs M.! x) `Set.intersection` (cs M.! y) - , not (Set.null s)- , let v = foldb1 (+) [ s1 ! (x,k) * s2 ! (k,y) | k <- Set.toList s ]- , v /= 0- ] - (Matrix _ mp1) = prune 0 s1- (Matrix _ mp2) = prune 0 s2- rs = rowSets (Map.keysSet mp1)- cs = columnSets (Map.keysSet mp2)+ mp = Map.fromList [ ((x,y),v)+ | (x,y) <- X.universe+ , let s = (rs B.! x) `Set.intersection` (cs B.! y)+ , not (Set.null s)+ , let v = foldb1 (+) [(getElem s1 (x,k)) * (getElem s2 (k,y)) | k <- Set.toList s ]+ , v /= 0+ ]+ (SpMatrix _ mp1) = prune 0 s1+ (SpMatrix _ mp2) = prune 0 s2+ rs = rowSets (Map.keysSet mp1)+ cs = columnSets (Map.keysSet mp2) - foldb1 _ [x] = x- foldb1 f xs = foldb1 f (take len_before xs) `f` foldb1 f (drop len_before xs)- where len = length xs- len_before = len `div` 2+ foldb1 _ [x] = x+ foldb1 f xs = foldb1 f (take len_before xs) `f` foldb1 f (drop len_before xs)+ where len = length xs+ len_before = len `div` 2 -rowSets :: (Size a, Ord b) => Set (a,b) -> M.Matrix a (Set b)-rowSets set = M.accum f (pure Set.empty) (Set.toList set)- where- f set' e = Set.insert e set'- -columnSets :: (Size b, Ord a) => Set (a,b) -> M.Matrix b (Set a)+rowSets :: (Bounded a, Ix a, Ord b) => Set (a,b) -> M.Matrix a (Set b)+rowSets set = B.accum f (pure Set.empty) (Set.toList set)+ where+ f set' e = Set.insert e set'++columnSets :: (Bounded b, Ix b, Ord a) => Set (a,b) -> M.Matrix b (Set a) columnSets = rowSets . Set.map (\ (a,b) -> (b,a)) -instance (Size i) => Applicative (Matrix i) where- pure a = Matrix a (Map.empty)- sm1@(Matrix d1 m1) <*> sm2@(Matrix d2 m2)- = Matrix (d1 d2) (Map.fromList [ (k,(sm1 ! k) (sm2 ! k)) | k <- Set.toList keys ])- where keys = Map.keysSet m1 `Set.union` Map.keysSet m2+instance (Bounded i, Ix i) => Applicative (SpMatrix i) where+ pure a = SpMatrix a (Map.empty)+ sm1@(SpMatrix d1 m1) <*> sm2@(SpMatrix d2 m2)+ = SpMatrix (d1 d2) (Map.fromList [ (k, (getElem sm1 k) (getElem sm2 k)) | k <- Set.toList keys ])+ where keys = Map.keysSet m1 `Set.union` Map.keysSet m2 -instance (Show a, Size ix) => Show (Matrix ix a) where- show m = show (fill m)+instance (Show a, Show ix, Bounded ix, Ix ix) => Show (SpMatrix ix a) where+ show m = show (fill m) -transpose :: (Size x, Size y, Eq a) => Matrix (x,y) a -> Matrix (y,x) a-transpose (Matrix d m) = Matrix d (Map.fromList [ ((y,x),a) | ((x,y),a) <- Map.assocs m ])+transpose :: (Bounded x, Ix x, Bounded y, Ix y, Eq a) => SpMatrix (x,y) a -> SpMatrix (y,x) a+transpose (SpMatrix d m) = SpMatrix d (Map.fromList [ ((y,x),a) | ((x,y),a) <- Map.assocs m ]) -zipWith :: (Size x) => (a -> b -> c) -> Matrix x a -> Matrix x b -> Matrix x c-zipWith f m1 m2 = pure f <*> m1 <*> m2 - - +zipWith :: (Bounded x, Ix x) => (a -> b -> c) -> SpMatrix x a -> SpMatrix x b -> SpMatrix x c+zipWith f m1 m2 = pure f <*> m1 <*> m2
Data/Sized/Unsigned.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables, TypeFamilies, DataKinds, FlexibleContexts, DataKinds, DeriveDataTypeable, CPP #-} -- | Unsigned, fixed sized numbers. --@@ -10,91 +10,123 @@ -- Portability: ghc module Data.Sized.Unsigned- ( Unsigned- , toMatrix- , fromMatrix- , 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+ ( Unsigned+ , toVector+ , fromVector+ , showBits+ , 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.Array.IArray(elems, (!)) import Data.Sized.Matrix as M-import Data.Sized.Ix+import Data.Sized.Fin import Data.Bits import Data.Ix+#if __GLASGOW_HASKELL__ >= 708+import Data.Typeable+#endif -newtype Unsigned ix = Unsigned Integer+newtype Unsigned (ix :: Nat) = Unsigned Integer+ deriving ( Eq+ , Ord+#if __GLASGOW_HASKELL__ >= 708+ , Typeable+#endif+ ) -toMatrix :: forall ix . (Size ix) => Unsigned ix -> Matrix ix Bool-toMatrix (Unsigned v) = matrix $ take (size (error "toMatrix" :: ix)) $ map odd $ iterate (`div` 2) v+-- 'toVector' turns a sized 'Unsigned' value into a 'Vector' of 'Bool's.+toVector :: forall ix . (SingI ix) => Unsigned ix -> Vector ix Bool+toVector (Unsigned v) = matrix $ take (fromIntegral $ fromSing (sing :: Sing ix)) $ map odd $ iterate (`div` 2) v -fromMatrix :: (Size ix) => Matrix ix Bool -> Unsigned ix-fromMatrix m = mkUnsigned $- sum [ n- | (n,b) <- zip (iterate (* 2) 1)- (M.toList m)- , b- ]+-- 'fromVector' turns a 'Vector' of 'Bool's into sized 'Unsigned' value.+fromVector :: (SingI ix) => Vector ix Bool -> Unsigned ix+fromVector m = mkUnsigned $+ sum [ n+ | (n,b) <- zip (iterate (* 2) 1)+ (elems m)+ , b+ ] -mkUnsigned :: forall ix . (Size ix) => Integer -> Unsigned ix-mkUnsigned v = res- where sz' = 2 ^ (fromIntegral bitCount :: Integer)- bitCount = size (error "mkUnsigned" :: ix)- res = Unsigned (v `mod` sz')+mkUnsigned :: forall ix . (SingI ix) => Integer -> Unsigned ix+mkUnsigned x = Unsigned (x `mod` (2 ^ bitCount))+ where bitCount = fromNat (sing :: Sing ix) -instance (Size ix) => Eq (Unsigned ix) where- (Unsigned a) == (Unsigned b) = a == b-instance (Size ix) => Ord (Unsigned ix) where- (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) =- case quotRem a b of- (q,r) -> (mkUnsigned q,mkUnsigned r)-instance (Size ix) => Num (Unsigned ix) where- (Unsigned a) + (Unsigned b) = mkUnsigned $ a + b- (Unsigned a) - (Unsigned b) = mkUnsigned $ a - b- (Unsigned a) * (Unsigned b) = mkUnsigned $ a * b- abs (Unsigned n) = mkUnsigned $ abs n- signum (Unsigned n) = mkUnsigned $ signum n- fromInteger n = mkUnsigned n-instance (Size ix) => Real (Unsigned ix) where- toRational (Unsigned n) = toRational n-instance (Size ix) => Enum (Unsigned ix) where- fromEnum (Unsigned n) = fromEnum n- toEnum n = mkUnsigned (toInteger n)-instance (Size ix, Integral ix) => Bits (Unsigned ix) where- bitSize s = size (undefined :: ix)- bitSizeMaybe = Just . bitSize- complement = fromMatrix . fmap not . toMatrix- isSigned _ = False- 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)-instance (Size ix, Integral ix) => FiniteBits (Unsigned ix) where- finiteBitSize s = size (undefined :: ix)+instance Show (Unsigned ix) where+ show (Unsigned a) = show a -instance forall ix . (Size ix) => Bounded (Unsigned ix) where- minBound = Unsigned 0- maxBound = Unsigned (2 ^ (size (error "Bounded/Unsigned" :: ix)) - 1)+instance (SingI ix) => Read (Unsigned ix) where+ readsPrec i str = [ (mkUnsigned a,r) | (a,r) <- readsPrec i str ] --- Unsigned ix as member of Size class.--- We do not address efficiency in this implementation.+instance (SingI ix) => Integral (Unsigned ix) where+ toInteger (Unsigned m) = m+ quotRem (Unsigned a) (Unsigned b) =+ case quotRem a b of+ (q,r) -> (mkUnsigned q,mkUnsigned r) -- TODO: check for size -type instance Index (Unsigned ix) = Int+instance (SingI ix) => Num (Unsigned ix) where+ (Unsigned a) + (Unsigned b) = mkUnsigned $ a + b+ (Unsigned a) - (Unsigned b) = mkUnsigned $ a - b+ (Unsigned a) * (Unsigned b) = mkUnsigned $ a * b+ abs (Unsigned n) = mkUnsigned $ abs n+ signum (Unsigned n) = mkUnsigned $ signum n+ fromInteger n = mkUnsigned n -instance forall ix . (Size ix) => Ix (Unsigned ix) where+instance (SingI ix) => Real (Unsigned ix) where+ toRational (Unsigned n) = toRational n++instance (SingI ix) => Enum (Unsigned ix) where+ fromEnum (Unsigned n) = fromEnum n+ toEnum n = mkUnsigned (toInteger n)++instance (SingI ix) => Bits (Unsigned ix) where+#if MIN_VERSION_base(4,7,0)+ bitSizeMaybe = return . finiteBitSize+#endif+ bitSize = finiteBitSize+ complement (Unsigned v) = Unsigned (complement v)+ isSigned _ = False+ (Unsigned a) `xor` (Unsigned b) = Unsigned (a `xor` b)+ (Unsigned a) .|. (Unsigned b) = Unsigned (a .|. b)+ (Unsigned a) .&. (Unsigned b) = Unsigned (a .&. b)+ shiftL (Unsigned v) i = mkUnsigned (shiftL v i)+ shiftR (Unsigned v) i = mkUnsigned (shiftR v i)++-- TODO: fix+ -- it might be possible to loosen the Integral requirement+-- rotate (Ui i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` M.population m)))+-- where m = toVector v++ rotate v i = fromVector (forAll $ \ ix -> m ! (fromIntegral ((fromIntegral ix - i) `mod` mLeng)))+ where m = toVector v+ mLeng = size $ M.zeroOf m++ testBit (Unsigned u) idx = testBit u idx+ bit i = fromVector (forAll $ \ ix -> if ix == fromIntegral i then True else False)+ popCount n = sum $ fmap (\ b -> if b then 1 else 0) $ elems $ toVector n++#if MIN_VERSION_base(4,7,0)+instance (SingI ix) => FiniteBits (Unsigned ix) where+ finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#else+finiteBitSize :: forall (ix :: Nat). SingI ix => Unsigned ix -> Int+finiteBitSize _ = fromIntegral (fromNat (sing :: Sing ix))+#endif++showBits :: (SingI ix) => Unsigned ix -> String+showBits u = "0b" ++ reverse+ [ if testBit u i then '1' else '0'+ | i <- [0..(finiteBitSize u - 1)]+ ]++instance (SingI ix) => Bounded (Unsigned ix) where+ minBound = Unsigned 0+ maxBound = Unsigned (2 ^ (fromNat (sing :: Sing ix)) - 1)++-- We do not address efficiency in this implementation.+instance (SingI ix) => Ix (Unsigned ix) where range (l, u) = [l .. u] inRange (l, u) v = (l <= v) && (v <= u) index (l, u) v | inRange (l,u) v = fromIntegral (v - l)@@ -102,43 +134,38 @@ rangeSize (l, u) | l <= u = fromIntegral $ (toInteger u) - (toInteger l) + 1 | otherwise = 0 -instance forall ix . (Size ix) => Size (Unsigned ix) where- size = const s- where s = fromIntegral $ toInteger (maxBound :: Unsigned ix) + 1- addIndex v n = v + (fromIntegral n) -- fix bounds issues- toIndex v = fromIntegral v -- | common; numerically boolean.-type U1 = Unsigned X1+type U1 = Unsigned 1 -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+type U2 = Unsigned 2+type U3 = Unsigned 3+type U4 = Unsigned 4+type U5 = Unsigned 5+type U6 = Unsigned 6+type U7 = Unsigned 7+type U8 = Unsigned 8+type U9 = Unsigned 9+type U10 = Unsigned 10+type U11 = Unsigned 11+type U12 = Unsigned 12+type U13 = Unsigned 13+type U14 = Unsigned 14+type U15 = Unsigned 15+type U16 = Unsigned 16+type U17 = Unsigned 17+type U18 = Unsigned 18+type U19 = Unsigned 19+type U20 = Unsigned 20+type U21 = Unsigned 21+type U22 = Unsigned 22+type U23 = Unsigned 23+type U24 = Unsigned 24+type U25 = Unsigned 25+type U26 = Unsigned 26+type U27 = Unsigned 27+type U28 = Unsigned 28+type U29 = Unsigned 29+type U30 = Unsigned 30+type U31 = Unsigned 31+type U32 = Unsigned 32
− Data/Sized/Vector.hs
@@ -1,107 +0,0 @@--{-# 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
+ README.md view
@@ -0,0 +1,19 @@+# sized-types [](http://hackage.haskell.org/package/sized-types) [](https://travis-ci.org/ku-fpg/sized-types)++To build development version, and run tests use++```+% cabal configure -fall+% cabal build+```++To run tests, do++```+% make runtests+```++The reference outputs are in `/ref`, and the outputs from the current run are in `/run`.+++
Setup.hs view
@@ -1,6 +1,2 @@-module Main (main) where- import Distribution.Simple--main :: IO () main = defaultMain
− qc/QC.hs
@@ -1,21 +0,0 @@---- 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,66 +1,63 @@ Name: sized-types-Version: 0.3.5.2-Synopsis: Sized types in Haskell.-Description: Providing indices, matrixes, sparse matrixes, and signed and unsigned bit vectors.+Version: 0.5.1+Synopsis: Sized types in Haskell using the GHC Nat kind.+Description: Providing matrixes, sparse matrixes, and signed and unsigned bit vectors, using GHC Nat kind. Category: Language License: BSD3 License-file: LICENSE-Author: Andy Gill, Tristan Bull+Author: Andy Gill Maintainer: Andy Gill <andygill@ku.edu>-Copyright: (c) 2009 The University of Kansas+Copyright: (c) 2009-2013 The University of Kansas Homepage: http://www.ittc.ku.edu/csdl/fpg/Tools-Stability: beta-build-type: Simple-Cabal-Version: >= 1.6+Stability: beta+build-type: Simple+extra-source-files: CHANGELOG.md, README.md+Cabal-Version: >= 1.8 +source-repository head+ type: git+ location: https://github.com/ku-fpg/sized-types+ Flag all- Description: Enable full development tree- Default: False+ Description: Enable full development tree+ Default: False Library- Build-Depends: base >= 4.7 && < 5, containers, array- Exposed-modules:- Data.Sized.Arith,- Data.Sized.Ix,- Data.Sized.Matrix,- Data.Sized.Sparse.Matrix,- Data.Sized.Signed,- Data.Sized.Unsigned,- Data.Sized.Vector,- Data.Sized.Sampled-- Ghc-Options: -Wall+ Build-Depends: array >= 0.4,+ base >= 4.6 && < 5,+ base-compat >= 0.8.1 && < 1,+ containers == 0.5.*,+ singletons >= 0.10 && < 1.2+ Exposed-modules: Data.Sized.Fin,+ Data.Sized.Matrix,+ Data.Sized.Sparse.Matrix,+ Data.Sized.Signed,+ Data.Sized.Unsigned,+ Data.Sized.Sampled+ Ghc-Options: -Wall -Executable sized-types-test1- if flag(all)- Build-Depends: base, QuickCheck >= 2.0- buildable: True- Other-modules:- QC- else- Build-depends: base- buildable: False- Main-Is: Test1.hs- Hs-Source-Dirs: ., test, qc- Ghc-Options: -Wall+test-suite sized-types-test1+ if flag(all)+ buildable: True+ else+ buildable: False+ type: exitcode-stdio-1.0+ Build-Depends: base,+ QuickCheck >= 2.0,+ sized-types == 0.5.1+ Main-Is: Test1.hs+ Other-modules: QC.QC+ Hs-Source-Dirs: test+ Ghc-Options: -Wall Executable sized-types-example1- if flag(all)- Build-Depends: base- buildable: True- else- Build-depends: base- buildable: False- Main-Is: Example1.hs- Hs-Source-Dirs: ., test- Ghc-Options: -Wall--source-repository head- type: git- location: git://github.com/ku-fpg/sized-types--source-repository this- type: git- location: git://github.com/ku-fpg/sized-types- branch: sized-types-0.3- tag: 0.3.5.1+ if flag(all)+ buildable: True+ else+ buildable: False+ Build-depends: base,+ base-compat >= 0.8.1 && < 1,+ sized-types == 0.5.1+ Main-Is: Example1.hs+ Hs-Source-Dirs: test+ Ghc-Options: -Wall
test/Example1.hs view
@@ -1,65 +1,80 @@+{-# LANGUAGE CPP, DataKinds, NoImplicitPrelude, TypeFamilies, TypeOperators #-}+ module Main where +import Data.Sized.Fin import Data.Sized.Matrix import Data.Sized.Signed as S import Data.Sized.Unsigned as U-import Control.Applicative+#if !(MIN_VERSION_base(4,7,0))+import GHC.TypeLits+#endif+import Prelude.Compat +-- NatType equivalences required for the above and beside tests.+#if !(MIN_VERSION_base(4,7,0))+type instance (3 + 3) = 6+type instance (4 + 4) = 8+#endif++ main :: IO () main = do- print example1- print example2- print $ transpose example2- print $ example2 `mm` transpose example2- print $ fmap odd example2- print $ example2 `above` example2- print $ example2 `beside` example2- print $ example3- print $ example4- print $ example5- print $ example6- print $ example7 - print $ example8- print $ fmap (\ v -> if v == (0 :: Double)- then S "" - else showAsE 3 v) - $ fmap (fromIntegral) example6 - - let s :: [Signed X4]- s = [ x * y | x <- [1..5], y <- [0..5]]- print s+ print example1+ print example2+ print $ transpose example2+ print $ example2 `mm` transpose example2+ print $ fmap odd example2+ print $ example2 `above` example2+ print $ example2 `beside` example2+ print $ example3+ print $ example4+ print $ example5+ print $ example6+ print $ example7+-- cropAt function no longer supported+-- print $ example8+ print $ fmap (\ v -> if v == (0 :: Double)+ then S ""+ else showAsE 3 v)+ $ fmap (fromIntegral) example6 - let u :: [Unsigned X4]- u = [ x * y | x <- [1..5], y <- [0..5]]- print u- - print $ fmap S.toMatrix s- print $ fmap U.toMatrix u- + let s :: [Signed 4]+ s = [ x * y | x <- [1..5], y <- [0..5]]+ print s -example1 :: Matrix (X5,X5) Int+ let u :: [Unsigned 4]+ u = [ x * y | x <- [1..5], y <- [0..5]]+ print u++ print $ fmap S.toVector s+ print $ fmap U.toVector u+++example1 :: Matrix (Fin 5,Fin 5) Int example1 = identity -example2 :: Matrix (X3,X4) Int+example2 :: Matrix (Fin 3,Fin 4) Int example2 = matrix [1..12] -example3 :: Matrix (X4,X5) Double+example3 :: Matrix (Fin 4,Fin 5) Double example3 = pure 1.2 -example4 :: Matrix (X4,X5) (X4,X5)+example4 :: Matrix (Fin 4,Fin 5) (Fin 4,Fin 5) example4 = coord -- also works in 2D-example5 :: Matrix X6 Bool+example5 :: Matrix (Fin 6) Bool example5 = forAll $ \ i -> i > 3 -example6 :: Matrix (X3,X4) Int-example6 = forEach example2 $ \ (i,j) a -> - if i == 0 || j == 0 then a else 0- -example7 :: Matrix (X10,X10) Int+example6 :: Matrix (Fin 3,Fin 4) Int+example6 = forEach example2 $ \ (i,j) a ->+ if i == 0 || j == 0 then a else 0++example7 :: Matrix (Fin 10,Fin 10) Int example7 = matrix [1..100] -example8 :: Matrix (X4,X5) Int-example8 = example7 `cropAt` (2,3)+-- cropAt function no longer supported+-- example8 :: Matrix (Fin 4,Fin 5) Int+-- example8 = example7 `cropAt` (2,3)
+ test/QC/QC.hs view
@@ -0,0 +1,19 @@+-- Copy this module if you need Quick Check.+{-# OPTIONS_GHC -fno-warn-orphans #-}+module QC.QC where++import Data.Ix+import Data.Sized.Fin+import Data.Sized.Matrix++import qualified Test.QuickCheck as QC++instance (SingI n) => QC.Arbitrary (Fin n) where+ arbitrary = QC.elements [minBound .. maxBound]++instance (QC.Arbitrary ix, Bounded ix, Ix ix, QC.Arbitrary a) => QC.Arbitrary (Matrix ix a) where+ arbitrary = f $ \ ixs -> do+ elems <- sequence [ QC.arbitrary | _ <- ixs ]+ return $ matrix elems+ where f :: (Bounded ix, Ix ix) => ([ix] -> m (Matrix ix a)) -> m (Matrix ix a)+ f fn = fn (allIndices (undefined :: Matrix ix a))
test/Test1.hs view
@@ -1,36 +1,51 @@+{-# LANGUAGE CPP, DataKinds, TypeFamilies, TypeOperators #-}+ module Main where- -import Data.Sized.Ix+ import Data.Sized.Matrix +import QC.QC() import Test.QuickCheck as QC-import QC-import qualified Data.Sized.Sparse.Matrix as SM-import Control.Applicative-import Data.Sized.Arith+-- import qualified Data.Sized.Sparse.Matrix as SM+#if !(MIN_VERSION_base(4,7,0))+import GHC.TypeLits+#endif -import Data.Array+-- NatType equivalences required for the join tests.+#if !(MIN_VERSION_base(4,7,0))+type instance (4 + 5) = 9+type instance (3 + 7) = 10+#endif -- Small first cut at tests.+main :: IO () main = do- quickCheck prop_mm1- quickCheck prop_fmap1- quickCheck prop_joins- putStrLn "[Done]"+ quickCheck prop_mm1+ quickCheck prop_fmap1+ quickCheck prop_joins+ putStrLn "[Done]" +prop_mm1 :: Vector2 3 4 Int+ -> Vector2 4 5 Int+ -> Vector2 5 2 Int+ -> Bool prop_mm1 m1 m2 m3 = ((m1 `mm` m2) `mm` m3) == (m1 `mm` (m2 `mm` m3)) where- _types = (m1 :: Matrix (X3,X4) Int,- m2 :: Matrix (X4,X5) Int,- m3 :: Matrix (X5,X2) Int)- -prop_fmap1 m1 = fmap (+1) m1 == forEach m1 (\ i a -> a + 1)+ _types = (m1 :: Vector2 3 4 Int,+ m2 :: Vector2 4 5 Int,+ m3 :: Vector2 5 2 Int)++prop_fmap1 :: Vector2 9 29 Int -> Bool+prop_fmap1 m1 = fmap (+1) m1 == forEach m1 (\ _i a -> a + 1) where- _types = (m1 :: Matrix (X9,X29) Int)+ _types = (m1 :: Vector2 9 29 Int) +prop_joins :: Vector2 3 4 Int+ -> Vector2 3 5 Int+ -> Vector2 7 4 Int+ -> Vector2 7 5 Int+ -> Bool prop_joins m1 m2 m3 m4 = (m1 `above` m3) `beside` (m2 `above` m4)- == (m1 `beside` m2) `above` (m3 `beside` m4)- where _types = (m1 :: Matrix (X3,X4) Int,- m4 :: Matrix (X7,X5) Int)-- + == (m1 `beside` m2) `above` (m3 `beside` m4)+ where _types = (m1 :: Vector2 3 4 Int,+ m4 :: Vector2 7 5 Int)