Check for negative entries in system specification

internal/Data/Boltzmann/Sampler/TH.hs

@@ -29,6 +29,7 @@ import Data.Boltzmann.System (
   Types (Types, regTypes),
   collectTypes,
   collectTypes',
+  hasNonNegativeEntries,
   hasProperConstructors,
   hasProperFrequencies,
   paganiniSpecIO,
@@ -184,6 +185,7 @@ mkSystemCtx sys = do
 
   hasProperConstructors sys'
   hasProperFrequencies sys'
+  hasNonNegativeEntries sys'
 
   types <- collectTypes sys'
   distributions <- runIO $ do

internal/Data/Boltzmann/System.hs

@@ -19,6 +19,7 @@ module Data.Boltzmann.System (
   paganiniSpecIO,
   hasProperConstructors,
   hasProperFrequencies,
+  hasNonNegativeEntries,
   Constructable (..),
 ) where
 
@@ -230,6 +231,33 @@ hasProperFrequencies sys = do
       "Frequencies definied for non-system constructors: "
         ++ format additionalConstrs
 
+hasNonNegativeEntries :: System -> Q ()
+hasNonNegativeEntries sys = do
+  unless (meanSize sys >= 0) $ do
+    fail "Negative mean target size"
+
+  let negativeWeights =
+        filter
+          (\(_, w) -> w < 0)
+          (unConstructorWeights $ weights sys)
+
+  unless (null negativeWeights) $ do
+    fail $
+      "Negative weight for constructors: "
+        ++ format (Set.fromList $ map fst negativeWeights)
+
+  let negativeFrequencies =
+        filter
+          (\(_, w) -> w < 0)
+          (unConstructorFrequencies $ frequencies sys)
+
+  unless (null negativeFrequencies) $ do
+    fail $
+      "Negative frequencies for constructors: "
+        ++ format (Set.fromList $ map fst negativeFrequencies)
+
+  pure ()
+
 mkVariables :: Set Name -> Spec (Map Name Let)
 mkVariables sys = do
   let n = Set.size sys