{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module ToySolver.Converter.QUBO
( qubo2pb
, QUBO2PBInfo (..)
, pb2qubo
, PB2QUBOInfo
, pbAsQUBO
, PBAsQUBOInfo (..)
, qubo2ising
, QUBO2IsingInfo (..)
, ising2qubo
, Ising2QUBOInfo (..)
) where
import Control.Monad
import Control.Monad.State
import Data.Array.Unboxed
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.List
import Data.Maybe
import qualified Data.PseudoBoolean as PBFile
import Data.Ratio
import ToySolver.Converter.Base
import ToySolver.Converter.PB (pb2qubo', PB2QUBOInfo')
import qualified ToySolver.QUBO as QUBO
import qualified ToySolver.SAT.Types as SAT
qubo2pb :: Real a => QUBO.Problem a -> (PBFile.Formula, QUBO2PBInfo a)
qubo2pb :: Problem a -> (Formula, QUBO2PBInfo a)
qubo2pb Problem a
prob =
( Formula :: Maybe Sum -> [Constraint] -> Int -> Int -> Formula
PBFile.Formula
{ pbObjectiveFunction :: Maybe Sum
PBFile.pbObjectiveFunction = Sum -> Maybe Sum
forall a. a -> Maybe a
Just (Sum -> Maybe Sum) -> Sum -> Maybe Sum
forall a b. (a -> b) -> a -> b
$
[ (Integer
c, if Int
x1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
x2 then [Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1] else [Int
x1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
x2Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1])
| (Int
x1, IntMap Integer
row) <- IntMap (IntMap Integer) -> [(Int, IntMap Integer)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (IntMap Integer)
m2
, (Int
x2, Integer
c) <- IntMap Integer -> [(Int, Integer)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap Integer
row
]
, pbConstraints :: [Constraint]
PBFile.pbConstraints = []
, pbNumVars :: Int
PBFile.pbNumVars = Problem a -> Int
forall a. Problem a -> Int
QUBO.quboNumVars Problem a
prob
, pbNumConstraints :: Int
PBFile.pbNumConstraints = Int
0
}
, Integer -> QUBO2PBInfo a
forall a. Integer -> QUBO2PBInfo a
QUBO2PBInfo Integer
d
)
where
m1 :: IntMap (IntMap Rational)
m1 = (IntMap a -> IntMap Rational)
-> IntMap (IntMap a) -> IntMap (IntMap Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Rational) -> IntMap a -> IntMap Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Rational
forall a. Real a => a -> Rational
toRational) (IntMap (IntMap a) -> IntMap (IntMap Rational))
-> IntMap (IntMap a) -> IntMap (IntMap Rational)
forall a b. (a -> b) -> a -> b
$ Problem a -> IntMap (IntMap a)
forall a. Problem a -> IntMap (IntMap a)
QUBO.quboMatrix Problem a
prob
d :: Integer
d = (Integer -> Integer -> Integer) -> Integer -> [Integer] -> Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm Integer
1 [Rational -> Integer
forall a. Ratio a -> a
denominator Rational
c | IntMap Rational
row <- IntMap (IntMap Rational) -> [IntMap Rational]
forall a. IntMap a -> [a]
IntMap.elems IntMap (IntMap Rational)
m1, Rational
c <- IntMap Rational -> [Rational]
forall a. IntMap a -> [a]
IntMap.elems IntMap Rational
row, Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0]
m2 :: IntMap (IntMap Integer)
m2 = (IntMap Rational -> IntMap Integer)
-> IntMap (IntMap Rational) -> IntMap (IntMap Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rational -> Integer) -> IntMap Rational -> IntMap Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Rational
c -> Rational -> Integer
forall a. Ratio a -> a
numerator Rational
c Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
d ` div` Rational -> Integer
forall a. Ratio a -> a
denominator Rational
c))) IntMap (IntMap Rational)
m1
newtype QUBO2PBInfo a = QUBO2PBInfo Integer
deriving (QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
(QUBO2PBInfo a -> QUBO2PBInfo a -> Bool)
-> (QUBO2PBInfo a -> QUBO2PBInfo a -> Bool) -> Eq (QUBO2PBInfo a)
forall a. QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
$c/= :: forall a. QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
== :: QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
$c== :: forall a. QUBO2PBInfo a -> QUBO2PBInfo a -> Bool
Eq, Int -> QUBO2PBInfo a -> ShowS
[QUBO2PBInfo a] -> ShowS
QUBO2PBInfo a -> String
(Int -> QUBO2PBInfo a -> ShowS)
-> (QUBO2PBInfo a -> String)
-> ([QUBO2PBInfo a] -> ShowS)
-> Show (QUBO2PBInfo a)
forall a. Int -> QUBO2PBInfo a -> ShowS
forall a. [QUBO2PBInfo a] -> ShowS
forall a. QUBO2PBInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QUBO2PBInfo a] -> ShowS
$cshowList :: forall a. [QUBO2PBInfo a] -> ShowS
show :: QUBO2PBInfo a -> String
$cshow :: forall a. QUBO2PBInfo a -> String
showsPrec :: Int -> QUBO2PBInfo a -> ShowS
$cshowsPrec :: forall a. Int -> QUBO2PBInfo a -> ShowS
Show, ReadPrec [QUBO2PBInfo a]
ReadPrec (QUBO2PBInfo a)
Int -> ReadS (QUBO2PBInfo a)
ReadS [QUBO2PBInfo a]
(Int -> ReadS (QUBO2PBInfo a))
-> ReadS [QUBO2PBInfo a]
-> ReadPrec (QUBO2PBInfo a)
-> ReadPrec [QUBO2PBInfo a]
-> Read (QUBO2PBInfo a)
forall a. ReadPrec [QUBO2PBInfo a]
forall a. ReadPrec (QUBO2PBInfo a)
forall a. Int -> ReadS (QUBO2PBInfo a)
forall a. ReadS [QUBO2PBInfo a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QUBO2PBInfo a]
$creadListPrec :: forall a. ReadPrec [QUBO2PBInfo a]
readPrec :: ReadPrec (QUBO2PBInfo a)
$creadPrec :: forall a. ReadPrec (QUBO2PBInfo a)
readList :: ReadS [QUBO2PBInfo a]
$creadList :: forall a. ReadS [QUBO2PBInfo a]
readsPrec :: Int -> ReadS (QUBO2PBInfo a)
$creadsPrec :: forall a. Int -> ReadS (QUBO2PBInfo a)
Read)
instance (Eq a, Show a, Read a) => Transformer (QUBO2PBInfo a) where
type Source (QUBO2PBInfo a) = QUBO.Solution
type Target (QUBO2PBInfo a) = SAT.Model
instance (Eq a, Show a, Read a) => ForwardTransformer (QUBO2PBInfo a) where
transformForward :: QUBO2PBInfo a -> Source (QUBO2PBInfo a) -> Target (QUBO2PBInfo a)
transformForward (QUBO2PBInfo Integer
_) Source (QUBO2PBInfo a)
sol = (Int, Int) -> (Int -> Int) -> UArray Int Bool -> UArray Int Bool
forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
ixmap (Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
ubInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) UArray Int Bool
Source (QUBO2PBInfo a)
sol
where
(Int
lb,Int
ub) = UArray Int Bool -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Bool
Source (QUBO2PBInfo a)
sol
instance (Eq a, Show a, Read a) => BackwardTransformer (QUBO2PBInfo a) where
transformBackward :: QUBO2PBInfo a -> Target (QUBO2PBInfo a) -> Source (QUBO2PBInfo a)
transformBackward (QUBO2PBInfo Integer
_) Target (QUBO2PBInfo a)
m = (Int, Int) -> (Int -> Int) -> UArray Int Bool -> UArray Int Bool
forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
ixmap (Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
ubInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) UArray Int Bool
Target (QUBO2PBInfo a)
m
where
(Int
lb,Int
ub) = UArray Int Bool -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Bool
Target (QUBO2PBInfo a)
m
instance (Eq a, Show a, Read a) => ObjValueTransformer (QUBO2PBInfo a) where
type SourceObjValue (QUBO2PBInfo a) = a
type TargetObjValue (QUBO2PBInfo a) = Integer
instance (Eq a, Show a, Read a, Real a) => ObjValueForwardTransformer (QUBO2PBInfo a) where
transformObjValueForward :: QUBO2PBInfo a
-> SourceObjValue (QUBO2PBInfo a) -> TargetObjValue (QUBO2PBInfo a)
transformObjValueForward (QUBO2PBInfo Integer
d) SourceObjValue (QUBO2PBInfo a)
obj = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Rational
forall a. Real a => a -> Rational
toRational a
SourceObjValue (QUBO2PBInfo a)
obj) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
d
instance (Eq a, Show a, Read a, Num a) => ObjValueBackwardTransformer (QUBO2PBInfo a) where
transformObjValueBackward :: QUBO2PBInfo a
-> TargetObjValue (QUBO2PBInfo a) -> SourceObjValue (QUBO2PBInfo a)
transformObjValueBackward (QUBO2PBInfo Integer
d) TargetObjValue (QUBO2PBInfo a)
obj = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ (Integer
TargetObjValue (QUBO2PBInfo a)
obj Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
d
pbAsQUBO :: forall a. Real a => PBFile.Formula -> Maybe (QUBO.Problem a, PBAsQUBOInfo a)
pbAsQUBO :: Formula -> Maybe (Problem a, PBAsQUBOInfo a)
pbAsQUBO Formula
formula = do
(Problem a
prob, Integer
offset) <- StateT Integer Maybe (Problem a)
-> Integer -> Maybe (Problem a, Integer)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT Integer Maybe (Problem a)
body Integer
0
(Problem a, PBAsQUBOInfo a) -> Maybe (Problem a, PBAsQUBOInfo a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Problem a, PBAsQUBOInfo a) -> Maybe (Problem a, PBAsQUBOInfo a))
-> (Problem a, PBAsQUBOInfo a) -> Maybe (Problem a, PBAsQUBOInfo a)
forall a b. (a -> b) -> a -> b
$ (Problem a
prob, Integer -> PBAsQUBOInfo a
forall a. Integer -> PBAsQUBOInfo a
PBAsQUBOInfo Integer
offset)
where
body :: StateT Integer Maybe (QUBO.Problem a)
body :: StateT Integer Maybe (Problem a)
body = do
Bool -> StateT Integer Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> StateT Integer Maybe ())
-> Bool -> StateT Integer Maybe ()
forall a b. (a -> b) -> a -> b
$ [Constraint] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Formula -> [Constraint]
PBFile.pbConstraints Formula
formula)
let f :: PBFile.WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)]
f :: WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)]
f (Integer
c,[]) = (Integer -> Integer) -> StateT Integer Maybe ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
c) StateT Integer Maybe ()
-> StateT Integer Maybe [(Integer, Int, Int)]
-> StateT Integer Maybe [(Integer, Int, Int)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Integer, Int, Int)] -> StateT Integer Maybe [(Integer, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
f (Integer
c,[Int
x]) = [(Integer, Int, Int)] -> StateT Integer Maybe [(Integer, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Integer
c,Int
x,Int
x)]
f (Integer
c,[Int
x1,Int
x2]) = [(Integer, Int, Int)] -> StateT Integer Maybe [(Integer, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Integer
c,Int
x1,Int
x2)]
f WeightedTerm
_ = StateT Integer Maybe [(Integer, Int, Int)]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
[[(Integer, Int, Int)]]
xs <- (WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)])
-> Sum -> StateT Integer Maybe [[(Integer, Int, Int)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)]
f (Sum -> StateT Integer Maybe [[(Integer, Int, Int)]])
-> Sum -> StateT Integer Maybe [[(Integer, Int, Int)]]
forall a b. (a -> b) -> a -> b
$ Sum -> Sum
SAT.removeNegationFromPBSum (Sum -> Sum) -> Sum -> Sum
forall a b. (a -> b) -> a -> b
$ Sum -> Maybe Sum -> Sum
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe Sum -> Sum) -> Maybe Sum -> Sum
forall a b. (a -> b) -> a -> b
$ Formula -> Maybe Sum
PBFile.pbObjectiveFunction Formula
formula
Problem a -> StateT Integer Maybe (Problem a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Problem a -> StateT Integer Maybe (Problem a))
-> Problem a -> StateT Integer Maybe (Problem a)
forall a b. (a -> b) -> a -> b
$
Problem :: forall a. Int -> IntMap (IntMap a) -> Problem a
QUBO.Problem
{ quboNumVars :: Int
QUBO.quboNumVars = Formula -> Int
PBFile.pbNumVars Formula
formula
, quboMatrix :: IntMap (IntMap a)
QUBO.quboMatrix = [(Int, Int, a)] -> IntMap (IntMap a)
forall a. (Eq a, Num a) => [(Int, Int, a)] -> IntMap (IntMap a)
mkMat ([(Int, Int, a)] -> IntMap (IntMap a))
-> [(Int, Int, a)] -> IntMap (IntMap a)
forall a b. (a -> b) -> a -> b
$
[ (Int
x1', Int
x2', Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
c)
| (Integer
c,Int
x1,Int
x2) <- [[(Integer, Int, Int)]] -> [(Integer, Int, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Integer, Int, Int)]]
xs, let x1' :: Int
x1' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x1 Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, let x2' :: Int
x2' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x1 Int
x2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
]
}
data PBAsQUBOInfo a = PBAsQUBOInfo !Integer
deriving (PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
(PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool)
-> (PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool)
-> Eq (PBAsQUBOInfo a)
forall a. PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
$c/= :: forall a. PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
== :: PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
$c== :: forall a. PBAsQUBOInfo a -> PBAsQUBOInfo a -> Bool
Eq, Int -> PBAsQUBOInfo a -> ShowS
[PBAsQUBOInfo a] -> ShowS
PBAsQUBOInfo a -> String
(Int -> PBAsQUBOInfo a -> ShowS)
-> (PBAsQUBOInfo a -> String)
-> ([PBAsQUBOInfo a] -> ShowS)
-> Show (PBAsQUBOInfo a)
forall a. Int -> PBAsQUBOInfo a -> ShowS
forall a. [PBAsQUBOInfo a] -> ShowS
forall a. PBAsQUBOInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PBAsQUBOInfo a] -> ShowS
$cshowList :: forall a. [PBAsQUBOInfo a] -> ShowS
show :: PBAsQUBOInfo a -> String
$cshow :: forall a. PBAsQUBOInfo a -> String
showsPrec :: Int -> PBAsQUBOInfo a -> ShowS
$cshowsPrec :: forall a. Int -> PBAsQUBOInfo a -> ShowS
Show, ReadPrec [PBAsQUBOInfo a]
ReadPrec (PBAsQUBOInfo a)
Int -> ReadS (PBAsQUBOInfo a)
ReadS [PBAsQUBOInfo a]
(Int -> ReadS (PBAsQUBOInfo a))
-> ReadS [PBAsQUBOInfo a]
-> ReadPrec (PBAsQUBOInfo a)
-> ReadPrec [PBAsQUBOInfo a]
-> Read (PBAsQUBOInfo a)
forall a. ReadPrec [PBAsQUBOInfo a]
forall a. ReadPrec (PBAsQUBOInfo a)
forall a. Int -> ReadS (PBAsQUBOInfo a)
forall a. ReadS [PBAsQUBOInfo a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PBAsQUBOInfo a]
$creadListPrec :: forall a. ReadPrec [PBAsQUBOInfo a]
readPrec :: ReadPrec (PBAsQUBOInfo a)
$creadPrec :: forall a. ReadPrec (PBAsQUBOInfo a)
readList :: ReadS [PBAsQUBOInfo a]
$creadList :: forall a. ReadS [PBAsQUBOInfo a]
readsPrec :: Int -> ReadS (PBAsQUBOInfo a)
$creadsPrec :: forall a. Int -> ReadS (PBAsQUBOInfo a)
Read)
instance Transformer (PBAsQUBOInfo a) where
type Source (PBAsQUBOInfo a) = SAT.Model
type Target (PBAsQUBOInfo a) = QUBO.Solution
instance ForwardTransformer (PBAsQUBOInfo a) where
transformForward :: PBAsQUBOInfo a
-> Source (PBAsQUBOInfo a) -> Target (PBAsQUBOInfo a)
transformForward (PBAsQUBOInfo Integer
_offset) Source (PBAsQUBOInfo a)
m = (Int, Int) -> (Int -> Int) -> UArray Int Bool -> UArray Int Bool
forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
ixmap (Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1,Int
ubInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) UArray Int Bool
Source (PBAsQUBOInfo a)
m
where
(Int
lb,Int
ub) = UArray Int Bool -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Bool
Source (PBAsQUBOInfo a)
m
instance BackwardTransformer (PBAsQUBOInfo a) where
transformBackward :: PBAsQUBOInfo a
-> Target (PBAsQUBOInfo a) -> Source (PBAsQUBOInfo a)
transformBackward (PBAsQUBOInfo Integer
_offset) Target (PBAsQUBOInfo a)
sol = (Int, Int) -> (Int -> Int) -> UArray Int Bool -> UArray Int Bool
forall (a :: * -> * -> *) e i j.
(IArray a e, Ix i, Ix j) =>
(i, i) -> (i -> j) -> a j e -> a i e
ixmap (Int
lbInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
ubInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1) UArray Int Bool
Target (PBAsQUBOInfo a)
sol
where
(Int
lb,Int
ub) = UArray Int Bool -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Bool
Target (PBAsQUBOInfo a)
sol
instance ObjValueTransformer (PBAsQUBOInfo a) where
type SourceObjValue (PBAsQUBOInfo a) = Integer
type TargetObjValue (PBAsQUBOInfo a) = a
instance Num a => ObjValueForwardTransformer (PBAsQUBOInfo a) where
transformObjValueForward :: PBAsQUBOInfo a
-> SourceObjValue (PBAsQUBOInfo a)
-> TargetObjValue (PBAsQUBOInfo a)
transformObjValueForward (PBAsQUBOInfo Integer
offset) SourceObjValue (PBAsQUBOInfo a)
obj = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
SourceObjValue (PBAsQUBOInfo a)
obj Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
offset)
instance Real a => ObjValueBackwardTransformer (PBAsQUBOInfo a) where
transformObjValueBackward :: PBAsQUBOInfo a
-> TargetObjValue (PBAsQUBOInfo a)
-> SourceObjValue (PBAsQUBOInfo a)
transformObjValueBackward (PBAsQUBOInfo Integer
offset) TargetObjValue (PBAsQUBOInfo a)
obj = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (a -> Rational
forall a. Real a => a -> Rational
toRational a
TargetObjValue (PBAsQUBOInfo a)
obj) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
offset
pb2qubo :: Real a => PBFile.Formula -> ((QUBO.Problem a, a), PB2QUBOInfo a)
pb2qubo :: Formula -> ((Problem a, a), PB2QUBOInfo a)
pb2qubo Formula
formula = ((Problem a
qubo, Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
th Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
offset)), PB2QUBOInfo' -> PBAsQUBOInfo a -> PB2QUBOInfo a
forall a b. a -> b -> ComposedTransformer a b
ComposedTransformer PB2QUBOInfo'
info1 PBAsQUBOInfo a
info2)
where
((Formula
qubo', Integer
th), PB2QUBOInfo'
info1) = Formula -> ((Formula, Integer), PB2QUBOInfo')
pb2qubo' Formula
formula
Just (Problem a
qubo, info2 :: PBAsQUBOInfo a
info2@(PBAsQUBOInfo Integer
offset)) = Formula -> Maybe (Problem a, PBAsQUBOInfo a)
forall a. Real a => Formula -> Maybe (Problem a, PBAsQUBOInfo a)
pbAsQUBO Formula
qubo'
type PB2QUBOInfo a = ComposedTransformer PB2QUBOInfo' (PBAsQUBOInfo a)
qubo2ising :: (Eq a, Show a, Fractional a) => QUBO.Problem a -> (QUBO.IsingModel a, QUBO2IsingInfo a)
qubo2ising :: Problem a -> (IsingModel a, QUBO2IsingInfo a)
qubo2ising QUBO.Problem{ quboNumVars :: forall a. Problem a -> Int
QUBO.quboNumVars = Int
n, quboMatrix :: forall a. Problem a -> IntMap (IntMap a)
QUBO.quboMatrix = IntMap (IntMap a)
qq } =
( IsingModel :: forall a. Int -> IntMap (IntMap a) -> IntMap a -> IsingModel a
QUBO.IsingModel
{ isingNumVars :: Int
QUBO.isingNumVars = Int
n
, isingInteraction :: IntMap (IntMap a)
QUBO.isingInteraction = IntMap (IntMap a) -> IntMap (IntMap a)
forall a. (Eq a, Num a) => IntMap (IntMap a) -> IntMap (IntMap a)
normalizeMat (IntMap (IntMap a) -> IntMap (IntMap a))
-> IntMap (IntMap a) -> IntMap (IntMap a)
forall a b. (a -> b) -> a -> b
$ IntMap (IntMap a)
jj'
, isingExternalMagneticField :: IntMap a
QUBO.isingExternalMagneticField = IntMap a -> IntMap a
forall a. (Eq a, Num a) => IntMap a -> IntMap a
normalizeVec IntMap a
h'
}
, a -> QUBO2IsingInfo a
forall a. a -> QUBO2IsingInfo a
QUBO2IsingInfo a
c'
)
where
(IntMap (IntMap a)
jj', IntMap a
h', a
c') = ((IntMap (IntMap a), IntMap a, a)
-> (IntMap (IntMap a), IntMap a, a)
-> (IntMap (IntMap a), IntMap a, a))
-> (IntMap (IntMap a), IntMap a, a)
-> [(IntMap (IntMap a), IntMap a, a)]
-> (IntMap (IntMap a), IntMap a, a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (IntMap (IntMap a), IntMap a, a)
-> (IntMap (IntMap a), IntMap a, a)
-> (IntMap (IntMap a), IntMap a, a)
forall a a c.
(Num a, Num a, Num c) =>
(IntMap (IntMap a), IntMap a, c)
-> (IntMap (IntMap a), IntMap a, c)
-> (IntMap (IntMap a), IntMap a, c)
f (IntMap (IntMap a)
forall a. IntMap a
IntMap.empty, IntMap a
forall a. IntMap a
IntMap.empty, a
0) ([(IntMap (IntMap a), IntMap a, a)]
-> (IntMap (IntMap a), IntMap a, a))
-> [(IntMap (IntMap a), IntMap a, a)]
-> (IntMap (IntMap a), IntMap a, a)
forall a b. (a -> b) -> a -> b
$ do
(Int
i, IntMap a
row) <- IntMap (IntMap a) -> [(Int, IntMap a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (IntMap a)
qq
(Int
j, a
q_ij) <- IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap a
row
if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
j then
(IntMap (IntMap a), IntMap a, a)
-> [(IntMap (IntMap a), IntMap a, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return
( Int -> IntMap a -> IntMap (IntMap a)
forall a. Int -> a -> IntMap a
IntMap.singleton (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
j) (IntMap a -> IntMap (IntMap a)) -> IntMap a -> IntMap (IntMap a)
forall a b. (a -> b) -> a -> b
$ Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
IntMap.singleton (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j) (a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
4)
, [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int
i, a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
4), (Int
j, a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
4)]
, a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
4
)
else
(IntMap (IntMap a), IntMap a, a)
-> [(IntMap (IntMap a), IntMap a, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return
( IntMap (IntMap a)
forall a. IntMap a
IntMap.empty
, Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
IntMap.singleton Int
i (a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2)
, a
q_ij a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
2
)
f :: (IntMap (IntMap a), IntMap a, c)
-> (IntMap (IntMap a), IntMap a, c)
-> (IntMap (IntMap a), IntMap a, c)
f (IntMap (IntMap a)
jj1, IntMap a
h1, c
c1) (IntMap (IntMap a)
jj2, IntMap a
h2, c
c2) =
( (IntMap a -> IntMap a -> IntMap a)
-> IntMap (IntMap a) -> IntMap (IntMap a) -> IntMap (IntMap a)
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith ((a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith a -> a -> a
forall a. Num a => a -> a -> a
(+)) IntMap (IntMap a)
jj1 IntMap (IntMap a)
jj2
, (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith a -> a -> a
forall a. Num a => a -> a -> a
(+) IntMap a
h1 IntMap a
h2
, c
c1c -> c -> c
forall a. Num a => a -> a -> a
+c
c2
)
data QUBO2IsingInfo a = QUBO2IsingInfo a
deriving (QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
(QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool)
-> (QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool)
-> Eq (QUBO2IsingInfo a)
forall a. Eq a => QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
$c/= :: forall a. Eq a => QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
== :: QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
$c== :: forall a. Eq a => QUBO2IsingInfo a -> QUBO2IsingInfo a -> Bool
Eq, Int -> QUBO2IsingInfo a -> ShowS
[QUBO2IsingInfo a] -> ShowS
QUBO2IsingInfo a -> String
(Int -> QUBO2IsingInfo a -> ShowS)
-> (QUBO2IsingInfo a -> String)
-> ([QUBO2IsingInfo a] -> ShowS)
-> Show (QUBO2IsingInfo a)
forall a. Show a => Int -> QUBO2IsingInfo a -> ShowS
forall a. Show a => [QUBO2IsingInfo a] -> ShowS
forall a. Show a => QUBO2IsingInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QUBO2IsingInfo a] -> ShowS
$cshowList :: forall a. Show a => [QUBO2IsingInfo a] -> ShowS
show :: QUBO2IsingInfo a -> String
$cshow :: forall a. Show a => QUBO2IsingInfo a -> String
showsPrec :: Int -> QUBO2IsingInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> QUBO2IsingInfo a -> ShowS
Show, ReadPrec [QUBO2IsingInfo a]
ReadPrec (QUBO2IsingInfo a)
Int -> ReadS (QUBO2IsingInfo a)
ReadS [QUBO2IsingInfo a]
(Int -> ReadS (QUBO2IsingInfo a))
-> ReadS [QUBO2IsingInfo a]
-> ReadPrec (QUBO2IsingInfo a)
-> ReadPrec [QUBO2IsingInfo a]
-> Read (QUBO2IsingInfo a)
forall a. Read a => ReadPrec [QUBO2IsingInfo a]
forall a. Read a => ReadPrec (QUBO2IsingInfo a)
forall a. Read a => Int -> ReadS (QUBO2IsingInfo a)
forall a. Read a => ReadS [QUBO2IsingInfo a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QUBO2IsingInfo a]
$creadListPrec :: forall a. Read a => ReadPrec [QUBO2IsingInfo a]
readPrec :: ReadPrec (QUBO2IsingInfo a)
$creadPrec :: forall a. Read a => ReadPrec (QUBO2IsingInfo a)
readList :: ReadS [QUBO2IsingInfo a]
$creadList :: forall a. Read a => ReadS [QUBO2IsingInfo a]
readsPrec :: Int -> ReadS (QUBO2IsingInfo a)
$creadsPrec :: forall a. Read a => Int -> ReadS (QUBO2IsingInfo a)
Read)
instance (Eq a, Show a) => Transformer (QUBO2IsingInfo a) where
type Source (QUBO2IsingInfo a) = QUBO.Solution
type Target (QUBO2IsingInfo a) = QUBO.Solution
instance (Eq a, Show a) => ForwardTransformer (QUBO2IsingInfo a) where
transformForward :: QUBO2IsingInfo a
-> Source (QUBO2IsingInfo a) -> Target (QUBO2IsingInfo a)
transformForward QUBO2IsingInfo a
_ Source (QUBO2IsingInfo a)
sol = Source (QUBO2IsingInfo a)
Target (QUBO2IsingInfo a)
sol
instance (Eq a, Show a) => BackwardTransformer (QUBO2IsingInfo a) where
transformBackward :: QUBO2IsingInfo a
-> Target (QUBO2IsingInfo a) -> Source (QUBO2IsingInfo a)
transformBackward QUBO2IsingInfo a
_ Target (QUBO2IsingInfo a)
sol = Source (QUBO2IsingInfo a)
Target (QUBO2IsingInfo a)
sol
instance ObjValueTransformer (QUBO2IsingInfo a) where
type SourceObjValue (QUBO2IsingInfo a) = a
type TargetObjValue (QUBO2IsingInfo a) = a
instance (Eq a, Show a, Num a) => ObjValueForwardTransformer (QUBO2IsingInfo a) where
transformObjValueForward :: QUBO2IsingInfo a
-> SourceObjValue (QUBO2IsingInfo a)
-> TargetObjValue (QUBO2IsingInfo a)
transformObjValueForward (QUBO2IsingInfo a
offset) SourceObjValue (QUBO2IsingInfo a)
obj = a
SourceObjValue (QUBO2IsingInfo a)
obj a -> a -> a
forall a. Num a => a -> a -> a
- a
offset
instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (QUBO2IsingInfo a) where
transformObjValueBackward :: QUBO2IsingInfo a
-> TargetObjValue (QUBO2IsingInfo a)
-> SourceObjValue (QUBO2IsingInfo a)
transformObjValueBackward (QUBO2IsingInfo a
offset) TargetObjValue (QUBO2IsingInfo a)
obj = a
TargetObjValue (QUBO2IsingInfo a)
obj a -> a -> a
forall a. Num a => a -> a -> a
+ a
offset
ising2qubo :: (Eq a, Num a) => QUBO.IsingModel a -> (QUBO.Problem a, Ising2QUBOInfo a)
ising2qubo :: IsingModel a -> (Problem a, Ising2QUBOInfo a)
ising2qubo QUBO.IsingModel{ isingNumVars :: forall a. IsingModel a -> Int
QUBO.isingNumVars = Int
n, isingInteraction :: forall a. IsingModel a -> IntMap (IntMap a)
QUBO.isingInteraction = IntMap (IntMap a)
jj, isingExternalMagneticField :: forall a. IsingModel a -> IntMap a
QUBO.isingExternalMagneticField = IntMap a
h } =
( Problem :: forall a. Int -> IntMap (IntMap a) -> Problem a
QUBO.Problem
{ quboNumVars :: Int
QUBO.quboNumVars = Int
n
, quboMatrix :: IntMap (IntMap a)
QUBO.quboMatrix = [(Int, Int, a)] -> IntMap (IntMap a)
forall a. (Eq a, Num a) => [(Int, Int, a)] -> IntMap (IntMap a)
mkMat [(Int, Int, a)]
m
}
, a -> Ising2QUBOInfo a
forall a. a -> Ising2QUBOInfo a
Ising2QUBOInfo a
offset
)
where
m :: [(Int, Int, a)]
m =
[[(Int, Int, a)]] -> [(Int, Int, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [(Int
i, Int
j, a
4 a -> a -> a
forall a. Num a => a -> a -> a
* a
jj_ij), (Int
i, Int
i, - a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
jj_ij), (Int
j, Int
j, - a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
jj_ij)]
| (Int
i, IntMap a
row) <- IntMap (IntMap a) -> [(Int, IntMap a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap (IntMap a)
jj, (Int
j, a
jj_ij) <- IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap a
row
] [(Int, Int, a)] -> [(Int, Int, a)] -> [(Int, Int, a)]
forall a. [a] -> [a] -> [a]
++
[ (Int
i, Int
i, a
2 a -> a -> a
forall a. Num a => a -> a -> a
* a
hi) | (Int
i, a
hi) <- IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IntMap.toList IntMap a
h ]
offset :: a
offset =
[a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [a
jj_ij | IntMap a
row <- IntMap (IntMap a) -> [IntMap a]
forall a. IntMap a -> [a]
IntMap.elems IntMap (IntMap a)
jj, a
jj_ij <- IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
row]
a -> a -> a
forall a. Num a => a -> a -> a
- [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (IntMap a -> [a]
forall a. IntMap a -> [a]
IntMap.elems IntMap a
h)
data Ising2QUBOInfo a = Ising2QUBOInfo a
deriving (Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
(Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool)
-> (Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool)
-> Eq (Ising2QUBOInfo a)
forall a. Eq a => Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
$c/= :: forall a. Eq a => Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
== :: Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
$c== :: forall a. Eq a => Ising2QUBOInfo a -> Ising2QUBOInfo a -> Bool
Eq, Int -> Ising2QUBOInfo a -> ShowS
[Ising2QUBOInfo a] -> ShowS
Ising2QUBOInfo a -> String
(Int -> Ising2QUBOInfo a -> ShowS)
-> (Ising2QUBOInfo a -> String)
-> ([Ising2QUBOInfo a] -> ShowS)
-> Show (Ising2QUBOInfo a)
forall a. Show a => Int -> Ising2QUBOInfo a -> ShowS
forall a. Show a => [Ising2QUBOInfo a] -> ShowS
forall a. Show a => Ising2QUBOInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ising2QUBOInfo a] -> ShowS
$cshowList :: forall a. Show a => [Ising2QUBOInfo a] -> ShowS
show :: Ising2QUBOInfo a -> String
$cshow :: forall a. Show a => Ising2QUBOInfo a -> String
showsPrec :: Int -> Ising2QUBOInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Ising2QUBOInfo a -> ShowS
Show, ReadPrec [Ising2QUBOInfo a]
ReadPrec (Ising2QUBOInfo a)
Int -> ReadS (Ising2QUBOInfo a)
ReadS [Ising2QUBOInfo a]
(Int -> ReadS (Ising2QUBOInfo a))
-> ReadS [Ising2QUBOInfo a]
-> ReadPrec (Ising2QUBOInfo a)
-> ReadPrec [Ising2QUBOInfo a]
-> Read (Ising2QUBOInfo a)
forall a. Read a => ReadPrec [Ising2QUBOInfo a]
forall a. Read a => ReadPrec (Ising2QUBOInfo a)
forall a. Read a => Int -> ReadS (Ising2QUBOInfo a)
forall a. Read a => ReadS [Ising2QUBOInfo a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ising2QUBOInfo a]
$creadListPrec :: forall a. Read a => ReadPrec [Ising2QUBOInfo a]
readPrec :: ReadPrec (Ising2QUBOInfo a)
$creadPrec :: forall a. Read a => ReadPrec (Ising2QUBOInfo a)
readList :: ReadS [Ising2QUBOInfo a]
$creadList :: forall a. Read a => ReadS [Ising2QUBOInfo a]
readsPrec :: Int -> ReadS (Ising2QUBOInfo a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Ising2QUBOInfo a)
Read)
instance (Eq a, Show a) => Transformer (Ising2QUBOInfo a) where
type Source (Ising2QUBOInfo a) = QUBO.Solution
type Target (Ising2QUBOInfo a) = QUBO.Solution
instance (Eq a, Show a) => ForwardTransformer (Ising2QUBOInfo a) where
transformForward :: Ising2QUBOInfo a
-> Source (Ising2QUBOInfo a) -> Target (Ising2QUBOInfo a)
transformForward Ising2QUBOInfo a
_ Source (Ising2QUBOInfo a)
sol = Source (Ising2QUBOInfo a)
Target (Ising2QUBOInfo a)
sol
instance (Eq a, Show a) => BackwardTransformer (Ising2QUBOInfo a) where
transformBackward :: Ising2QUBOInfo a
-> Target (Ising2QUBOInfo a) -> Source (Ising2QUBOInfo a)
transformBackward Ising2QUBOInfo a
_ Target (Ising2QUBOInfo a)
sol = Source (Ising2QUBOInfo a)
Target (Ising2QUBOInfo a)
sol
instance (Eq a, Show a) => ObjValueTransformer (Ising2QUBOInfo a) where
type SourceObjValue (Ising2QUBOInfo a) = a
type TargetObjValue (Ising2QUBOInfo a) = a
instance (Eq a, Show a, Num a) => ObjValueForwardTransformer (Ising2QUBOInfo a) where
transformObjValueForward :: Ising2QUBOInfo a
-> SourceObjValue (Ising2QUBOInfo a)
-> TargetObjValue (Ising2QUBOInfo a)
transformObjValueForward (Ising2QUBOInfo a
offset) SourceObjValue (Ising2QUBOInfo a)
obj = a
SourceObjValue (Ising2QUBOInfo a)
obj a -> a -> a
forall a. Num a => a -> a -> a
- a
offset
instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (Ising2QUBOInfo a) where
transformObjValueBackward :: Ising2QUBOInfo a
-> TargetObjValue (Ising2QUBOInfo a)
-> SourceObjValue (Ising2QUBOInfo a)
transformObjValueBackward (Ising2QUBOInfo a
offset) TargetObjValue (Ising2QUBOInfo a)
obj = a
TargetObjValue (Ising2QUBOInfo a)
obj a -> a -> a
forall a. Num a => a -> a -> a
+ a
offset
mkMat :: (Eq a, Num a) => [(Int,Int,a)] -> IntMap (IntMap a)
mkMat :: [(Int, Int, a)] -> IntMap (IntMap a)
mkMat [(Int, Int, a)]
m = IntMap (IntMap a) -> IntMap (IntMap a)
forall a. (Eq a, Num a) => IntMap (IntMap a) -> IntMap (IntMap a)
normalizeMat (IntMap (IntMap a) -> IntMap (IntMap a))
-> IntMap (IntMap a) -> IntMap (IntMap a)
forall a b. (a -> b) -> a -> b
$
(IntMap a -> IntMap a -> IntMap a)
-> [IntMap (IntMap a)] -> IntMap (IntMap a)
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
IntMap.unionsWith ((a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith a -> a -> a
forall a. Num a => a -> a -> a
(+)) ([IntMap (IntMap a)] -> IntMap (IntMap a))
-> [IntMap (IntMap a)] -> IntMap (IntMap a)
forall a b. (a -> b) -> a -> b
$
[Int -> IntMap a -> IntMap (IntMap a)
forall a. Int -> a -> IntMap a
IntMap.singleton Int
i (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
IntMap.singleton Int
j a
qij) | (Int
i,Int
j,a
qij) <- [(Int, Int, a)]
m]
normalizeMat :: (Eq a, Num a) => IntMap (IntMap a) -> IntMap (IntMap a)
normalizeMat :: IntMap (IntMap a) -> IntMap (IntMap a)
normalizeMat = (IntMap a -> Maybe (IntMap a))
-> IntMap (IntMap a) -> IntMap (IntMap a)
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybe ((\IntMap a
m -> if IntMap a -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap a
m then Maybe (IntMap a)
forall a. Maybe a
Nothing else IntMap a -> Maybe (IntMap a)
forall a. a -> Maybe a
Just IntMap a
m) (IntMap a -> Maybe (IntMap a))
-> (IntMap a -> IntMap a) -> IntMap a -> Maybe (IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> IntMap a
forall a. (Eq a, Num a) => IntMap a -> IntMap a
normalizeVec)
normalizeVec :: (Eq a, Num a) => IntMap a -> IntMap a
normalizeVec :: IntMap a -> IntMap a
normalizeVec = (a -> Bool) -> IntMap a -> IntMap a
forall a. (a -> Bool) -> IntMap a -> IntMap a
IntMap.filter (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
0)