{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Text.SDPFile
-- Copyright   :  (c) Masahiro Sakai 2012,2016
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-- References:
--
-- * SDPA (Semidefinite Programming Algorithm) User's Manual
--   <http://sdpa.indsys.chuo-u.ac.jp/~fujisawa/sdpa_doc.pdf>
--
-- * <http://euler.nmt.edu/~brian/sdplib/FORMAT>
--
-----------------------------------------------------------------------------
module ToySolver.Text.SDPFile
  ( -- * The problem type
    Problem (..)
  , Matrix
  , Block
  , mDim
  , nBlock
  , blockElem
    -- * The solution type
  , Solution (..)
  , evalPrimalObjective
  , evalDualObjective

    -- * File I/O
  , readDataFile
  , writeDataFile

    -- * Construction
  , DenseMatrix
  , DenseBlock
  , denseMatrix
  , denseBlock
  , diagBlock

    -- * Rendering
  , renderData
  , renderSparseData

    -- * Parsing
  , ParseError
  , parseData
  , parseSparseData
  ) where

import Control.Exception
import Control.Monad
import qualified Data.ByteString.Lazy as BL
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Scientific as B
import Data.Char
import qualified Data.Foldable as F
import Data.List (intersperse)
import Data.Scientific (Scientific)
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import Data.Void
import Data.Word
import System.FilePath (takeExtension)
import System.IO
import qualified Text.Megaparsec as MegaParsec
import Text.Megaparsec hiding (ParseError, oneOf)
import Text.Megaparsec.Byte
import qualified Text.Megaparsec.Byte.Lexer as Lexer

type C e s m = (MonadParsec e s m, Token s ~ Word8)
type ParseError = MegaParsec.ParseErrorBundle BL.ByteString Void

anyChar :: C e s m => m Word8
anyChar :: forall e s (m :: * -> *). C e s m => m Word8
anyChar = m Word8
m (Token s)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle

-- ---------------------------------------------------------------------------
-- problem description
-- ---------------------------------------------------------------------------

data Problem
  = Problem
  { Problem -> [Int]
blockStruct :: [Int]      -- ^ the block strcuture vector (bLOCKsTRUCT)
  , Problem -> [Scientific]
costs       :: [Scientific] -- ^ Constant Vector
  , Problem -> [Matrix]
matrices    :: [Matrix]   -- ^ Constraint Matrices
  }
  deriving (Int -> Problem -> ShowS
[Problem] -> ShowS
Problem -> [Char]
(Int -> Problem -> ShowS)
-> (Problem -> [Char]) -> ([Problem] -> ShowS) -> Show Problem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Problem -> ShowS
showsPrec :: Int -> Problem -> ShowS
$cshow :: Problem -> [Char]
show :: Problem -> [Char]
$cshowList :: [Problem] -> ShowS
showList :: [Problem] -> ShowS
Show, Eq Problem
Eq Problem =>
(Problem -> Problem -> Ordering)
-> (Problem -> Problem -> Bool)
-> (Problem -> Problem -> Bool)
-> (Problem -> Problem -> Bool)
-> (Problem -> Problem -> Bool)
-> (Problem -> Problem -> Problem)
-> (Problem -> Problem -> Problem)
-> Ord Problem
Problem -> Problem -> Bool
Problem -> Problem -> Ordering
Problem -> Problem -> Problem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Problem -> Problem -> Ordering
compare :: Problem -> Problem -> Ordering
$c< :: Problem -> Problem -> Bool
< :: Problem -> Problem -> Bool
$c<= :: Problem -> Problem -> Bool
<= :: Problem -> Problem -> Bool
$c> :: Problem -> Problem -> Bool
> :: Problem -> Problem -> Bool
$c>= :: Problem -> Problem -> Bool
>= :: Problem -> Problem -> Bool
$cmax :: Problem -> Problem -> Problem
max :: Problem -> Problem -> Problem
$cmin :: Problem -> Problem -> Problem
min :: Problem -> Problem -> Problem
Ord, Problem -> Problem -> Bool
(Problem -> Problem -> Bool)
-> (Problem -> Problem -> Bool) -> Eq Problem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Problem -> Problem -> Bool
== :: Problem -> Problem -> Bool
$c/= :: Problem -> Problem -> Bool
/= :: Problem -> Problem -> Bool
Eq)

type Matrix = [Block]

type Block = Map (Int,Int) Scientific

-- | the number of primal variables (mDim)
mDim :: Problem -> Int
mDim :: Problem -> Int
mDim Problem
prob = [Matrix] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Problem -> [Matrix]
matrices Problem
prob) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | the number of blocks (nBLOCK)
nBlock :: Problem -> Int
nBlock :: Problem -> Int
nBlock Problem
prob = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Problem -> [Int]
blockStruct Problem
prob)

blockElem :: Int -> Int -> Block -> Scientific
blockElem :: Int -> Int -> Map (Int, Int) Scientific -> Scientific
blockElem Int
i Int
j Map (Int, Int) Scientific
b = Scientific -> (Int, Int) -> Map (Int, Int) Scientific -> Scientific
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Scientific
0 (Int
i,Int
j) Map (Int, Int) Scientific
b

-- ---------------------------------------------------------------------------
-- solution
-- ---------------------------------------------------------------------------

data Solution
  = Solution
  { Solution -> [Scientific]
primalVector :: [Scientific] -- ^ The primal variable vector x
  , Solution -> Matrix
primalMatrix :: Matrix -- ^ The primal variable matrix X
  , Solution -> Matrix
dualMatrix   :: Matrix -- ^ The dual variable matrix Y
  }
  deriving (Int -> Solution -> ShowS
[Solution] -> ShowS
Solution -> [Char]
(Int -> Solution -> ShowS)
-> (Solution -> [Char]) -> ([Solution] -> ShowS) -> Show Solution
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Solution -> ShowS
showsPrec :: Int -> Solution -> ShowS
$cshow :: Solution -> [Char]
show :: Solution -> [Char]
$cshowList :: [Solution] -> ShowS
showList :: [Solution] -> ShowS
Show, Eq Solution
Eq Solution =>
(Solution -> Solution -> Ordering)
-> (Solution -> Solution -> Bool)
-> (Solution -> Solution -> Bool)
-> (Solution -> Solution -> Bool)
-> (Solution -> Solution -> Bool)
-> (Solution -> Solution -> Solution)
-> (Solution -> Solution -> Solution)
-> Ord Solution
Solution -> Solution -> Bool
Solution -> Solution -> Ordering
Solution -> Solution -> Solution
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Solution -> Solution -> Ordering
compare :: Solution -> Solution -> Ordering
$c< :: Solution -> Solution -> Bool
< :: Solution -> Solution -> Bool
$c<= :: Solution -> Solution -> Bool
<= :: Solution -> Solution -> Bool
$c> :: Solution -> Solution -> Bool
> :: Solution -> Solution -> Bool
$c>= :: Solution -> Solution -> Bool
>= :: Solution -> Solution -> Bool
$cmax :: Solution -> Solution -> Solution
max :: Solution -> Solution -> Solution
$cmin :: Solution -> Solution -> Solution
min :: Solution -> Solution -> Solution
Ord, Solution -> Solution -> Bool
(Solution -> Solution -> Bool)
-> (Solution -> Solution -> Bool) -> Eq Solution
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Solution -> Solution -> Bool
== :: Solution -> Solution -> Bool
$c/= :: Solution -> Solution -> Bool
/= :: Solution -> Solution -> Bool
Eq)

evalPrimalObjective :: Problem -> Solution -> Scientific
evalPrimalObjective :: Problem -> Solution -> Scientific
evalPrimalObjective Problem
prob Solution
sol = [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$ (Scientific -> Scientific -> Scientific)
-> [Scientific] -> [Scientific] -> [Scientific]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) (Problem -> [Scientific]
costs Problem
prob) (Solution -> [Scientific]
primalVector Solution
sol)

evalDualObjective :: Problem -> Solution -> Scientific
evalDualObjective :: Problem -> Solution -> Scientific
evalDualObjective Problem{ matrices :: Problem -> [Matrix]
matrices = [] } Solution
_ = [Char] -> Scientific
forall a. HasCallStack => [Char] -> a
error [Char]
"evalDualObjective: invalid problem data"
evalDualObjective Problem{ matrices :: Problem -> [Matrix]
matrices = Matrix
f0:[Matrix]
_ } Solution
sol =
  [Scientific] -> Scientific
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Scientific] -> Scientific) -> [Scientific] -> Scientific
forall a b. (a -> b) -> a -> b
$ (Map (Int, Int) Scientific
 -> Map (Int, Int) Scientific -> Scientific)
-> Matrix -> Matrix -> [Scientific]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Map (Int, Int) Scientific
blk1 Map (Int, Int) Scientific
blk2 -> Map (Int, Int) Scientific -> Scientific
forall a. Num a => Map (Int, Int) a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum ((Scientific -> Scientific -> Scientific)
-> Map (Int, Int) Scientific
-> Map (Int, Int) Scientific
-> Map (Int, Int) Scientific
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
(*) Map (Int, Int) Scientific
blk1 Map (Int, Int) Scientific
blk2)) Matrix
f0 (Solution -> Matrix
dualMatrix Solution
sol)

-- ---------------------------------------------------------------------------
-- construction
-- ---------------------------------------------------------------------------

type DenseMatrix = [DenseBlock]

type DenseBlock = [[Scientific]]

denseBlock :: DenseBlock -> Block
denseBlock :: DenseBlock -> Map (Int, Int) Scientific
denseBlock DenseBlock
xxs = [((Int, Int), Scientific)] -> Map (Int, Int) Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
j),Scientific
x) | (Int
i,[Scientific]
xs) <- [Int] -> DenseBlock -> [(Int, [Scientific])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] DenseBlock
xxs, (Int
j,Scientific
x) <- [Int] -> [Scientific] -> [(Int, Scientific)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Scientific]
xs, Scientific
x Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
/= Scientific
0]

denseMatrix :: DenseMatrix -> Matrix
denseMatrix :: DenseMatrix -> Matrix
denseMatrix = (DenseBlock -> Map (Int, Int) Scientific) -> DenseMatrix -> Matrix
forall a b. (a -> b) -> [a] -> [b]
map DenseBlock -> Map (Int, Int) Scientific
denseBlock

diagBlock :: [Scientific] -> Block
diagBlock :: [Scientific] -> Map (Int, Int) Scientific
diagBlock [Scientific]
xs = [((Int, Int), Scientific)] -> Map (Int, Int) Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
i),Scientific
x) | (Int
i,Scientific
x) <- [Int] -> [Scientific] -> [(Int, Scientific)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Scientific]
xs]

-- ---------------------------------------------------------------------------
-- File I/O
-- ---------------------------------------------------------------------------

-- | Parse a SDPA format file (.dat) or a SDPA sparse format file (.dat-s)..
readDataFile :: FilePath -> IO Problem
readDataFile :: [Char] -> IO Problem
readDataFile [Char]
fname = do
  ParsecT Void ByteString Identity Problem
p <- case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShowS
takeExtension [Char]
fname) of
    [Char]
".dat" -> ParsecT Void ByteString Identity Problem
-> IO (ParsecT Void ByteString Identity Problem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsecT Void ByteString Identity Problem
forall e s (m :: * -> *). C e s m => m Problem
pDataFile
    [Char]
".dat-s" -> ParsecT Void ByteString Identity Problem
-> IO (ParsecT Void ByteString Identity Problem)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsecT Void ByteString Identity Problem
forall e s (m :: * -> *). C e s m => m Problem
pSparseDataFile
    [Char]
ext -> IOError -> IO (ParsecT Void ByteString Identity Problem)
forall a. IOError -> IO a
ioError (IOError -> IO (ParsecT Void ByteString Identity Problem))
-> IOError -> IO (ParsecT Void ByteString Identity Problem)
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown extension: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ext
  ByteString
s <- [Char] -> IO ByteString
BL.readFile [Char]
fname
  case ParsecT Void ByteString Identity Problem
-> [Char] -> ByteString -> Either ParseError Problem
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void ByteString Identity Problem
p ParsecT Void ByteString Identity Problem
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Problem
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
fname ByteString
s of
    Left ParseError
e -> ParseError -> IO Problem
forall a e. Exception e => e -> a
throw (ParseError
e :: ParseError)
    Right Problem
prob -> Problem -> IO Problem
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Problem
prob

writeDataFile :: FilePath -> Problem -> IO ()
writeDataFile :: [Char] -> Problem -> IO ()
writeDataFile [Char]
fname Problem
prob = do
  Bool
isSparse <- case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShowS
takeExtension [Char]
fname) of
    [Char]
".dat" -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [Char]
".dat-s" -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    [Char]
ext -> IOError -> IO Bool
forall a. IOError -> IO a
ioError (IOError -> IO Bool) -> IOError -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError ([Char] -> IOError) -> [Char] -> IOError
forall a b. (a -> b) -> a -> b
$ [Char]
"unknown extension: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
ext
  [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile [Char]
fname IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> Builder -> IO ()
B.hPutBuilder Handle
h (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Problem -> Builder
renderImpl Bool
isSparse Problem
prob

-- ---------------------------------------------------------------------------
-- parsing
-- ---------------------------------------------------------------------------

-- | Parse a SDPA format (.dat) string.
parseData :: String -> BL.ByteString -> Either ParseError Problem
parseData :: [Char] -> ByteString -> Either ParseError Problem
parseData = ParsecT Void ByteString Identity Problem
-> [Char] -> ByteString -> Either ParseError Problem
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void ByteString Identity Problem
forall e s (m :: * -> *). C e s m => m Problem
pDataFile ParsecT Void ByteString Identity Problem
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Problem
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

-- | Parse a SDPA sparse format (.dat-s) string.
parseSparseData :: String -> BL.ByteString -> Either ParseError Problem
parseSparseData :: [Char] -> ByteString -> Either ParseError Problem
parseSparseData = ParsecT Void ByteString Identity Problem
-> [Char] -> ByteString -> Either ParseError Problem
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void ByteString Identity Problem
forall e s (m :: * -> *). C e s m => m Problem
pSparseDataFile ParsecT Void ByteString Identity Problem
-> ParsecT Void ByteString Identity ()
-> ParsecT Void ByteString Identity Problem
forall a b.
ParsecT Void ByteString Identity a
-> ParsecT Void ByteString Identity b
-> ParsecT Void ByteString Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void ByteString Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)

pDataFile :: C e s m => m Problem
pDataFile :: forall e s (m :: * -> *). C e s m => m Problem
pDataFile = do
  [ByteString]
_ <- m ByteString -> m [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m ByteString
forall e s (m :: * -> *). C e s m => m ByteString
pComment
  Integer
m  <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat_line -- mDim
  Integer
_n <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat_line -- nBlock
  [Int]
bs <- m [Int]
forall e s (m :: * -> *). C e s m => m [Int]
pBlockStruct -- bLOCKsTRUCT
  [Scientific]
cs <- m [Scientific]
forall e s (m :: * -> *). C e s m => m [Scientific]
pCosts
  [Matrix]
ms <- Int -> [Int] -> m [Matrix]
forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pDenseMatrices (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) [Int]
bs
  m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  Problem -> m Problem
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Problem -> m Problem) -> Problem -> m Problem
forall a b. (a -> b) -> a -> b
$
    Problem
    { blockStruct :: [Int]
blockStruct = [Int]
bs
    , costs :: [Scientific]
costs       = [Scientific]
cs
    , matrices :: [Matrix]
matrices    = [Matrix]
ms
    }

pSparseDataFile :: C e s m => m Problem
pSparseDataFile :: forall e s (m :: * -> *). C e s m => m Problem
pSparseDataFile = do
  [ByteString]
_ <- m ByteString -> m [ByteString]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m ByteString
forall e s (m :: * -> *). C e s m => m ByteString
pComment
  Integer
m  <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat_line -- mDim
  Integer
_n <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat_line -- nBlock
  [Int]
bs <- m [Int]
forall e s (m :: * -> *). C e s m => m [Int]
pBlockStruct -- bLOCKsTRUCT
  [Scientific]
cs <- m [Scientific]
forall e s (m :: * -> *). C e s m => m [Scientific]
pCosts
  [Matrix]
ms <- Int -> [Int] -> m [Matrix]
forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pSparseMatrices (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) [Int]
bs
  m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  Problem -> m Problem
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Problem -> m Problem) -> Problem -> m Problem
forall a b. (a -> b) -> a -> b
$
    Problem
    { blockStruct :: [Int]
blockStruct = [Int]
bs
    , costs :: [Scientific]
costs       = [Scientific]
cs
    , matrices :: [Matrix]
matrices    = [Matrix]
ms
    }

pComment :: C e s m => m BL.ByteString
pComment :: forall e s (m :: * -> *). C e s m => m ByteString
pComment = do
  Word8
c <- [Char] -> m Word8
forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
"*\""
  [Word8]
cs <- m Word8 -> m Word8 -> m [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Word8
forall e s (m :: * -> *). C e s m => m Word8
anyChar m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  ByteString -> m ByteString
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BL.pack (Word8
cWord8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
:[Word8]
cs)

pBlockStruct :: C e s m => m [Int]
pBlockStruct :: forall e s (m :: * -> *). C e s m => m [Int]
pBlockStruct = do
  Maybe [Word8]
_ <- m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep
  let int' :: m Integer
int' = m Integer
forall e s (m :: * -> *). C e s m => m Integer
int m Integer -> (Integer -> m Integer) -> m Integer
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep m (Maybe [Word8]) -> m Integer -> m Integer
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i
  [Integer]
xs <- m Integer -> m [Integer]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Integer
int'
  [Word8]
_ <- m Word8 -> m Word8 -> m [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Word8
forall e s (m :: * -> *). C e s m => m Word8
anyChar m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  [Int] -> m [Int]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Int] -> m [Int]) -> [Int] -> m [Int]
forall a b. (a -> b) -> a -> b
$ (Integer -> Int) -> [Integer] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
xs
  where
    sep :: m [Word8]
sep = m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Char] -> m Word8
forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
" \t(){},")

pCosts :: C e s m => m [Scientific]
pCosts :: forall e s (m :: * -> *). C e s m => m [Scientific]
pCosts = do
  let sep :: m [Word8]
sep = m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Char] -> m Word8
forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
" \t(){},")
      real' :: m Scientific
real' = m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
real m Scientific -> (Scientific -> m Scientific) -> m Scientific
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Scientific
r -> m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep m (Maybe [Word8]) -> m Scientific -> m Scientific
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> m Scientific
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
r
  Maybe [Word8]
_ <- m [Word8] -> m (Maybe [Word8])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep
  [Scientific]
cs <- m Scientific -> m [Scientific]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Scientific
real'
  Word8
_ <- m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  [Scientific] -> m [Scientific]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Scientific]
cs

pDenseMatrices :: C e s m => Int -> [Int] -> m [Matrix]
pDenseMatrices :: forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pDenseMatrices Int
m [Int]
bs = m [()] -> m (Maybe [()])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [()]
sep m (Maybe [()]) -> m [Matrix] -> m [Matrix]
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m Matrix -> m [Matrix]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) m Matrix
pDenceMatrix
  where
    sep :: m [()]
sep = m () -> m [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
spaceChar m Word8 -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> m Word8
forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
"(){}," m Word8 -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
    real' :: m Scientific
real' = m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
real m Scientific -> (Scientific -> m Scientific) -> m Scientific
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Scientific
r -> m [()] -> m (Maybe [()])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [()]
sep m (Maybe [()]) -> m Scientific -> m Scientific
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scientific -> m Scientific
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
r
    pDenceMatrix :: m Matrix
pDenceMatrix = [Int] -> (Int -> m (Map (Int, Int) Scientific)) -> m Matrix
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
bs ((Int -> m (Map (Int, Int) Scientific)) -> m Matrix)
-> (Int -> m (Map (Int, Int) Scientific)) -> m Matrix
forall a b. (a -> b) -> a -> b
$ \Int
b ->
      if Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
      then do
        DenseBlock
xs <- Int -> m [Scientific] -> m DenseBlock
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
b (Int -> m Scientific -> m [Scientific]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
b m Scientific
real')
        Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific))
-> Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific)
forall a b. (a -> b) -> a -> b
$ DenseBlock -> Map (Int, Int) Scientific
denseBlock DenseBlock
xs
      else do
        [Scientific]
xs <- Int -> m Scientific -> m [Scientific]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a. Num a => a -> a
abs Int
b) m Scientific
real'
        Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific))
-> Map (Int, Int) Scientific -> m (Map (Int, Int) Scientific)
forall a b. (a -> b) -> a -> b
$ [Scientific] -> Map (Int, Int) Scientific
diagBlock [Scientific]
xs

pSparseMatrices :: C e s m => Int -> [Int] -> m [Matrix]
pSparseMatrices :: forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pSparseMatrices Int
m [Int]
bs = do
  [(Int, Int, Int, Int, Scientific)]
xs <- m (Int, Int, Int, Int, Scientific)
-> m [(Int, Int, Int, Int, Scientific)]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m (Int, Int, Int, Int, Scientific)
pLine
  let t :: IntMap (IntMap (Map (Int, Int) Scientific))
t = (IntMap (Map (Int, Int) Scientific)
 -> IntMap (Map (Int, Int) Scientific)
 -> IntMap (Map (Int, Int) Scientific))
-> [IntMap (IntMap (Map (Int, Int) Scientific))]
-> IntMap (IntMap (Map (Int, Int) Scientific))
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith ((Map (Int, Int) Scientific
 -> Map (Int, Int) Scientific -> Map (Int, Int) Scientific)
-> IntMap (Map (Int, Int) Scientific)
-> IntMap (Map (Int, Int) Scientific)
-> IntMap (Map (Int, Int) Scientific)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith Map (Int, Int) Scientific
-> Map (Int, Int) Scientific -> Map (Int, Int) Scientific
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union)
            [ Int
-> IntMap (Map (Int, Int) Scientific)
-> IntMap (IntMap (Map (Int, Int) Scientific))
forall a. Int -> a -> IntMap a
IntMap.singleton Int
matno (Int
-> Map (Int, Int) Scientific -> IntMap (Map (Int, Int) Scientific)
forall a. Int -> a -> IntMap a
IntMap.singleton Int
blkno ([((Int, Int), Scientific)] -> Map (Int, Int) Scientific
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
j),Scientific
e),((Int
j,Int
i),Scientific
e)]))
            | (Int
matno,Int
blkno,Int
i,Int
j,Scientific
e) <- [(Int, Int, Int, Int, Scientific)]
xs ]
  [Matrix] -> m [Matrix]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Matrix] -> m [Matrix]) -> [Matrix] -> m [Matrix]
forall a b. (a -> b) -> a -> b
$
    [ [Map (Int, Int) Scientific
-> Int
-> IntMap (Map (Int, Int) Scientific)
-> Map (Int, Int) Scientific
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault Map (Int, Int) Scientific
forall k a. Map k a
Map.empty Int
blkno IntMap (Map (Int, Int) Scientific)
mat | Int
blkno <- [Int
1 .. [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
bs]]
    | Int
matno <- [Int
0..Int
m], let mat :: IntMap (Map (Int, Int) Scientific)
mat = IntMap (Map (Int, Int) Scientific)
-> Int
-> IntMap (IntMap (Map (Int, Int) Scientific))
-> IntMap (Map (Int, Int) Scientific)
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault IntMap (Map (Int, Int) Scientific)
forall a. IntMap a
IntMap.empty Int
matno IntMap (IntMap (Map (Int, Int) Scientific))
t
    ]

  where
    sep :: m ()
sep = m Word8 -> m [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ([Char] -> m Word8
forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
" \t") m [Word8] -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    pLine :: m (Int, Int, Int, Int, Scientific)
pLine = do
      Maybe ()
_ <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ()
sep
      Integer
matno <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
blkno <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
i <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
j <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Scientific
e <- m Scientific
forall e s (m :: * -> *). C e s m => m Scientific
real
      Maybe ()
_ <- m () -> m (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ()
sep
      Word8
_ <- m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
      (Int, Int, Int, Int, Scientific)
-> m (Int, Int, Int, Int, Scientific)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
matno, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
blkno, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
j, Scientific
e)

nat_line :: C e s m => m Integer
nat_line :: forall e s (m :: * -> *). C e s m => m Integer
nat_line = do
  m ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  Integer
n <- m Integer
forall e s (m :: * -> *). C e s m => m Integer
nat
  [Word8]
_ <- m Word8 -> m Word8 -> m [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m Word8
forall e s (m :: * -> *). C e s m => m Word8
anyChar m Word8
m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  Integer -> m Integer
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n

nat :: C e s m => m Integer
nat :: forall e s (m :: * -> *). C e s m => m Integer
nat = m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
Lexer.decimal

int :: C e s m => m Integer
int :: forall e s (m :: * -> *). C e s m => m Integer
int = m () -> m Integer -> m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m a
Lexer.decimal

real :: forall e s m. C e s m => m Scientific
real :: forall e s (m :: * -> *). C e s m => m Scientific
real = m () -> m Scientific -> m Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
Lexer.signed (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m Scientific
Lexer.scientific

oneOf :: C e s m => [Char] -> m Word8
oneOf :: forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf = [Token s] -> m Word8
[Token s] -> m (Token s)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MegaParsec.oneOf ([Token s] -> m Word8)
-> ([Char] -> [Token s]) -> [Char] -> m Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Token s) -> [Char] -> [Token s]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Token s
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Token s) -> (Char -> Int) -> Char -> Token s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)

-- ---------------------------------------------------------------------------
-- rendering
-- ---------------------------------------------------------------------------

renderData :: Problem -> Builder
renderData :: Problem -> Builder
renderData = Bool -> Problem -> Builder
renderImpl Bool
False

renderSparseData :: Problem -> Builder
renderSparseData :: Problem -> Builder
renderSparseData = Bool -> Problem -> Builder
renderImpl Bool
True

renderImpl :: Bool -> Problem -> Builder
renderImpl :: Bool -> Problem -> Builder
renderImpl Bool
sparse Problem
prob = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
  [
  -- mDim
    Int -> Builder
B.intDec (Problem -> Int
mDim Problem
prob) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = mDIM\n"

  -- nBlock
  , Int -> Builder
B.intDec (Problem -> Int
nBlock Problem
prob) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" = nBlock\n"

  -- blockStruct
  , Char -> Builder
B.char7 Char
'('
  , [Builder] -> Builder -> Builder
sepByS [Int -> Builder
B.intDec Int
i | Int
i <- Problem -> [Int]
blockStruct Problem
prob] Builder
", "
  , Char -> Builder
B.char7 Char
')'
  , Builder
" = bLOCKsTRUCT\n"

  -- costs
  , Char -> Builder
B.char7 Char
'('
  , [Builder] -> Builder -> Builder
sepByS [Scientific -> Builder
B.scientificBuilder Scientific
c | Scientific
c <- Problem -> [Scientific]
costs Problem
prob] Builder
", "
  , Builder
")\n"

  -- matrices
  , if Bool
sparse
    then [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Int -> Matrix -> Builder
renderSparseMatrix Int
matno Matrix
m | (Int
matno, Matrix
m) <- [Int] -> [Matrix] -> [(Int, Matrix)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Problem -> [Matrix]
matrices Problem
prob)]
    else [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Matrix -> Builder) -> [Matrix] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Matrix -> Builder
renderDenseMatrix (Problem -> [Matrix]
matrices Problem
prob)
  ]

  where
    renderSparseMatrix :: Int -> Matrix -> Builder
    renderSparseMatrix :: Int -> Matrix -> Builder
renderSparseMatrix Int
matno Matrix
m =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Int -> Builder
B.intDec Int
matno Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
blkno Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
j Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                Scientific -> Builder
B.scientificBuilder Scientific
e Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'\n'
              | (Int
blkno, Map (Int, Int) Scientific
blk) <- [Int] -> Matrix -> [(Int, Map (Int, Int) Scientific)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1::Int)..] Matrix
m, ((Int
i,Int
j),Scientific
e) <- Map (Int, Int) Scientific -> [((Int, Int), Scientific)]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Int, Int) Scientific
blk, Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j ]

    renderDenseMatrix :: Matrix -> Builder
    renderDenseMatrix :: Matrix -> Builder
renderDenseMatrix Matrix
m =
      Builder
"{\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Map (Int, Int) Scientific -> Int -> Builder
renderDenseBlock Map (Int, Int) Scientific
b Int
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | (Map (Int, Int) Scientific
b,Int
s) <- Matrix -> [Int] -> [(Map (Int, Int) Scientific, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip Matrix
m (Problem -> [Int]
blockStruct Problem
prob)] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder
"}\n"

    renderDenseBlock :: Block -> Int -> Builder
    renderDenseBlock :: Map (Int, Int) Scientific -> Int -> Builder
renderDenseBlock Map (Int, Int) Scientific
b Int
s
      | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
          Builder
"  " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Scientific] -> Builder
renderVec [Int -> Int -> Map (Int, Int) Scientific -> Scientific
blockElem Int
i Int
i Map (Int, Int) Scientific
b | Int
i <- [Int
1 .. Int -> Int
forall a. Num a => a -> a
abs Int
s]]
      | Bool
otherwise =
          Builder
"  { " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          [Builder] -> Builder -> Builder
sepByS [Int -> Builder
renderRow Int
i | Int
i <- [Int
1..Int
s]] Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
          Builder
" }"
      where
        renderRow :: Int -> Builder
renderRow Int
i = [Scientific] -> Builder
renderVec [Int -> Int -> Map (Int, Int) Scientific -> Scientific
blockElem Int
i Int
j Map (Int, Int) Scientific
b | Int
j <- [Int
1..Int
s]]

renderVec :: [Scientific] -> Builder
renderVec :: [Scientific] -> Builder
renderVec [Scientific]
xs =
  Char -> Builder
B.char7 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  [Builder] -> Builder -> Builder
sepByS ((Scientific -> Builder) -> [Scientific] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Builder
B.scientificBuilder [Scientific]
xs) Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Char -> Builder
B.char7 Char
'}'

sepByS :: [Builder] -> Builder -> Builder
sepByS :: [Builder] -> Builder -> Builder
sepByS [Builder]
xs Builder
sep = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
sep [Builder]
xs