section \Proof Systems for First-Order Logic - Refining the Natural Deduction Assistant (NaDeA)\ theory MainProof imports Main begin section \Natural Deduction\ subsection \Syntax\ type_synonym id = nat datatype tm = Var nat | Fun id \tm list\ datatype fm = Falsity | Pre id \tm list\ | Imp fm fm | Dis fm fm | Con fm fm | Exi fm | Uni fm subsection \Semantics\ primrec semantics_term :: \(nat \ 'a) \ (id \ 'a list \ 'a) \ tm \ 'a\ and semantics_list :: \(nat \ 'a) \ (id \ 'a list \ 'a) \ tm list \ 'a list\ where \semantics_term e f (Var n) = e n\ | \semantics_term e f (Fun i l) = f i (semantics_list e f l)\ | \semantics_list e f [] = []\ | \semantics_list e f (t # l) = semantics_term e f t # semantics_list e f l\ primrec semantics :: \(nat \ 'a) \ (id \ 'a list \ 'a) \ (id \ 'a list \ bool) \ fm \ bool\ where \semantics e f g Falsity = False\ | \semantics e f g (Pre i l) = g i (semantics_list e f l)\ | \semantics e f g (Imp p q) = (if semantics e f g p then semantics e f g q else True)\ | \semantics e f g (Dis p q) = (if semantics e f g p then True else semantics e f g q)\ | \semantics e f g (Con p q) = (if semantics e f g p then semantics e f g q else False)\ | \semantics e f g (Exi p) = (\x. semantics (\n. if n = 0 then x else e (n - 1)) f g p)\ | \semantics e f g (Uni p) = (\x. semantics (\n. if n = 0 then x else e (n - 1)) f g p)\ subsection \Proof System\ primrec member :: \fm \ fm list \ bool\ where \member p [] = False\ | \member p (q # z) = (if p = q then True else member p z)\ primrec new_term :: \id \ tm \ bool\ and new_list :: \id \ tm list \ bool\ where \new_term c (Var n) = True\ | \new_term c (Fun i l) = (if i = c then False else new_list c l)\ | \new_list c [] = True\ | \new_list c (t # l) = (if new_term c t then new_list c l else False)\ primrec new :: \id \ fm \ bool\ where \new c Falsity = True\ | \new c (Pre i l) = new_list c l\ | \new c (Imp p q) = (if new c p then new c q else False)\ | \new c (Dis p q) = (if new c p then new c q else False)\ | \new c (Con p q) = (if new c p then new c q else False)\ | \new c (Exi p) = new c p\ | \new c (Uni p) = new c p\ primrec news :: \id \ fm list \ bool\ where \news c [] = True\ | \news c (p # z) = (if new c p then news c z else False)\ primrec inc_term :: \tm \ tm\ and inc_list :: \tm list \ tm list\ where \inc_term (Var n) = Var (n + 1)\ | \inc_term (Fun i l) = Fun i (inc_list l)\ | \inc_list [] = []\ | \inc_list (t # l) = inc_term t # inc_list l\ primrec sub_term :: \nat \ tm \ tm \ tm\ and sub_list :: \nat \ tm \ tm list \ tm list\ where \sub_term v s (Var n) = (if n < v then Var n else if n = v then s else Var (n - 1))\ | \sub_term v s (Fun i l) = Fun i (sub_list v s l)\ | \sub_list v s [] = []\ | \sub_list v s (t # l) = sub_term v s t # sub_list v s l\ primrec sub :: \nat \ tm \ fm \ fm\ where \sub v s Falsity = Falsity\ | \sub v s (Pre i l) = Pre i (sub_list v s l)\ | \sub v s (Imp p q) = Imp (sub v s p) (sub v s q)\ | \sub v s (Dis p q) = Dis (sub v s p) (sub v s q)\ | \sub v s (Con p q) = Con (sub v s p) (sub v s q)\ | \sub v s (Exi p) = Exi (sub (v + 1) (inc_term s) p)\ | \sub v s (Uni p) = Uni (sub (v + 1) (inc_term s) p)\ abbreviation (input) \subt t p \ sub 0 t p\ abbreviation (input) \inst c p \ subt (Fun c []) p\ inductive natural_deduction :: \fm list \ fm \ bool\ (infix \\\ 0) where Assms: \z \ p\ if \member p z\ | Fls_E: \z \ p\ if \z \ Falsity\ | Imp_E: \z \ q\ if \z \ Imp p q\ and \z \ p\ | Imp_I: \z \ Imp p q\ if \p # z \ q\ | Dis_E: \z \ r\ if \z \ Dis p q\ and \p # z \ r\ and \q # z \ r\ | Dis_I: \z \ Dis p q\ if \z \ p\ | Dis_J: \z \ Dis p q\ if \z \ q\ | Con_E: \z \ p\ if \z \ Con p q\ | Con_F: \z \ q\ if \z \ Con p q\ | Con_I: \z \ Con p q\ if \z \ p\ and \z \ q\ | Exi_E: \z \ q\ if \z \ Exi p\ and \inst c p # z \ q\ and \news c (p # q # z)\ | Exi_I: \z \ Exi p\ if \z \ subt t p\ | Uni_E: \z \ subt t p\ if \z \ Uni p\ | Uni_I: \z \ Uni p\ if \z \ inst c p\ and \news c (p # z)\ | Imp_C: \z \ p\ if \Imp p q # z \ p\ subsection \Soundness\ lemma member [iff]: \member p z \ p \ set z\ by (induct z) simp_all lemma symbols [simp]: \(if p then q else True) = (p \ q)\ \(if p then True else q) = (p \ q)\ \(if p then q else False) = (p \ q)\ by simp_all fun put :: \(nat \ 'a) \ nat \ 'a \ nat \ 'a\ where \put e v x = (\n. if n < v then e n else if n = v then x else e (n - 1))\ proposition \put e 0 x = (\n. if n = 0 then x else e (n - 1))\ by simp proposition \semantics e f g (Exi p) = (\x. semantics (put e 0 x) f g p)\ \semantics e f g (Uni p) = (\x. semantics (put e 0 x) f g p)\ by simp_all lemma increment: \semantics_term (put e 0 x) f (inc_term t) = semantics_term e f t\ \semantics_list (put e 0 x) f (inc_list l) = semantics_list e f l\ by (induct t and l rule: semantics_term.induct semantics_list.induct) simp_all lemma commute: \put (put e v x) 0 y = put (put e 0 y) (v + 1) x\ by fastforce lemma allnew [simp]: \list_all (new c) z = news c z\ by (induct z) simp_all lemma map' [simp]: \new_term n t \ semantics_term e (f(n := x)) t = semantics_term e f t\ \new_list n l \ semantics_list e (f(n := x)) l = semantics_list e f l\ by (induct t and l rule: semantics_term.induct semantics_list.induct) auto lemma map [simp]: \new n p \ semantics e (f(n := x)) g p = semantics e f g p\ by (induct p arbitrary: e) simp_all lemma allmap [simp]: \news c z \ list_all (semantics e (f(c := m)) g) z = list_all (semantics e f g) z\ by (induct z) simp_all lemma substitute' [simp]: \semantics_term e f (sub_term v s t) = semantics_term (put e v (semantics_term e f s)) f t\ \semantics_list e f (sub_list v s l) = semantics_list (put e v (semantics_term e f s)) f l\ by (induct t and l rule: semantics_term.induct semantics_list.induct) simp_all lemma substitute [simp]: \semantics e f g (sub v t p) = semantics (put e v (semantics_term e f t)) f g p\ proof (induct p arbitrary: e v t) case (Exi p) have \semantics e f g (sub v t (Exi p)) = (\x. semantics (put e 0 x) f g (sub (v + 1) (inc_term t) p))\ by simp also have \\ = (\x. semantics (put (put e 0 x) (v + 1) (semantics_term (put e 0 x) f (inc_term t))) f g p)\ using Exi by simp also have \\ = (\x. semantics (put (put e v (semantics_term e f t)) 0 x) f g p)\ using commute increment(1) by metis finally show ?case by simp next case (Uni p) have \semantics e f g (sub v t (Uni p)) = (\x. semantics (put e 0 x) f g (sub (v + 1) (inc_term t) p))\ by simp also have \\ = (\x. semantics (put (put e 0 x) (v + 1) (semantics_term (put e 0 x) f (inc_term t))) f g p)\ using Uni by simp also have \\ = (\x. semantics (put (put e v (semantics_term e f t)) 0 x) f g p)\ using commute increment(1) by metis finally show ?case by simp qed simp_all lemma natural_deduction_soundness: \z \ p \ list_all (semantics e f g) z \ semantics e f g p\ proof (induct z p arbitrary: f rule: natural_deduction.induct) case (Exi_E z p c q) then obtain x where \semantics (put e 0 x) f g p\ by auto then have \semantics (put e 0 x) (f(c := \w. x)) g p\ using \news c (p # q # z)\ by simp then have \semantics e (f(c := \w. x)) g (inst c p)\ by simp then have \list_all (semantics e (f(c := \w. x)) g) (inst c p # z)\ using Exi_E by simp then have \semantics e (f(c := \w. x)) g q\ using Exi_E by blast then show \semantics e f g q\ using \news c (p # q # z)\ by simp next case (Uni_I z c p) then have \\x. list_all (semantics e (f(c := \w. x)) g) z\ by simp then have \\x. semantics e (f(c := \w. x)) g (inst c p)\ using Uni_I by blast then have \\x. semantics (put e 0 x) (f(c := \w. x)) g p\ by simp then have \\x. semantics (put e 0 x) f g p\ using \news c (p # z)\ by simp then show \semantics e f g (Uni p)\ by simp qed (auto simp: list_all_iff) abbreviation \Neg p \ Imp p Falsity\ abbreviation \Truth \ Neg Falsity\ abbreviation provable (\\ _\ 0) where \(\ p) \ ([] \ p)\ proposition \\ Truth\ using Assms Imp_I by (meson member.simps) theorem soundness_provable: \semantics e f g p\ if \\ p\ using natural_deduction_soundness that by fastforce subsection \Equivalent Proof System (NaDeA)\ inductive OK where Assms: \member p z \ OK p z\ | Imp_E: \OK (Imp p q) z \ OK p z \ OK q z\ | Imp_I: \OK q (p # z) \ OK (Imp p q) z\ | Dis_E: \OK (Dis p q) z \ OK r (p # z) \ OK r (q # z) \ OK r z\ | Dis_I: \OK p z \ OK (Dis p q) z\ | Dis_J: \OK q z \ OK (Dis p q) z\ | Con_E: \OK (Con p q) z \ OK p z\ | Con_F: \OK (Con p q) z \ OK q z\ | Con_I: \OK p z \ OK q z \ OK (Con p q) z\ | Exi_E: \OK (Exi p) z \ OK q (inst c p # z) \ news c (p # q # z) \ OK q z\ | Exi_I: \OK (subt t p) z \ OK (Exi p) z\ | Uni_E: \OK (Uni p) z \ OK (subt t p) z\ | Uni_I: \OK (inst c p) z \ news c (p # z) \ OK (Uni p) z\ | Boole: \OK Falsity (Neg p # z) \ OK p z\ lemmas Dis_I1 = Dis_I and Dis_I2 = Dis_J and Con_E1 = Con_E and Con_E2 = Con_F and Assume = Assms lemma OK_to_natural_deduction: \OK p z \ (z \ p)\ proof (induct p z rule: OK.induct) case Assms then show ?case using natural_deduction.Assms by blast next case Imp_E then show ?case using natural_deduction.Imp_E by blast next case Imp_I then show ?case using natural_deduction.Imp_I by blast next case Dis_E then show ?case using natural_deduction.Dis_E by blast next case Dis_I then show ?case using natural_deduction.Dis_I by blast next case Dis_J then show ?case using natural_deduction.Dis_J by blast next case Con_E then show ?case using natural_deduction.Con_E by blast next case Con_F then show ?case using natural_deduction.Con_F by blast next case Con_I then show ?case using natural_deduction.Con_I by blast next case Exi_E then show ?case using natural_deduction.Exi_E by blast next case Exi_I then show ?case using natural_deduction.Exi_I by blast next case Uni_E then show ?case using natural_deduction.Uni_E by blast next case Uni_I then show ?case using natural_deduction.Uni_I by blast next case Boole then show ?case using Fls_E Imp_C by blast qed lemma Peirce: \OK (Imp (Imp (Imp p q) p) p) z\ proof (rule Imp_I) show \OK p (Imp (Imp p q) p # z)\ proof (rule Boole) show \OK Falsity (Neg p # Imp (Imp p q) p # z)\ proof (rule Imp_E) show \OK (Neg p) (Neg p # Imp (Imp p q) p # z)\ by (rule Assume) simp next show \OK p (Neg p # Imp (Imp p q) p # z)\ proof (rule Imp_E) show \OK (Imp (Imp p q) p) (Neg p # Imp (Imp p q) p # z)\ by (rule Assume) simp next show \OK (Imp p q) (Neg p # Imp (Imp p q) p # z)\ proof (rule Imp_I) show \OK q (p # Neg p # Imp (Imp p q) p # z)\ proof (rule Boole) show \OK Falsity (Neg q # p # Neg p # Imp (Imp p q) p # z)\ proof (rule Imp_E) show \OK (Neg p) (Neg q # p # Neg p # Imp (Imp p q) p # z)\ by (rule Assume) simp next show \OK p (Neg q # p # Neg p # Imp (Imp p q) p # z)\ by (rule Assume) simp qed qed qed qed qed qed qed lemma natural_deduction_to_OK: \(z \ p) \ OK p z\ proof (induct z p rule: natural_deduction.induct) case Assms then show ?case using Assume by blast next case Fls_E then show ?case using Assume Boole Imp_E Imp_I by (meson member.simps) next case Imp_E then show ?case using OK.Imp_E by blast next case Imp_I then show ?case using OK.Imp_I by blast next case Dis_E then show ?case using OK.Dis_E by blast next case Dis_I then show ?case using OK.Dis_I by blast next case Dis_J then show ?case using OK.Dis_J by blast next case Con_E then show ?case using OK.Con_E by blast next case Con_F then show ?case using OK.Con_F by blast next case Con_I then show ?case using OK.Con_I by blast next case Exi_E then show ?case using OK.Exi_E by blast next case Exi_I then show ?case using OK.Exi_I by blast next case Uni_E then show ?case using OK.Uni_E by blast next case Uni_I then show ?case using OK.Uni_I by blast next case Imp_C then show ?case using Imp_E Imp_I Peirce by blast qed theorem OK_natural_deduction: \OK p z = (z \ p)\ using OK_to_natural_deduction natural_deduction_to_OK by blast theorem soundness: \OK p [] \ semantics e f g p\ using OK_natural_deduction soundness_provable by blast corollary \\p. OK p []\ \\p. \ OK p []\ proof - have \OK (Imp p p) []\ for p by (rule Imp_I, rule Assume, simp) then show \\p. OK p []\ by iprover next have \\ semantics (e :: _ \ unit) f g Falsity\ for e f g by simp then show \\p. \ OK p []\ using soundness by iprover qed section \Appendix: Sequent Calculus\ subsection \Proof System\ inductive sequent_calculus :: \fm list \ bool\ (\\ _\ 0) where Basic: \\ p # z\ if \member (Neg p) z\ | Imp_R: \\ Imp p q # z\ if \\ Neg p # q # z\ | Imp_L: \\ Neg (Imp p q) # z\ if \\ p # z\ and \\ Neg q # z\ | Dis_R: \\ Dis p q # z\ if \\ p # q # z\ | Dis_L: \\ Neg (Dis p q) # z\ if \\ Neg p # z\ and \\ Neg q # z\ | Con_R: \\ Con p q # z\ if \\ p # z\ and \\ q # z\ | Con_L: \\ Neg (Con p q) # z\ if \\ Neg p # Neg q # z\ | Exi_R: \\ Exi p # z\ if \\ subt t p # z\ | Exi_L: \\ Neg (Exi p) # z\ if \\ Neg (inst c p) # z\ and \news c (p # z)\ | Uni_R: \\ Uni p # z\ if \\ inst c p # z\ and \news c (p # z)\ | Uni_L: \\ Neg (Uni p) # z\ if \\ Neg (subt t p) # z\ | Extra: \\ z\ if \\ p # z\ and \member p z\ subsection \Soundness\ theorem sequent_calculus_soundness: \\ z \ \p \ set z. semantics e f g p\ proof (induct arbitrary: f rule: sequent_calculus.induct) case (Exi_L c p z) then consider \\x. semantics e (f(c := \w. x)) g (Neg (inst c p))\ | \\x. \p \ set (Neg (Exi p) # z). semantics e (f(c := \w. x)) g p\ by fastforce then show ?case proof cases case 1 then have \\x. semantics (put e 0 x) (f(c := \w. x)) g (Neg p)\ by simp then have \\x. semantics (put e 0 x) f g (Neg p)\ using \news c (p # z)\ by simp then show ?thesis by simp next case 2 then show ?thesis using \news c (p # z)\ by (metis Ball_set allnew map new.simps(1,3,6) news.simps(2)) qed next case (Uni_R c p z) then consider \\x. semantics e (f(c := \w. x)) g (inst c p)\ | \\x. \p \ set (Uni p # z). semantics e (f(c := \w. x)) g p\ by fastforce then show ?case proof cases case 1 then have \\x. semantics (put e 0 x) (f(c := \w. x)) g p\ by simp then have \\x. semantics (put e 0 x) f g p\ using \news c (p # z)\ by simp then show ?thesis by simp next case 2 then show ?thesis using \news c (p # z)\ by (metis Ball_set allnew map new.simps(7) news.simps(2)) qed qed force+ subsection \Derived Rules\ theorem Truth: \\ Truth # z\ using Basic Extra Imp_R by (meson member.simps) theorem NegNeg: \\ Neg (Neg p) # z\ if \\ p # z\ using Imp_L that Truth . text \MiniCalc uses the derived rule Ext instead of Extra and does not allow Falsity and Truth\ end