feat(meta): split input and output variables

src/MCSP/Data/Meta.hs

@@ -1,17 +1,19 @@
 -- | Additional variables and parameters.
 module MCSP.Data.Meta (
-    MetaVariable,
-
     -- * Collection of variables
     VariableMap,
     lookup,
 
+    -- * Data Class
+    MetaInputVariable (..),
+    MetaOutputVariable (..),
+
     -- * Monadic operations
     Meta,
-    setVar,
+    getOrDefine,
+    setOutputVar,
+    inspect,
     (<::),
-    getVar,
-    getVarOrDefault,
 
     -- ** Execution
     evalMeta,
@@ -28,11 +30,6 @@ import Data.TypeMap.Dynamic.Alt qualified as Map (Item, TypeMap, empty, insert,
 import Data.Typeable (Typeable, showsTypeRep, typeOf)
 import Text.Show (Show (..), showChar, showListWith, showString)
 
--- | Represents a additional variable that can be used as input or output of a computation.
---
--- These variables are set and resolved dynamically inside the `Meta` monad.
-class Typeable v => MetaVariable v
-
 -- ---------- --
 -- Collection --
 
@@ -60,104 +57,127 @@ empty :: VariableMap
 empty = VariableMap Map.empty
 {-# INLINEABLE empty #-}
 
--- | Return `Just` the value a `MetaVariable` of the given type, or `Nothing` if no such variable is
+-- | Insert a meta-variable into the map.
+--
+-- >>> import Prelude (Int)
+--
+-- >>> insert @Int 12 empty
+-- VariableMap [Int]
+insert :: Typeable v => v -> VariableMap -> VariableMap
+insert value (VariableMap vm) = VariableMap (Map.insert value vm)
+{-# INLINEABLE insert #-}
+
+-- | Return `Just` the value a meta-variable of the given type, or `Nothing` if no such variable is
 -- available.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
 -- >>> lookup @Int empty
 -- Nothing
 --
 -- >>> let (_, vars) = runMeta (setVar (12 :: Int))
 -- >>> lookup @Int vars
 -- Just 12
-lookup :: MetaVariable v => VariableMap -> Maybe v
+lookup :: Typeable v => VariableMap -> Maybe v
 lookup (VariableMap vars) = Map.lookup vars
 {-# INLINEABLE lookup #-}
 
 -- | Return the previous value of a `MetaVariable` of the given type, or insert and return the
--- default values if no such variable is available.
+-- default value if no such variable is available.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
 -- >>> lookupOrInsert (12 :: Int) empty
 -- (12,VariableMap [Int])
 --
 -- >>> let (_, vars) = runMeta (setVar (34 :: Int))
 -- >>> lookupOrInsert (12 :: Int) vars
 -- (34,VariableMap [Int])
-lookupOrInsert :: MetaVariable v => v -> VariableMap -> (v, VariableMap)
+lookupOrInsert :: Typeable v => v -> VariableMap -> (v, VariableMap)
 lookupOrInsert defaultValue vars = case lookup vars of
     Just value -> (value, vars)
     Nothing -> (defaultValue, insert defaultValue vars)
-  where
-    insert value (VariableMap vm) = VariableMap $ Map.insert value vm
 {-# INLINEABLE lookupOrInsert #-}
 
+-- ---------------------- --
+-- Dynamic Variable Class --
+
+-- | Represents a additional variable that can be used as input of a computation.
+--
+-- These variables are set and resolved dynamically inside the `Meta` monad.
+class Typeable v => MetaInputVariable v where
+    -- | Extracts the input variable, possibly modifying the environment.
+    getVar :: Meta v
+
+-- | Represents a additional variable that can be set as output of a computation.
+--
+-- These variables are set and resolved dynamically inside the `Meta` monad.
+class Typeable v => MetaOutputVariable v where
+    -- | Updates the output variable, possibly modifying the environment.
+    setVar :: v -> Meta ()
+    setVar = setOutputVar
+
 -- ----------------- --
 -- Monadic Operation --
 
--- | A monad that represents operation with `MetaVariable`s.
+-- | A monad that represents operation with meta-variables.
 --
 -- The meta-variables may be used as input, output or both.
 newtype Meta a = Meta (State VariableMap a)
     deriving newtype (Functor, Applicative, Monad)
 
--- | Set meta-variable for the given type.
+-- | Get the value of an input meta-variable or set a default one.
+--
+-- >>> import Prelude (String)
+-- >>> instance MetaInputVariable String where getVar = getOrDefine ""
+--
+-- >>> runMeta (getOrDefine "default")
+-- ("default",VariableMap [[Char]])
+--
+-- >>> runMeta (getOrDefine "default" <:: "pre-set")
+-- ("pre-set",VariableMap [[Char]])
+getOrDefine :: MetaInputVariable v => v -> Meta v
+getOrDefine value = Meta $ state (lookupOrInsert value)
+{-# INLINEABLE getOrDefine #-}
+
+-- | Set the value of meta-variable for the given type, without any additional side-effect.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int where
+-- >>>     setVar = setOutputVar
 --
--- >>> runMeta (setVar (12 :: Int))
+-- >>> runMeta (setOutputVar @Int 12)
 -- ((),VariableMap [Int])
-setVar :: MetaVariable v => v -> Meta ()
-setVar value = Meta $ modify $ variableMap (Map.insert value)
-  where
-    variableMap f (VariableMap vm) = VariableMap (f vm)
-{-# INLINEABLE setVar #-}
+setOutputVar :: MetaOutputVariable v => v -> Meta ()
+setOutputVar value = Meta (modify $ insert value)
+{-# INLINEABLE setOutputVar #-}
 
--- | Set a meta-variable for the given type.
---
--- Infix version of `setVar`.
+-- | Set an input meta-variable for the given type.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaInputVariable Int where getVar = getOrDefine 0
 --
 -- >>> runMeta (getVar @Int <:: (12 :: Int))
--- (Just 12,VariableMap [Int])
-(<::) :: MetaVariable v => Meta a -> v -> Meta a
-m <:: value = setVar value >> m
+-- (12,VariableMap [Int])
+(<::) :: MetaInputVariable v => Meta a -> v -> Meta a
+m <:: value = Meta (modify $ insert value) >> m
 {-# INLINEABLE (<::) #-}
 
 -- | Get a meta-variable for the expected type.
 --
 -- >>> import Prelude (Int)
--- >>> instance MetaVariable Int
+-- >>> instance MetaOutputVariable Int
 --
--- >>> runMeta (getVar @Int)
+-- >>> runMeta (inspect @Int)
 -- (Nothing,VariableMap [])
 --
--- >>> runMeta (getVar @Int <:: (12 :: Int))
+-- >>> runMeta (setVar (12 :: Int) >> inspect @Int)
 -- (Just 12,VariableMap [Int])
-getVar :: MetaVariable v => Meta (Maybe v)
-getVar = Meta $ gets lookup
-{-# INLINEABLE getVar #-}
-
--- | Get the value of a meta-variable or set a default one.
---
--- >>> import Prelude (String)
--- >>> instance MetaVariable String
---
--- >>> runMeta (getVarOrDefault "default")
--- ("default",VariableMap [[Char]])
---
--- >>> runMeta (getVarOrDefault "default" <:: "pre-set")
--- ("pre-set",VariableMap [[Char]])
-getVarOrDefault :: MetaVariable v => v -> Meta v
-getVarOrDefault value = Meta $ state (lookupOrInsert value)
-{-# INLINEABLE getVarOrDefault #-}
+inspect :: MetaOutputVariable v => Meta (Maybe v)
+inspect = Meta $ gets lookup
+{-# INLINEABLE inspect #-}
 
 -- | Execute a `Meta` monad and return the output.
 evalMeta :: Meta a -> a

src/MCSP/Heuristics/Combine.hs

@@ -9,7 +9,7 @@ import Prelude hiding (String, concat, (++))
 
 import Data.Set (Set)
 
-import MCSP.Data.Meta (Meta, MetaVariable, getVarOrDefault)
+import MCSP.Data.Meta (Meta, MetaInputVariable (..), getOrDefine)
 import MCSP.Data.Pair (Pair, both, first, second)
 import MCSP.Data.String (String (..), Unbox, concat, (++))
 import MCSP.Data.String.Extra (Partition, chars, hasOneOf, singletons)
@@ -109,7 +109,8 @@ combineWithSingletons (x, y)
 newtype UseSingletons = UseSingletons Bool
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable UseSingletons
+instance MetaInputVariable UseSingletons where
+    getVar = getOrDefine (UseSingletons True)
 
 -- | MSCP combine heuristic.
 --
@@ -120,7 +121,7 @@ combine strs@(Unboxed, _) = combineP (chars `both` strs)
 -- | Lifted MSCP combine heuristic.
 combineP :: (Unbox a, Ord a) => Pair (Partition a) -> Meta (Pair (Partition a))
 combineP parts = do
-    UseSingletons withSingletons <- getVarOrDefault (UseSingletons True)
+    UseSingletons withSingletons <- getVar
     pure $
         if withSingletons
             then combineWithSingletons parts

src/MCSP/Heuristics/PSOBased.hs

@@ -25,7 +25,6 @@ import Data.Int (Int)
 import Data.List qualified as List (take)
 import Data.List.Extra (sumOn')
 import Data.List.NonEmpty (NonEmpty (..))
-import Data.Maybe (fromMaybe)
 import Data.Ord (Ord (..))
 import Data.Semigroup (Last (..), Min (..))
 import Data.Vector.Unboxed (Vector, length, map)
@@ -63,7 +62,16 @@ import MCSP.Data.MatchingGraph (
     solution,
     toPartitions,
  )
-import MCSP.Data.Meta (Meta, MetaVariable, evalMeta, getVar, getVarOrDefault, setVar, (<::))
+import MCSP.Data.Meta (
+    Meta,
+    MetaInputVariable (..),
+    MetaOutputVariable (..),
+    evalMeta,
+    getOrDefine,
+    getVar,
+    setVar,
+    (<::),
+ )
 import MCSP.Data.Pair (Pair)
 import MCSP.Data.String (String (Unboxed))
 import MCSP.Data.String.Extra (Partition)
@@ -78,39 +86,50 @@ import MCSP.System.Random (Random, Seed, generateWith)
 newtype PSOIterations = PSOIterations Int
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOIterations
+instance MetaInputVariable PSOIterations where
+    getVar = getOrDefine (PSOIterations 100)
 
 -- | The number of particles used at each iteration of the PSO algorithm.
 newtype PSOParticles = PSOParticles Int
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOParticles
+instance MetaInputVariable PSOParticles where
+    getVar = getOrDefine (PSOParticles 200)
 
 -- | Initial seed used for randomized operation in the PSO algorithm.
 newtype PSOSeed = PSOSeed Seed
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOSeed
+instance MetaInputVariable PSOSeed where
+    getVar = getOrDefine (PSOSeed defaultSeed)
+      where
+        defaultSeed = (0x7f166a5f52178da7, 0xe190ca41e26454c3)
 
 -- | Output for the first iteration that reached the best solution in PSO.
 newtype PSOFirstBestIter = PSOFirstBestIter
     { getFirstBestIter :: Int
     }
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOFirstBestIter
+instance MetaOutputVariable PSOFirstBestIter
 
 -- | Run PSO only, without using other heuristics.
 newtype PSOPure = PSOPure Bool
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOPure
+instance MetaInputVariable PSOPure where
+    getVar = getOrDefine (PSOPure False)
 
 -- | Run combine after on the partitions represented by the edge list.
 newtype PSOCombine = PSOCombine Bool
     deriving newtype (Eq, Ord, Show)
 
-instance MetaVariable PSOCombine
+instance MetaInputVariable PSOCombine where
+    getVar = do
+        PSOPure usePure <- getVar
+        if usePure
+            then pure (PSOCombine False)
+            else getOrDefine (PSOCombine False)
 
 -- -------------------- --
 -- Edge List Operations --
@@ -186,13 +205,10 @@ objective (PSOCombine False) _ = mergeness . solution
 -- | Create an iterated PSO swarm for the MCSP problem.
 mcspSwarm :: Ord a => Pair (String a) -> Meta (Random (NonEmpty (Swarm Edge)))
 mcspSwarm strs@(edgeSet -> edges) = do
-    PSOIterations iterations <- getVarOrDefault (PSOIterations 100)
-    PSOParticles particles <- getVarOrDefault (PSOParticles 200)
-    usePure <- getVarOrDefault (PSOPure False)
-    runCombine <-
-        if usePure == PSOPure False
-            then getVarOrDefault (PSOCombine False)
-            else pure (PSOCombine False)
+    PSOIterations iterations <- getVar
+    PSOParticles particles <- getVar
+    usePure <- getVar
+    runCombine <- getVar
 
     let ?eval = objective runCombine strs
     let ?values = edges
@@ -206,9 +222,9 @@ mcspSwarm strs@(edgeSet -> edges) = do
 -- | Extract information about the PSO execution.
 evalPso :: Ord a => Pair (String a) -> NonEmpty (Swarm Edge) -> Meta (Pair (Partition a), Int)
 evalPso strs swarms = do
-    runCombine <- fromMaybe (PSOCombine False) <$> getVar
+    PSOCombine runCombine <- getVar
     let partitions =
-            if runCombine == PSOCombine True
+            if runCombine
                 then combineEdges strs $ sortedValues guide
                 else toPartitions strs $ solution $ sortedValues guide
     pure (partitions, firstBestIter)
@@ -224,12 +240,10 @@ evalPso strs swarms = do
 -- | PSO heuristic.
 pso :: Ord a => Pair (String a) -> Meta (Pair (Partition a))
 pso strs = do
-    PSOSeed seed <- getVarOrDefault (PSOSeed defaultSeed)
+    PSOSeed seed <- getVar
 
     swarms <- generateWith seed <$> mcspSwarm strs
     (partitions, firstBestIter) <- evalPso strs swarms
 
     setVar (PSOFirstBestIter firstBestIter)
     pure partitions
-  where
-    defaultSeed = (0x7f166a5f52178da7, 0xe190ca41e26454c3)