{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Documentation.SBV.Examples.Optimization.Enumerate where
import Data.SBV
data Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun
mkSymbolicEnumeration ''Day
type SDay = SBV Day
instance Metric Day where
type MetricSpace Day = Word8
toMetricSpace x = ite (x .== literal Mon) 0
$ ite (x .== literal Tue) 1
$ ite (x .== literal Wed) 2
$ ite (x .== literal Thu) 3
$ ite (x .== literal Fri) 4
$ ite (x .== literal Sat) 5
6
fromMetricSpace x = ite (x .== 0) (literal Mon)
$ ite (x .== 1) (literal Tue)
$ ite (x .== 2) (literal Wed)
$ ite (x .== 3) (literal Thu)
$ ite (x .== 4) (literal Fri)
$ ite (x .== 5) (literal Sat)
(literal Sun)
isWeekend :: SDay -> SBool
isWeekend = (`sElem` weekend)
where weekend = map literal [Sat, Sun]
almostWeekend :: IO OptimizeResult
almostWeekend = optimize Lexicographic $ do
day <- free "almostWeekend"
constrain $ sNot (isWeekend day)
maximize "last-day" day
weekendJustOver :: IO OptimizeResult
weekendJustOver = optimize Lexicographic $ do
day <- free "weekendJustOver"
constrain $ sNot (isWeekend day)
minimize "first-day" day
firstWeekend :: IO OptimizeResult
firstWeekend = optimize Lexicographic $ do
day <- free "firstWeekend"
constrain $ isWeekend day
minimize "first-weekend" day