diff --git a/randcool/randcool.hs b/randcool/randcool.hs index dfa9c893c850266f63faa286160c39022fa66f2b..96839b9a7dab723a26770902691f8344111ec993 100644 --- a/randcool/randcool.hs +++ b/randcool/randcool.hs @@ -86,6 +86,8 @@ data RandConf ,minDis :: Nat -- min number of disjuncts per disjunction (0 allows for Bot) ,maxDis :: Nat -- max number of disjuncts per disjunction ,probAt :: Float -- probability of having an atom + ,topCon :: Bool -- allow conjunctions at the top level + ,topDis :: Bool -- allow disjunctions at the top level } @@ -114,19 +116,30 @@ someFormula modGen conf = go (depth conf) lits = let as = [1..1+numAts conf] in [top,bot] ++ map PAt as ++ map NAt as + juncts junct_type r = \f -> + do n <- inRange r + junct_type <$> exactly n f + formulaOfDepth d - = do (m,junct,r) <- oneOf [(Dia,Con,(minCon conf,maxCon conf)) - ,(Box,Dis,(minDis conf,maxDis conf))] - n <- inRange r - m <$> modGen <*> (junct <$> exactly n (go d)) + = do (diabox,xxjuncts) <- oneOf [(Dia,Con `juncts` (minCon conf,maxCon conf)) + ,(Box,Dis `juncts` (minDis conf,maxDis conf))] + diabox <$> modGen <*> xxjuncts (go d) + p = max 0 $ min 1 $ probAt conf go d | d == 0 = oneOf lits + | d == depth conf - = formulaOfDepth (d-1) + = let modal_form = formulaOfDepth (d-1) + in join $ oneOf $ concat + [ [modal_form] + , [Con `juncts` (minCon conf,maxCon conf) $ modal_form | topCon conf] + , [Dis `juncts` (minDis conf,maxDis conf) $ modal_form | topDis conf] + ] + | otherwise = join $ fromFreqs [oneOf lits `withFreq` p ,formulaOfDepth (d-1) `withFreq` (1-p)] @@ -252,6 +265,15 @@ randConf <> help "Probability of an atom occurring instead of a modality" <> showDefault ) + <*> flag True False + ( long "no-toplevel-conj" + <> help "Don't generate conjunctions at the top-level" + ) + <*> flag True False + ( long "no-toplevel-disj" + <> help "Don't generate disjunctions at the top-level" + ) +