{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Converter.QUBO
-- Copyright   :  (c) Masahiro Sakai 2018
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  provisional
-- Portability :  non-portable
--
-----------------------------------------------------------------------------
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
    {-
       Let xi = (si + 1)/2.

       Then,
         Qij xi xj
       = Qij (si + 1)/2 (sj + 1)/2
       = 1/4 Qij (si sj + si + sj + 1).

       Also,
         Qii xi xi
       = Qii (si + 1)/2 (si + 1)/2
       = 1/4 Qii (si si + 2 si + 1)
       = 1/4 Qii (2 si + 2).
    -}
    (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
    {-
       Let si = 2 xi - 1

       Then,
         Jij si sj
       = Jij (2 xi - 1) (2 xj - 1)
       = Jij (4 xi xj - 2 xi - 2 xj + 1)
       = 4 Jij xi xj - 2 Jij xi    - 2 Jij xj    + Jij
       = 4 Jij xi xj - 2 Jij xi xi - 2 Jij xj xj + Jij

         hi si
       = hi (2 xi - 1)
       = 2 hi xi - hi
       = 2 hi xi xi - hi
    -}
    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)