summaryrefslogtreecommitdiff
path: root/packages/base/src/Internal/Element.hs
diff options
context:
space:
mode:
authoridontgetoutmuch <dominic@steinitz.org>2018-04-01 05:43:38 -0700
committerGitHub <noreply@github.com>2018-04-01 05:43:38 -0700
commitc8c6a3e414bb08e3f818f58c121ddc99396b4f1e (patch)
treedaf3add31de83efcc74b41755c2d05c811242ce6 /packages/base/src/Internal/Element.hs
parentd83b17190029c11e3ab8b504e5cdc917f5863120 (diff)
parent1a68793247b8845cefad4d157e4f4d25b1731b42 (diff)
Merge pull request #262 from idontgetoutmuch/master
Implement CI
Diffstat (limited to 'packages/base/src/Internal/Element.hs')
-rw-r--r--packages/base/src/Internal/Element.hs23
1 files changed, 20 insertions, 3 deletions
diff --git a/packages/base/src/Internal/Element.hs b/packages/base/src/Internal/Element.hs
index eb3a25b..2e330ee 100644
--- a/packages/base/src/Internal/Element.hs
+++ b/packages/base/src/Internal/Element.hs
@@ -4,6 +4,8 @@
4{-# LANGUAGE UndecidableInstances #-} 4{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE MultiParamTypeClasses #-} 5{-# LANGUAGE MultiParamTypeClasses #-}
6 6
7{-# OPTIONS_GHC -fno-warn-orphans #-}
8
7----------------------------------------------------------------------------- 9-----------------------------------------------------------------------------
8-- | 10-- |
9-- Module : Data.Packed.Matrix 11-- Module : Data.Packed.Matrix
@@ -31,6 +33,7 @@ import Data.List.Split(chunksOf)
31import Foreign.Storable(Storable) 33import Foreign.Storable(Storable)
32import System.IO.Unsafe(unsafePerformIO) 34import System.IO.Unsafe(unsafePerformIO)
33import Control.Monad(liftM) 35import Control.Monad(liftM)
36import Foreign.C.Types(CInt)
34 37
35------------------------------------------------------------------- 38-------------------------------------------------------------------
36 39
@@ -53,8 +56,10 @@ instance (Show a, Element a) => (Show (Matrix a)) where
53 show m | rows m == 0 || cols m == 0 = sizes m ++" []" 56 show m | rows m == 0 || cols m == 0 = sizes m ++" []"
54 show m = (sizes m++) . dsp . map (map show) . toLists $ m 57 show m = (sizes m++) . dsp . map (map show) . toLists $ m
55 58
59sizes :: Matrix t -> [Char]
56sizes m = "("++show (rows m)++"><"++show (cols m)++")\n" 60sizes m = "("++show (rows m)++"><"++show (cols m)++")\n"
57 61
62dsp :: [[[Char]]] -> [Char]
58dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unwords' $ transpose mtp 63dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unwords' $ transpose mtp
59 where 64 where
60 mt = transpose as 65 mt = transpose as
@@ -73,6 +78,7 @@ instance (Element a, Read a) => Read (Matrix a) where
73 rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims 78 rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims
74 79
75 80
81breakAt :: Eq a => a -> [a] -> ([a], [a])
76breakAt c l = (a++[c],tail b) where 82breakAt c l = (a++[c],tail b) where
77 (a,b) = break (==c) l 83 (a,b) = break (==c) l
78 84
@@ -88,7 +94,8 @@ data Extractor
88 | Drop Int 94 | Drop Int
89 | DropLast Int 95 | DropLast Int
90 deriving Show 96 deriving Show
91 97
98ppext :: Extractor -> [Char]
92ppext All = ":" 99ppext All = ":"
93ppext (Range a 1 c) = printf "%d:%d" a c 100ppext (Range a 1 c) = printf "%d:%d" a c
94ppext (Range a b c) = printf "%d:%d:%d" a b c 101ppext (Range a b c) = printf "%d:%d:%d" a b c
@@ -128,10 +135,14 @@ ppext (DropLast n) = printf "DropLast %d" n
128infixl 9 ?? 135infixl 9 ??
129(??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t 136(??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t
130 137
138minEl :: Vector CInt -> CInt
131minEl = toScalarI Min 139minEl = toScalarI Min
140maxEl :: Vector CInt -> CInt
132maxEl = toScalarI Max 141maxEl = toScalarI Max
142cmodi :: Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt
133cmodi = vectorMapValI ModVS 143cmodi = vectorMapValI ModVS
134 144
145extractError :: Matrix t1 -> (Extractor, Extractor) -> t
135extractError m (e1,e2)= error $ printf "can't extract (%s,%s) from matrix %dx%d" (ppext e1::String) (ppext e2::String) (rows m) (cols m) 146extractError m (e1,e2)= error $ printf "can't extract (%s,%s) from matrix %dx%d" (ppext e1::String) (ppext e2::String) (rows m) (cols m)
136 147
137m ?? (Range a s b,e) | s /= 1 = m ?? (Pos (idxs [a,a+s .. b]), e) 148m ?? (Range a s b,e) | s /= 1 = m ?? (Pos (idxs [a,a+s .. b]), e)
@@ -232,8 +243,10 @@ disp = putStr . dispf 2
232fromBlocks :: Element t => [[Matrix t]] -> Matrix t 243fromBlocks :: Element t => [[Matrix t]] -> Matrix t
233fromBlocks = fromBlocksRaw . adaptBlocks 244fromBlocks = fromBlocksRaw . adaptBlocks
234 245
246fromBlocksRaw :: Element t => [[Matrix t]] -> Matrix t
235fromBlocksRaw mms = joinVert . map joinHoriz $ mms 247fromBlocksRaw mms = joinVert . map joinHoriz $ mms
236 248
249adaptBlocks :: Element t => [[Matrix t]] -> [[Matrix t]]
237adaptBlocks ms = ms' where 250adaptBlocks ms = ms' where
238 bc = case common length ms of 251 bc = case common length ms of
239 Just c -> c 252 Just c -> c
@@ -486,6 +499,9 @@ liftMatrix2Auto f m1 m2
486 m2' = conformMTo (r,c) m2 499 m2' = conformMTo (r,c) m2
487 500
488-- FIXME do not flatten if equal order 501-- FIXME do not flatten if equal order
502lM :: (Storable t, Element t1, Element t2)
503 => (Vector t1 -> Vector t2 -> Vector t)
504 -> Matrix t1 -> Matrix t2 -> Matrix t
489lM f m1 m2 = matrixFromVector 505lM f m1 m2 = matrixFromVector
490 RowMajor 506 RowMajor
491 (max' (rows m1) (rows m2)) 507 (max' (rows m1) (rows m2))
@@ -504,6 +520,7 @@ compat' m1 m2 = s1 == (1,1) || s2 == (1,1) || s1 == s2
504 520
505------------------------------------------------------------ 521------------------------------------------------------------
506 522
523toBlockRows :: Element t => [Int] -> Matrix t -> [Matrix t]
507toBlockRows [r] m 524toBlockRows [r] m
508 | r == rows m = [m] 525 | r == rows m = [m]
509toBlockRows rs m 526toBlockRows rs m
@@ -513,6 +530,7 @@ toBlockRows rs m
513 szs = map (* cols m) rs 530 szs = map (* cols m) rs
514 g k = (k><0)[] 531 g k = (k><0)[]
515 532
533toBlockCols :: Element t => [Int] -> Matrix t -> [Matrix t]
516toBlockCols [c] m | c == cols m = [m] 534toBlockCols [c] m | c == cols m = [m]
517toBlockCols cs m = map trans . toBlockRows cs . trans $ m 535toBlockCols cs m = map trans . toBlockRows cs . trans $ m
518 536
@@ -576,7 +594,7 @@ Just (3><3)
576mapMatrixWithIndexM 594mapMatrixWithIndexM
577 :: (Element a, Storable b, Monad m) => 595 :: (Element a, Storable b, Monad m) =>
578 ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b) 596 ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b)
579mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m 597mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m
580 where 598 where
581 c = cols m 599 c = cols m
582 600
@@ -598,4 +616,3 @@ mapMatrixWithIndex g m = reshape c . mapVectorWithIndex (mk c g) . flatten $ m
598 616
599mapMatrix :: (Element a, Element b) => (a -> b) -> Matrix a -> Matrix b 617mapMatrix :: (Element a, Element b) => (a -> b) -> Matrix a -> Matrix b
600mapMatrix f = liftMatrix (mapVector f) 618mapMatrix f = liftMatrix (mapVector f)
601