sized-types (empty) → 0.1
raw patch · 14 files changed
+1474/−0 lines, 14 filesdep +QuickCheckdep +arraydep +basesetup-changed
Dependencies added: QuickCheck, array, base, containers
Files
- Data/Sized/Arith.hs +142/−0
- Data/Sized/Ix.hs +637/−0
- Data/Sized/Matrix.hs +226/−0
- Data/Sized/QC/Ix.hs +12/−0
- Data/Sized/QC/Matrix.hs +12/−0
- Data/Sized/QC/Signed.hs +7/−0
- Data/Sized/Signed.hs +79/−0
- Data/Sized/Sparse/Matrix.hs +98/−0
- Data/Sized/Unsigned.hs +77/−0
- LICENSE +25/−0
- Setup.hs +2/−0
- sized-types.cabal +55/−0
- test/Example1.hs +65/−0
- test/Test1.hs +37/−0
+ Data/Sized/Arith.hs view
@@ -0,0 +1,142 @@+-- | 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_ Int+data X1_ a = X1_ Int+++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 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 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 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)++--- 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
@@ -0,0 +1,637 @@+-- | 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 :: (Size i) => [i]+all = 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+ -- | project any 2D array position onto any array. Helper method for 'show'.+ seeIn2D :: (Row ix, Column ix) -> ix++ -- TO CONSIDER: ADDing a zero method? This will allow coerseSize to + -- work in 2D, and drop the Enum requrement.++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 -- TODO: fix bounds issues+ toIndex X0 = 0+ seeIn2D (_,y) = y++instance Size a => Bounded (X1_ a) where+ minBound = X1_ 0+ maxBound = let a = X1_ (size a - 1) in 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 = X1_ (v + n) -- fix bounds issues+ toIndex (X1_ v) = 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_ (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 = X0_ (v + n) -- fix bounds issues+ toIndex (X0_ v) = v+ seeIn2D (_,y) = y+ +------++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
@@ -0,0 +1,226 @@+-- | Sized matrixes.+-- +-- Copyright: (c) 2009 University of Kansas+-- License: BSD3+--+-- Maintainer: Andy Gill <andygill@ku.edu>+-- Stability: unstable+-- Portability: ghc++{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}+module Data.Sized.Matrix + ( module Data.Sized.Matrix+ , module Data.Sized.Ix+ ) 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 qualified Data.Traversable as T+import qualified Data.Foldable as F+import qualified Data.List as L +import Numeric ++import Data.Sized.Ix++-- | 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++-- | '!' looks up an element in the matrix.+(!) :: (Size n) => Matrix n a -> n -> a+(!) (Matrix xs) n = xs A.! n++instance (Size i) => Functor (Matrix i) where+ fmap f (Matrix xs) = Matrix (fmap f xs)++-- | 'toList' turns a matrix into an always finite list.+toList :: (Size i) => Matrix i a -> [a]+toList (Matrix a) = elems a++-- | '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"+ ++ ", found " ++ show (L.length xs) ++ " elements."++-- | '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++-- | 'assocs' extracts the index/value pairs.+assocs :: (Size i) => Matrix i a -> [(i,a)]+assocs (Matrix a) = A.assocs a++(//) :: (Size i) => Matrix i e -> [(i, e)] -> Matrix i e+(//) (Matrix arr) ixs = Matrix (arr A.// ixs)++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)++-- | 'zeroOf' is for use to force typing issues, and is 0.+zeroOf :: (Size i) => Matrix i a -> i+zeroOf _ = minBound++-- | 'coord' returns a matrix filled with indexes.+coord :: (Size i) => Matrix i i+coord = fromList all++-- | Same as for lists.+zipWith :: (Size 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 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 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 ]+ +-- | 'transpose' a 2D matrix.+transpose :: (Size x, Size y) => Matrix (x,y) a -> Matrix (y,x) a+transpose = ixmap $ \ (x,y) -> (y,x)++-- | return the identity for a specific matrix size.+identity :: (Size x, Num a) => Matrix (x,x) a+identity = (\ (x,y) -> if x == y then 1 else 0) <$> coord++-- | 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)++-- | 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 m1 m2 = transpose (transpose m1 `above` transpose 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 f m = (fmap (\ j -> m ! j) . f) <$> coord++-- | 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++-- | 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++-- | 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 = 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 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 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 (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)++-- | 'showMatrix' displays a 2D matrix, and is the worker for 'show'.+-- +-- > GHCi> matrix [1..42] :: Matrix (X7,X6) Int+-- > [ 1, 2, 3, 4, 5, 6,+-- > 7, 8, 9, 10, 11, 12,+-- > 13, 14, 15, 16, 17, 18,+-- > 19, 20, 21, 22, 23, 24,+-- > 25, 26, 27, 28, 29, 30,+-- > 31, 32, 33, 34, 35, 36,+-- > 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 . L.zipWith (++) ("[":repeat " ") + 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+++instance (Show a, Size ix,Size (Row ix), Size (Column ix)) => Show (Matrix ix a) where+ show = showMatrix . fmap show . ixmap seeIn2D ++-- | 'S' is shown as the contents, without the quotes.+-- One use is a matrix of S, so that you can do show-style functions+-- using fmap.+newtype S = S String++instance Show S where+ show (S s) = s++showAs :: (RealFloat a) => Int -> a -> S +showAs i a = S $ showEFloat (Just i) a ""++
+ Data/Sized/QC/Ix.hs view
@@ -0,0 +1,12 @@+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 view
@@ -0,0 +1,12 @@+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 view
@@ -0,0 +1,7 @@+module Data.Sized.QC.Signed where+ +import Data.Sized.Signed+import Data.Sized.Unsigned+import Data.Sized.Ix+import Test.QuickCheck+
+ Data/Sized/Signed.hs view
@@ -0,0 +1,79 @@+-- | Signed, fixed sized numbers.+-- +-- Copyright: (c) 2009 University of Kansas+-- License: BSD3+--+-- Maintainer: Andy Gill <andygill@ku.edu>+-- Stability: unstable+-- Portability: ghc++module Data.Sized.Signed + ( Signed+ , toMatrix+ , fromMatrix+ ) where+ +import Data.Sized.Matrix as M+import Data.Sized.Ix+import Data.List as L+import Data.Bits++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' 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+ ]+-- +mkSigned :: (Size ix) => Integer -> Signed ix+mkSigned v = res+ where sz' = 2 ^ (fromIntegral bitCount :: Integer)+ bitCount = bitSize res - 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 (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) => Bits (Signed ix) where+ bitSize s = f s undefined+ where+ f :: (Size a) => Signed a -> a -> Int+ f _ ix = size ix+ 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))+ ++
+ Data/Sized/Sparse/Matrix.hs view
@@ -0,0 +1,98 @@+-- | Sparse Matrix.+-- +-- Copyright: (c) 2009 University of Kansas+-- License: BSD3+--+-- Maintainer: Andy Gill <andygill@ku.edu>+-- Stability: unstable+-- Portability: ghc++{-# LANGUAGE TypeFamilies, RankNTypes, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses #-}+module Data.Sized.Sparse.Matrix where+ +import Data.Sized.Ix 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)++instance Functor (Matrix ix) where+ 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 d xs = Matrix d (Map.fromList [ (i,a) | (i,a) <- xs, a /= d ])++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+(!) (Matrix d sm) id = Map.findWithDefault d id sm ++fill :: (Size ix) => Matrix ix a -> M.Matrix ix a+fill sm = M.forAll $ \ i -> 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++-- | 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 ])++foldb1 f [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++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 s1 s2 = Matrix 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+ ] + sm1@(Matrix _ mp1) = prune 0 s1+ sm2@(Matrix _ mp2) = prune 0 s2+ rs = rowSets (Map.keysSet mp1)+ cs = columnSets (Map.keysSet mp2)++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)+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 (Show a, Size ix,Size (Row ix), Size (Column ix)) => Show (Matrix 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 ])++m1 = M.matrix [1..6] :: M.Matrix (X2,X3) Int+m2 = M.matrix [1..12] :: M.Matrix (X3,X4) Int+m3 = m1 `M.mm` m2+m4 = M.identity :: M.Matrix (X200,X200) Int+++zipWith :: (Size x) => (a -> b -> c) -> Matrix x a -> Matrix x b -> Matrix x c+zipWith f m1 m2 = pure f <*> m1 <*> m2 + +
+ Data/Sized/Unsigned.hs view
@@ -0,0 +1,77 @@+-- | Unsigned, fixed sized numbers.+-- +-- Copyright: (c) 2009 University of Kansas+-- License: BSD3+--+-- Maintainer: Andy Gill <andygill@ku.edu>+-- Stability: unstable+-- Portability: ghc++module Data.Sized.Unsigned + ( Unsigned+ , toMatrix+ , fromMatrix+ , U1+ ) where+ +import Data.Sized.Matrix as M+import Data.Sized.Ix+import Data.List as L+import Data.Bits++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++fromMatrix :: Size ix => Matrix ix Bool -> Unsigned ix+fromMatrix m = mkUnsigned $+ sum [ n + | (n,b) <- zip (iterate (* 2) 1)+ (M.toList m)+ , b+ ]++mkUnsigned :: (Size ix) => Integer -> Unsigned ix+mkUnsigned v = res+ where sz' = 2 ^ (fromIntegral bitCount :: Integer)+ bitCount = bitSize res+ res = Unsigned (v `mod` sz')++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) => 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) => Bits (Unsigned ix) where+ bitSize s = f s undefined+ where+ f :: (Size a) => Unsigned a -> a -> Int+ f _ ix = size ix+ 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))++-- | common; numerically boolean. +type U1 = Unsigned X1+
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2009 The University of Kansas+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ sized-types.cabal view
@@ -0,0 +1,55 @@+Name: sized-types+Version: 0.1+Synopsis: Sized types in Haskell.+Description: Providing indices, matrixes, sparse matrixes, and signed and unsigned bit vectors.+Category: Language+License: BSD3+License-file: LICENSE+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+Stability: alpha+build-type: Simple+Cabal-Version: >= 1.6++Flag devel+ Description: Enable full development tree+ Default: False++Library+ Build-Depends: base >= 4 && < 5, containers, array+ Exposed-modules:+ Data.Sized.Arith,+ Data.Sized.Ix,+ Data.Sized.Matrix,+ Data.Sized.Sparse.Matrix,+ Data.Sized.Signed,+ Data.Sized.Unsigned+ Ghc-Options: -Wall++Executable sized-types-test1+ if flag(devel)+ Build-Depends: base, QuickCheck >= 2.0+ buildable: True+ Other-modules:+ Data.Sized.QC.Ix,+ Data.Sized.QC.Matrix,+ Data.Sized.QC.Signed+ else+ Build-depends: base+ buildable: False+ Main-Is: Test1.hs+ Hs-Source-Dirs: ., test+ Ghc-Options: -Wall++Executable sized-types-example1+ if flag(devel)+ Build-Depends: base+ buildable: True+ else+ Build-depends: base+ buildable: False+ Main-Is: Example1.hs+ Hs-Source-Dirs: ., test+ Ghc-Options: -Wall
+ test/Example1.hs view
@@ -0,0 +1,65 @@+module Main where++import Data.Sized.Matrix+import Data.Sized.Signed as S+import Data.Sized.Unsigned as U+import Control.Applicative++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 showAs 3 v) + $ fmap (fromIntegral) example6 + + let s :: [Signed X4]+ s = [ x * y | x <- [1..5], y <- [0..5]]+ print s++ 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+ ++example1 :: Matrix (X5,X5) Int+example1 = identity++example2 :: Matrix (X3,X4) Int+example2 = matrix [1..12]++example3 :: Matrix (X4,X5) Double+example3 = pure 1.2++example4 :: Matrix (X4,X5) (X4,X5)+example4 = coord++-- also works in 2D+example5 :: Matrix X6 Bool+example5 = forAll $ \ i -> i > 6++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+example7 = matrix [1..100]+++example8 :: Matrix (X4,X5) Int+example8 = example7 `cropAt` (2,3)
+ test/Test1.hs view
@@ -0,0 +1,37 @@+module Main where+ +import Data.Sized.Ix+import Data.Sized.Matrix++import Test.QuickCheck as QC+import Data.Sized.QC.Ix+import Data.Sized.QC.Matrix as M+import qualified Data.Sized.Sparse.Matrix as SM+import Control.Applicative+import Data.Sized.Arith++import Data.Array++-- Small first cut at tests.+main = do+ quickCheck prop_mm1+ quickCheck prop_fmap1+ quickCheck prop_joins+ putStrLn "[Done]"++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)+ where+ _types = (m1 :: Matrix (X9,X29) Int)++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)++