{-# 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 = 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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Problem] -> ShowS
$cshowList :: [Problem] -> ShowS
show :: Problem -> [Char]
$cshow :: Problem -> [Char]
showsPrec :: Int -> Problem -> ShowS
$cshowsPrec :: Int -> Problem -> ShowS
Show, Eq 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
min :: Problem -> Problem -> Problem
$cmin :: Problem -> Problem -> Problem
max :: Problem -> Problem -> Problem
$cmax :: Problem -> Problem -> Problem
>= :: Problem -> Problem -> Bool
$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
compare :: Problem -> Problem -> Ordering
$ccompare :: Problem -> Problem -> Ordering
Ord, Problem -> Problem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Problem -> Problem -> Bool
$c/= :: Problem -> Problem -> Bool
== :: Problem -> Problem -> Bool
$c== :: 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length (Problem -> [Matrix]
matrices Problem
prob) forall a. Num a => a -> a -> a
- Int
1

-- | the number of blocks (nBLOCK)
nBlock :: Problem -> Int
nBlock :: Problem -> Int
nBlock Problem
prob = 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 = 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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Solution] -> ShowS
$cshowList :: [Solution] -> ShowS
show :: Solution -> [Char]
$cshow :: Solution -> [Char]
showsPrec :: Int -> Solution -> ShowS
$cshowsPrec :: Int -> Solution -> ShowS
Show, Eq 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
min :: Solution -> Solution -> Solution
$cmin :: Solution -> Solution -> Solution
max :: Solution -> Solution -> Solution
$cmax :: Solution -> Solution -> Solution
>= :: Solution -> Solution -> Bool
$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
compare :: Solution -> Solution -> Ordering
$ccompare :: Solution -> Solution -> Ordering
Ord, Solution -> Solution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Solution -> Solution -> Bool
$c/= :: Solution -> Solution -> Bool
== :: Solution -> Solution -> Bool
$c== :: Solution -> Solution -> Bool
Eq)

evalPrimalObjective :: Problem -> Solution -> Scientific
evalPrimalObjective :: Problem -> Solution -> Scientific
evalPrimalObjective Problem
prob Solution
sol = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"evalDualObjective: invalid problem data"
evalDualObjective Problem{ matrices :: Problem -> [Matrix]
matrices = Matrix
f0:[Matrix]
_ } Solution
sol =
  forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Map (Int, Int) Scientific
blk1 Map (Int, Int) Scientific
blk2 -> forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum (forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
j),Scientific
x) | (Int
i,[Scientific]
xs) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] DenseBlock
xxs, (Int
j,Scientific
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Scientific]
xs, Scientific
x forall a. Eq a => a -> a -> Bool
/= Scientific
0]

denseMatrix :: DenseMatrix -> Matrix
denseMatrix :: DenseMatrix -> Matrix
denseMatrix = 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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
i),Scientific
x) | (Int
i,Scientific
x) <- 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 forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShowS
takeExtension [Char]
fname) of
    [Char]
".dat" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall e s (m :: * -> *). C e s m => m Problem
pDataFile
    [Char]
".dat-s" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall e s (m :: * -> *). C e s m => m Problem
pSparseDataFile
    [Char]
ext -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ [Char]
"unknown extension: " forall a. [a] -> [a] -> [a]
++ [Char]
ext
  ByteString
s <- [Char] -> IO ByteString
BL.readFile [Char]
fname
  case forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (ParsecT Void ByteString Identity Problem
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) [Char]
fname ByteString
s of
    Left ParseError
e -> forall a e. Exception e => e -> a
throw (ParseError
e :: ParseError)
    Right Problem
prob -> 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 forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (ShowS
takeExtension [Char]
fname) of
    [Char]
".dat" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    [Char]
".dat-s" -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    [Char]
ext -> forall a. IOError -> IO a
ioError forall a b. (a -> b) -> a -> b
$ [Char] -> IOError
userError forall a b. (a -> b) -> a -> b
$ [Char]
"unknown extension: " forall a. [a] -> [a] -> [a]
++ [Char]
ext
  forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile [Char]
fname IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> Builder -> IO ()
B.hPutBuilder Handle
h 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 = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (forall e s (m :: * -> *). C e s m => m Problem
pDataFile forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 = forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
parse (forall e s (m :: * -> *). C e s m => m Problem
pSparseDataFile forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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]
_ <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *). C e s m => m ByteString
pComment
  Integer
m  <- forall e s (m :: * -> *). C e s m => m Integer
nat_line -- mDim
  Integer
_n <- forall e s (m :: * -> *). C e s m => m Integer
nat_line -- nBlock
  [Int]
bs <- forall e s (m :: * -> *). C e s m => m [Int]
pBlockStruct -- bLOCKsTRUCT
  [Scientific]
cs <- forall e s (m :: * -> *). C e s m => m [Scientific]
pCosts
  [Matrix]
ms <- forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pDenseMatrices (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) [Int]
bs
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  forall (m :: * -> *) a. Monad m => a -> m a
return 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]
_ <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many forall e s (m :: * -> *). C e s m => m ByteString
pComment
  Integer
m  <- forall e s (m :: * -> *). C e s m => m Integer
nat_line -- mDim
  Integer
_n <- forall e s (m :: * -> *). C e s m => m Integer
nat_line -- nBlock
  [Int]
bs <- forall e s (m :: * -> *). C e s m => m [Int]
pBlockStruct -- bLOCKsTRUCT
  [Scientific]
cs <- forall e s (m :: * -> *). C e s m => m [Scientific]
pCosts
  [Matrix]
ms <- forall e s (m :: * -> *). C e s m => Int -> [Int] -> m [Matrix]
pSparseMatrices (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m) [Int]
bs
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
"*\""
  [Word8]
cs <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). C e s m => m Word8
anyChar forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Word8] -> ByteString
BL.pack (Word8
cforall 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]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep
  let int' :: m Integer
int' = forall e s (m :: * -> *). C e s m => m Integer
int forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
i -> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
i
  [Integer]
xs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Integer
int'
  [Word8]
_ <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). C e s m => m Word8
anyChar forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
xs
  where
    sep :: m [Word8]
sep = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (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 = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
" \t(){},")
      real' :: m Scientific
real' = forall e s (m :: * -> *). C e s m => m Scientific
real forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Scientific
r -> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
r
  Maybe [Word8]
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [Word8]
sep
  [Scientific]
cs <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m Scientific
real'
  Token s
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  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 = forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [()]
sep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
+ Int
1) m Matrix
pDenceMatrix
  where
    sep :: m [()]
sep = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ((forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
spaceChar forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
"(){}," forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
    real' :: m Scientific
real' = forall e s (m :: * -> *). C e s m => m Scientific
real forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Scientific
r -> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m [()]
sep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Scientific
r
    pDenceMatrix :: m Matrix
pDenceMatrix = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
bs forall a b. (a -> b) -> a -> b
$ \Int
b ->
      if Int
b forall a. Ord a => a -> a -> Bool
>= Int
0
      then do
        DenseBlock
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
b (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
b m Scientific
real')
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DenseBlock -> Map (Int, Int) Scientific
denseBlock DenseBlock
xs
      else do
        [Scientific]
xs <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a. Num a => a -> a
abs Int
b) m Scientific
real'
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- 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 = forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith (forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union)
            [ forall a. Int -> a -> IntMap a
IntMap.singleton Int
matno (forall a. Int -> a -> IntMap a
IntMap.singleton Int
blkno (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 ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    [ [forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault forall k a. Map k a
Map.empty Int
blkno IntMap (Map (Int, Int) Scientific)
mat | Int
blkno <- [Int
1 .. 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 = forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault forall a. IntMap a
IntMap.empty Int
matno IntMap (IntMap (Map (Int, Int) Scientific))
t
    ]

  where
    sep :: m ()
sep = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall e s (m :: * -> *). C e s m => [Char] -> m Word8
oneOf [Char]
" \t") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    pLine :: m (Int, Int, Int, Int, Scientific)
pLine = do
      Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ()
sep
      Integer
matno <- forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
blkno <- forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
i <- forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Integer
j <- forall e s (m :: * -> *). C e s m => m Integer
nat
      m ()
sep
      Scientific
e <- forall e s (m :: * -> *). C e s m => m Scientific
real
      Maybe ()
_ <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m ()
sep
      Token s
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
matno, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
blkno, forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i, 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
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space
  Integer
n <- forall e s (m :: * -> *). C e s m => m Integer
nat
  [Word8]
_ <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). C e s m => m Word8
anyChar forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
newline
  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 = 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 = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
Lexer.signed (forall (m :: * -> *) a. Monad m => a -> m a
return ()) 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 = forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Word8, Num a) =>
m () -> m a -> m a
Lexer.signed (forall (m :: * -> *) a. Monad m => a -> m a
return ()) 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 = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MegaParsec.oneOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Monoid a => [a] -> a
mconcat
  [
  -- mDim
    Int -> Builder
B.intDec (Problem -> Int
mDim Problem
prob) forall a. Semigroup a => a -> a -> a
<> Builder
" = mDIM\n"

  -- nBlock
  , Int -> Builder
B.intDec (Problem -> Int
nBlock Problem
prob) 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 forall a. Monoid a => [a] -> a
mconcat [Int -> Matrix -> Builder
renderSparseMatrix Int
matno Matrix
m | (Int
matno, Matrix
m) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Problem -> [Matrix]
matrices Problem
prob)]
    else forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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 =
      forall a. Monoid a => [a] -> a
mconcat [ Int -> Builder
B.intDec Int
matno forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
blkno forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
i forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' forall a. Semigroup a => a -> a -> a
<>
                Int -> Builder
B.intDec Int
j forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
' ' forall a. Semigroup a => a -> a -> a
<>
                Scientific -> Builder
B.scientificBuilder Scientific
e forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'\n'
              | (Int
blkno, Map (Int, Int) Scientific
blk) <- forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
1::Int)..] Matrix
m, ((Int
i,Int
j),Scientific
e) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Int, Int) Scientific
blk, Int
i forall a. Ord a => a -> a -> Bool
<= Int
j ]

    renderDenseMatrix :: Matrix -> Builder
    renderDenseMatrix :: Matrix -> Builder
renderDenseMatrix Matrix
m =
      Builder
"{\n" forall a. Semigroup a => a -> a -> a
<>
      forall a. Monoid a => [a] -> a
mconcat [Map (Int, Int) Scientific -> Int -> Builder
renderDenseBlock Map (Int, Int) Scientific
b Int
s forall a. Semigroup a => a -> a -> a
<> Builder
"\n" | (Map (Int, Int) Scientific
b,Int
s) <- forall a b. [a] -> [b] -> [(a, b)]
zip Matrix
m (Problem -> [Int]
blockStruct Problem
prob)] 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 forall a. Ord a => a -> a -> Bool
< Int
0 =
          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 .. forall a. Num a => a -> a
abs Int
s]]
      | Bool
otherwise =
          Builder
"  { " forall a. Semigroup a => a -> a -> a
<>
          [Builder] -> Builder -> Builder
sepByS [Int -> Builder
renderRow Int
i | Int
i <- [Int
1..Int
s]] 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
'{' forall a. Semigroup a => a -> a -> a
<>
  [Builder] -> Builder -> Builder
sepByS (forall a b. (a -> b) -> [a] -> [b]
map Scientific -> Builder
B.scientificBuilder [Scientific]
xs) 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 = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Builder
sep [Builder]
xs