diff options
author | Alberto Ruiz <aruiz@um.es> | 2014-06-11 13:53:55 +0200 |
---|---|---|
committer | Alberto Ruiz <aruiz@um.es> | 2014-06-11 13:53:55 +0200 |
commit | ab6d7efb73bcfa3b331cc7f2abce75430f7cff09 (patch) | |
tree | 09f5edfb666ef1c096a04b486445b648b3a4cd22 /packages/base/src/Numeric/LinearAlgebra/Util.hs | |
parent | 4403c176938a990f51762a48e95d1f03a11adc4e (diff) |
additional display functions
Diffstat (limited to 'packages/base/src/Numeric/LinearAlgebra/Util.hs')
-rw-r--r-- | packages/base/src/Numeric/LinearAlgebra/Util.hs | 75 |
1 files changed, 74 insertions, 1 deletions
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 | |||