diff options
Diffstat (limited to 'packages/base/src/Internal/IO.hs')
-rw-r--r-- | packages/base/src/Internal/IO.hs | 16 |
1 files changed, 13 insertions, 3 deletions
diff --git a/packages/base/src/Internal/IO.hs b/packages/base/src/Internal/IO.hs index a899cfd..b0f5606 100644 --- a/packages/base/src/Internal/IO.hs +++ b/packages/base/src/Internal/IO.hs | |||
@@ -20,7 +20,7 @@ import Internal.Devel | |||
20 | import Internal.Vector | 20 | import Internal.Vector |
21 | import Internal.Matrix | 21 | import Internal.Matrix |
22 | import Internal.Vectorized | 22 | import Internal.Vectorized |
23 | import Text.Printf(printf) | 23 | import Text.Printf(printf, PrintfArg, PrintfType) |
24 | import Data.List(intersperse,transpose) | 24 | import Data.List(intersperse,transpose) |
25 | import Data.Complex | 25 | import Data.Complex |
26 | 26 | ||
@@ -78,12 +78,18 @@ disps d x = sdims x ++ " " ++ formatScaled d x | |||
78 | dispf :: Int -> Matrix Double -> String | 78 | dispf :: Int -> Matrix Double -> String |
79 | dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x | 79 | dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x |
80 | 80 | ||
81 | sdims :: Matrix t -> [Char] | ||
81 | sdims x = show (rows x) ++ "x" ++ show (cols x) | 82 | sdims x = show (rows x) ++ "x" ++ show (cols x) |
82 | 83 | ||
84 | formatFixed :: (Show a, Text.Printf.PrintfArg t, Element t) | ||
85 | => a -> Matrix t -> String | ||
83 | formatFixed d x = format " " (printf ("%."++show d++"f")) $ x | 86 | formatFixed d x = format " " (printf ("%."++show d++"f")) $ x |
84 | 87 | ||
88 | isInt :: Matrix Double -> Bool | ||
85 | isInt = all lookslikeInt . toList . flatten | 89 | isInt = all lookslikeInt . toList . flatten |
86 | 90 | ||
91 | formatScaled :: (Text.Printf.PrintfArg b, RealFrac b, Floating b, Num t, Element b, Show t) | ||
92 | => t -> Matrix b -> [Char] | ||
87 | formatScaled dec t = "E"++show o++"\n" ++ ss | 93 | formatScaled dec t = "E"++show o++"\n" ++ ss |
88 | where ss = format " " (printf fmt. g) t | 94 | where ss = format " " (printf fmt. g) t |
89 | g x | o >= 0 = x/10^(o::Int) | 95 | g x | o >= 0 = x/10^(o::Int) |
@@ -133,14 +139,18 @@ showComplex d (a:+b) | |||
133 | s2 = if b<0 then "-" else "" | 139 | s2 = if b<0 then "-" else "" |
134 | s3 = if b<0 then "-" else "+" | 140 | s3 = if b<0 then "-" else "+" |
135 | 141 | ||
142 | shcr :: (Show a, Show t1, Text.Printf.PrintfType t, Text.Printf.PrintfArg t1, RealFrac t1) | ||
143 | => a -> t1 -> t | ||
136 | shcr d a | lookslikeInt a = printf "%.0f" a | 144 | shcr d a | lookslikeInt a = printf "%.0f" a |
137 | | otherwise = printf ("%."++show d++"f") a | 145 | | otherwise = printf ("%."++show d++"f") a |
138 | 146 | ||
139 | 147 | lookslikeInt :: (Show a, RealFrac a) => a -> Bool | |
140 | lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx | 148 | lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx |
141 | where shx = show x | 149 | where shx = show x |
142 | 150 | ||
151 | isZero :: Show a => a -> Bool | ||
143 | isZero x = show x `elem` ["0.0","-0.0"] | 152 | isZero x = show x `elem` ["0.0","-0.0"] |
153 | isOne :: Show a => a -> Bool | ||
144 | isOne x = show x `elem` ["1.0","-1.0"] | 154 | isOne x = show x `elem` ["1.0","-1.0"] |
145 | 155 | ||
146 | -- | Pretty print a complex matrix with at most n decimal digits. | 156 | -- | Pretty print a complex matrix with at most n decimal digits. |
@@ -168,6 +178,6 @@ loadMatrix f = do | |||
168 | else | 178 | else |
169 | return (reshape c v) | 179 | return (reshape c v) |
170 | 180 | ||
171 | 181 | loadMatrix' :: FilePath -> IO (Maybe (Matrix Double)) | |
172 | loadMatrix' name = mbCatch (loadMatrix name) | 182 | loadMatrix' name = mbCatch (loadMatrix name) |
173 | 183 | ||