diff options
author | Alberto Ruiz <aruiz@um.es> | 2015-06-14 19:49:10 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2015-06-14 19:49:10 +0200 |
commit | 57487d828065ea219cdb33c9dc177b67c60b34c7 (patch) | |
tree | f6cc1e11ba41165e3a65930c66954a5220a4a8cb /packages/base/src/Internal/Util.hs | |
parent | 517dfdbf884ef2b3f3f3d365294a6a714ba7ff9d (diff) |
minor changes
Diffstat (limited to 'packages/base/src/Internal/Util.hs')
-rw-r--r-- | packages/base/src/Internal/Util.hs | 44 |
1 files changed, 24 insertions, 20 deletions
diff --git a/packages/base/src/Internal/Util.hs b/packages/base/src/Internal/Util.hs index 2650ac8..09ba21c 100644 --- a/packages/base/src/Internal/Util.hs +++ b/packages/base/src/Internal/Util.hs | |||
@@ -65,7 +65,7 @@ import Internal.Element | |||
65 | import Internal.Container | 65 | import Internal.Container |
66 | import Internal.Vectorized | 66 | import Internal.Vectorized |
67 | import Internal.IO | 67 | import Internal.IO |
68 | import Internal.Algorithms hiding (i,Normed,swap) | 68 | import Internal.Algorithms hiding (i,Normed,swap,linearSolve') |
69 | import Numeric.Matrix() | 69 | import Numeric.Matrix() |
70 | import Numeric.Vector() | 70 | import Numeric.Vector() |
71 | import Internal.Random | 71 | import Internal.Random |
@@ -155,7 +155,7 @@ infixl 3 & | |||
155 | (&) :: Vector Double -> Vector Double -> Vector Double | 155 | (&) :: Vector Double -> Vector Double -> Vector Double |
156 | a & b = vjoin [a,b] | 156 | a & b = vjoin [a,b] |
157 | 157 | ||
158 | {- | horizontal concatenation of real matrices | 158 | {- | horizontal concatenation |
159 | 159 | ||
160 | >>> ident 3 ||| konst 7 (3,4) | 160 | >>> ident 3 ||| konst 7 (3,4) |
161 | (3><7) | 161 | (3><7) |
@@ -165,7 +165,7 @@ a & b = vjoin [a,b] | |||
165 | 165 | ||
166 | -} | 166 | -} |
167 | infixl 3 ||| | 167 | infixl 3 ||| |
168 | (|||) :: Matrix Double -> Matrix Double -> Matrix Double | 168 | (|||) :: Element t => Matrix t -> Matrix t -> Matrix t |
169 | a ||| b = fromBlocks [[a,b]] | 169 | a ||| b = fromBlocks [[a,b]] |
170 | 170 | ||
171 | -- | a synonym for ('|||') (unicode 0x00a6, broken bar) | 171 | -- | a synonym for ('|||') (unicode 0x00a6, broken bar) |
@@ -174,9 +174,9 @@ infixl 3 ¦ | |||
174 | (¦) = (|||) | 174 | (¦) = (|||) |
175 | 175 | ||
176 | 176 | ||
177 | -- | vertical concatenation of real matrices | 177 | -- | vertical concatenation |
178 | -- | 178 | -- |
179 | (===) :: Matrix Double -> Matrix Double -> Matrix Double | 179 | (===) :: Element t => Matrix t -> Matrix t -> Matrix t |
180 | infixl 2 === | 180 | infixl 2 === |
181 | a === b = fromBlocks [[a],[b]] | 181 | a === b = fromBlocks [[a],[b]] |
182 | 182 | ||
@@ -588,7 +588,7 @@ gaussElim_2 a b = flipudrl r | |||
588 | where | 588 | where |
589 | flipudrl = flipud . fliprl | 589 | flipudrl = flipud . fliprl |
590 | splitColsAt n = (takeColumns n &&& dropColumns n) | 590 | splitColsAt n = (takeColumns n &&& dropColumns n) |
591 | go f x y = splitColsAt (cols a) (down f $ fromBlocks [[x,y]]) | 591 | go f x y = splitColsAt (cols a) (down f $ x ||| y) |
592 | (a1,b1) = go (snd . swapMax 0) a b | 592 | (a1,b1) = go (snd . swapMax 0) a b |
593 | ( _, r) = go id (flipudrl $ a1) (flipudrl $ b1) | 593 | ( _, r) = go id (flipudrl $ a1) (flipudrl $ b1) |
594 | 594 | ||
@@ -600,7 +600,7 @@ gaussElim_1 | |||
600 | 600 | ||
601 | gaussElim_1 x y = dropColumns (rows x) (flipud $ fromRows s2) | 601 | gaussElim_1 x y = dropColumns (rows x) (flipud $ fromRows s2) |
602 | where | 602 | where |
603 | rs = toRows $ fromBlocks [[x , y]] | 603 | rs = toRows $ x ||| y |
604 | s1 = fromRows $ pivotDown (rows x) 0 rs -- interesting | 604 | s1 = fromRows $ pivotDown (rows x) 0 rs -- interesting |
605 | s2 = pivotUp (rows x-1) (toRows $ flipud s1) | 605 | s2 = pivotUp (rows x-1) (toRows $ flipud s1) |
606 | 606 | ||
@@ -637,12 +637,15 @@ pivotUp n xs | |||
637 | 637 | ||
638 | -------------------------------------------------------------------------------- | 638 | -------------------------------------------------------------------------------- |
639 | 639 | ||
640 | gaussElim a b = dropColumns (rows a) $ fst $ mutable gaussST (fromBlocks [[a,b]]) | 640 | gaussElim a b = dropColumns (rows a) $ fst $ mutable gaussST (a ||| b) |
641 | 641 | ||
642 | gaussST (r,_) x = do | 642 | gaussST (r,_) x = do |
643 | let n = r-1 | 643 | let n = r-1 |
644 | axpy m a i j = rowOper (AXPY a i j AllCols) m | ||
645 | swap m i j = rowOper (SWAP i j AllCols) m | ||
646 | scal m a i = rowOper (SCAL a (Row i) AllCols) m | ||
644 | forM_ [0..n] $ \i -> do | 647 | forM_ [0..n] $ \i -> do |
645 | c <- maxIndex . abs . flatten <$> extractMatrix x i n i i | 648 | c <- maxIndex . abs . flatten <$> extractMatrix x (FromRow i) (Col i) |
646 | swap x i (i+c) | 649 | swap x i (i+c) |
647 | a <- readMatrix x i i | 650 | a <- readMatrix x i i |
648 | when (a == 0) $ error "singular!" | 651 | when (a == 0) $ error "singular!" |
@@ -656,22 +659,23 @@ gaussST (r,_) x = do | |||
656 | axpy x (-b) i j | 659 | axpy x (-b) i j |
657 | 660 | ||
658 | 661 | ||
659 | luST ok (r,c) x = do | 662 | |
660 | let n = r-1 | 663 | luST ok (r,_) x = do |
661 | axpy' m a i j = rowOpST 0 a i j (i+1) (c-1) m | 664 | let axpy m a i j = rowOper (AXPY a i j (FromCol (i+1))) m |
662 | p <- thawMatrix . asColumn . range $ r | 665 | swap m i j = rowOper (SWAP i j AllCols) m |
663 | forM_ [0..n] $ \i -> do | 666 | p <- newUndefinedVector r |
664 | k <- maxIndex . abs . flatten <$> extractMatrix x i n i i | 667 | forM_ [0..r-1] $ \i -> do |
665 | writeMatrix p i 0 (fi (k+i)) | 668 | k <- maxIndex . abs . flatten <$> extractMatrix x (FromRow i) (Col i) |
669 | writeVector p i (k+i) | ||
666 | swap x i (i+k) | 670 | swap x i (i+k) |
667 | a <- readMatrix x i i | 671 | a <- readMatrix x i i |
668 | when (ok a) $ do | 672 | when (ok a) $ do |
669 | forM_ [i+1..n] $ \j -> do | 673 | forM_ [i+1..r-1] $ \j -> do |
670 | b <- (/a) <$> readMatrix x j i | 674 | b <- (/a) <$> readMatrix x j i |
671 | axpy' x (-b) i j | 675 | axpy x (-b) i j |
672 | writeMatrix x j i b | 676 | writeMatrix x j i b |
673 | v <- unsafeFreezeMatrix p | 677 | v <- unsafeFreezeVector p |
674 | return (map ti $ toList $ flatten v) | 678 | return (toList v) |
675 | 679 | ||
676 | 680 | ||
677 | -------------------------------------------------------------------------------- | 681 | -------------------------------------------------------------------------------- |