-----------------------------------------------------------------------------
-- |
-- Module      :  Internal.IO
-- Copyright   :  (c) Alberto Ruiz 2010
-- License     :  BSD3
--
-- Maintainer  :  Alberto Ruiz
-- Stability   :  provisional
--
-- Display, formatting and IO functions for numeric 'Vector' and 'Matrix'
--
-----------------------------------------------------------------------------

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, PrintfArg, PrintfType)
import Data.List(intersperse,transpose)
import Data.Complex


-- | Formatting tool
table :: String -> [[String]] -> String
table :: String -> [[String]] -> String
table String
sep [[String]]
as = [String] -> String
unlines ([String] -> String)
-> ([[String]] -> [String]) -> [[String]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords' ([[String]] -> String) -> [[String]] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose [[String]]
mtp
  where
    mt :: [[String]]
mt = [[String]] -> [[String]]
forall a. [[a]] -> [[a]]
transpose [[String]]
as
    longs :: [Int]
longs = ([String] -> Int) -> [[String]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> ([String] -> [Int]) -> [String] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[String]]
mt
    mtp :: [[String]]
mtp = (Int -> [String] -> [String]) -> [Int] -> [[String]] -> [[String]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
a [String]
b -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
pad Int
a) [String]
b) [Int]
longs [[String]]
mt
    pad :: Int -> String -> String
pad Int
n String
str = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str
    unwords' :: [String] -> String
unwords' = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
sep



{- | Creates a string from a matrix given a separator and a function to show each entry. Using
this function the user can easily define any desired display function:

@import Text.Printf(printf)@

@disp = putStr . format \"  \" (printf \"%.2f\")@

-}
format :: (Element t) => String -> (t -> String) -> Matrix t -> String
format :: String -> (t -> String) -> Matrix t -> String
format String
sep t -> String
f Matrix t
m = String -> [[String]] -> String
table String
sep ([[String]] -> String)
-> (Matrix t -> [[String]]) -> Matrix t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([t] -> [String]) -> [[t]] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map ((t -> String) -> [t] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map t -> String
f) ([[t]] -> [[String]])
-> (Matrix t -> [[t]]) -> Matrix t -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> [[t]]
forall t. Element t => Matrix t -> [[t]]
toLists (Matrix t -> String) -> Matrix t -> String
forall a b. (a -> b) -> a -> b
$ Matrix t
m

{- | Show a matrix with \"autoscaling\" and a given number of decimal places.

>>> putStr . disps 2 $ 120 * (3><4) [1..]
3x4  E3
 0.12  0.24  0.36  0.48
 0.60  0.72  0.84  0.96
 1.08  1.20  1.32  1.44

-}
disps :: Int -> Matrix Double -> String
disps :: Int -> Matrix Double -> String
disps Int
d Matrix Double
x = Matrix Double -> String
forall t. Matrix t -> String
sdims Matrix Double
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Matrix Double -> String
forall b t.
(PrintfArg b, RealFrac b, Floating b, Num t, Element b, Show t) =>
t -> Matrix b -> String
formatScaled Int
d Matrix Double
x

{- | Show a matrix with a given number of decimal places.

>>> dispf 2 (1/3 + ident 3)
"3x3\n1.33  0.33  0.33\n0.33  1.33  0.33\n0.33  0.33  1.33\n"

>>> putStr . dispf 2 $ (3><4)[1,1.5..]
3x4
1.00  1.50  2.00  2.50
3.00  3.50  4.00  4.50
5.00  5.50  6.00  6.50

>>> putStr . unlines . tail . lines . dispf 2 . asRow $ linspace 10 (0,1)
0.00  0.11  0.22  0.33  0.44  0.56  0.67  0.78  0.89  1.00

-}
dispf :: Int -> Matrix Double -> String
dispf :: Int -> Matrix Double -> String
dispf Int
d Matrix Double
x = Matrix Double -> String
forall t. Matrix t -> String
sdims Matrix Double
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Matrix Double -> String
forall a t.
(Show a, PrintfArg t, Element t) =>
a -> Matrix t -> String
formatFixed (if Matrix Double -> Bool
isInt Matrix Double
x then Int
0 else Int
d) Matrix Double
x

sdims :: Matrix t -> [Char]
sdims :: Matrix t -> String
sdims Matrix t
x = Int -> String
forall a. Show a => a -> String
show (Matrix t -> Int
forall t. Matrix t -> Int
rows Matrix t
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Matrix t -> Int
forall t. Matrix t -> Int
cols Matrix t
x)

formatFixed :: (Show a, Text.Printf.PrintfArg t, Element t)
            => a -> Matrix t -> String
formatFixed :: a -> Matrix t -> String
formatFixed a
d Matrix t
x = String -> (t -> String) -> Matrix t -> String
forall t.
Element t =>
String -> (t -> String) -> Matrix t -> String
format String
"  " (String -> t -> String
forall r. PrintfType r => String -> r
printf (String
"%."String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"f")) (Matrix t -> String) -> Matrix t -> String
forall a b. (a -> b) -> a -> b
$ Matrix t
x

isInt :: Matrix Double -> Bool
isInt :: Matrix Double -> Bool
isInt = (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Double -> Bool
forall a. (Show a, RealFrac a) => a -> Bool
lookslikeInt ([Double] -> Bool)
-> (Matrix Double -> [Double]) -> Matrix Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> [Double]
forall a. Storable a => Vector a -> [a]
toList (Vector Double -> [Double])
-> (Matrix Double -> Vector Double) -> Matrix Double -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Double -> Vector Double
forall t. Element t => Matrix t -> Vector t
flatten

formatScaled :: (Text.Printf.PrintfArg b, RealFrac b, Floating b, Num t, Element b, Show t)
             => t -> Matrix b -> [Char]
formatScaled :: t -> Matrix b -> String
formatScaled t
dec Matrix b
t = String
"E"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
oString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ss
    where ss :: String
ss = String -> (b -> String) -> Matrix b -> String
forall t.
Element t =>
String -> (t -> String) -> Matrix t -> String
format String
" " (String -> b -> String
forall r. PrintfType r => String -> r
printf String
fmt(b -> String) -> (b -> b) -> b -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
forall a. Fractional a => a -> a
g) Matrix b
t
          g :: a -> a
g a
x | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0    = a
xa -> a -> a
forall a. Fractional a => a -> a -> a
/a
10a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
o::Int)
              | Bool
otherwise = a
xa -> a -> a
forall a. Num a => a -> a -> a
*a
10a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(-Int
o)
          o :: Int
o | Matrix b -> Int
forall t. Matrix t -> Int
rows Matrix b
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Matrix b -> Int
forall t. Matrix t -> Int
cols Matrix b
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
0
            | Bool
otherwise = b -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (b -> Int) -> b -> Int
forall a b. (a -> b) -> a -> b
$ [b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (b -> b -> b
forall a. Floating a => a -> a -> a
logBase b
10 (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
forall a. Num a => a -> a
abs) ([b] -> [b]) -> [b] -> [b]
forall a b. (a -> b) -> a -> b
$ Vector b -> [b]
forall a. Storable a => Vector a -> [a]
toList (Vector b -> [b]) -> Vector b -> [b]
forall a b. (a -> b) -> a -> b
$ Matrix b -> Vector b
forall t. Element t => Matrix t -> Vector t
flatten Matrix b
t
          fmt :: String
fmt = Char
'%'Char -> String -> String
forall a. a -> [a] -> [a]
:t -> String
forall a. Show a => a -> String
show (t
dect -> t -> t
forall a. Num a => a -> a -> a
+t
3) String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
:t -> String
forall a. Show a => a -> String
show t
dec String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"f"

{- | Show a vector using a function for showing matrices.

>>> putStr . vecdisp (dispf 2) $ linspace 10 (0,1)
10 |> 0.00  0.11  0.22  0.33  0.44  0.56  0.67  0.78  0.89  1.00

-}
vecdisp :: (Element t) => (Matrix t -> String) -> Vector t -> String
vecdisp :: (Matrix t -> String) -> Vector t -> String
vecdisp Matrix t -> String
f Vector t
v
    = ((Int -> String
forall a. Show a => a -> String
show (Vector t -> Int
forall t. Storable t => Vector t -> Int
dim Vector t
v) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" |> ") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> (Vector t -> String) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n")
    (String -> String) -> (Vector t -> String) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> String)
-> (Vector t -> [String]) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (Vector t -> String) -> Vector t -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  String -> String
forall a. [a] -> [a]
tail (String -> String) -> (Vector t -> String) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \n"))
    (String -> String) -> (Vector t -> String) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> String
f (Matrix t -> String)
-> (Vector t -> Matrix t) -> Vector t -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix t -> Matrix t
forall t. Matrix t -> Matrix t
trans (Matrix t -> Matrix t)
-> (Vector t -> Matrix t) -> Vector t -> Matrix t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector t -> Matrix t
forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
1
    (Vector t -> String) -> Vector t -> String
forall a b. (a -> b) -> a -> b
$ Vector t
v

{- | Tool to display matrices with latex syntax.

>>>  latexFormat "bmatrix" (dispf 2 $ ident 2)
"\\begin{bmatrix}\n1  &  0\n\\\\\n0  &  1\n\\end{bmatrix}"

-}
latexFormat :: String -- ^ type of braces: \"matrix\", \"bmatrix\", \"pmatrix\", etc.
            -> String -- ^ Formatted matrix, with elements separated by spaces and newlines
            -> String
latexFormat :: String -> String -> String
latexFormat String
del String
tab = String
"\\begin{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
delString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
f String
tab String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\end{"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
delString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"}"
    where f :: String -> String
f = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\\\\" ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unwords ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
" & " ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
tail ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

-- | Pretty print a complex number with at most n decimal digits.
showComplex :: Int -> Complex Double -> String
showComplex :: Int -> Complex Double -> String
showComplex Int
d (Double
a:+Double
b)
    | Double -> Bool
forall a. Show a => a -> Bool
isZero Double
a Bool -> Bool -> Bool
&& Double -> Bool
forall a. Show a => a -> Bool
isZero Double
b = String
"0"
    | Double -> Bool
forall a. Show a => a -> Bool
isZero Double
b = String
sa
    | Double -> Bool
forall a. Show a => a -> Bool
isZero Double
a Bool -> Bool -> Bool
&& Double -> Bool
forall a. Show a => a -> Bool
isOne Double
b = String
s2String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"i"
    | Double -> Bool
forall a. Show a => a -> Bool
isZero Double
a = String
sbString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"i"
    | Double -> Bool
forall a. Show a => a -> Bool
isOne Double
b = String
saString -> String -> String
forall a. [a] -> [a] -> [a]
++String
s3String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"i"
    | Bool
otherwise = String
saString -> String -> String
forall a. [a] -> [a] -> [a]
++String
s1String -> String -> String
forall a. [a] -> [a] -> [a]
++String
sbString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"i"
  where
    sa :: String
sa = Int -> Double -> String
forall a t1 t.
(Show a, Show t1, PrintfType t, PrintfArg t1, RealFrac t1) =>
a -> t1 -> t
shcr Int
d Double
a
    sb :: String
sb = Int -> Double -> String
forall a t1 t.
(Show a, Show t1, PrintfType t, PrintfArg t1, RealFrac t1) =>
a -> t1 -> t
shcr Int
d Double
b
    s1 :: String
s1 = if Double
bDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0 then String
"" else String
"+"
    s2 :: String
s2 = if Double
bDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0 then String
"-" else String
""
    s3 :: String
s3 = if Double
bDouble -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0 then String
"-" else String
"+"

shcr :: (Show a, Show t1, Text.Printf.PrintfType t, Text.Printf.PrintfArg t1, RealFrac t1)
     => a -> t1 -> t
shcr :: a -> t1 -> t
shcr a
d t1
a | t1 -> Bool
forall a. (Show a, RealFrac a) => a -> Bool
lookslikeInt t1
a = String -> t1 -> t
forall r. PrintfType r => String -> r
printf String
"%.0f" t1
a
         | Bool
otherwise      = String -> t1 -> t
forall r. PrintfType r => String -> r
printf (String
"%."String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
dString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"f") t1
a

lookslikeInt :: (Show a, RealFrac a) => a -> Bool
lookslikeInt :: a -> Bool
lookslikeInt a
x = Int -> String
forall a. Show a => a -> String
show (a -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round a
x :: Int) String -> String -> String
forall a. [a] -> [a] -> [a]
++String
".0" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
shx Bool -> Bool -> Bool
|| String
"-0.0" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
shx
   where shx :: String
shx = a -> String
forall a. Show a => a -> String
show a
x

isZero :: Show a => a -> Bool
isZero :: a -> Bool
isZero a
x = a -> String
forall a. Show a => a -> String
show a
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"0.0",String
"-0.0"]
isOne :: Show a => a -> Bool
isOne :: a -> Bool
isOne  a
x = a -> String
forall a. Show a => a -> String
show a
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"1.0",String
"-1.0"]

-- | Pretty print a complex matrix with at most n decimal digits.
dispcf :: Int -> Matrix (Complex Double) -> String
dispcf :: Int -> Matrix (Complex Double) -> String
dispcf Int
d Matrix (Complex Double)
m = Matrix (Complex Double) -> String
forall t. Matrix t -> String
sdims Matrix (Complex Double)
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
-> (Complex Double -> String) -> Matrix (Complex Double) -> String
forall t.
Element t =>
String -> (t -> String) -> Matrix t -> String
format String
"  " (Int -> Complex Double -> String
showComplex Int
d) Matrix (Complex Double)
m

--------------------------------------------------------------------

apparentCols :: FilePath -> IO Int
apparentCols :: String -> IO Int
apparentCols String
s = [[String]] -> Int
forall (t :: * -> *) a. Foldable t => [t a] -> Int
f ([[String]] -> Int) -> (String -> [[String]]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Bool) -> [[String]] -> [[String]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Int) -> IO String -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile String
s
  where
    f :: [t a] -> Int
f [] = Int
0
    f (t a
x:[t a]
_) = t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x


-- | load a matrix from an ASCII file formatted as a 2D table.
loadMatrix :: FilePath -> IO (Matrix Double)
loadMatrix :: String -> IO (Matrix Double)
loadMatrix String
f = do
    Vector Double
v <- String -> IO (Vector Double)
vectorScan String
f
    Int
c <- String -> IO Int
apparentCols String
f
    if (Vector Double -> Int
forall t. Storable t => Vector t -> Int
dim Vector Double
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
      then
        String -> IO (Matrix Double)
forall a. HasCallStack => String -> a
error (String -> IO (Matrix Double)) -> String -> IO (Matrix Double)
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"loadMatrix: %d elements and %d columns in file %s"
                       (Vector Double -> Int
forall t. Storable t => Vector t -> Int
dim Vector Double
v) Int
c String
f
      else
        Matrix Double -> IO (Matrix Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Vector Double -> Matrix Double
forall t. Storable t => Int -> Vector t -> Matrix t
reshape Int
c Vector Double
v)

loadMatrix' :: FilePath -> IO (Maybe (Matrix Double))
loadMatrix' :: String -> IO (Maybe (Matrix Double))
loadMatrix' String
name = IO (Matrix Double) -> IO (Maybe (Matrix Double))
forall x. IO x -> IO (Maybe x)
mbCatch (String -> IO (Matrix Double)
loadMatrix String
name)