diff options
Diffstat (limited to 'packages/base/src/Numeric')
-rw-r--r-- | packages/base/src/Numeric/LinearAlgebra/Data.hs | 4 | ||||
-rw-r--r-- | packages/base/src/Numeric/LinearAlgebra/Util.hs | 75 |
2 files changed, 76 insertions, 3 deletions
diff --git a/packages/base/src/Numeric/LinearAlgebra/Data.hs b/packages/base/src/Numeric/LinearAlgebra/Data.hs index 5099445..d5ce32f 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Data.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Data.hs | |||
@@ -58,10 +58,10 @@ module Numeric.LinearAlgebra.Data( | |||
58 | loadMatrix, saveMatrix, | 58 | loadMatrix, saveMatrix, |
59 | latexFormat, | 59 | latexFormat, |
60 | dispf, disps, dispcf, format, | 60 | dispf, disps, dispcf, format, |
61 | 61 | dispDots, dispBlanks, dispShort, | |
62 | -- * Conversion | 62 | -- * Conversion |
63 | Convert(..), | 63 | Convert(..), |
64 | 64 | roundVector, | |
65 | -- * Misc | 65 | -- * Misc |
66 | arctan2, | 66 | arctan2, |
67 | rows, cols, | 67 | rows, cols, |
diff --git a/packages/base/src/Numeric/LinearAlgebra/Util.hs b/packages/base/src/Numeric/LinearAlgebra/Util.hs index 0ac4634..b6f8966 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Util.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Util.hs | |||
@@ -3,6 +3,8 @@ | |||
3 | {-# LANGUAGE TypeFamilies #-} | 3 | {-# LANGUAGE TypeFamilies #-} |
4 | {-# LANGUAGE MultiParamTypeClasses #-} | 4 | {-# LANGUAGE MultiParamTypeClasses #-} |
5 | {-# LANGUAGE FunctionalDependencies #-} | 5 | {-# LANGUAGE FunctionalDependencies #-} |
6 | {-# LANGUAGE ViewPatterns #-} | ||
7 | |||
6 | 8 | ||
7 | ----------------------------------------------------------------------------- | 9 | ----------------------------------------------------------------------------- |
8 | {- | | 10 | {- | |
@@ -21,6 +23,12 @@ module Numeric.LinearAlgebra.Util( | |||
21 | -- * Convenience functions | 23 | -- * Convenience functions |
22 | vector, matrix, | 24 | vector, matrix, |
23 | disp, | 25 | disp, |
26 | formatSparse, | ||
27 | approxInt, | ||
28 | dispDots, | ||
29 | dispBlanks, | ||
30 | formatShort, | ||
31 | dispShort, | ||
24 | zeros, ones, | 32 | zeros, ones, |
25 | diagl, | 33 | diagl, |
26 | row, | 34 | row, |
@@ -67,6 +75,9 @@ import Numeric.Vector() | |||
67 | import Numeric.LinearAlgebra.Random | 75 | import Numeric.LinearAlgebra.Random |
68 | import Numeric.LinearAlgebra.Util.Convolution | 76 | import Numeric.LinearAlgebra.Util.Convolution |
69 | import Control.Monad(when) | 77 | import Control.Monad(when) |
78 | import Text.Printf | ||
79 | import Data.List.Split(splitOn) | ||
80 | import Data.List(intercalate) | ||
70 | 81 | ||
71 | type ℝ = Double | 82 | type ℝ = Double |
72 | type ℕ = Int | 83 | type ℕ = Int |
@@ -112,7 +123,7 @@ matrix c = reshape c . fromList | |||
112 | -} | 123 | -} |
113 | disp :: Int -> Matrix Double -> IO () | 124 | disp :: Int -> Matrix Double -> IO () |
114 | 125 | ||
115 | disp n = putStrLn . dispf n | 126 | disp n = putStr . dispf n |
116 | 127 | ||
117 | 128 | ||
118 | {- | create a real diagonal matrix from a list | 129 | {- | create a real diagonal matrix from a list |
@@ -401,3 +412,65 @@ vtrans p m | r == 0 = fromBlocks . map (map asColumn . takesV (replicate q p)) . | |||
401 | infixl 0 ~!~ | 412 | infixl 0 ~!~ |
402 | c ~!~ msg = when c (error msg) | 413 | c ~!~ msg = when c (error msg) |
403 | 414 | ||
415 | -------------------------------------------------------------------------------- | ||
416 | |||
417 | formatSparse :: String -> String -> String -> Int -> Matrix Double -> String | ||
418 | |||
419 | formatSparse zeroI zeroF sep _ (approxInt -> Just m) = format sep f m | ||
420 | where | ||
421 | f 0 = zeroI | ||
422 | f x = printf "%.0f" x | ||
423 | |||
424 | formatSparse zeroI zeroF sep n m = format sep f m | ||
425 | where | ||
426 | f x | abs (x::Double) < 2*peps = zeroI++zeroF | ||
427 | | abs (fromIntegral (round x) - x) / abs x < 2*peps = printf ("%.0f."++replicate n ' ') x | ||
428 | | otherwise = printf ("%."++show n++"f") x | ||
429 | |||
430 | approxInt m | ||
431 | | norm_Inf (v - vi) < 2*peps * norm_Inf v = Just (reshape (cols m) vi) | ||
432 | | otherwise = Nothing | ||
433 | where | ||
434 | v = flatten m | ||
435 | vi = roundVector v | ||
436 | |||
437 | dispDots n = putStr . formatSparse "." (replicate n ' ') " " n | ||
438 | |||
439 | dispBlanks n = putStr . formatSparse "" "" " " n | ||
440 | |||
441 | formatShort sep fmt maxr maxc m = auxm4 | ||
442 | where | ||
443 | (rm,cm) = size m | ||
444 | (r1,r2,r3) | ||
445 | | rm <= maxr = (rm,0,0) | ||
446 | | otherwise = (maxr-3,rm-maxr+1,2) | ||
447 | (c1,c2,c3) | ||
448 | | cm <= maxc = (cm,0,0) | ||
449 | | otherwise = (maxc-3,cm-maxc+1,2) | ||
450 | [ [a,_,b] | ||
451 | ,[_,_,_] | ||
452 | ,[c,_,d]] = toBlocks [r1,r2,r3] | ||
453 | [c1,c2,c3] m | ||
454 | auxm = fromBlocks [[a,b],[c,d]] | ||
455 | auxm2 | ||
456 | | cm > maxc = format "|" fmt auxm | ||
457 | | otherwise = format sep fmt auxm | ||
458 | auxm3 | ||
459 | | cm > maxc = map (f . splitOn "|") (lines auxm2) | ||
460 | | otherwise = (lines auxm2) | ||
461 | f items = intercalate sep (take (maxc-3) items) ++ " .. " ++ | ||
462 | intercalate sep (drop (maxc-3) items) | ||
463 | auxm4 | ||
464 | | rm > maxr = unlines (take (maxr-3) auxm3 ++ vsep : drop (maxr-3) auxm3) | ||
465 | | otherwise = unlines auxm3 | ||
466 | vsep = map g (head auxm3) | ||
467 | g '.' = ':' | ||
468 | g _ = ' ' | ||
469 | |||
470 | |||
471 | dispShort :: Int -> Int -> Int -> Matrix Double -> IO () | ||
472 | dispShort maxr maxc dec m = | ||
473 | printf "%dx%d\n%s" (rows m) (cols m) (formatShort " " fmt maxr maxc m) | ||
474 | where | ||
475 | fmt = printf ("%."++show dec ++"f") | ||
476 | |||