{-# OPTIONS_GHC -Wall #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  ToySolver.Converter.PBSetObj
-- Copyright   :  (c) Masahiro Sakai 2013
-- License     :  BSD-style
--
-- Maintainer  :  masahiro.sakai@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-----------------------------------------------------------------------------
module ToySolver.Converter.PBSetObj
  ( ObjType (..)
  , setObj
  ) where

import qualified Data.PseudoBoolean as PBFile
import ToySolver.Converter.ObjType

setObj :: ObjType -> PBFile.Formula -> PBFile.Formula
setObj :: ObjType -> Formula -> Formula
setObj ObjType
objType Formula
formula = Formula
formula{ pbObjectiveFunction :: Maybe Sum
PBFile.pbObjectiveFunction = forall a. a -> Maybe a
Just Sum
obj2 }
  where
    obj2 :: Sum
obj2 = ObjType -> Formula -> Sum
genObj ObjType
objType Formula
formula

genObj :: ObjType -> PBFile.Formula -> PBFile.Sum
genObj :: ObjType -> Formula -> Sum
genObj ObjType
objType Formula
formula =
  case ObjType
objType of
    ObjType
ObjNone    -> []
    ObjType
ObjMaxOne  -> [(Integer
1,[-Int
v]) | Int
v <- [Int
1 .. Formula -> Int
PBFile.pbNumVars Formula
formula]] -- minimize false literals
    ObjType
ObjMaxZero -> [(Integer
1,[ Int
v]) | Int
v <- [Int
1 .. Formula -> Int
PBFile.pbNumVars Formula
formula]] -- minimize true literals