{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE TypeFamilies #-}
module ToySolver.SDP
( dualize
, DualizeInfo (..)
) where
import qualified Data.Map.Strict as Map
import Data.Scientific (Scientific)
import ToySolver.Converter.Base
import qualified ToySolver.Text.SDPFile as SDPFile
dualize :: SDPFile.Problem -> (SDPFile.Problem, DualizeInfo)
dualize :: Problem -> (Problem, DualizeInfo)
dualize Problem
origProb =
( SDPFile.Problem
{ blockStruct :: [Int]
SDPFile.blockStruct = [Int]
blockStruct
, costs :: [Scientific]
SDPFile.costs = [Scientific]
d
, matrices :: [Matrix]
SDPFile.matrices = Matrix
a0 forall a. a -> [a] -> [a]
: [Matrix]
as
}
, Int -> [Int] -> DualizeInfo
DualizeInfo Int
m (Problem -> [Int]
SDPFile.blockStruct Problem
origProb)
)
where
m :: Int
m :: Int
m = Problem -> Int
SDPFile.mDim Problem
origProb
c :: [Scientific]
c :: [Scientific]
c = Problem -> [Scientific]
SDPFile.costs Problem
origProb
f0 :: SDPFile.Matrix
fs :: [SDPFile.Matrix]
Matrix
f0:[Matrix]
fs = Problem -> [Matrix]
SDPFile.matrices Problem
origProb
blockStruct :: [Int]
blockStruct :: [Int]
blockStruct = [-Int
m, -Int
m] forall a. [a] -> [a] -> [a]
++ Problem -> [Int]
SDPFile.blockStruct Problem
origProb
a0 :: SDPFile.Matrix
a0 :: Matrix
a0 =
[ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
j,Int
j), -Scientific
cj) | (Int
j,Scientific
cj) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
m] [Scientific]
c, Scientific
cj forall a. Eq a => a -> a -> Bool
/= Scientific
0]
, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
j,Int
j), Scientific
cj) | (Int
j,Scientific
cj) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
m] [Scientific]
c, Scientific
cj forall a. Eq a => a -> a -> Bool
/= Scientific
0]
] forall a. [a] -> [a] -> [a]
++
[ forall k a. Map k a
Map.empty | Int
_ <- Problem -> [Int]
SDPFile.blockStruct Problem
origProb]
as :: [SDPFile.Matrix]
as :: [Matrix]
as =
[ [ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ((Int
k,Int
k), - (if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then Scientific
v else Scientific
2forall a. Num a => a -> a -> a
*Scientific
v))
| (Int
k,Matrix
fk) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
m] [Matrix]
fs, let v :: Scientific
v = Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
j (Matrix
fkforall a. [a] -> Int -> a
!!Int
b), Scientific
v forall a. Eq a => a -> a -> Bool
/= Scientific
0]
, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ ((Int
k,Int
k), (if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then Scientific
v else Scientific
2forall a. Num a => a -> a -> a
*Scientific
v))
| (Int
k,Matrix
fk) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..Int
m] [Matrix]
fs, let v :: Scientific
v = Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
j (Matrix
fkforall a. [a] -> Int -> a
!!Int
b), Scientific
v forall a. Eq a => a -> a -> Bool
/= Scientific
0]
] forall a. [a] -> [a] -> [a]
++
[ if Int
b forall a. Eq a => a -> a -> Bool
/= Int
b2 then
forall k a. Map k a
Map.empty
else if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then
forall k a. k -> a -> Map k a
Map.singleton (Int
i,Int
j) Scientific
1
else
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((Int
i,Int
j),Scientific
1), ((Int
j,Int
i),Scientific
1)]
| (Int
b2, Int
_) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Problem -> [Int]
SDPFile.blockStruct Problem
origProb)
]
| (Int
b,Int
block) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Problem -> [Int]
SDPFile.blockStruct Problem
origProb)
, (Int
i,Int
j) <- Int -> [(Int, Int)]
blockIndexes Int
block
]
d :: [Scientific]
d =
[ - (if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then Scientific
v else Scientific
2forall a. Num a => a -> a -> a
*Scientific
v)
| (Int
b,Int
block) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (Problem -> [Int]
SDPFile.blockStruct Problem
origProb)
, (Int
i,Int
j) <- Int -> [(Int, Int)]
blockIndexes Int
block
, let v :: Scientific
v = Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
j (Matrix
f0 forall a. [a] -> Int -> a
!! Int
b)
]
blockIndexes :: Int -> [(Int,Int)]
blockIndexes :: Int -> [(Int, Int)]
blockIndexes Int
n = if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then [(Int
i,Int
j) | Int
i <- [Int
1..Int
n], Int
j <- [Int
1..Int
i]] else [(Int
i,Int
i) | Int
i <- [Int
1..(-Int
n)]]
blockIndexesLen :: Int -> Int
blockIndexesLen :: Int -> Int
blockIndexesLen Int
n = if Int
n forall a. Ord a => a -> a -> Bool
>= Int
0 then Int
nforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`div` Int
2 else -Int
n
data DualizeInfo = DualizeInfo Int [Int]
deriving (DualizeInfo -> DualizeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DualizeInfo -> DualizeInfo -> Bool
$c/= :: DualizeInfo -> DualizeInfo -> Bool
== :: DualizeInfo -> DualizeInfo -> Bool
$c== :: DualizeInfo -> DualizeInfo -> Bool
Eq, Int -> DualizeInfo -> ShowS
[DualizeInfo] -> ShowS
DualizeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DualizeInfo] -> ShowS
$cshowList :: [DualizeInfo] -> ShowS
show :: DualizeInfo -> String
$cshow :: DualizeInfo -> String
showsPrec :: Int -> DualizeInfo -> ShowS
$cshowsPrec :: Int -> DualizeInfo -> ShowS
Show, ReadPrec [DualizeInfo]
ReadPrec DualizeInfo
Int -> ReadS DualizeInfo
ReadS [DualizeInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DualizeInfo]
$creadListPrec :: ReadPrec [DualizeInfo]
readPrec :: ReadPrec DualizeInfo
$creadPrec :: ReadPrec DualizeInfo
readList :: ReadS [DualizeInfo]
$creadList :: ReadS [DualizeInfo]
readsPrec :: Int -> ReadS DualizeInfo
$creadsPrec :: Int -> ReadS DualizeInfo
Read)
instance Transformer DualizeInfo where
type Source DualizeInfo = SDPFile.Solution
type Target DualizeInfo = SDPFile.Solution
instance ForwardTransformer DualizeInfo where
transformForward :: DualizeInfo -> Source DualizeInfo -> Target DualizeInfo
transformForward (DualizeInfo Int
_origM [Int]
origBlockStruct)
SDPFile.Solution
{ primalVector :: Solution -> [Scientific]
SDPFile.primalVector = [Scientific]
xV
, primalMatrix :: Solution -> Matrix
SDPFile.primalMatrix = Matrix
xM
, dualMatrix :: Solution -> Matrix
SDPFile.dualMatrix = Matrix
yM
} =
SDPFile.Solution
{ primalVector :: [Scientific]
SDPFile.primalVector = [Scientific]
zV
, primalMatrix :: Matrix
SDPFile.primalMatrix = Matrix
zM
, dualMatrix :: Matrix
SDPFile.dualMatrix = Matrix
wM
}
where
zV :: [Scientific]
zV = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
j Block
block | (Int
i,Int
j) <- Int -> [(Int, Int)]
blockIndexes Int
b] | (Int
b,Block
block) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
origBlockStruct Matrix
yM]
zM :: Matrix
zM = forall k a. Map k a
Map.empty forall a. a -> [a] -> [a]
: forall k a. Map k a
Map.empty forall a. a -> [a] -> [a]
: Matrix
yM
wM :: Matrix
wM =
[ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Scientific
x -> ((Int
i,Int
i), if Scientific
x forall a. Ord a => a -> a -> Bool
>= Scientific
0 then Scientific
x else Scientific
0)) [Int
1..] [Scientific]
xV
, forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
i Scientific
x -> ((Int
i,Int
i), if Scientific
x forall a. Ord a => a -> a -> Bool
<= Scientific
0 then -Scientific
x else Scientific
0)) [Int
1..] [Scientific]
xV
] forall a. [a] -> [a] -> [a]
++ Matrix
xM
instance BackwardTransformer DualizeInfo where
transformBackward :: DualizeInfo -> Target DualizeInfo -> Source DualizeInfo
transformBackward (DualizeInfo Int
origM [Int]
origBlockStruct)
SDPFile.Solution
{ primalVector :: Solution -> [Scientific]
SDPFile.primalVector = [Scientific]
zV
, primalMatrix :: Solution -> Matrix
SDPFile.primalMatrix = Matrix
_zM
, dualMatrix :: Solution -> Matrix
SDPFile.dualMatrix = Matrix
wM
} =
case Matrix
wM of
(Block
xps:Block
xns:Matrix
xM) ->
SDPFile.Solution
{ primalVector :: [Scientific]
SDPFile.primalVector = [Scientific]
xV
, primalMatrix :: Matrix
SDPFile.primalMatrix = Matrix
xM
, dualMatrix :: Matrix
SDPFile.dualMatrix = Matrix
yM
}
where
xV :: [Scientific]
xV = [Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
i Block
xps forall a. Num a => a -> a -> a
- Int -> Int -> Block -> Scientific
SDPFile.blockElem Int
i Int
i Block
xns | Int
i <- [Int
1..Int
origM]]
yM :: Matrix
yM = [Int] -> [Scientific] -> Matrix
f [Int]
origBlockStruct [Scientific]
zV
where
f :: [Int] -> [Scientific] -> Matrix
f [] [Scientific]
_ = []
f (Int
block : [Int]
blocks) [Scientific]
zV1 =
case forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
blockIndexesLen Int
block) [Scientific]
zV1 of
([Scientific]
vals, [Scientific]
zV2) -> [((Int, Int), Scientific)] -> Block
symblock (forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [(Int, Int)]
blockIndexes Int
block) [Scientific]
vals) forall a. a -> [a] -> [a]
: [Int] -> [Scientific] -> Matrix
f [Int]
blocks [Scientific]
zV2
Matrix
_ -> forall a. HasCallStack => String -> a
error String
"ToySolver.SDP.transformSolutionBackward: invalid solution"
symblock :: [((Int,Int), Scientific)] -> SDPFile.Block
symblock :: [((Int, Int), Scientific)] -> Block
symblock [((Int, Int), Scientific)]
es = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ do
e :: ((Int, Int), Scientific)
e@((Int
i,Int
j),Scientific
x) <- [((Int, Int), Scientific)]
es
if Scientific
x forall a. Eq a => a -> a -> Bool
== Scientific
0 then
[]
else if Int
i forall a. Eq a => a -> a -> Bool
== Int
j then
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int), Scientific)
e
else
[((Int, Int), Scientific)
e, ((Int
j,Int
i),Scientific
x)]