module Swish.Proof
( Proof(..), Step(..)
, checkProof, explainProof, checkStep, showProof, showsProof, showsFormula )
where
import Swish.Rule (Expression(..), Formula(..), Rule(..))
import Swish.Rule (showsFormula, showsFormulae)
import Swish.Ruleset (Ruleset(..))
import Data.List (union, intersect, intercalate, foldl')
import Data.Maybe (catMaybes, isNothing)
import Data.String.ShowLines (ShowLines(..))
import qualified Data.Set as S
data Step ex = Step
{ Step ex -> Rule ex
stepRule :: Rule ex
, Step ex -> [Formula ex]
stepAnt :: [Formula ex]
, Step ex -> Formula ex
stepCon :: Formula ex
} deriving Int -> Step ex -> ShowS
[Step ex] -> ShowS
Step ex -> String
(Int -> Step ex -> ShowS)
-> (Step ex -> String) -> ([Step ex] -> ShowS) -> Show (Step ex)
forall ex. Show ex => Int -> Step ex -> ShowS
forall ex. Show ex => [Step ex] -> ShowS
forall ex. Show ex => Step ex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Step ex] -> ShowS
$cshowList :: forall ex. Show ex => [Step ex] -> ShowS
show :: Step ex -> String
$cshow :: forall ex. Show ex => Step ex -> String
showsPrec :: Int -> Step ex -> ShowS
$cshowsPrec :: forall ex. Show ex => Int -> Step ex -> ShowS
Show
data Proof ex = Proof
{ Proof ex -> [Ruleset ex]
proofContext :: [Ruleset ex]
, Proof ex -> Formula ex
proofInput :: Formula ex
, Proof ex -> Formula ex
proofResult :: Formula ex
, Proof ex -> [Step ex]
proofChain :: [Step ex]
}
proofAxioms :: Proof a -> [Formula a]
proofAxioms :: Proof a -> [Formula a]
proofAxioms = (Ruleset a -> [Formula a]) -> [Ruleset a] -> [Formula a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ruleset a -> [Formula a]
forall ex. Ruleset ex -> [Formula ex]
rsAxioms ([Ruleset a] -> [Formula a])
-> (Proof a -> [Ruleset a]) -> Proof a -> [Formula a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof a -> [Ruleset a]
forall ex. Proof ex -> [Ruleset ex]
proofContext
proofRules :: Proof a -> [Rule a]
proofRules :: Proof a -> [Rule a]
proofRules = (Ruleset a -> [Rule a]) -> [Ruleset a] -> [Rule a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Ruleset a -> [Rule a]
forall ex. Ruleset ex -> [Rule ex]
rsRules ([Ruleset a] -> [Rule a])
-> (Proof a -> [Ruleset a]) -> Proof a -> [Rule a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proof a -> [Ruleset a]
forall ex. Proof ex -> [Ruleset ex]
proofContext
proofAxiomsUsed :: Proof ex -> [Formula ex]
proofAxiomsUsed :: Proof ex -> [Formula ex]
proofAxiomsUsed Proof ex
proof = ([Formula ex] -> [Formula ex] -> [Formula ex])
-> [Formula ex] -> [[Formula ex]] -> [Formula ex]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Formula ex] -> [Formula ex] -> [Formula ex]
forall a. Eq a => [a] -> [a] -> [a]
union [] ([[Formula ex]] -> [Formula ex]) -> [[Formula ex]] -> [Formula ex]
forall a b. (a -> b) -> a -> b
$ (Step ex -> [Formula ex]) -> [Step ex] -> [[Formula ex]]
forall a b. (a -> b) -> [a] -> [b]
map Step ex -> [Formula ex]
stepAxioms (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
proof)
where
stepAxioms :: Step ex -> [Formula ex]
stepAxioms Step ex
st = Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
st [Formula ex] -> [Formula ex] -> [Formula ex]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
proof
checkProof ::
(Expression ex, Ord ex)
=> Proof ex -> Bool
checkProof :: Proof ex -> Bool
checkProof Proof ex
pr =
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 (Proof ex -> [Rule ex]
forall a. Proof a -> [Rule a]
proofRules Proof ex
pr) [ex]
initExpr (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
pr) ex
goalExpr
where
initExpr :: [ex]
initExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
pr) ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
: (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
pr)
goalExpr :: ex
goalExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofResult Proof ex
pr
checkProof1 ::
(Expression ex, Ord ex)
=> [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 :: [Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 [Rule ex]
_ [ex]
prev [] ex
res = ex
res ex -> [ex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ex]
prev
checkProof1 [Rule ex]
rules [ex]
prev (Step ex
st:[Step ex]
steps) ex
res =
[Rule ex] -> [ex] -> Step ex -> Bool
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Bool
checkStep [Rule ex]
rules [ex]
prev Step ex
st Bool -> Bool -> Bool
&&
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Bool
checkProof1 [Rule ex]
rules (Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st)ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
:[ex]
prev) [Step ex]
steps ex
res
checkStep ::
Ord ex
=> [Rule ex]
-> [ex]
-> Step ex
-> Bool
checkStep :: [Rule ex] -> [ex] -> Step ex -> Bool
checkStep [Rule ex]
rules [ex]
prev Step ex
step = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> Maybe String -> Bool
forall a b. (a -> b) -> a -> b
$ [Rule ex] -> [ex] -> Step ex -> Maybe String
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
step
explainProof ::
(Expression ex, Ord ex) => Proof ex -> Maybe String
explainProof :: Proof ex -> Maybe String
explainProof Proof ex
pr =
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 (Proof ex -> [Rule ex]
forall a. Proof a -> [Rule a]
proofRules Proof ex
pr) [ex]
initExpr (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
pr) ex
goalExpr
where
initExpr :: [ex]
initExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
pr) ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
: (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxioms Proof ex
pr)
goalExpr :: ex
goalExpr = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofResult Proof ex
pr
explainProof1 ::
(Expression ex, Ord ex)
=> [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 :: [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 [Rule ex]
_ [ex]
prev [] ex
res =
if ex
res ex -> [ex] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ex]
prev then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
"Result not demonstrated"
explainProof1 [Rule ex]
rules [ex]
prev (Step ex
st:[Step ex]
steps) ex
res =
case [Rule ex] -> [ex] -> Step ex -> Maybe String
forall ex. Ord ex => [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
st of
Maybe String
Nothing -> [Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
forall ex.
(Expression ex, Ord ex) =>
[Rule ex] -> [ex] -> [Step ex] -> ex -> Maybe String
explainProof1 [Rule ex]
rules (Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st)ex -> [ex] -> [ex]
forall a. a -> [a] -> [a]
:[ex]
prev) [Step ex]
steps ex
res
Just String
ex -> String -> Maybe String
forall a. a -> Maybe a
Just (String
"Invalid step: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ScopedName -> String
forall a. Show a => a -> String
show (Formula ex -> ScopedName
forall ex. Formula ex -> ScopedName
formName (Formula ex -> ScopedName) -> Formula ex -> ScopedName
forall a b. (a -> b) -> a -> b
$ Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
st)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
": "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
ex)
explainStep ::
Ord ex
=> [Rule ex]
-> [ex]
-> Step ex
-> Maybe String
explainStep :: [Rule ex] -> [ex] -> Step ex -> Maybe String
explainStep [Rule ex]
rules [ex]
prev Step ex
step =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
errors
where
srul :: Rule ex
srul = Step ex -> Rule ex
forall ex. Step ex -> Rule ex
stepRule Step ex
step
sant :: [ex]
sant = (Formula ex -> ex) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> [a] -> [b]
map Formula ex -> ex
forall ex. Formula ex -> ex
formExpr ([Formula ex] -> [ex]) -> [Formula ex] -> [ex]
forall a b. (a -> b) -> a -> b
$ Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
step
scon :: ex
scon = Formula ex -> ex
forall ex. Formula ex -> ex
formExpr (Formula ex -> ex) -> Formula ex -> ex
forall a b. (a -> b) -> a -> b
$ Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
step
errors :: [String]
errors = [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
[ Bool -> String -> Maybe String
forall a. Bool -> a -> Maybe a
require (Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName Rule ex
srul ScopedName -> [ScopedName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Rule ex -> ScopedName) -> [Rule ex] -> [ScopedName]
forall a b. (a -> b) -> [a] -> [b]
map Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName [Rule ex]
rules)
(String
"rule "String -> ShowS
forall a. [a] -> [a] -> [a]
++ScopedName -> String
forall a. Show a => a -> String
show (Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName Rule ex
srul)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" not present")
, Bool -> String -> Maybe String
forall a. Bool -> a -> Maybe a
require ([ex] -> Set ex
forall a. Ord a => [a] -> Set a
S.fromList [ex]
sant Set ex -> Set ex -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`S.isSubsetOf` [ex] -> Set ex
forall a. Ord a => [a] -> Set a
S.fromList [ex]
prev)
String
"antecedent not axiom or previous result"
, Bool -> String -> Maybe String
forall a. Bool -> a -> Maybe a
require (Rule ex -> [ex] -> ex -> Bool
forall ex. Rule ex -> [ex] -> ex -> Bool
checkInference Rule ex
srul [ex]
sant ex
scon)
String
"rule does not deduce consequence from antecedents"
]
require :: Bool -> a -> Maybe a
require Bool
b a
s = if Bool
b then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
s
showsProof ::
(ShowLines ex)
=> String
-> Proof ex
-> ShowS
showsProof :: String -> Proof ex -> ShowS
showsProof String
newline Proof ex
proof =
if [Formula ex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Formula ex]
axioms then ShowS
shProof else ShowS
shAxioms ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
shProof
where
axioms :: [Formula ex]
axioms = Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxiomsUsed Proof ex
proof
shAxioms :: ShowS
shAxioms =
String -> ShowS
showString (String
"Axioms:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Formula ex] -> String -> ShowS
forall ex.
ShowLines ex =>
String -> [Formula ex] -> String -> ShowS
showsFormulae String
newline (Proof ex -> [Formula ex]
forall a. Proof a -> [Formula a]
proofAxiomsUsed Proof ex
proof) String
newline
shProof :: ShowS
shProof =
String -> ShowS
showString (String
"Input:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Formula ex -> ShowS
forall ex. ShowLines ex => String -> Formula ex -> ShowS
showsFormula String
newline (Proof ex -> Formula ex
forall ex. Proof ex -> Formula ex
proofInput Proof ex
proof) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString (String
newline String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Proof:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
newline) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Step ex] -> ShowS
forall ex. ShowLines ex => String -> [Step ex] -> ShowS
showsSteps String
newline (Proof ex -> [Step ex]
forall ex. Proof ex -> [Step ex]
proofChain Proof ex
proof)
showProof ::
(ShowLines ex)
=> String
-> Proof ex
-> String
showProof :: String -> Proof ex -> String
showProof String
newline Proof ex
proof = String -> Proof ex -> ShowS
forall ex. ShowLines ex => String -> Proof ex -> ShowS
showsProof String
newline Proof ex
proof String
""
showsSteps :: (ShowLines ex) => String -> [Step ex] -> ShowS
showsSteps :: String -> [Step ex] -> ShowS
showsSteps String
_ [] = ShowS
forall a. a -> a
id
showsSteps String
newline [Step ex
s] = String -> Step ex -> ShowS
forall ex. ShowLines ex => String -> Step ex -> ShowS
showsStep String
newline Step ex
s
showsSteps String
newline (Step ex
s:[Step ex]
ss) = String -> Step ex -> ShowS
forall ex. ShowLines ex => String -> Step ex -> ShowS
showsStep String
newline Step ex
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
newline ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> [Step ex] -> ShowS
forall ex. ShowLines ex => String -> [Step ex] -> ShowS
showsSteps String
newline [Step ex]
ss
showsStep :: (ShowLines ex) => String -> Step ex -> ShowS
showsStep :: String -> Step ex -> ShowS
showsStep String
newline Step ex
s = String -> Formula ex -> ShowS
forall ex. ShowLines ex => String -> Formula ex -> ShowS
showsFormula String
newline (Step ex -> Formula ex
forall ex. Step ex -> Formula ex
stepCon Step ex
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
newline ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString (String
" (by ["String -> ShowS
forall a. [a] -> [a] -> [a]
++String
rulenameString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"] from "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
antnamesString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")")
where
rulename :: String
rulename = ScopedName -> String
forall a. Show a => a -> String
show (ScopedName -> String)
-> (Rule ex -> ScopedName) -> Rule ex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule ex -> ScopedName
forall ex. Rule ex -> ScopedName
ruleName (Rule ex -> String) -> Rule ex -> String
forall a b. (a -> b) -> a -> b
$ Step ex -> Rule ex
forall ex. Step ex -> Rule ex
stepRule Step ex
s
antnames :: String
antnames = [String] -> String
showNames ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Formula ex -> String) -> [Formula ex] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ScopedName -> String
forall a. Show a => a -> String
show (ScopedName -> String)
-> (Formula ex -> ScopedName) -> Formula ex -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Formula ex -> ScopedName
forall ex. Formula ex -> ScopedName
formName) (Step ex -> [Formula ex]
forall ex. Step ex -> [Formula ex]
stepAnt Step ex
s)
showNames :: [String] -> String
showNames :: [String] -> String
showNames [] = String
"<nothing>"
showNames [String
n] = ShowS
showName String
n
showNames [String
n1,String
n2] = ShowS
showName String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
showName String
n2
showNames (String
n1:[String]
ns) = ShowS
showName String
n1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
showNames [String]
ns
showName :: String -> String
showName :: ShowS
showName String
n = String
"["String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++String
"]"