module Internal.IO (
dispf, disps, dispcf, vecdisp, latexFormat, format,
loadMatrix, loadMatrix', saveMatrix
) where
import Internal.Devel
import Internal.Vector
import Internal.Matrix
import Internal.Vectorized
import Text.Printf(printf)
import Data.List(intersperse,transpose)
import Data.Complex
table :: String -> [[String]] -> String
table sep as = unlines . map unwords' $ transpose mtp
where
mt = transpose as
longs = map (maximum . map length) mt
mtp = zipWith (\a b -> map (pad a) b) longs mt
pad n str = replicate (n length str) ' ' ++ str
unwords' = concat . intersperse sep
format :: (Element t) => String -> (t -> String) -> Matrix t -> String
format sep f m = table sep . map (map f) . toLists $ m
disps :: Int -> Matrix Double -> String
disps d x = sdims x ++ " " ++ formatScaled d x
dispf :: Int -> Matrix Double -> String
dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x
sdims x = show (rows x) ++ "x" ++ show (cols x)
formatFixed d x = format " " (printf ("%."++show d++"f")) $ x
isInt = all lookslikeInt . toList . flatten
formatScaled dec t = "E"++show o++"\n" ++ ss
where ss = format " " (printf fmt. g) t
g x | o >= 0 = x/10^(o::Int)
| otherwise = x*10^(o)
o | rows t == 0 || cols t == 0 = 0
| otherwise = floor $ maximum $ map (logBase 10 . abs) $ toList $ flatten t
fmt = '%':show (dec+3) ++ '.':show dec ++"f"
vecdisp :: (Element t) => (Matrix t -> String) -> Vector t -> String
vecdisp f v
= ((show (dim v) ++ " |> ") ++) . (++"\n")
. unwords . lines . tail . dropWhile (not . (`elem` " \n"))
. f . trans . reshape 1
$ v
latexFormat :: String
-> String
-> String
latexFormat del tab = "\\begin{"++del++"}\n" ++ f tab ++ "\\end{"++del++"}"
where f = unlines . intersperse "\\\\" . map unwords . map (intersperse " & " . words) . tail . lines
showComplex :: Int -> Complex Double -> String
showComplex d (a:+b)
| isZero a && isZero b = "0"
| isZero b = sa
| isZero a && isOne b = s2++"i"
| isZero a = sb++"i"
| isOne b = sa++s3++"i"
| otherwise = sa++s1++sb++"i"
where
sa = shcr d a
sb = shcr d b
s1 = if b<0 then "" else "+"
s2 = if b<0 then "-" else ""
s3 = if b<0 then "-" else "+"
shcr d a | lookslikeInt a = printf "%.0f" a
| otherwise = printf ("%."++show d++"f") a
lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx
where shx = show x
isZero x = show x `elem` ["0.0","-0.0"]
isOne x = show x `elem` ["1.0","-1.0"]
dispcf :: Int -> Matrix (Complex Double) -> String
dispcf d m = sdims m ++ "\n" ++ format " " (showComplex d) m
apparentCols :: FilePath -> IO Int
apparentCols s = f . dropWhile null . map words . lines <$> readFile s
where
f [] = 0
f (x:_) = length x
loadMatrix :: FilePath -> IO (Matrix Double)
loadMatrix f = do
v <- vectorScan f
c <- apparentCols f
if (dim v `mod` c /= 0)
then
error $ printf "loadMatrix: %d elements and %d columns in file %s"
(dim v) c f
else
return (reshape c v)
loadMatrix' name = mbCatch (loadMatrix name)