diff options
Diffstat (limited to 'packages/base/src/Internal/IO.hs')
-rw-r--r-- | packages/base/src/Internal/IO.hs | 163 |
1 files changed, 163 insertions, 0 deletions
diff --git a/packages/base/src/Internal/IO.hs b/packages/base/src/Internal/IO.hs new file mode 100644 index 0000000..e594a1c --- /dev/null +++ b/packages/base/src/Internal/IO.hs | |||
@@ -0,0 +1,163 @@ | |||
1 | ----------------------------------------------------------------------------- | ||
2 | -- | | ||
3 | -- Module : Internal.IO | ||
4 | -- Copyright : (c) Alberto Ruiz 2010 | ||
5 | -- License : BSD3 | ||
6 | -- | ||
7 | -- Maintainer : Alberto Ruiz | ||
8 | -- Stability : provisional | ||
9 | -- | ||
10 | -- Display, formatting and IO functions for numeric 'Vector' and 'Matrix' | ||
11 | -- | ||
12 | ----------------------------------------------------------------------------- | ||
13 | |||
14 | module Internal.IO ( | ||
15 | dispf, disps, dispcf, vecdisp, latexFormat, format, | ||
16 | loadMatrix, loadMatrix', saveMatrix | ||
17 | ) where | ||
18 | |||
19 | import Internal.Tools | ||
20 | import Internal.Devel | ||
21 | import Internal.Vector | ||
22 | import Internal.Matrix | ||
23 | import Internal.Vectorized | ||
24 | import Text.Printf(printf) | ||
25 | import Data.List(intersperse) | ||
26 | import Data.Complex | ||
27 | |||
28 | |||
29 | |||
30 | {- | Creates a string from a matrix given a separator and a function to show each entry. Using | ||
31 | this function the user can easily define any desired display function: | ||
32 | |||
33 | @import Text.Printf(printf)@ | ||
34 | |||
35 | @disp = putStr . format \" \" (printf \"%.2f\")@ | ||
36 | |||
37 | -} | ||
38 | format :: (Element t) => String -> (t -> String) -> Matrix t -> String | ||
39 | format sep f m = table sep . map (map f) . toLists $ m | ||
40 | |||
41 | {- | Show a matrix with \"autoscaling\" and a given number of decimal places. | ||
42 | |||
43 | >>> putStr . disps 2 $ 120 * (3><4) [1..] | ||
44 | 3x4 E3 | ||
45 | 0.12 0.24 0.36 0.48 | ||
46 | 0.60 0.72 0.84 0.96 | ||
47 | 1.08 1.20 1.32 1.44 | ||
48 | |||
49 | -} | ||
50 | disps :: Int -> Matrix Double -> String | ||
51 | disps d x = sdims x ++ " " ++ formatScaled d x | ||
52 | |||
53 | {- | Show a matrix with a given number of decimal places. | ||
54 | |||
55 | >>> dispf 2 (1/3 + ident 3) | ||
56 | "3x3\n1.33 0.33 0.33\n0.33 1.33 0.33\n0.33 0.33 1.33\n" | ||
57 | |||
58 | >>> putStr . dispf 2 $ (3><4)[1,1.5..] | ||
59 | 3x4 | ||
60 | 1.00 1.50 2.00 2.50 | ||
61 | 3.00 3.50 4.00 4.50 | ||
62 | 5.00 5.50 6.00 6.50 | ||
63 | |||
64 | >>> putStr . unlines . tail . lines . dispf 2 . asRow $ linspace 10 (0,1) | ||
65 | 0.00 0.11 0.22 0.33 0.44 0.56 0.67 0.78 0.89 1.00 | ||
66 | |||
67 | -} | ||
68 | dispf :: Int -> Matrix Double -> String | ||
69 | dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x | ||
70 | |||
71 | sdims x = show (rows x) ++ "x" ++ show (cols x) | ||
72 | |||
73 | formatFixed d x = format " " (printf ("%."++show d++"f")) $ x | ||
74 | |||
75 | isInt = all lookslikeInt . toList . flatten | ||
76 | |||
77 | formatScaled dec t = "E"++show o++"\n" ++ ss | ||
78 | where ss = format " " (printf fmt. g) t | ||
79 | g x | o >= 0 = x/10^(o::Int) | ||
80 | | otherwise = x*10^(-o) | ||
81 | o | rows t == 0 || cols t == 0 = 0 | ||
82 | | otherwise = floor $ maximum $ map (logBase 10 . abs) $ toList $ flatten t | ||
83 | fmt = '%':show (dec+3) ++ '.':show dec ++"f" | ||
84 | |||
85 | {- | Show a vector using a function for showing matrices. | ||
86 | |||
87 | >>> putStr . vecdisp (dispf 2) $ linspace 10 (0,1) | ||
88 | 10 |> 0.00 0.11 0.22 0.33 0.44 0.56 0.67 0.78 0.89 1.00 | ||
89 | |||
90 | -} | ||
91 | vecdisp :: (Element t) => (Matrix t -> String) -> Vector t -> String | ||
92 | vecdisp f v | ||
93 | = ((show (dim v) ++ " |> ") ++) . (++"\n") | ||
94 | . unwords . lines . tail . dropWhile (not . (`elem` " \n")) | ||
95 | . f . trans . reshape 1 | ||
96 | $ v | ||
97 | |||
98 | {- | Tool to display matrices with latex syntax. | ||
99 | |||
100 | >>> latexFormat "bmatrix" (dispf 2 $ ident 2) | ||
101 | "\\begin{bmatrix}\n1 & 0\n\\\\\n0 & 1\n\\end{bmatrix}" | ||
102 | |||
103 | -} | ||
104 | latexFormat :: String -- ^ type of braces: \"matrix\", \"bmatrix\", \"pmatrix\", etc. | ||
105 | -> String -- ^ Formatted matrix, with elements separated by spaces and newlines | ||
106 | -> String | ||
107 | latexFormat del tab = "\\begin{"++del++"}\n" ++ f tab ++ "\\end{"++del++"}" | ||
108 | where f = unlines . intersperse "\\\\" . map unwords . map (intersperse " & " . words) . tail . lines | ||
109 | |||
110 | -- | Pretty print a complex number with at most n decimal digits. | ||
111 | showComplex :: Int -> Complex Double -> String | ||
112 | showComplex d (a:+b) | ||
113 | | isZero a && isZero b = "0" | ||
114 | | isZero b = sa | ||
115 | | isZero a && isOne b = s2++"i" | ||
116 | | isZero a = sb++"i" | ||
117 | | isOne b = sa++s3++"i" | ||
118 | | otherwise = sa++s1++sb++"i" | ||
119 | where | ||
120 | sa = shcr d a | ||
121 | sb = shcr d b | ||
122 | s1 = if b<0 then "" else "+" | ||
123 | s2 = if b<0 then "-" else "" | ||
124 | s3 = if b<0 then "-" else "+" | ||
125 | |||
126 | shcr d a | lookslikeInt a = printf "%.0f" a | ||
127 | | otherwise = printf ("%."++show d++"f") a | ||
128 | |||
129 | |||
130 | lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx | ||
131 | where shx = show x | ||
132 | |||
133 | isZero x = show x `elem` ["0.0","-0.0"] | ||
134 | isOne x = show x `elem` ["1.0","-1.0"] | ||
135 | |||
136 | -- | Pretty print a complex matrix with at most n decimal digits. | ||
137 | dispcf :: Int -> Matrix (Complex Double) -> String | ||
138 | dispcf d m = sdims m ++ "\n" ++ format " " (showComplex d) m | ||
139 | |||
140 | -------------------------------------------------------------------- | ||
141 | |||
142 | apparentCols :: FilePath -> IO Int | ||
143 | apparentCols s = f . dropWhile null . map words . lines <$> readFile s | ||
144 | where | ||
145 | f [] = 0 | ||
146 | f (x:_) = length x | ||
147 | |||
148 | |||
149 | -- | load a matrix from an ASCII file formatted as a 2D table. | ||
150 | loadMatrix :: FilePath -> IO (Matrix Double) | ||
151 | loadMatrix f = do | ||
152 | v <- vectorScan f | ||
153 | c <- apparentCols f | ||
154 | if (dim v `mod` c /= 0) | ||
155 | then | ||
156 | error $ printf "loadMatrix: %d elements and %d columns in file %s" | ||
157 | (dim v) c f | ||
158 | else | ||
159 | return (reshape c v) | ||
160 | |||
161 | |||
162 | loadMatrix' name = mbCatch (loadMatrix name) | ||
163 | |||