Allow restricting positive literals in formula besides percentTrueEntries

examples/src/Semantics/TruthTables/ChooseForFormula/Config.hs

@@ -9,6 +9,7 @@ import LogicTasks.Config (
 
 import Test.Hspec
 import Util.VerifyConfig
+import Formula.Util(PercentRangeMode(TrueEntries))
 
 -- 2023: Weight 0.33
 task08 :: PickConfig
@@ -24,7 +25,7 @@ task08 = PickConfig
                   , maxClauseAmount = 2
                   })
   , amountOfOptions = 3
-  , percentTrueEntries = (0, 100)
+  , percentRangeMode = TrueEntries (0, 100)
   , extraText = Nothing
   , printSolution = True
   }
@@ -43,7 +44,7 @@ task12 = PickConfig
                    , maxClauseAmount = 4
                    })
   , amountOfOptions = 4
-  , percentTrueEntries = (30, 70)
+  , percentRangeMode = TrueEntries (30, 70)
   , printSolution = True
   , extraText = Nothing
   }

examples/src/Semantics/TruthTables/FillGaps/Config.hs

@@ -8,6 +8,7 @@ import LogicTasks.Config (
   )
 import Test.Hspec
 import Util.VerifyConfig
+import Formula.Util(PercentRangeMode(TrueEntries))
 
 -- 2025: Weight 0.3
 task07 :: FillConfig
@@ -23,7 +24,7 @@ task07 = FillConfig
                   , maxClauseAmount = 3
                   })
   , percentageOfGaps = 60
-  , percentTrueEntries = (30, 70)
+  , percentRangeMode = TrueEntries (30, 70)
   , printSolution = True
   , extraText = Nothing
   }
@@ -42,7 +43,7 @@ task20 = FillConfig
                    , maxClauseAmount = 4
                    })
   , percentageOfGaps = 40
-  , percentTrueEntries = (35, 65)
+  , percentRangeMode = TrueEntries (35, 65)
   , extraText = Nothing
   , printSolution = True
   }

examples/src/Semantics/TruthTables/FindMistakes/Config.hs

@@ -14,6 +14,7 @@ import Trees.Types (BinOp(..))
 import Util.VerifyConfig
 import qualified Data.Map as Map (fromList)
 import Data.Map (Map)
+import Formula.Util(PercentRangeMode(TrueEntries))
 
 listToFM :: Ord k => [(k, a)] -> Map k a
 listToFM = Map.fromList
@@ -32,7 +33,7 @@ task11 = DecideConfig
                    , maxClauseAmount = 3
                    })
   , percentageOfChanged = 40
-  , percentTrueEntries = (30, 70)
+  , percentRangeMode = TrueEntries (30, 70)
   , printSolution = True
   , extraText = Nothing
   }
@@ -60,7 +61,7 @@ task13 = DecideConfig
                         , minUniqueBinOperators = 4
                         })
   , percentageOfChanged = 30
-  , percentTrueEntries = (30, 70)
+  , percentRangeMode = TrueEntries (30, 70)
   , printSolution = True
   , extraText = Nothing
   }

examples/src/Semantics/TruthTables/MaxTerm/Config.hs

@@ -9,6 +9,7 @@ import Test.Hspec
 import LogicTasks.Util (checkNormalFormConfig)
 import Util.VerifyConfig
 import Control.OutputCapable.Blocks (Language(German))
+import Formula.Util(PercentRangeMode(TrueEntries))
 
 -- Weight 0.33
 -- Type: Max
@@ -23,7 +24,7 @@ unused01 = MinMaxConfig
     , minClauseAmount = 3
     , maxClauseAmount = 3
     }
-  , percentTrueEntries = (50, 70)
+  , percentRangeMode = TrueEntries (50, 70)
   , extraText = Nothing
   , printSolution = True
   , offerUnicodeInput = False
@@ -42,7 +43,7 @@ unused02 = MinMaxConfig
     , minClauseAmount = 3
     , maxClauseAmount = 4
     }
-  , percentTrueEntries = (50, 70)
+  , percentRangeMode = TrueEntries (50, 70)
   , extraText = Nothing
   , printSolution = True
   , offerUnicodeInput = False

examples/src/Semantics/TruthTables/MinTerm/Config.hs

@@ -9,6 +9,7 @@ import Test.Hspec
 import LogicTasks.Util (checkNormalFormConfig)
 import Util.VerifyConfig
 import Control.OutputCapable.Blocks (Language(German))
+import Formula.Util(PercentRangeMode(TrueEntries))
 
 -- Weight 0.2
 -- Type: Min
@@ -23,7 +24,7 @@ unused03 = MinMaxConfig
     , minClauseAmount = 2
     , maxClauseAmount = 3
     }
-  , percentTrueEntries = (55, 70)
+  , percentRangeMode = TrueEntries (55, 70)
   , extraText = Nothing
   , printSolution = True
   , offerUnicodeInput = False

src/Config.hs

@@ -297,7 +297,7 @@ dNormalFormConf = NormalFormConfig
 data PickConfig = PickConfig {
        formulaConfig :: FormulaConfig
      , amountOfOptions :: Int
-     , percentTrueEntries :: (Int, Int)
+     , percentRangeMode :: PercentRangeMode
      , printSolution :: Bool
      , extraText :: Maybe (Map Language String)
      }
@@ -307,7 +307,7 @@ dPickConf :: PickConfig
 dPickConf = PickConfig
     { formulaConfig = FormulaCnf dNormalFormConf
     , amountOfOptions = 3
-    , percentTrueEntries = (30, 70)
+    , percentRangeMode = TrueEntries (30, 70)
     , printSolution = True
     , extraText = Nothing
     }
@@ -317,7 +317,7 @@ dPickConf = PickConfig
 data FillConfig = FillConfig {
       formulaConfig :: FormulaConfig
     , percentageOfGaps :: Int
-    , percentTrueEntries :: (Int, Int)
+    , percentRangeMode :: PercentRangeMode
     , printSolution :: Bool
     , extraText :: Maybe (Map Language String)
     }
@@ -327,7 +327,7 @@ dFillConf :: FillConfig
 dFillConf = FillConfig
     { formulaConfig = FormulaCnf dNormalFormConf
     , percentageOfGaps = 40
-    , percentTrueEntries = (30, 70)
+    , percentRangeMode = TrueEntries (30, 70)
     , printSolution = True
     , extraText = Nothing
     }
@@ -336,7 +336,7 @@ dFillConf = FillConfig
 
 data MinMaxConfig = MinMaxConfig {
       normalFormConf :: NormalFormConfig
-    , percentTrueEntries :: (Int, Int)
+    , percentRangeMode :: PercentRangeMode
     , printSolution :: Bool
     , extraText :: Maybe (Map Language String)
     , offerUnicodeInput :: Bool
@@ -346,7 +346,7 @@ data MinMaxConfig = MinMaxConfig {
 dMinMaxConf :: MinMaxConfig
 dMinMaxConf = MinMaxConfig
     { normalFormConf = dNormalFormConf
-    , percentTrueEntries = (50, 70)
+    , percentRangeMode = TrueEntries (50, 70)
     , printSolution = True
     , extraText = Nothing
     , offerUnicodeInput = False
@@ -357,7 +357,7 @@ dMinMaxConf = MinMaxConfig
 data DecideConfig = DecideConfig {
       formulaConfig :: FormulaConfig
     , percentageOfChanged :: Int
-    , percentTrueEntries :: (Int, Int)
+    , percentRangeMode :: PercentRangeMode
     , printSolution :: Bool
     , extraText :: Maybe (Map Language String)
     }
@@ -367,7 +367,7 @@ dDecideConf :: DecideConfig
 dDecideConf = DecideConfig
     { formulaConfig = FormulaCnf dNormalFormConf
     , percentageOfChanged = 40
-    , percentTrueEntries = (30, 70)
+    , percentRangeMode = TrueEntries (30, 70)
     , printSolution = True
     , extraText = Nothing
     }

src/Formula/Types.hs

@@ -244,7 +244,7 @@ instance Show Cnf where
         withBraces cl = if amount cl == 1 then show cl else "(" ++ show cl ++ ")"
 
 instance Formula Cnf where
-    literals (Cnf set) = Set.toList $ Set.unions $ Set.map (Set.fromList . literals) set
+    literals (Cnf set) = concatMap literals set
 
     atomics (Cnf set) = Set.toList $ Set.unions $ Set.map (Set.fromList . atomics) set
 
@@ -390,7 +390,7 @@ instance Show Dnf where
 
 
 instance Formula Dnf where
-    literals (Dnf set) = Set.toList $ Set.unions $ Set.map (Set.fromList . literals) set
+    literals (Dnf set) = concatMap literals set
 
     atomics (Dnf set) = Set.toList $ Set.unions $ Set.map (Set.fromList . atomics) set
 

src/Formula/Util.hs

@@ -21,6 +21,9 @@ module Formula.Util
        -- , isSemanticEqualSat
        , cnfDependsOnAllAtomics
        , dnfDependsOnAllAtomics
+       , withPercentRange
+       , PercentRangeMode (TrueEntries, PosLiterals)
+       , percentRangeModeRange
        ) where
 
 
@@ -30,6 +33,7 @@ import qualified SAT.MiniSat as Sat
 import Data.Maybe(fromJust)
 
 import Formula.Types
+import Formula.Table (readEntries)
 
 
 ---------------------------------------------------------------------------------------------------
@@ -165,3 +169,41 @@ transformProlog :: PrologClause -> [(PrologLiteral,Literal)] -> Clause
 transformProlog pc mapping = mkClause $ map (fromJust . (`lookup` mapping)) lits
   where
     lits = Set.toList (pLiterals pc)
+
+----------------------------------------------------------------------------------------------------------
+
+data PercentRangeMode = TrueEntries (Int, Int) | PosLiterals (Int, Int) deriving (Show)
+
+withPercentRange :: Formula a => PercentRangeMode -> a -> Bool
+withPercentRange mode form = isFullRange mode || withPercentRange' range count total
+ where
+  -- isFullRange ensures that the trueEntries are not
+  -- calculated when not restricted
+  isFullRange (TrueEntries (0,100)) = True
+  isFullRange (PosLiterals (0,100)) = True
+  isFullRange _ = False
+  (range, count, total) = percentRangeStats mode form
+
+withPercentRange' :: (Int,Int) -> Int -> Int -> Bool
+withPercentRange' (lower, upper) count total =
+  count <= max (min 1 upper) (percentage upper)
+          && count >= max (min 1 lower) (percentage lower)
+  where
+    percentage :: Int -> Int
+    percentage n = total * n `div` 100
+
+percentRangeStats :: Formula a => PercentRangeMode -> a -> ((Int, Int), Int, Int)
+percentRangeStats (TrueEntries range) form =
+  let tableEntries = readEntries (getTable form)
+      trueEntries = length $ filter (== Just True) tableEntries
+      totalEntries = 2 ^ length (atomics form)
+  in (range, trueEntries, totalEntries)
+percentRangeStats (PosLiterals range) form =
+  let allLiterals = literals form
+      posLiterals = length $ filter isPositive allLiterals
+      totalLiterals = length allLiterals
+  in (range, posLiterals, totalLiterals)
+
+percentRangeModeRange :: PercentRangeMode -> (Int, Int)
+percentRangeModeRange (TrueEntries range) = range
+percentRangeModeRange (PosLiterals range) = range

src/LogicTasks/Debug.hs

@@ -18,7 +18,7 @@ import Text.Parsec.String (Parser)
 import Formula.Types (Cnf(..), Clause(..), Literal(..), Formula(..))
 import Formula.Util (isPositive)
 import Data.Set (size, toList)
-import Data.List (partition)
+import Data.List (partition, nub)
 import Data.List.Extra (nubSort)
 import Control.OutputCapable.Blocks.Debug (testTask, Display(..))
 import Formula.Parsing.Delayed (delayed)
@@ -49,13 +49,13 @@ testModule prettyCfg lang gen desc partial complete p =
 
 analyseCnfGenerator :: Gen Cnf -> IO ()
 analyseCnfGenerator gen = quickCheckWith stdArgs{maxSuccess=1000} $ forAll gen $ \cnf ->
-  tabulate "all literals" (map show $ literals cnf) $
-  tabulate "positive literals" (map show $ filter isPositive $ literals cnf) $
-  tabulate "negative literals" (map show $ filter (not . isPositive) $ literals cnf) $
+  tabulate "all literals" (map show $ nub $ literals cnf) $
+  tabulate "positive literals" (map show $ filter isPositive $ nub $ literals cnf) $
+  tabulate "negative literals" (map show $ filter (not . isPositive) $ nub $ literals cnf) $
   tabulate "clause lengths" (map (show . size . literalSet) . toList $ clauseSet cnf) $
   tabulate "number of clauses" (pure . show . size $ clauseSet cnf) $
   tabulate "trivial clauses (containing both X and not X)" (map (show . isTrivial) . toList $ clauseSet cnf) $
-  tabulate "usage of atomic formulas" (pure . nubSort . map (\case (Positive x) -> x ; (Negative x) -> x) $ literals cnf)
+  tabulate "usage of atomic formulas" (pure . nubSort . map (\case (Positive x) -> x ; (Negative x) -> x) $ nub $ literals cnf)
     True
 
 isTrivial :: Clause -> Bool

src/LogicTasks/Semantics/Decide.hs

@@ -32,7 +32,8 @@ import Test.QuickCheck (Gen, suchThat)
 import Config (DecideConfig(..), DecideInst(..), FormulaConfig (..), FormulaInst (..), DecideChoice (..), showChoice)
 import Formula.Table (flipAt, readEntries)
 import Formula.Types (atomics, availableLetter, getTable)
-import Util (isOutside, remove, withRatio, checkTruthValueRangeAndFormulaConf, formulaDependsOnAllAtoms)
+import Formula.Util (withPercentRange)
+import Util (isOutside, remove, checkTruthValueRangeAndFormulaConf, formulaDependsOnAllAtoms)
 import LogicTasks.Helpers (extra, reject)
 import Control.Monad (unless, when)
 import Trees.Generate (genSynTree)
@@ -47,11 +48,11 @@ genDecideInst DecideConfig{..} = do
     -- jscpd:ignore-start
     formula <- flip suchThat formulaDependsOnAllAtoms $ case formulaConfig of
       (FormulaArbitrary syntaxTreeConfig) ->
-        InstArbitrary <$> genSynTree syntaxTreeConfig  `suchThat` withRatio percentTrueEntries
+        InstArbitrary <$> genSynTree syntaxTreeConfig  `suchThat` withPercentRange percentRangeMode
       (FormulaCnf cnfCfg) ->
-        InstCnf <$> genCnf' cnfCfg `suchThat` withRatio percentTrueEntries
+        InstCnf <$> genCnf' cnfCfg `suchThat` withPercentRange percentRangeMode
       (FormulaDnf dnfCfg) ->
-        InstDnf <$> genDnf' dnfCfg `suchThat` withRatio percentTrueEntries
+        InstDnf <$> genDnf' dnfCfg `suchThat` withPercentRange percentRangeMode
     -- jscpd:ignore-end
 
     let
@@ -167,7 +168,7 @@ verifyQuiz DecideConfig{..}
           german "Bei dieser Aufgabe müssen alle verfügbaren Atome verwendet werden."
           english "All available atoms must be used for this task."
 
-    | otherwise = checkTruthValueRangeAndFormulaConf percentTrueEntries formulaConfig
+    | otherwise = checkTruthValueRangeAndFormulaConf percentRangeMode formulaConfig
 
 
 

src/LogicTasks/Semantics/Fill.hs

@@ -25,12 +25,12 @@ import Test.QuickCheck(Gen, suchThat)
 import Config ( FillConfig(..), FillInst(..), FormulaInst (..), FormulaConfig (..))
 import Formula.Table (gapsAt, readEntries)
 import Formula.Types (TruthValue, availableLetter, atomics, getTable, truth)
+import Formula.Util(withPercentRange)
 import Util (
   isOutside,
   pairwiseCheck,
   preventWithHint,
   remove,
-  withRatio,
   checkTruthValueRangeAndFormulaConf,
   formulaDependsOnAllAtoms
   )
@@ -49,11 +49,11 @@ genFillInst FillConfig{..} = do
 
     formula <- flip suchThat formulaDependsOnAllAtoms $ case formulaConfig of
       (FormulaArbitrary syntaxTreeConfig) ->
-        InstArbitrary <$> genSynTree syntaxTreeConfig `suchThat` withRatio percentTrueEntries
+        InstArbitrary <$> genSynTree syntaxTreeConfig `suchThat` withPercentRange percentRangeMode
       (FormulaCnf cnfCfg) ->
-        InstCnf <$> genCnf' cnfCfg `suchThat` withRatio percentTrueEntries
+        InstCnf <$> genCnf' cnfCfg `suchThat` withPercentRange percentRangeMode
       (FormulaDnf dnfCfg) ->
-        InstDnf <$> genDnf' dnfCfg `suchThat` withRatio percentTrueEntries
+        InstDnf <$> genDnf' dnfCfg `suchThat` withPercentRange percentRangeMode
 
     let
       entries = readEntries $ getTable formula
@@ -143,7 +143,7 @@ verifyQuiz FillConfig{..}
           german "Bei dieser Aufgabe müssen alle verfügbaren Atome verwendet werden."
           english "All available atoms must be used for this task."
 
-    | otherwise = checkTruthValueRangeAndFormulaConf percentTrueEntries formulaConfig
+    | otherwise = checkTruthValueRangeAndFormulaConf percentRangeMode formulaConfig