Commit a1a9ed33 authored by AVANZINI Martin's avatar AVANZINI Martin
Browse files

cexp simplifications and extended heuristics

parent be38823e
......@@ -53,11 +53,14 @@ data CExp c =
-- fromExp :: (Eq c, Num c) => E.Exp -> CExp c
-- fromExp = E . fmap fromIntegral
nm :: (Eq c, Num c) => c -> Norm -> CExp c
nm 0 _ = zero
nm c (Norm _ (E.Constant i)) = N (c * fromIntegral i) (norm Top 1)
nm c n = N c n
traverseCoeff :: (Num c', Ord c', Applicative f) => (c -> f c') -> CExp c -> f (CExp c')
traverseCoeff f = walk where
walk (N k n) = nm <$> f k where
nm 0 = zero
nm k' = N k' n
walk (N k n) = nm <$> f k <*> pure n where
walk (Div c e) = divBy <$> walk c <*> pure e
walk (Plus c d) = plus <$> walk c <*> walk d
walk (Sup c d) = sup <$> walk c <*> walk d
......@@ -79,7 +82,10 @@ plus :: (Eq c, Num c, Ord c) => CExp c -> CExp c -> CExp c
plus (Cond g c1 c2) (Cond g' c1' c2')
| g == g' = Cond g (c1 `plus` c1') (c2 `plus` c2')
plus (Div c1 e1) (Div c2 e2) | e1 == e2 = (c1 `plus` c2) `divBy` e1
plus (N k1 n1) (N k2 n2) | k1 == k2 = N k1 (n1 `plusN` n2)
plus (N k1 n1) (N k2 n2) | k1 == k2 = nm k1 (n1 `plusN` n2)
| n1 == n2 = nm (k1 + k2) n1
-- plus (N k1 (Norm _ (E.Constant i1))) (N k2 (Norm _ (E.Constant i2)))
-- = nm (k1 * fromIntegral i1 + k1 * fromIntegral i2) oneN
plus c1 c2 | c1 == zero = c2
| c2 == zero = c1
| otherwise = Plus c1 c2
......@@ -216,5 +222,8 @@ gNorms = walk B.Top 1 where
walk b k (Sup c d) = walk b k c ++ walk b k d
walk b k (Cond g c d) = walk (b .&& g) k c ++ walk (b .&& neg g) k d
norms :: (Eq c, Num c) => CExp c -> S.Set Norm
norms c = S.fromList [n | GNorm _ _ n <- gNorms c]
instance (PP.Pretty c, Eq c, Ord c, Num c) => PP.Pretty (GNorm c) where
pretty = PP.pretty . fromGNorm
......@@ -268,7 +268,9 @@ extractRanking body i c g f = do
<|> (logMsg "squared-optimistic" >> pure (squared (ranksFromBExpWith optimistic)))
gRanks <- combine rankFromBExp (c .&& i) (varGNorms g)
fRanks <- pure (sum (fromGNorm `map` C.gNorms f))
return (toNormList (norm 1 + fRanks + gRanks)) -- ++ fRanks'
fRanks' <- (*) <$> rankFromBExp c
<*> P.fromPolynomialM (fmap P.variable . delta) (pure . P.coefficient) fRanks
return (toNormList (norm 1 + fRanks + gRanks + fRanks'))
where
toNormList p = filter (not . zeroN) [ C.prodN [ C.expN n i | (n,i) <- P.toPowers m ]
| (_,m) <- P.toMonos p]
......@@ -276,7 +278,8 @@ extractRanking body i c g f = do
norm e = P.variable (C.Norm (e .>= 0) e)
fromGNorm (C.GNorm _ _ n) = P.variable n
ranksFromBExpWith sel bexp = sum <$> mapM sel (S.toList (literals bexp))
maxE [] = 0
maxE es = foldl1 (P.zipCoefficientsWith (max 0) (max 0) max) es
additive fromBExp b gexps =
(+) (sum (fromGNorm `map` gexps))
......@@ -287,22 +290,22 @@ extractRanking body i c g f = do
<*> (sum <$> sequence [ (*) (P.variable n) <$> fromBExp (b .&& b')
| C.GNorm b' _ n <- gexps])
ranksFromBExpWith sel bexp = sum <$> mapM sel (S.toList (literals bexp))
optimistic (a :>=: b) = pure $ norm (a - b + 1)
-- optimistic' i (a :>=: b) = pure $ guarded (a .>= b) (a - b + i)
squared m x = sq <$> m x where sq n = n * n
-- delta (C.Norm e) = do
-- ns <- S.toList <$> C.norms <$> evt body (C.fromNorm (C.norm e) :: C.NormPoly Rational)
-- return $ C.Norm $ maxE [ ne | C.Norm ne <- ns ] - e
delta n@(C.Norm _ e) = do
ns <- S.toList <$> C.norms <$> evt body (C.nm 1 n)
let f = maxE [ ne | C.Norm _ ne <- ns ] - e
return (C.norm (f .>= 0) f)
shift l@(a :>=: b) = do
shift l@(a :>=: b) =
-- TODO: this is a mess; maybe define wp for non-recursive language?
mkNorm <$> maxE <$> concatMap diffs <$> C.gNorms <$> evt body (C.pred (a .>= b))
where
maxE [] = 0
maxE es = foldl1 (P.zipCoefficientsWith (max 0) (max 0) max) es
diffs (C.GNorm gd _ n)
| not (C.isZeroN n) = [ (a' - b') - (a - b) | a' :>=: b' <- S.toList (literals gd) ]
| otherwise = []
......
......@@ -31,8 +31,8 @@ type SmtFormula = SMT.SMTFormula SMT.SMTLib2
type SmtExpression = SMT.SMTExpression SMT.SMTLib2
runSmtM :: SmtM a -> a
runSmtM = unsafePerformIO . SMT.runSMTLib2 "z3" ["-smt2", "-in"]
-- runSmtM = unsafePerformIO . SMT.runSMTLib2Using "QF_LIRA" "yices-smt2" ["--incremental"]
-- runSmtM = unsafePerformIO . SMT.runSMTLib2 "z3" ["-smt2", "-in"]
runSmtM = unsafePerformIO . SMT.runSMTLib2Using "QF_LIRA" "yices-smt2" ["--incremental"]
-- runSmtM = unsafePerformIO . SMT.runSMTLib2 "yices-smt2" []
-- MS: Optimisation with OptiMathSat (version 1.6.3)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment