msakai / toysolver / 496

Committed 10 Nov 2024 11:05AM UTC coverage: 69.994% (-1.1%) from 71.113%

Build # 496

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #117 from msakai/update-coveralls-and-haddock

GitHub Actions: Update coveralls and haddock configuration

Run Details

9872 of 14104 relevant lines covered (69.99%)

0.7 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

79.75

/src/ToySolver/Text/SDPFile.hs

{-# 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 = anySingle

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

data Problem
  = Problem
  { blockStruct :: [Int]      -- ^ the block strcuture vector (bLOCKsTRUCT)
  , costs       :: [Scientific] -- ^ Constant Vector
  , matrices    :: [Matrix]   -- ^ Constraint Matrices
  }
  deriving (Show, Ord, Eq)

type Matrix = [Block]

type Block = Map (Int,Int) Scientific

-- | the number of primal variables (mDim)
mDim :: Problem -> Int
mDim prob = length (matrices prob) - 1

-- | the number of blocks (nBLOCK)
nBlock :: Problem -> Int
nBlock prob = length (blockStruct prob)

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

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

data Solution
  = Solution
  { primalVector :: [Scientific] -- ^ The primal variable vector x
  , primalMatrix :: Matrix -- ^ The primal variable matrix X
  , dualMatrix   :: Matrix -- ^ The dual variable matrix Y
  }
  deriving (Show, Ord, Eq)

evalPrimalObjective :: Problem -> Solution -> Scientific
evalPrimalObjective prob sol = sum $ zipWith (*) (costs prob) (primalVector sol)

evalDualObjective :: Problem -> Solution -> Scientific
evalDualObjective Problem{ matrices = [] } _ = error "evalDualObjective: invalid problem data"
evalDualObjective Problem{ matrices = f0:_ } sol =
  sum $ zipWith (\blk1 blk2 -> F.sum (Map.intersectionWith (*) blk1 blk2)) f0 (dualMatrix sol)

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

type DenseMatrix = [DenseBlock]

type DenseBlock = [[Scientific]]

denseBlock :: DenseBlock -> Block
denseBlock xxs = Map.fromList [((i,j),x) | (i,xs) <- zip [1..] xxs, (j,x) <- zip [1..] xs, x /= 0]

denseMatrix :: DenseMatrix -> Matrix
denseMatrix = map denseBlock

diagBlock :: [Scientific] -> Block
diagBlock xs = Map.fromList [((i,i),x) | (i,x) <- zip [1..] xs]

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

-- | Parse a SDPA format file (.dat) or a SDPA sparse format file (.dat-s)..
readDataFile :: FilePath -> IO Problem
readDataFile fname = do
  p <- case map toLower (takeExtension fname) of
    ".dat" -> return pDataFile
    ".dat-s" -> return pSparseDataFile
    ext -> ioError $ userError $ "unknown extension: " ++ ext
  s <- BL.readFile fname
  case parse (p <* eof) fname s of
    Left e -> throw (e :: ParseError)
    Right prob -> return prob

writeDataFile :: FilePath -> Problem -> IO ()
writeDataFile fname prob = do
  isSparse <- case map toLower (takeExtension fname) of
    ".dat" -> return False
    ".dat-s" -> return True
    ext -> ioError $ userError $ "unknown extension: " ++ ext
  withBinaryFile fname WriteMode $ \h -> do
    B.hPutBuilder h $ renderImpl isSparse prob

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

-- | Parse a SDPA format (.dat) string.
parseData :: String -> BL.ByteString -> Either ParseError Problem
parseData = parse (pDataFile <* eof)

-- | Parse a SDPA sparse format (.dat-s) string.
parseSparseData :: String -> BL.ByteString -> Either ParseError Problem
parseSparseData = parse (pSparseDataFile <* eof)

pDataFile :: C e s m => m Problem
pDataFile = do
  _ <- many pComment
  m  <- nat_line -- mDim
  _n <- nat_line -- nBlock
  bs <- pBlockStruct -- bLOCKsTRUCT
  cs <- pCosts
  ms <- pDenseMatrices (fromIntegral m) bs
  space
  return $
    Problem
    { blockStruct = bs
    , costs       = cs
    , matrices    = ms
    }

pSparseDataFile :: C e s m => m Problem
pSparseDataFile = do
  _ <- many pComment
  m  <- nat_line -- mDim
  _n <- nat_line -- nBlock
  bs <- pBlockStruct -- bLOCKsTRUCT
  cs <- pCosts
  ms <- pSparseMatrices (fromIntegral m) bs
  space
  return $
    Problem
    { blockStruct = bs
    , costs       = cs
    , matrices    = ms
    }

pComment :: C e s m => m BL.ByteString
pComment = do
  c <- oneOf "*\""
  cs <- manyTill anyChar newline
  return $ BL.pack (c:cs)

pBlockStruct :: C e s m => m [Int]
pBlockStruct = do
  _ <- optional sep
  let int' = int >>= \i -> optional sep >> return i
  xs <- many int'
  _ <- manyTill anyChar newline
  return $ map fromIntegral xs
  where
    sep = some (oneOf " \t(){},")

pCosts :: C e s m => m [Scientific]
pCosts = do
  let sep = some (oneOf " \t(){},")
      real' = real >>= \r -> optional sep >> return r
  _ <- optional sep
  cs <- many real'
  _ <- newline
  return cs

pDenseMatrices :: C e s m => Int -> [Int] -> m [Matrix]
pDenseMatrices m bs = optional sep >> replicateM (fromIntegral m + 1) pDenceMatrix
  where
    sep = some ((spaceChar >> return ()) <|> (oneOf "(){}," >> return ()))
    real' = real >>= \r -> optional sep >> return r
    pDenceMatrix = forM bs $ \b ->
      if b >= 0
      then do
        xs <- replicateM b (replicateM b real')
        return $ denseBlock xs
      else do
        xs <- replicateM (abs b) real'
        return $ diagBlock xs

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

  where
    sep = some (oneOf " \t") >> return ()
    pLine = do
      _ <- optional sep
      matno <- nat
      sep
      blkno <- nat
      sep
      i <- nat
      sep
      j <- nat
      sep
      e <- real
      _ <- optional sep
      _ <- newline
      return (fromIntegral matno, fromIntegral blkno, fromIntegral i, fromIntegral j, e)

nat_line :: C e s m => m Integer
nat_line = do
  space
  n <- nat
  _ <- manyTill anyChar newline
  return n

nat :: C e s m => m Integer
nat = Lexer.decimal

int :: C e s m => m Integer
int = Lexer.signed (return ()) Lexer.decimal

real :: forall e s m. C e s m => m Scientific
real = Lexer.signed (return ()) Lexer.scientific

oneOf :: C e s m => [Char] -> m Word8
oneOf = MegaParsec.oneOf . map (fromIntegral . fromEnum)

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

renderData :: Problem -> Builder
renderData = renderImpl False

renderSparseData :: Problem -> Builder
renderSparseData = renderImpl True

renderImpl :: Bool -> Problem -> Builder
renderImpl sparse prob = mconcat
  [
  -- mDim
    B.intDec (mDim prob) <> " = mDIM\n"

  -- nBlock
  , B.intDec (nBlock prob) <> " = nBlock\n"

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

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

  -- matrices
  , if sparse
    then mconcat [renderSparseMatrix matno m | (matno, m) <- zip [0..] (matrices prob)]
    else mconcat $ map renderDenseMatrix (matrices prob)
  ]

  where
    renderSparseMatrix :: Int -> Matrix -> Builder
    renderSparseMatrix matno m =
      mconcat [ B.intDec matno <> B.char7 ' ' <>
                B.intDec blkno <> B.char7 ' ' <>
                B.intDec i <> B.char7 ' ' <>
                B.intDec j <> B.char7 ' ' <>
                B.scientificBuilder e <> B.char7 '\n'
              | (blkno, blk) <- zip [(1::Int)..] m, ((i,j),e) <- Map.toList blk, i <= j ]

    renderDenseMatrix :: Matrix -> Builder
    renderDenseMatrix m =
      "{\n" <>
      mconcat [renderDenseBlock b s <> "\n" | (b,s) <- zip m (blockStruct prob)] <>
      "}\n"

    renderDenseBlock :: Block -> Int -> Builder
    renderDenseBlock b s
      | s < 0 =
          "  " <> renderVec [blockElem i i b | i <- [1 .. abs s]]
      | otherwise =
          "  { " <>
          sepByS [renderRow i | i <- [1..s]] ", " <>
          " }"
      where
        renderRow i = renderVec [blockElem i j b | j <- [1..s]]

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

sepByS :: [Builder] -> Builder -> Builder
sepByS xs sep = mconcat $ intersperse sep xs

1	{-# LANGUAGE ConstraintKinds #-}
2	{-# LANGUAGE FlexibleContexts #-}
3	{-# LANGUAGE GADTs #-}
4	{-# LANGUAGE OverloadedStrings #-}
5	{-# LANGUAGE ScopedTypeVariables #-}
6	{-# LANGUAGE TypeOperators #-}
7	{-# OPTIONS_GHC -Wall #-}
8	{-# OPTIONS_HADDOCK show-extensions #-}
9	-----------------------------------------------------------------------------
10	-- \|
11	-- Module : ToySolver.Text.SDPFile
12	-- Copyright : (c) Masahiro Sakai 2012,2016
13	-- License : BSD-style
14	--
15	-- Maintainer : masahiro.sakai@gmail.com
16	-- Stability : provisional
17	-- Portability : non-portable
18	--
19	-- References:
20	--
21	-- * SDPA (Semidefinite Programming Algorithm) User's Manual
22	-- <http://sdpa.indsys.chuo-u.ac.jp/~fujisawa/sdpa_doc.pdf>
23	--
24	-- * <http://euler.nmt.edu/~brian/sdplib/FORMAT>
25	--
26	-----------------------------------------------------------------------------
27	module ToySolver.Text.SDPFile
28	( -- * The problem type
29	Problem (..)
30	, Matrix
31	, Block
32	, mDim
33	, nBlock
34	, blockElem
35	-- * The solution type
36	, Solution (..)
37	, evalPrimalObjective
38	, evalDualObjective
39
40	-- * File I/O
41	, readDataFile
42	, writeDataFile
43
44	-- * Construction
45	, DenseMatrix
46	, DenseBlock
47	, denseMatrix
48	, denseBlock
49	, diagBlock
50
51	-- * Rendering
52	, renderData
53	, renderSparseData
54
55	-- * Parsing
56	, ParseError
57	, parseData
58	, parseSparseData
59	) where
60
61	import Control.Exception
62	import Control.Monad
63	import qualified Data.ByteString.Lazy as BL
64	import Data.ByteString.Builder (Builder)
65	import qualified Data.ByteString.Builder as B
66	import qualified Data.ByteString.Builder.Scientific as B
67	import Data.Char
68	import qualified Data.Foldable as F
69	import Data.List (intersperse)
70	import Data.Scientific (Scientific)
71	import Data.Map (Map)
72	import qualified Data.Map as Map
73	import qualified Data.IntMap as IntMap
74	import Data.Void
75	import Data.Word
76	import System.FilePath (takeExtension)
77	import System.IO
78	import qualified Text.Megaparsec as MegaParsec
79	import Text.Megaparsec hiding (ParseError, oneOf)
80	import Text.Megaparsec.Byte
81	import qualified Text.Megaparsec.Byte.Lexer as Lexer
82
83	type C e s m = (MonadParsec e s m, Token s ~ Word8)
84	type ParseError = MegaParsec.ParseErrorBundle BL.ByteString Void
85
86	anyChar :: C e s m => m Word8
87	anyChar = anySingle	1✔
88
89	-- ---------------------------------------------------------------------------
90	-- problem description
91	-- ---------------------------------------------------------------------------
92
93	data Problem
94	= Problem
95	{ blockStruct :: [Int] -- ^ the block strcuture vector (bLOCKsTRUCT)	1✔
96	, costs :: [Scientific] -- ^ Constant Vector	1✔
97	, matrices :: [Matrix] -- ^ Constraint Matrices	1✔
98	}
99	deriving (Show, Ord, Eq)	×
100
101	type Matrix = [Block]
102
103	type Block = Map (Int,Int) Scientific
104
105	-- \| the number of primal variables (mDim)
106	mDim :: Problem -> Int
107	mDim prob = length (matrices prob) - 1	1✔
108
109	-- \| the number of blocks (nBLOCK)
110	nBlock :: Problem -> Int
111	nBlock prob = length (blockStruct prob)	1✔
112
113	blockElem :: Int -> Int -> Block -> Scientific
114	blockElem i j b = Map.findWithDefault 0 (i,j) b	1✔
115
116	-- ---------------------------------------------------------------------------
117	-- solution
118	-- ---------------------------------------------------------------------------
119
120	data Solution
121	= Solution
122	{ primalVector :: [Scientific] -- ^ The primal variable vector x	×
123	, primalMatrix :: Matrix -- ^ The primal variable matrix X	×
124	, dualMatrix :: Matrix -- ^ The dual variable matrix Y	×
125	}
126	deriving (Show, Ord, Eq)	×
127
128	evalPrimalObjective :: Problem -> Solution -> Scientific
129	evalPrimalObjective prob sol = sum $ zipWith (*) (costs prob) (primalVector sol)	×
130
131	evalDualObjective :: Problem -> Solution -> Scientific
132	evalDualObjective Problem{ matrices = [] } _ = error "evalDualObjective: invalid problem data"	×
133	evalDualObjective Problem{ matrices = f0:_ } sol =
134	sum $ zipWith (\blk1 blk2 -> F.sum (Map.intersectionWith (*) blk1 blk2)) f0 (dualMatrix sol)	×
135
136	-- ---------------------------------------------------------------------------
137	-- construction
138	-- ---------------------------------------------------------------------------
139
140	type DenseMatrix = [DenseBlock]
141
142	type DenseBlock = [[Scientific]]
143
144	denseBlock :: DenseBlock -> Block
145	denseBlock xxs = Map.fromList [((i,j),x) \| (i,xs) <- zip [1..] xxs, (j,x) <- zip [1..] xs, x /= 0]	1✔
146
147	denseMatrix :: DenseMatrix -> Matrix
148	denseMatrix = map denseBlock	1✔
149
150	diagBlock :: [Scientific] -> Block
151	diagBlock xs = Map.fromList [((i,i),x) \| (i,x) <- zip [1..] xs]	1✔
152
153	-- ---------------------------------------------------------------------------
154	-- File I/O
155	-- ---------------------------------------------------------------------------
156
157	-- \| Parse a SDPA format file (.dat) or a SDPA sparse format file (.dat-s)..
158	readDataFile :: FilePath -> IO Problem
159	readDataFile fname = do	×
160	p <- case map toLower (takeExtension fname) of	×
161	".dat" -> return pDataFile	×
162	".dat-s" -> return pSparseDataFile	×
163	ext -> ioError $ userError $ "unknown extension: " ++ ext	×
164	s <- BL.readFile fname	×
165	case parse (p <* eof) fname s of	×
166	Left e -> throw (e :: ParseError)	×
167	Right prob -> return prob	×
168
169	writeDataFile :: FilePath -> Problem -> IO ()
170	writeDataFile fname prob = do	×
171	isSparse <- case map toLower (takeExtension fname) of	×
172	".dat" -> return False	×
173	".dat-s" -> return True	×
174	ext -> ioError $ userError $ "unknown extension: " ++ ext	×
175	withBinaryFile fname WriteMode $ \h -> do	×
176	B.hPutBuilder h $ renderImpl isSparse prob	×
177
178	-- ---------------------------------------------------------------------------
179	-- parsing
180	-- ---------------------------------------------------------------------------
181
182	-- \| Parse a SDPA format (.dat) string.
183	parseData :: String -> BL.ByteString -> Either ParseError Problem
184	parseData = parse (pDataFile <* eof)	1✔
185
186	-- \| Parse a SDPA sparse format (.dat-s) string.
187	parseSparseData :: String -> BL.ByteString -> Either ParseError Problem
188	parseSparseData = parse (pSparseDataFile <* eof)	1✔
189
190	pDataFile :: C e s m => m Problem
191	pDataFile = do	1✔
192	_ <- many pComment	1✔
193	m <- nat_line -- mDim	1✔
194	_n <- nat_line -- nBlock	1✔
195	bs <- pBlockStruct -- bLOCKsTRUCT	1✔
196	cs <- pCosts	1✔
197	ms <- pDenseMatrices (fromIntegral m) bs	1✔
198	space	1✔
199	return $	1✔
200	Problem	1✔
201	{ blockStruct = bs	1✔
202	, costs = cs	1✔
203	, matrices = ms	1✔
204	}
205
206	pSparseDataFile :: C e s m => m Problem
207	pSparseDataFile = do	1✔
208	_ <- many pComment	1✔
209	m <- nat_line -- mDim	1✔
210	_n <- nat_line -- nBlock	1✔
211	bs <- pBlockStruct -- bLOCKsTRUCT	1✔
212	cs <- pCosts	1✔
213	ms <- pSparseMatrices (fromIntegral m) bs	1✔
214	space	1✔
215	return $	1✔
216	Problem	1✔
217	{ blockStruct = bs	1✔
218	, costs = cs	1✔
219	, matrices = ms	1✔
220	}
221
222	pComment :: C e s m => m BL.ByteString
223	pComment = do	1✔
224	c <- oneOf "*\""	1✔
225	cs <- manyTill anyChar newline	×
226	return $ BL.pack (c:cs)	×
227
228	pBlockStruct :: C e s m => m [Int]
229	pBlockStruct = do	1✔
230	_ <- optional sep	1✔
231	let int' = int >>= \i -> optional sep >> return i	1✔
232	xs <- many int'	1✔
233	_ <- manyTill anyChar newline	1✔
234	return $ map fromIntegral xs	1✔
235	where
236	sep = some (oneOf " \t(){},")	1✔
237
238	pCosts :: C e s m => m [Scientific]
239	pCosts = do	1✔
240	let sep = some (oneOf " \t(){},")	1✔
241	real' = real >>= \r -> optional sep >> return r	1✔
242	_ <- optional sep	1✔
243	cs <- many real'	1✔
244	_ <- newline	1✔
245	return cs	1✔
246
247	pDenseMatrices :: C e s m => Int -> [Int] -> m [Matrix]
248	pDenseMatrices m bs = optional sep >> replicateM (fromIntegral m + 1) pDenceMatrix	1✔
249	where
250	sep = some ((spaceChar >> return ()) <\|> (oneOf "(){}," >> return ()))	×
251	real' = real >>= \r -> optional sep >> return r	1✔
252	pDenceMatrix = forM bs $ \b ->	1✔
253	if b >= 0	1✔
254	then do	1✔
255	xs <- replicateM b (replicateM b real')	1✔
256	return $ denseBlock xs	1✔
257	else do	1✔
258	xs <- replicateM (abs b) real'	1✔
259	return $ diagBlock xs	1✔
260
261	pSparseMatrices :: C e s m => Int -> [Int] -> m [Matrix]
262	pSparseMatrices m bs = do	1✔
263	xs <- many pLine	1✔
264	let t = IntMap.unionsWith (IntMap.unionWith Map.union)	1✔
265	[ IntMap.singleton matno (IntMap.singleton blkno (Map.fromList [((i,j),e),((j,i),e)]))	1✔
266	\| (matno,blkno,i,j,e) <- xs ]	1✔
267	return $	1✔
268	[ [IntMap.findWithDefault Map.empty blkno mat \| blkno <- [1 .. length bs]]	×
269	\| matno <- [0..m], let mat = IntMap.findWithDefault IntMap.empty matno t	×
270	]
271
272	where
273	sep = some (oneOf " \t") >> return ()	×
274	pLine = do	1✔
275	_ <- optional sep	1✔
276	matno <- nat	1✔
277	sep	1✔
278	blkno <- nat	1✔
279	sep	1✔
280	i <- nat	1✔
281	sep	1✔
282	j <- nat	1✔
283	sep	1✔
284	e <- real	1✔
285	_ <- optional sep	1✔
286	_ <- newline	1✔
287	return (fromIntegral matno, fromIntegral blkno, fromIntegral i, fromIntegral j, e)	1✔
288
289	nat_line :: C e s m => m Integer
290	nat_line = do	1✔
291	space	1✔
292	n <- nat	1✔
293	_ <- manyTill anyChar newline	1✔
294	return n	1✔
295
296	nat :: C e s m => m Integer
297	nat = Lexer.decimal	1✔
298
299	int :: C e s m => m Integer
300	int = Lexer.signed (return ()) Lexer.decimal	×
301
302	real :: forall e s m. C e s m => m Scientific
303	real = Lexer.signed (return ()) Lexer.scientific	×
304
305	oneOf :: C e s m => [Char] -> m Word8
306	oneOf = MegaParsec.oneOf . map (fromIntegral . fromEnum)	1✔
307
308	-- ---------------------------------------------------------------------------
309	-- rendering
310	-- ---------------------------------------------------------------------------
311
312	renderData :: Problem -> Builder
313	renderData = renderImpl False	1✔
314
315	renderSparseData :: Problem -> Builder
316	renderSparseData = renderImpl True	1✔
317
318	renderImpl :: Bool -> Problem -> Builder
319	renderImpl sparse prob = mconcat	1✔
320	[	1✔
321	-- mDim
322	B.intDec (mDim prob) <> " = mDIM\n"	1✔
323
324	-- nBlock
325	, B.intDec (nBlock prob) <> " = nBlock\n"	1✔
326
327	-- blockStruct
328	, B.char7 '('	1✔
329	, sepByS [B.intDec i \| i <- blockStruct prob] ", "	1✔
330	, B.char7 ')'	1✔
331	, " = bLOCKsTRUCT\n"	1✔
332
333	-- costs
334	, B.char7 '('	1✔
335	, sepByS [B.scientificBuilder c \| c <- costs prob] ", "	1✔
336	, ")\n"	1✔
337
338	-- matrices
339	, if sparse	1✔
340	then mconcat [renderSparseMatrix matno m \| (matno, m) <- zip [0..] (matrices prob)]	1✔
341	else mconcat $ map renderDenseMatrix (matrices prob)	1✔
342	]
343
344	where
345	renderSparseMatrix :: Int -> Matrix -> Builder
346	renderSparseMatrix matno m =	1✔
347	mconcat [ B.intDec matno <> B.char7 ' ' <>	1✔
348	B.intDec blkno <> B.char7 ' ' <>	1✔
349	B.intDec i <> B.char7 ' ' <>	1✔
350	B.intDec j <> B.char7 ' ' <>	1✔
351	B.scientificBuilder e <> B.char7 '\n'	1✔
352	\| (blkno, blk) <- zip [(1::Int)..] m, ((i,j),e) <- Map.toList blk, i <= j ]	1✔
353
354	renderDenseMatrix :: Matrix -> Builder
355	renderDenseMatrix m =	1✔
356	"{\n" <>	1✔
357	mconcat [renderDenseBlock b s <> "\n" \| (b,s) <- zip m (blockStruct prob)] <>	1✔
358	"}\n"	1✔
359
360	renderDenseBlock :: Block -> Int -> Builder
361	renderDenseBlock b s	1✔
362	\| s < 0 =	1✔
363	" " <> renderVec [blockElem i i b \| i <- [1 .. abs s]]	1✔
364	\| otherwise =	×
365	" { " <>	1✔
366	sepByS [renderRow i \| i <- [1..s]] ", " <>	1✔
367	" }"	1✔
368	where
369	renderRow i = renderVec [blockElem i j b \| j <- [1..s]]	1✔
370
371	renderVec :: [Scientific] -> Builder
372	renderVec xs =	1✔
373	B.char7 '{' <>	1✔
374	sepByS (map B.scientificBuilder xs) ", " <>	1✔
375	B.char7 '}'	1✔
376
377	sepByS :: [Builder] -> Builder -> Builder
378	sepByS xs sep = mconcat $ intersperse sep xs	1✔

msakai / toysolver / 496

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous