summaryrefslogtreecommitdiff
path: root/packages/base/src
diff options
context:
space:
mode:
Diffstat (limited to 'packages/base/src')
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Data.hs4
-rw-r--r--packages/base/src/Numeric/LinearAlgebra/Util.hs75
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()
67import Numeric.LinearAlgebra.Random 75import Numeric.LinearAlgebra.Random
68import Numeric.LinearAlgebra.Util.Convolution 76import Numeric.LinearAlgebra.Util.Convolution
69import Control.Monad(when) 77import Control.Monad(when)
78import Text.Printf
79import Data.List.Split(splitOn)
80import Data.List(intercalate)
70 81
71type ℝ = Double 82type ℝ = Double
72type ℕ = Int 83type ℕ = Int
@@ -112,7 +123,7 @@ matrix c = reshape c . fromList
112-} 123-}
113disp :: Int -> Matrix Double -> IO () 124disp :: Int -> Matrix Double -> IO ()
114 125
115disp n = putStrLn . dispf n 126disp 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)) .
401infixl 0 ~!~ 412infixl 0 ~!~
402c ~!~ msg = when c (error msg) 413c ~!~ msg = when c (error msg)
403 414
415--------------------------------------------------------------------------------
416
417formatSparse :: String -> String -> String -> Int -> Matrix Double -> String
418
419formatSparse zeroI zeroF sep _ (approxInt -> Just m) = format sep f m
420 where
421 f 0 = zeroI
422 f x = printf "%.0f" x
423
424formatSparse 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
430approxInt 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
437dispDots n = putStr . formatSparse "." (replicate n ' ') " " n
438
439dispBlanks n = putStr . formatSparse "" "" " " n
440
441formatShort 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
471dispShort :: Int -> Int -> Int -> Matrix Double -> IO ()
472dispShort 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