Commits

Sergey Astanin committed 4499bdd

dumpMM, a pure writer.

  • Participants
  • Parent commits a59217b

Comments (0)

Files changed (1)

--- | Pure and composable Matrix Market parser.
+-- | Pure and composable Matrix Market reader and writer.
 module MatrixMarket where
 
 import Data.Char (toLower)
 -- | Matrix Market format representation.
 data Matrix = MM
   { mm'data :: MatrixData
+  , mm'field :: MField
   , mm'symmetry :: Symmetry
   , mm'comments :: [String]
-  } deriving (Show)
+  } deriving (Show, Eq)
 
 -- | Matrix' data block.
 data MatrixData = CoordinateM { coords'm :: CM }
                 | ArrayM { array'm :: AM }
-  deriving (Show)
+  deriving (Show, Eq)
 
 -- | Coordinate format (sparse matrix).
 data CM = CM
   , cm'cols :: Int
   , cm'size :: Int
   , cm'values :: [((Int, Int), MValue)]
-  } deriving (Show)
+  } deriving (Show, Eq)
 
 -- | Array format (dense matrix).
 data AM = AM
   { am'rows :: Int
   , am'cols :: Int
   , am'values :: [MValue]
-  } deriving (Show)
+  } deriving (Show, Eq)
+
+-- | Field of the matrix.
+data MField = MInt | MReal | MComplex | MPattern deriving (Eq)
+
+instance Show MField where
+    show MInt = "integer"
+    show MReal = "real"
+    show MComplex = "complex"
+    show MPattern = "pattern"
+
+-- | Values allowed in the Matrix Market files.
+data MValue = I { unI :: Int}
+            | R { unR :: Double}
+            | C { unC :: (Complex Double)}
+            | NotAValue
+  deriving (Eq)
+
+-- | Format the value as Haskell literal.
+instance Show MValue where
+  show (I i) = show i
+  show (R r) = show r
+  show (C c) = show c
+  show NotAValue = "undefined"
+
+-- | Format the value as in MatrixMarket format.
+showMV (I i) = show i
+showMV (R r) = show r
+showMV (C (re :+ im)) = unwords [show re, show im]
+showMV NotAValue = ""
 
 -- | Symmetry class of the matrix.
 data Symmetry = General | Symmetric | SkewSymmetric | Hermitian
   | NoParse
   deriving (Show, Eq)
 
--- | Values allowed in the Matrix Market files.
-data MValue = I { unI :: Int}
-            | R { unR :: Double}
-            | C { unC :: (Complex Double)}
-            | NotAValue
-  deriving (Show, Eq)
+-- | Write Matrix Market format.
+dumpMM :: Matrix -> String
+dumpMM m@(MM md fld sy coms) = unlines $ header : (map ('%':) coms) ++ body
+  where
+    header =
+        let fmt = case md of
+                    (CoordinateM _) -> "coordinate"
+                    (ArrayM _) -> "array"
+            sym = case sy of
+                      General -> "general"
+                      Symmetric -> "symmetric"
+                      SkewSymmetric -> "skew-symmetric"
+                      Hermitian -> "hermitian"
+        in  "%%MatrixMarket matrix " ++ unwords [fmt, show fld, sym]
+    body = case md of
+      (CoordinateM cm) -> dumpCM cm
+      (ArrayM am) -> dumpAM am
+    dumpCM (CM rows cols size vals) =
+        unwords [show rows, show cols, show size] :
+        map (\((i,j), v) -> unwords [show i, show j, showMV v]) vals
+    dumpAM (AM rows cols vals) = unwords [show rows, show cols] : map show vals
 
 -- | Parse Matrix Market format.
 readMM :: String -> Either MMError Matrix
         coms = map (drop 1) (drop 1 clins)  -- comments
         toks = concatMap words lins
     in  case words . map toLower $ hdr of
-        ("%%matrixmarket":"matrix":fmt:fieldq:symq:_) ->
+        ("%%matrixmarket":"matrix":fmt:field:sym:_) ->
           let p = lookup fmt parsers     :: Maybe FormatReader
-              nr = lookup fieldq readers :: Maybe (Int, ValueReader)
-              sy = lookup symq symmetries :: Maybe Symmetry
-              p' = uncurry <$> p <*> nr :: Maybe ([String] -> Maybe MatrixData)
+              fi = lookup field fields   :: Maybe MField
+              nr = lookup field readers  :: Maybe (Int, ValueReader)
+              sy = lookup sym symmetries :: Maybe Symmetry
+              p' = uncurry <$> p <*> nr  :: Maybe ([String] -> Maybe MatrixData)
               d = join $ p' <*> (Just toks) :: Maybe MatrixData
-              m = MM <$> d <*> sy <*> (Just coms) :: Maybe Matrix
+              m = MM <$> d <*> fi <*> sy <*> (Just coms)
           in  case m of
               Just m' -> Right m'
               Nothing -> Left $
                 case (p,nr,sy) of
                   (Nothing,_,_) -> UnknownFormat fmt
-                  (_,Nothing,_) -> UnknownField  fieldq
-                  (_,_,Nothing) -> UnknownSymmetry symq
+                  (_,Nothing,_) -> UnknownField  field
+                  (_,_,Nothing) -> UnknownSymmetry sym
                   _             -> NoParse
         _ -> Left $ InvalidHeader hdr
   --
             , ("integer", (1, readInt))
             , ("complex", (2, readComplex))
             , ("pattern", (0, const $ Just NotAValue))]
+  fields =  [ ("real", MReal)
+            , ("integer", MInt)
+            , ("complex", MComplex)
+            , ("pattern", MPattern)]
   symmetries = [ ("general",        General)
                , ("symmetric",      Symmetric)
                , ("skew-symmetric", SkewSymmetric)