actually switch from Unravel to DagTableau

m4lvin · Dec 9, 2023 · 70a3edb · 70a3edb
1 parent fc7ca03
commit 70a3edb
Show file tree

Hide file tree

Showing 3 changed files with 88 additions and 127 deletions.
diff --git a/Pdl.lean b/Pdl.lean
@@ -6,7 +6,8 @@ import «Pdl».Vocab
 import «Pdl».Semantics
 import «Pdl».Star
 import «Pdl».Discon
-import «Pdl».Unravel
+-- import «Pdl».Unravel -- no longer used!
+import «Pdl».DagTableau
 import «Pdl».Tableau
 import «Pdl».Examples
 import «Pdl».Interpolation
diff --git a/Pdl/DagTableau.lean b/Pdl/DagTableau.lean
@@ -1,4 +1,5 @@
 import Mathlib.Data.Finset.Basic
+import Mathlib.Tactic.Linarith
 
 import Pdl.Syntax
 import Pdl.Discon
@@ -42,9 +43,7 @@ local notation "⌈" α "⌉" P => DagFormula.box α P
 local notation "⌈⌈" α "⌉⌉" P => DagFormula.boxes α P
 local notation "⌈" α "†⌉" P => DagFormula.dag α P
 
--- THE f FUNCTION
--- | Borzechowski's f function, sort of.
-
+-- | Borzechowski's function "f".
 def undag : DagFormula → Formula
   | ⊥ => ⊥
   | ~f => ~(undag f)
@@ -61,7 +60,6 @@ def inject : Formula → DagFormula
   | φ⋀ψ => inject φ ⋀ inject ψ
   | ⌈α⌉φ => ⌈α⌉(inject φ)
 
--- | Borzechowski's f function, sort of.
 @[simp]
 def containsDag : DagFormula → Bool
   | ⊥ => False
@@ -142,7 +140,7 @@ def dagNext : (Finset Formula × Option DagFormula) → Finset (Finset Formula
   | (_, some _) => { }  -- bad catch-all fallback, and maybe wrong?
   | (_, none) => { }  -- maybe wrong?
 
-theorem mOfDagNode.isDec (x y : Finset Formula × Option DagFormula) (y_in : y ∈ dagNext x) :
+theorem mOfDagNode.isDec {x y : Finset Formula × Option DagFormula} (y_in : y ∈ dagNext x) :
     mOfDagNode y < mOfDagNode x := by
   rcases x with ⟨_, _|dfx⟩
   case none =>
@@ -151,29 +149,42 @@ theorem mOfDagNode.isDec (x y : Finset Formula × Option DagFormula) (y_in : y
   case some =>
     simp [mOfDagNode]
     rcases y with ⟨_, _|dfy⟩
-    case none =>
-      simp
+    all_goals simp
     case some =>
-      simp
       cases dfx
-      all_goals (try simp [dagNext]; try cases y_in)
+      all_goals (try cases y_in)
       case neg g =>
         cases g
-        all_goals (try simp [dagNext]; try cases y_in)
-        case box a =>
+        all_goals (try cases y_in)
+        case box a f =>
           cases a
-          all_goals (cases dfy)
-          all_goals (simp [dagNext])
-          all_goals sorry
-          -- There must be a nicer way to do this?!
+          all_goals (simp [dagNext] at *)
+          case sequence =>
+            rcases y_in with ⟨l,r⟩
+            subst l
+            subst r
+            simp
+            linarith
+          case union a b =>
+            rcases y_in with ⟨l,r⟩|⟨l,r⟩
+            all_goals (subst l; subst r; simp; linarith)
+          case star a =>
+            rcases y_in with ⟨l,r⟩|⟨l,r⟩
+            all_goals (subst l; subst r; simp)
+          case test f =>
+            rcases y_in with ⟨l,r⟩
+            subst l
+            subst r
+            simp
 
 @[simp]
 def dagNextTransRefl : (Finset Formula × Option DagFormula) → Finset (Finset Formula × Option DagFormula) :=
-  ftr dagNext instDecidableEqProd mOfDagNode mOfDagNode.isDec
+  ftr dagNext instDecidableEqProd mOfDagNode @mOfDagNode.isDec
 
 instance modelCanSemImplyDagTabNodeNext {W : Type} : vDash (KripkeModel W × W) (Finset Formula × Option DagFormula) :=
   vDash.mk (λ ⟨M,w⟩ (fs, mf) => ∀ φ ∈ fs ∪ (mf.map undag).toFinset, evaluate M w φ)
 
+-- Similar to Borzechowski's Lemma 4
 theorem notStarSoundnessAux (a : Program) M (v w : W) (fs)
     (φ : DagFormula)
     (v_D : (M, v) ⊨ (fs, some (~⌈a⌉φ)))
@@ -206,7 +217,7 @@ theorem notStarSoundnessAux (a : Program) M (v w : W) (fs)
     case inl v_is_w =>
       use (fs, some (~φ))
       constructor
-      · unfold dagNextTransRefl; rw [ftr.iff]; right; simp; rw [ftr_iff]; simp
+      · unfold dagNextTransRefl; rw [ftr.iff]; right; simp; rw [ftr.iff]; simp
       · constructor
         · intro f
           aesop
@@ -275,15 +286,14 @@ theorem notStarSoundnessAux (a : Program) M (v w : W) (fs)
             · exact v_a_y
             · use u
               aesop
-    · -- TODO "If (2) ..."
-      -- subst v_is_u
+    · -- "If (2) ..."
       have := notStarSoundnessAux γ M u w S.1 φ -- not use "fs" here!
       specialize this _ u_γ_w w_nP
       · intro f
         sorry -- should be easy
       rcases this with ⟨Γ, Γ_in, v_Γ, split⟩
-      -- need transitivity here
       have also_in_prev : Γ ∈ dagNextTransRefl (fs, some (~⌈β;'γ⌉φ)) := by
+        -- Here we use transitivity of "being a successor" in a dagger tableau.
         apply ftr.Trans Γ S (fs, some (~⌈β;'γ⌉φ))
         · convert Γ_in
         · rw [ftr.iff]; simp; right; exact S_in
@@ -341,10 +351,27 @@ theorem notStarSoundnessAux (a : Program) M (v w : W) (fs)
       · intro f; aesop
       · right; aesop
 
-
 termination_by
   notStarSoundnessAux α M v w fs φ v_D v_a_w w_nP => mOfProgram α
 
+def dagEndNodes : (Finset Formula × Option DagFormula) → Finset (Finset Formula)
+  | (fs, none) => { fs }
+  | (fs, some df) => (dagNext (fs, some df)).attach.biUnion
+      (fun ⟨gsdf, h⟩ =>
+        have : mOfDagNode gsdf < mOfDagNode (fs, some df) := mOfDagNode.isDec h
+        dagEndNodes gsdf)
+termination_by
+  dagEndNodes fs => mOfDagNode fs
+decreasing_by simp_wf; assumption
+
+-- Similar to Borzechowski's Lemma 5
+-- (This is actually soundness AND invertibility.)
+theorem notStarSoundness (a : Program) (M : KripkeModel W) (v : W) (fs)
+    (φ : DagFormula)
+    :
+    ((M, v) ⊨ (fs, some (~⌈∗a⌉φ))) ↔ ∃ Γ ∈ dagEndNodes (fs, ~⌈∗a⌉φ), (M, v) ⊨ Γ := by
+
+    sorry
 
 -- -- -- BOXES -- -- --
 
@@ -374,3 +401,12 @@ termination_by
 -- how to ensure that union rule is "eventually" applied?
 -- May need to redefine DagTab to make it fully deterministic, even in box cases?
 -- Was not a problem for diamonds above.
+
+-- Analogon of Borzechowski's Lemma 5 for boxes, was missing.
+-- (This is actually soundness AND invertibility.)
+theorem starSoundness (a : Program) (M : KripkeModel W) (v : W) (fs)
+    (φ : DagFormula)
+    :
+    ((M, v) ⊨ (fs, some (⌈∗a⌉φ))) ↔ ∃ Γ ∈ dagEndNodes (fs, ⌈∗a⌉φ), (M, v) ⊨ Γ := by
+
+    sorry
diff --git a/Pdl/Tableau.lean b/Pdl/Tableau.lean
@@ -8,7 +8,7 @@ import Pdl.Measures
 import Pdl.Setsimp
 import Pdl.Semantics
 import Pdl.Discon
-import Pdl.Unravel
+import Pdl.DagTableau -- replaces Pdl.Unravel
 
 -- HELPER FUNCTIONS
 
@@ -46,8 +46,8 @@ inductive localRule : Finset Formula → Finset (Finset Formula) → Type
   | nUn {a b f} (h : (~⌈a⋓b⌉f) ∈ X) : localRule X { X \ {~⌈a ⋓ b⌉f} ∪ {~⌈a⌉f}
                                                     , X \ {~⌈a ⋓ b⌉f} ∪ {~⌈b⌉f} }
   -- STAR
-  | sta {X a f} (h : (⌈∗a⌉f) ∈ X) : localRule X ({ X \ {⌈∗a⌉f} } ⊎ (listsToSets (unravel (inject (⌈∗a⌉f)))))
-  | nSt {a f} (h : (~⌈∗a⌉f) ∈ X) : localRule X ({ X \ {~⌈∗a⌉f} } ⊎ (listsToSets (unravel (inject (~⌈∗a⌉f)))))
+  | sta {X a f} (h : (⌈∗a⌉f) ∈ X) : localRule X (dagEndNodes (X \ {⌈∗a⌉f}, inject (⌈∗a⌉f)))
+  | nSt {a f} (h : (~⌈∗a⌉f) ∈ X) : localRule X (dagEndNodes (X \ {~⌈∗a⌉f}, inject (~⌈∗a⌉f)))
 
   -- TODO which rules need and modify markings?
   -- TODO only apply * if there is a marking.
@@ -62,7 +62,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
   -- PROPOSITIONAL LOGIC
   case bot bot_in_a =>
     constructor
-    · intro ⟨Y,Y_in,w_Y⟩; simp at Y_in
+    · intro ⟨_, Y_in, _⟩; simp at Y_in
     · intro w_sat_a
       by_contra
       let w_sat_bot := w_sat_a ⊥ bot_in_a
@@ -199,105 +199,29 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
         case inr h_is_notf => rw [h_is_notf]; simp; exact not_w_g
   -- STAR RULES
   case nSt a f naSf_in_X =>
+    rw [Iff.comm]
+    convert notStarSoundness a M w (X \ {~⌈∗a⌉f}) (inject f) -- using Lemma 5
+    all_goals simp [vDash, undag, modelCanSemImplyDagTabNodeNext]
     constructor
-    · rintro ⟨Y, Y_in, MwY⟩ -- invertibility, should be easy
-      simp at Y_in
-      rcases Y_in with ⟨FS,FS_in,Y_def⟩
-      subst Y_def
-      intro g g_in_X
-      cases em (g = (~⌈∗a⌉f))
-      case inl g_is_nsSf =>
-        subst g_is_nsSf
-        simp
-        cases FS_in
-        case inl FS_is_nf =>
-          have : (FS : List Formula) = {~f} := by cases FS_is_nf; rfl; tauto
-          subst this
-          use w
-          constructor
-          · exact Relation.ReflTransGen.refl
-          · specialize MwY (~f)
-            simp at MwY
-            apply MwY
-            right
-            exact List.mem_of_mem_head? rfl
-        case inr FS_in_unrav =>
-
-          sorry
-      case inr g_neq_nsSf =>
-        apply MwY
-        simp
-        left
-        exact ⟨g_in_X, g_neq_nsSf⟩
-    · intro Mw_X -- soundness, needs Lemma
-      have w_adiamond_f := Mw_X (~⌈∗a⌉f) naSf_in_X
-      simp at w_adiamond_f
-      rcases w_adiamond_f with ⟨v, w_aS_v, v_nF⟩
-      -- NOTE: Borze also makes a distinction whether a is atomic. Not needed?
-      -- We still distinguish cases whether v = w
-      cases Classical.em (w = v)
-      case inl w_is_v =>
-        -- Same world, we can use the left branch.
-        subst w_is_v
-        use (X \ {~⌈∗a⌉f} ∪ {~f})
-        constructor
-        · apply union_elem_uplus
-          simp
-          unfold unravel
-          simp
-          use {~f}
-          constructor
-          · left
-            exact List.mem_of_mem_head? rfl
-          · rfl
-        · intro g g_in
-          simp at g_in
-          cases g_in
-          · tauto
-          case h.right.inr hyp =>
-            subst hyp
-            unfold evaluate
-            assumption
-      case inr w_neq_v =>
-        -- Different world, we use the right branch and Lemma 4 here:
-        have lemFour := likeLemmaFour M (∗ a) w v X.toList (inject f) w_neq_v
-        simp [vDash, modelCanSemImplyForm, modelCanSemImplyList] at lemFour
-        specialize lemFour _ w_aS_v v_nF
-        · intro g g_in
-          apply Mw_X
-          cases g_in
-          case a.inl => assumption
-          case a.inr h => convert naSf_in_X
-        rcases lemFour with ⟨Z, Z_in, Mw_ZX, ⟨as, nBasf_in, w_as_v⟩⟩
-        use (X \ {~⌈∗a⌉f}) ∪ Z.toFinset
-        constructor
-        · exact union_elem_uplus (by simp) (by simp; use Z)
-        · intro g g_in; simp at g_in; apply Mw_ZX; tauto
+    · intro Mw_X φ phi_in
+      apply Mw_X
+      aesop
+    · intro Mw_X φ phi_in
+      apply Mw_X
+      cases em (φ = (~⌈∗a⌉f))
+      all_goals aesop
   case sta a f aSf_in_X =>
+    rw [Iff.comm]
+    convert starSoundness a M w (X \ {⌈∗a⌉f}) (inject f) -- using the Box version of Lemma 5
+    all_goals simp [vDash, undag, modelCanSemImplyDagTabNodeNext, inject]
     constructor
-    · rintro ⟨Y, Y_in, w_Y⟩ -- invertibility, needs Lemma 4 3/4
-      simp at Y_in
-      rcases Y_in with ⟨Z, Z_in_unrav, Y_def⟩
-      subst Y_def
-      intro g g_in_X
-      cases Classical.em (g = (⌈∗a⌉f))
-      case inl g_def =>
-        subst g_def
-        simp
-        intro v w_a_v
-        have := lemmaFourAndThreeQuarters M -- use here?
-        sorry
-      case inr g_not =>
-        apply w_Y
-        simp
-        tauto
-    · intro w_X -- soundness, should be easy
-      simp
-      specialize w_X (⌈∗a⌉f) aSf_in_X
-      simp at w_X
-      -- simp
-      -- use (X \ {⌈∗a⌉f} ∪ (List.toFinset {f} ∪ List.toFinset a_1))
-      sorry
+    · intro Mw_X φ phi_in
+      apply Mw_X
+      aesop
+    · intro Mw_X φ phi_in
+      apply Mw_X
+      cases em (φ = (⌈∗a⌉f))
+      all_goals aesop
 
   -- OTHER PDL RULES
   case nTe φ ψ in_X =>
@@ -317,7 +241,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
       simp
       intro f f_in
       simp at f_in
-      rcases f_in with f_is_phi | ⟨f_in_X, not_f⟩ | f_is_notPsi
+      rcases f_in with f_is_phi | ⟨f_in_X, _⟩ | f_is_notPsi
       · subst f_is_phi
         specialize w_X _ in_X
         simp at w_X
@@ -344,7 +268,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
       simp
       intro f f_in
       simp at f_in
-      rcases f_in with ⟨f_in_X, not_f⟩ | f_is_notabPhi
+      rcases f_in with ⟨f_in_X, _⟩ | f_is_notabPhi
       · exact w_X _ f_in_X
       · subst f_is_notabPhi
         specialize w_X (~(⌈a;'b⌉φ)) nabf_in_X
@@ -367,7 +291,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
       simp
       intro f f_in
       simp at f_in
-      rcases f_in with f_is_aPhi | ⟨f_in_X, f_is_not_aubPhi⟩ | f_is_bPhi
+      rcases f_in with f_is_aPhi | ⟨f_in_X, _⟩ | f_is_bPhi
       · subst f_is_aPhi
         specialize w_X (⌈a⋓b⌉φ) aubPhi_in_X
         simp at *
@@ -394,7 +318,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
       simp
       intro f f_in
       simp at f_in
-      rcases f_in with ⟨f_in_X, not_f⟩ | f_is_abPhi
+      rcases f_in with ⟨f_in_X, _⟩ | f_is_abPhi
       · exact w_X _ f_in_X
       · subst f_is_abPhi
         specialize w_X (⌈a;'b⌉φ) abPhi_in_X
@@ -452,7 +376,7 @@ lemma localRuleTruth {W} {M : KripkeModel W} {w : W} {X B} :
         case inr f_def =>
           subst f_def
           exact w_Phi
-  case nUn a b φ naubPhi_in_X  => -- localRule X { X \ {~⌈a ⋓ b⌉φ} ∪ {~⌈a⌉φ}, X \ {~⌈a ⋓ b⌉φ} ∪ {~⌈b⌉φ} }
+  case nUn a b φ naubPhi_in_X => -- { X \ {~⌈a ⋓ b⌉φ} ∪ {~⌈a⌉φ}, X \ {~⌈a ⋓ b⌉φ} ∪ {~⌈b⌉φ} }
     constructor
     · rintro ⟨Y, Y_in, w_Y⟩
       simp at Y_in