msakai / toysolver / 513

Committed 24 Nov 2024 08:49AM UTC coverage: 68.675% (-1.0%) from 69.681%

Build # 513

Build Type

push

github

Committed by

web-flow

Commit Message

Merge 496ed4263 into 46e1509c4

Run Details

5 of 121 new or added lines in 7 files covered. (4.13%)

105 existing lines in 14 files now uncovered.

9745 of 14190 relevant lines covered (68.68%)

0.69 hits per line

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

70.75

/src/ToySolver/Converter/QUBO.hs

{-# OPTIONS_GHC -Wall #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 qualified Data.Aeson as J
import Data.Aeson ((.=))
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 prob =
  ( PBFile.Formula
    { PBFile.pbObjectiveFunction = Just $
        [ (c, if x1==x2 then [x1+1] else [x1+1, x2+1])
        | (x1, row) <- IntMap.toList m2
        , (x2, c) <- IntMap.toList row
        ]
    , PBFile.pbConstraints = []
    , PBFile.pbNumVars = QUBO.quboNumVars prob
    , PBFile.pbNumConstraints = 0
    }
  , QUBO2PBInfo d
  )
  where
    m1 = fmap (fmap toRational) $ QUBO.quboMatrix prob
    d = foldl' lcm 1 [denominator c | row <- IntMap.elems m1, c <- IntMap.elems row, c /= 0]
    m2 = fmap (fmap (\c -> numerator c * (d ` div` denominator c))) m1

newtype QUBO2PBInfo a = QUBO2PBInfo Integer
  deriving (Eq, Show, 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 _) sol = ixmap (lb+1,ub+1) (subtract 1) sol
    where
      (lb,ub) = bounds sol

instance (Eq a, Show a, Read a) => BackwardTransformer (QUBO2PBInfo a) where
  transformBackward (QUBO2PBInfo _) m = ixmap (lb-1,ub-1) (+1) m
    where
      (lb,ub) = bounds 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 d) obj = round (toRational obj) * d

instance (Eq a, Show a, Read a, Num a) => ObjValueBackwardTransformer (QUBO2PBInfo a) where
  transformObjValueBackward (QUBO2PBInfo d) obj = fromInteger $ (obj + d - 1) `div` d

instance J.ToJSON (QUBO2PBInfo a) where
  toJSON (QUBO2PBInfo d) =
    J.object
    [ "type" .= J.String "PBAsQUBOInfo"
    , "objective_function_multiply" .= d
    ]

-- -----------------------------------------------------------------------------

pbAsQUBO :: forall a. Real a => PBFile.Formula -> Maybe (QUBO.Problem a, PBAsQUBOInfo a)
pbAsQUBO formula = do
  (prob, offset) <- runStateT body 0
  return $ (prob, PBAsQUBOInfo offset)
  where
    body :: StateT Integer Maybe (QUBO.Problem a)
    body = do
      guard $ null (PBFile.pbConstraints formula)
      let f :: PBFile.WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)]
          f (c,[]) = modify (+c) >> return []
          f (c,[x]) = return [(c,x,x)]
          f (c,[x1,x2]) = return [(c,x1,x2)]
          f _ = mzero
      xs <- mapM f $ SAT.removeNegationFromPBSum $ fromMaybe [] $ PBFile.pbObjectiveFunction formula
      return $
        QUBO.Problem
        { QUBO.quboNumVars = PBFile.pbNumVars formula
        , QUBO.quboMatrix = mkMat $
            [ (x1', x2', fromInteger c)
            | (c,x1,x2) <- concat xs, let x1' = min x1 x2 - 1, let x2' = max x1 x2 - 1
            ]
        }

data PBAsQUBOInfo a = PBAsQUBOInfo !Integer
  deriving (Eq, Show, 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 _offset) m = ixmap (lb-1,ub-1) (+1) m
    where
      (lb,ub) = bounds m

instance BackwardTransformer (PBAsQUBOInfo a) where
  transformBackward (PBAsQUBOInfo _offset) sol = ixmap (lb+1,ub+1) (subtract 1) sol
    where
      (lb,ub) = bounds 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 offset) obj = fromInteger (obj - offset)

instance Real a => ObjValueBackwardTransformer (PBAsQUBOInfo a) where
  transformObjValueBackward (PBAsQUBOInfo offset) obj = round (toRational obj) + offset

instance J.ToJSON (PBAsQUBOInfo a) where
  toJSON (PBAsQUBOInfo offset) =
    J.object
    [ "type" .= J.String "PBAsQUBOInfo"
    , "objective_function_subtract" .= offset
    ]

-- -----------------------------------------------------------------------------

pb2qubo :: Real a => PBFile.Formula -> ((QUBO.Problem a, a), PB2QUBOInfo a)
pb2qubo formula = ((qubo, fromInteger (th - offset)), ComposedTransformer info1 info2)
  where
    ((qubo', th), info1) = pb2qubo' formula
    Just (qubo, info2@(PBAsQUBOInfo offset)) = pbAsQUBO qubo'

type PB2QUBOInfo a = ComposedTransformer PB2QUBOInfo' (PBAsQUBOInfo a)

-- -----------------------------------------------------------------------------

qubo2ising :: (Eq a, Show a, Fractional a) => QUBO.Problem a -> (QUBO.IsingModel a, QUBO2IsingInfo a)
qubo2ising QUBO.Problem{ QUBO.quboNumVars = n, QUBO.quboMatrix = qq } =
  ( QUBO.IsingModel
    { QUBO.isingNumVars = n
    , QUBO.isingInteraction = normalizeMat $ jj'
    , QUBO.isingExternalMagneticField = normalizeVec h'
    }
  , QUBO2IsingInfo 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).
    -}
    (jj', h', c') = foldl' f (IntMap.empty, IntMap.empty, 0) $ do
      (i, row)  <- IntMap.toList qq
      (j, q_ij) <- IntMap.toList row
      if i /= j then
        return
          ( IntMap.singleton (min i j) $ IntMap.singleton (max i j) (q_ij / 4)
          , IntMap.fromList [(i, q_ij / 4), (j, q_ij / 4)]
          , q_ij / 4
          )
      else
        return
          ( IntMap.empty
          , IntMap.singleton i (q_ij / 2)
          , q_ij / 2
          )

    f (jj1, h1, c1) (jj2, h2, c2) =
      ( IntMap.unionWith (IntMap.unionWith (+)) jj1 jj2
      , IntMap.unionWith (+) h1 h2
      , c1+c2
      )

data QUBO2IsingInfo a = QUBO2IsingInfo a
  deriving (Eq, Show, 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 _ sol = sol

instance (Eq a, Show a) => BackwardTransformer (QUBO2IsingInfo a) where
  transformBackward _ sol = 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 offset) obj = obj - offset

instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (QUBO2IsingInfo a) where
  transformObjValueBackward (QUBO2IsingInfo offset) obj = obj + offset

-- -----------------------------------------------------------------------------

ising2qubo :: (Eq a, Num a) => QUBO.IsingModel a -> (QUBO.Problem a, Ising2QUBOInfo a)
ising2qubo QUBO.IsingModel{ QUBO.isingNumVars = n, QUBO.isingInteraction = jj, QUBO.isingExternalMagneticField = h } =
  ( QUBO.Problem
    { QUBO.quboNumVars = n
    , QUBO.quboMatrix = mkMat m
    }
  , Ising2QUBOInfo 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 =
      concat
      [ [(i, j, 4 * jj_ij), (i, i,  - 2 * jj_ij), (j, j,  - 2 * jj_ij)]
      | (i, row) <- IntMap.toList jj, (j, jj_ij) <- IntMap.toList row
      ] ++
      [ (i, i,  2 * hi) | (i, hi) <- IntMap.toList h ]
    offset =
        sum [jj_ij | row <- IntMap.elems jj, jj_ij <- IntMap.elems row]
      - sum (IntMap.elems h)

data Ising2QUBOInfo a = Ising2QUBOInfo a
  deriving (Eq, Show, 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 _ sol = sol

instance (Eq a, Show a) => BackwardTransformer (Ising2QUBOInfo a) where
  transformBackward _ sol = 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 offset) obj = obj - offset

instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (Ising2QUBOInfo a) where
  transformObjValueBackward (Ising2QUBOInfo offset) obj = obj + offset

-- -----------------------------------------------------------------------------

mkMat :: (Eq a, Num a) => [(Int,Int,a)] -> IntMap (IntMap a)
mkMat m = normalizeMat $
  IntMap.unionsWith (IntMap.unionWith (+)) $
  [IntMap.singleton i (IntMap.singleton j qij) | (i,j,qij) <- m]

normalizeMat :: (Eq a, Num a) => IntMap (IntMap a) -> IntMap (IntMap a)
normalizeMat = IntMap.mapMaybe ((\m -> if IntMap.null m then Nothing else Just m) . normalizeVec)

normalizeVec :: (Eq a, Num a) => IntMap a -> IntMap a
normalizeVec = IntMap.filter (/=0)

1	{-# OPTIONS_GHC -Wall #-}
2	{-# OPTIONS_HADDOCK show-extensions #-}
3	{-# LANGUAGE OverloadedStrings #-}
4	{-# LANGUAGE ScopedTypeVariables #-}
5	{-# LANGUAGE TypeFamilies #-}
6	-----------------------------------------------------------------------------
7	-- \|
8	-- Module : ToySolver.Converter.QUBO
9	-- Copyright : (c) Masahiro Sakai 2018
10	-- License : BSD-style
11	--
12	-- Maintainer : masahiro.sakai@gmail.com
13	-- Stability : provisional
14	-- Portability : non-portable
15	--
16	-----------------------------------------------------------------------------
17	module ToySolver.Converter.QUBO
18	( qubo2pb
19	, QUBO2PBInfo (..)
20
21	, pb2qubo
22	, PB2QUBOInfo
23
24	, pbAsQUBO
25	, PBAsQUBOInfo (..)
26
27	, qubo2ising
28	, QUBO2IsingInfo (..)
29
30	, ising2qubo
31	, Ising2QUBOInfo (..)
32	) where
33
34	import Control.Monad
35	import Control.Monad.State
36	import qualified Data.Aeson as J
37	import Data.Aeson ((.=))
38	import Data.Array.Unboxed
39	import Data.IntMap.Strict (IntMap)
40	import qualified Data.IntMap.Strict as IntMap
41	import Data.List
42	import Data.Maybe
43	import qualified Data.PseudoBoolean as PBFile
44	import Data.Ratio
45	import ToySolver.Converter.Base
46	import ToySolver.Converter.PB (pb2qubo', PB2QUBOInfo')
47	import qualified ToySolver.QUBO as QUBO
48	import qualified ToySolver.SAT.Types as SAT
49
50	-- -----------------------------------------------------------------------------
51
52	qubo2pb :: Real a => QUBO.Problem a -> (PBFile.Formula, QUBO2PBInfo a)
53	qubo2pb prob =	1✔
54	( PBFile.Formula	1✔
55	{ PBFile.pbObjectiveFunction = Just $	1✔
56	[ (c, if x1==x2 then [x1+1] else [x1+1, x2+1])	1✔
57	\| (x1, row) <- IntMap.toList m2	1✔
58	, (x2, c) <- IntMap.toList row	1✔
59	]
60	, PBFile.pbConstraints = []	1✔
61	, PBFile.pbNumVars = QUBO.quboNumVars prob	1✔
62	, PBFile.pbNumConstraints = 0	1✔
63	}
64	, QUBO2PBInfo d	×
65	)
66	where
67	m1 = fmap (fmap toRational) $ QUBO.quboMatrix prob	1✔
68	d = foldl' lcm 1 [denominator c \| row <- IntMap.elems m1, c <- IntMap.elems row, c /= 0]	×
69	m2 = fmap (fmap (\c -> numerator c * (d ` div` denominator c))) m1	1✔
70
71	newtype QUBO2PBInfo a = QUBO2PBInfo Integer
72	deriving (Eq, Show, Read)	×
73
74	instance (Eq a, Show a, Read a) => Transformer (QUBO2PBInfo a) where
75	type Source (QUBO2PBInfo a) = QUBO.Solution
76	type Target (QUBO2PBInfo a) = SAT.Model
77
78	instance (Eq a, Show a, Read a) => ForwardTransformer (QUBO2PBInfo a) where
79	transformForward (QUBO2PBInfo _) sol = ixmap (lb+1,ub+1) (subtract 1) sol	×
80	where
81	(lb,ub) = bounds sol	×
82
83	instance (Eq a, Show a, Read a) => BackwardTransformer (QUBO2PBInfo a) where
84	transformBackward (QUBO2PBInfo _) m = ixmap (lb-1,ub-1) (+1) m	×
85	where
86	(lb,ub) = bounds m	×
87
88	instance (Eq a, Show a, Read a) => ObjValueTransformer (QUBO2PBInfo a) where
89	type SourceObjValue (QUBO2PBInfo a) = a
90	type TargetObjValue (QUBO2PBInfo a) = Integer
91
92	instance (Eq a, Show a, Read a, Real a) => ObjValueForwardTransformer (QUBO2PBInfo a) where
93	transformObjValueForward (QUBO2PBInfo d) obj = round (toRational obj) * d	×
94
95	instance (Eq a, Show a, Read a, Num a) => ObjValueBackwardTransformer (QUBO2PBInfo a) where
96	transformObjValueBackward (QUBO2PBInfo d) obj = fromInteger $ (obj + d - 1) `div` d	×
97
NEW 98	instance J.ToJSON (QUBO2PBInfo a) where	×
NEW 99	toJSON (QUBO2PBInfo d) =	×
NEW 100	J.object	×
NEW 101	[ "type" .= J.String "PBAsQUBOInfo"	×
NEW 102	, "objective_function_multiply" .= d	×
103	]
104
105	-- -----------------------------------------------------------------------------
106
107	pbAsQUBO :: forall a. Real a => PBFile.Formula -> Maybe (QUBO.Problem a, PBAsQUBOInfo a)
108	pbAsQUBO formula = do	1✔
109	(prob, offset) <- runStateT body 0	1✔
110	return $ (prob, PBAsQUBOInfo offset)	1✔
111	where
112	body :: StateT Integer Maybe (QUBO.Problem a)
113	body = do	1✔
114	guard $ null (PBFile.pbConstraints formula)	1✔
115	let f :: PBFile.WeightedTerm -> StateT Integer Maybe [(Integer, Int, Int)]
116	f (c,[]) = modify (+c) >> return []	1✔
117	f (c,[x]) = return [(c,x,x)]	1✔
118	f (c,[x1,x2]) = return [(c,x1,x2)]	1✔
119	f _ = mzero	×
120	xs <- mapM f $ SAT.removeNegationFromPBSum $ fromMaybe [] $ PBFile.pbObjectiveFunction formula	×
121	return $	1✔
122	QUBO.Problem	1✔
123	{ QUBO.quboNumVars = PBFile.pbNumVars formula	1✔
124	, QUBO.quboMatrix = mkMat $	1✔
125	[ (x1', x2', fromInteger c)	1✔
126	\| (c,x1,x2) <- concat xs, let x1' = min x1 x2 - 1, let x2' = max x1 x2 - 1	1✔
127	]
128	}
129
130	data PBAsQUBOInfo a = PBAsQUBOInfo !Integer
131	deriving (Eq, Show, Read)	×
132
133	instance Transformer (PBAsQUBOInfo a) where
134	type Source (PBAsQUBOInfo a) = SAT.Model
135	type Target (PBAsQUBOInfo a) = QUBO.Solution
136
137	instance ForwardTransformer (PBAsQUBOInfo a) where
138	transformForward (PBAsQUBOInfo _offset) m = ixmap (lb-1,ub-1) (+1) m	1✔
139	where
140	(lb,ub) = bounds m	1✔
141
142	instance BackwardTransformer (PBAsQUBOInfo a) where
143	transformBackward (PBAsQUBOInfo _offset) sol = ixmap (lb+1,ub+1) (subtract 1) sol	1✔
144	where
145	(lb,ub) = bounds sol	1✔
146
147	instance ObjValueTransformer (PBAsQUBOInfo a) where
148	type SourceObjValue (PBAsQUBOInfo a) = Integer
149	type TargetObjValue (PBAsQUBOInfo a) = a
150
151	instance Num a => ObjValueForwardTransformer (PBAsQUBOInfo a) where
152	transformObjValueForward (PBAsQUBOInfo offset) obj = fromInteger (obj - offset)	1✔
153
154	instance Real a => ObjValueBackwardTransformer (PBAsQUBOInfo a) where
155	transformObjValueBackward (PBAsQUBOInfo offset) obj = round (toRational obj) + offset	1✔
156
NEW 157	instance J.ToJSON (PBAsQUBOInfo a) where	×
NEW 158	toJSON (PBAsQUBOInfo offset) =	×
NEW 159	J.object	×
NEW 160	[ "type" .= J.String "PBAsQUBOInfo"	×
NEW 161	, "objective_function_subtract" .= offset	×
162	]
163
164	-- -----------------------------------------------------------------------------
165
166	pb2qubo :: Real a => PBFile.Formula -> ((QUBO.Problem a, a), PB2QUBOInfo a)
167	pb2qubo formula = ((qubo, fromInteger (th - offset)), ComposedTransformer info1 info2)	1✔
168	where
169	((qubo', th), info1) = pb2qubo' formula	1✔
170	Just (qubo, info2@(PBAsQUBOInfo offset)) = pbAsQUBO qubo'	1✔
171
172	type PB2QUBOInfo a = ComposedTransformer PB2QUBOInfo' (PBAsQUBOInfo a)
173
174	-- -----------------------------------------------------------------------------
175
176	qubo2ising :: (Eq a, Show a, Fractional a) => QUBO.Problem a -> (QUBO.IsingModel a, QUBO2IsingInfo a)
177	qubo2ising QUBO.Problem{ QUBO.quboNumVars = n, QUBO.quboMatrix = qq } =	1✔
178	( QUBO.IsingModel	1✔
179	{ QUBO.isingNumVars = n	1✔
180	, QUBO.isingInteraction = normalizeMat $ jj'	1✔
181	, QUBO.isingExternalMagneticField = normalizeVec h'	1✔
182	}
183	, QUBO2IsingInfo c'	1✔
184	)
185	where
186	{-
187	Let xi = (si + 1)/2.
188
189	Then,
190	Qij xi xj
191	= Qij (si + 1)/2 (sj + 1)/2
192	= 1/4 Qij (si sj + si + sj + 1).
193
194	Also,
195	Qii xi xi
196	= Qii (si + 1)/2 (si + 1)/2
197	= 1/4 Qii (si si + 2 si + 1)
198	= 1/4 Qii (2 si + 2).
199	-}
200	(jj', h', c') = foldl' f (IntMap.empty, IntMap.empty, 0) $ do	1✔
201	(i, row) <- IntMap.toList qq	1✔
202	(j, q_ij) <- IntMap.toList row	1✔
203	if i /= j then	1✔
204	return	1✔
205	( IntMap.singleton (min i j) $ IntMap.singleton (max i j) (q_ij / 4)	1✔
206	, IntMap.fromList [(i, q_ij / 4), (j, q_ij / 4)]	1✔
207	, q_ij / 4	1✔
208	)
209	else
210	return	1✔
211	( IntMap.empty	1✔
212	, IntMap.singleton i (q_ij / 2)	1✔
213	, q_ij / 2	1✔
214	)
215
216	f (jj1, h1, c1) (jj2, h2, c2) =	1✔
217	( IntMap.unionWith (IntMap.unionWith (+)) jj1 jj2	×
218	, IntMap.unionWith (+) h1 h2	1✔
219	, c1+c2	1✔
220	)
221
222	data QUBO2IsingInfo a = QUBO2IsingInfo a
223	deriving (Eq, Show, Read)	×
224
225	instance (Eq a, Show a) => Transformer (QUBO2IsingInfo a) where
226	type Source (QUBO2IsingInfo a) = QUBO.Solution
227	type Target (QUBO2IsingInfo a) = QUBO.Solution
228
229	instance (Eq a, Show a) => ForwardTransformer (QUBO2IsingInfo a) where
230	transformForward _ sol = sol	×
231
232	instance (Eq a, Show a) => BackwardTransformer (QUBO2IsingInfo a) where
233	transformBackward _ sol = sol	×
234
235	instance ObjValueTransformer (QUBO2IsingInfo a) where
236	type SourceObjValue (QUBO2IsingInfo a) = a
237	type TargetObjValue (QUBO2IsingInfo a) = a
238
239	instance (Eq a, Show a, Num a) => ObjValueForwardTransformer (QUBO2IsingInfo a) where
240	transformObjValueForward (QUBO2IsingInfo offset) obj = obj - offset	1✔
241
242	instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (QUBO2IsingInfo a) where
243	transformObjValueBackward (QUBO2IsingInfo offset) obj = obj + offset	×
244
245	-- -----------------------------------------------------------------------------
246
247	ising2qubo :: (Eq a, Num a) => QUBO.IsingModel a -> (QUBO.Problem a, Ising2QUBOInfo a)
248	ising2qubo QUBO.IsingModel{ QUBO.isingNumVars = n, QUBO.isingInteraction = jj, QUBO.isingExternalMagneticField = h } =	1✔
249	( QUBO.Problem	1✔
250	{ QUBO.quboNumVars = n	1✔
251	, QUBO.quboMatrix = mkMat m	1✔
252	}
253	, Ising2QUBOInfo offset	1✔
254	)
255	where
256	{-
257	Let si = 2 xi - 1
258
259	Then,
260	Jij si sj
261	= Jij (2 xi - 1) (2 xj - 1)
262	= Jij (4 xi xj - 2 xi - 2 xj + 1)
263	= 4 Jij xi xj - 2 Jij xi - 2 Jij xj + Jij
264	= 4 Jij xi xj - 2 Jij xi xi - 2 Jij xj xj + Jij
265
266	hi si
267	= hi (2 xi - 1)
268	= 2 hi xi - hi
269	= 2 hi xi xi - hi
270	-}
271	m =	1✔
272	concat	1✔
273	[ [(i, j, 4 * jj_ij), (i, i, - 2 * jj_ij), (j, j, - 2 * jj_ij)]	1✔
274	\| (i, row) <- IntMap.toList jj, (j, jj_ij) <- IntMap.toList row	1✔
275	] ++
276	[ (i, i, 2 * hi) \| (i, hi) <- IntMap.toList h ]	1✔
277	offset =	1✔
278	sum [jj_ij \| row <- IntMap.elems jj, jj_ij <- IntMap.elems row]	1✔
279	- sum (IntMap.elems h)	1✔
280
281	data Ising2QUBOInfo a = Ising2QUBOInfo a
282	deriving (Eq, Show, Read)	×
283
284	instance (Eq a, Show a) => Transformer (Ising2QUBOInfo a) where
285	type Source (Ising2QUBOInfo a) = QUBO.Solution
286	type Target (Ising2QUBOInfo a) = QUBO.Solution
287
288	instance (Eq a, Show a) => ForwardTransformer (Ising2QUBOInfo a) where
289	transformForward _ sol = sol	×
290
291	instance (Eq a, Show a) => BackwardTransformer (Ising2QUBOInfo a) where
292	transformBackward _ sol = sol	×
293
294	instance (Eq a, Show a) => ObjValueTransformer (Ising2QUBOInfo a) where
295	type SourceObjValue (Ising2QUBOInfo a) = a
296	type TargetObjValue (Ising2QUBOInfo a) = a
297
298	instance (Eq a, Show a, Num a) => ObjValueForwardTransformer (Ising2QUBOInfo a) where
299	transformObjValueForward (Ising2QUBOInfo offset) obj = obj - offset	1✔
300
301	instance (Eq a, Show a, Num a) => ObjValueBackwardTransformer (Ising2QUBOInfo a) where
302	transformObjValueBackward (Ising2QUBOInfo offset) obj = obj + offset	×
303
304	-- -----------------------------------------------------------------------------
305
306	mkMat :: (Eq a, Num a) => [(Int,Int,a)] -> IntMap (IntMap a)
307	mkMat m = normalizeMat $	1✔
308	IntMap.unionsWith (IntMap.unionWith (+)) $	1✔
309	[IntMap.singleton i (IntMap.singleton j qij) \| (i,j,qij) <- m]	1✔
310
311	normalizeMat :: (Eq a, Num a) => IntMap (IntMap a) -> IntMap (IntMap a)
312	normalizeMat = IntMap.mapMaybe ((\m -> if IntMap.null m then Nothing else Just m) . normalizeVec)	1✔
313
314	normalizeVec :: (Eq a, Num a) => IntMap a -> IntMap a
315	normalizeVec = IntMap.filter (/=0)	1✔

msakai / toysolver / 513

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