diff --git a/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution.thy b/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution.thy --- a/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution.thy +++ b/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution.thy @@ -1,1297 +1,1309 @@ (* Title: First-Order Ordered Resolution Calculus with Selection Author: Anders Schlichtkrull , 2016, 2017 Author: Jasmin Blanchette , 2014, 2017 Author: Dmitriy Traytel , 2014 + Author: Sophie Tourret , 2020 Maintainer: Anders Schlichtkrull *) section \First-Order Ordered Resolution Calculus with Selection\ theory FO_Ordered_Resolution imports Abstract_Substitution Ordered_Ground_Resolution Standard_Redundancy begin text \ This material is based on Section 4.3 (``A Simple Resolution Prover for First-Order Clauses'') of Bachmair and Ganzinger's chapter. Specifically, it formalizes the ordered resolution calculus for first-order standard clauses presented in Figure 4 and its related lemmas and theorems, including soundness and Lemma 4.12 (the lifting lemma). The following corresponds to pages 41--42 of Section 4.3, until Figure 5 and its explanation. \ locale FO_resolution = mgu subst_atm id_subst comp_subst atm_of_atms renamings_apart mgu for subst_atm :: "'a :: wellorder \ 's \ 'a" and id_subst :: "'s" and comp_subst :: "'s \ 's \ 's" and renamings_apart :: "'a literal multiset list \ 's list" and atm_of_atms :: "'a list \ 'a" and mgu :: "'a set set \ 's option" + fixes less_atm :: "'a \ 'a \ bool" assumes less_atm_stable: "less_atm A B \ less_atm (A \a \) (B \a \)" begin subsection \Library\ lemma Bex_cartesian_product: "(\xy \ A \ B. P xy) \ (\x \ A. \y \ B. P (x, y))" by simp (* FIXME: Move to "Multiset.thy" *) lemma length_sorted_list_of_multiset[simp]: "length (sorted_list_of_multiset A) = size A" by (metis mset_sorted_list_of_multiset size_mset) (* FIXME: move? or avoid? *) lemma eql_map_neg_lit_eql_atm: assumes "map (\L. L \l \) (map Neg As') = map Neg As" shows "As' \al \ = As" using assms by (induction As' arbitrary: As) auto lemma instance_list: assumes "negs (mset As) = SDA' \ \" shows "\As'. negs (mset As') = SDA' \ As' \al \ = As" proof - from assms have negL: "\L \# SDA'. is_neg L" using Melem_subst_cls subst_lit_in_negs_is_neg by metis from assms have "{#L \l \. L \# SDA'#} = mset (map Neg As)" using subst_cls_def by auto then have "\NAs'. map (\L. L \l \) NAs' = map Neg As \ mset NAs' = SDA'" using image_mset_of_subset_list[of "\L. L \l \" SDA' "map Neg As"] by auto then obtain As' where As'_p: "map (\L. L \l \) (map Neg As') = map Neg As \ mset (map Neg As') = SDA'" by (metis (no_types, lifting) Neg_atm_of_iff negL ex_map_conv set_mset_mset) have "negs (mset As') = SDA'" using As'_p by auto moreover have "map (\L. L \l \) (map Neg As') = map Neg As" using As'_p by auto then have "As' \al \ = As" using eql_map_neg_lit_eql_atm by auto ultimately show ?thesis by blast qed context fixes S :: "'a clause \ 'a clause" begin subsection \Calculus\ text \ The following corresponds to Figure 4. \ definition maximal_wrt :: "'a \ 'a literal multiset \ bool" where "maximal_wrt A C \ (\B \ atms_of C. \ less_atm A B)" definition strictly_maximal_wrt :: "'a \ 'a literal multiset \ bool" where "strictly_maximal_wrt A C \ \B \ atms_of C. A \ B \ \ less_atm A B" lemma strictly_maximal_wrt_maximal_wrt: "strictly_maximal_wrt A C \ maximal_wrt A C" unfolding maximal_wrt_def strictly_maximal_wrt_def by auto (* FIXME: use hd instead of ! 0 *) inductive eligible :: "'s \ 'a list \ 'a clause \ bool" where eligible: "S DA = negs (mset As) \ S DA = {#} \ length As = 1 \ maximal_wrt (As ! 0 \a \) (DA \ \) \ eligible \ As DA" inductive ord_resolve :: "'a clause list \ 'a clause \ 'a multiset list \ 'a list \ 's \ 'a clause \ bool" where ord_resolve: "length CAs = n \ length Cs = n \ length AAs = n \ length As = n \ n \ 0 \ (\i < n. CAs ! i = Cs ! i + poss (AAs ! i)) \ (\i < n. AAs ! i \ {#}) \ Some \ = mgu (set_mset ` set (map2 add_mset As AAs)) \ eligible \ As (D + negs (mset As)) \ (\i < n. strictly_maximal_wrt (As ! i \a \) (Cs ! i \ \)) \ (\i < n. S (CAs ! i) = {#}) \ ord_resolve CAs (D + negs (mset As)) AAs As \ ((\# (mset Cs) + D) \ \)" inductive ord_resolve_rename :: "'a clause list \ 'a clause \ 'a multiset list \ 'a list \ 's \ 'a clause \ bool" where ord_resolve_rename: "length CAs = n \ length AAs = n \ length As = n \ (\i < n. poss (AAs ! i) \# CAs ! i) \ negs (mset As) \# DA \ \ = hd (renamings_apart (DA # CAs)) \ \s = tl (renamings_apart (DA # CAs)) \ ord_resolve (CAs \\cl \s) (DA \ \) (AAs \\aml \s) (As \al \) \ E \ ord_resolve_rename CAs DA AAs As \ E" lemma ord_resolve_empty_main_prem: "\ ord_resolve Cs {#} AAs As \ E" by (simp add: ord_resolve.simps) lemma ord_resolve_rename_empty_main_prem: "\ ord_resolve_rename Cs {#} AAs As \ E" by (simp add: ord_resolve_empty_main_prem ord_resolve_rename.simps) subsection \Soundness\ text \ Soundness is not discussed in the chapter, but it is an important property. \ lemma ord_resolve_ground_inst_sound: assumes res_e: "ord_resolve CAs DA AAs As \ E" and cc_inst_true: "I \m mset CAs \cm \ \cm \" and d_inst_true: "I \ DA \ \ \ \" and ground_subst_\: "is_ground_subst \" shows "I \ E \ \" using res_e proof (cases rule: ord_resolve.cases) case (ord_resolve n Cs D) note da = this(1) and e = this(2) and cas_len = this(3) and cs_len = this(4) and aas_len = this(5) and as_len = this(6) and cas = this(8) and mgu = this(10) and len = this(1) have len: "length CAs = length As" using as_len cas_len by auto have "is_ground_subst (\ \ \)" using ground_subst_\ by (rule is_ground_comp_subst) then have cc_true: "I \m mset CAs \cm \ \cm \" and d_true: "I \ DA \ \ \ \" using cc_inst_true d_inst_true by auto from mgu have unif: "\i < n. \A\#AAs ! i. A \a \ = As ! i \a \" using mgu_unifier as_len aas_len by blast show "I \ E \ \" proof (cases "\A \ set As. A \a \ \a \ \ I") case True then have "\ I \ negs (mset As) \ \ \ \" unfolding true_cls_def[of I] by auto then have "I \ D \ \ \ \" using d_true da by auto then show ?thesis unfolding e by auto next case False then obtain i where a_in_aa: "i < length CAs" and a_false: "(As ! i) \a \ \a \ \ I" using da len by (metis in_set_conv_nth) define C where "C \ Cs ! i" define BB where "BB \ AAs ! i" have c_cf': "C \# \# (mset CAs)" unfolding C_def using a_in_aa cas cas_len by (metis less_subset_eq_Union_mset mset_subset_eq_add_left subset_mset.order.trans) have c_in_cc: "C + poss BB \# mset CAs" using C_def BB_def a_in_aa cas_len in_set_conv_nth cas by fastforce { fix B assume "B \# BB" then have "B \a \ = (As ! i) \a \" using unif a_in_aa cas_len unfolding BB_def by auto } then have "\ I \ poss BB \ \ \ \" using a_false by (auto simp: true_cls_def) moreover have "I \ (C + poss BB) \ \ \ \" using c_in_cc cc_true true_cls_mset_true_cls[of I "mset CAs \cm \ \cm \"] by force ultimately have "I \ C \ \ \ \" by simp then show ?thesis unfolding e subst_cls_union using c_cf' C_def a_in_aa cas_len cs_len by (metis (no_types, lifting) mset_subset_eq_add_left nth_mem_mset set_mset_mono sum_mset.remove true_cls_mono subst_cls_mono) qed qed text \ -The previous lemma is not only used to prove soundness, but also the following lemma which is +The previous lemma is not only used to prove soundness, but also the following lemma which is used to prove Lemma 4.10. \ lemma ord_resolve_rename_ground_inst_sound: assumes "ord_resolve_rename CAs DA AAs As \ E" and "\s = tl (renamings_apart (DA # CAs))" and "\ = hd (renamings_apart (DA # CAs))" and "I \m (mset (CAs \\cl \s)) \cm \ \cm \" and "I \ DA \ \ \ \ \ \" and "is_ground_subst \" shows "I \ E \ \" using assms by (cases rule: ord_resolve_rename.cases) (fast intro: ord_resolve_ground_inst_sound) text \ Here follows the soundness theorem for the resolution rule. \ theorem ord_resolve_sound: assumes res_e: "ord_resolve CAs DA AAs As \ E" and cc_d_true: "\\. is_ground_subst \ \ I \m (mset CAs + {#DA#}) \cm \" and ground_subst_\: "is_ground_subst \" shows "I \ E \ \" proof (use res_e in \cases rule: ord_resolve.cases\) case (ord_resolve n Cs D) note da = this(1) and e = this(2) and cas_len = this(3) and cs_len = this(4) and aas_len = this(5) and as_len = this(6) and cas = this(8) and mgu = this(10) have ground_subst_\_\: "is_ground_subst (\ \ \)" using ground_subst_\ by (rule is_ground_comp_subst) have cas_true: "I \m mset CAs \cm \ \cm \" using cc_d_true ground_subst_\_\ by fastforce have da_true: "I \ DA \ \ \ \" using cc_d_true ground_subst_\_\ by fastforce show "I \ E \ \" using ord_resolve_ground_inst_sound[OF res_e cas_true da_true] ground_subst_\ by auto qed lemma subst_sound: - assumes + assumes "\\. is_ground_subst \ \ I \ (C \ \)" and "is_ground_subst \" shows "I \ (C \ \) \ \" - using assms is_ground_comp_subst subst_cls_comp_subst by metis + using assms is_ground_comp_subst subst_cls_comp_subst by metis lemma subst_sound_scl: assumes len: "length P = length CAs" and true_cas: "\\. is_ground_subst \ \ I \m (mset CAs) \cm \" and - ground_subst_\: "is_ground_subst \" + ground_subst_\: "is_ground_subst \" shows "I \m mset (CAs \\cl P) \cm \" proof - from true_cas have "\CA. CA\# mset CAs \ (\\. is_ground_subst \ \ I \ CA \ \)" unfolding true_cls_mset_def by force then have "\i < length CAs. \\. is_ground_subst \ \ (I \ CAs ! i \ \)" using in_set_conv_nth by auto then have true_cp: "\i < length CAs. \\. is_ground_subst \ \ I \ CAs ! i \ P ! i \ \" using subst_sound len by auto { fix CA assume "CA \# mset (CAs \\cl P)" then obtain i where i_x: "i < length (CAs \\cl P)" "CA = (CAs \\cl P) ! i" by (metis in_mset_conv_nth) then have "\\. is_ground_subst \ \ I \ CA \ \" using true_cp unfolding subst_cls_lists_def by (simp add: len) } then show ?thesis using assms unfolding true_cls_mset_def by auto qed text \ Here follows the soundness theorem for the resolution rule with renaming. \ lemma ord_resolve_rename_sound: assumes res_e: "ord_resolve_rename CAs DA AAs As \ E" and cc_d_true: "\\. is_ground_subst \ \ I \m ((mset CAs) + {#DA#}) \cm \" and ground_subst_\: "is_ground_subst \" shows "I \ E \ \" using res_e proof (cases rule: ord_resolve_rename.cases) case (ord_resolve_rename n \ \s) note \s = this(7) and res = this(8) have len: "length \s = length CAs" using \s renamings_apart_length by auto have "\\. is_ground_subst \ \ I \m (mset (CAs \\cl \s) + {#DA \ \#}) \cm \" using subst_sound_scl[OF len, of I] subst_sound cc_d_true by auto then show "I \ E \ \" using ground_subst_\ ord_resolve_sound[OF res] by simp qed subsection \Other Basic Properties\ lemma ord_resolve_unique: assumes "ord_resolve CAs DA AAs As \ E" and "ord_resolve CAs DA AAs As \' E'" shows "\ = \' \ E = E'" using assms proof (cases rule: ord_resolve.cases[case_product ord_resolve.cases], intro conjI) case (ord_resolve_ord_resolve CAs n Cs AAs As \'' DA CAs' n' Cs' AAs' As' \''' DA') note res = this(1-17) and res' = this(18-34) show \: "\ = \'" using res(3-5,14) res'(3-5,14) by (metis option.inject) have "Cs = Cs'" using res(1,3,7,8,12) res'(1,3,7,8,12) by (metis add_right_imp_eq nth_equalityI) moreover have "DA = DA'" using res(2,4) res'(2,4) by fastforce ultimately show "E = E'" using res(5,6) res'(5,6) \ by blast qed lemma ord_resolve_rename_unique: assumes "ord_resolve_rename CAs DA AAs As \ E" and "ord_resolve_rename CAs DA AAs As \' E'" shows "\ = \' \ E = E'" using assms unfolding ord_resolve_rename.simps using ord_resolve_unique by meson lemma ord_resolve_max_side_prems: "ord_resolve CAs DA AAs As \ E \ length CAs \ size DA" by (auto elim!: ord_resolve.cases) lemma ord_resolve_rename_max_side_prems: "ord_resolve_rename CAs DA AAs As \ E \ length CAs \ size DA" by (elim ord_resolve_rename.cases, drule ord_resolve_max_side_prems, simp add: renamings_apart_length) subsection \Inference System\ definition ord_FO_\ :: "'a inference set" where "ord_FO_\ = {Infer (mset CAs) DA E | CAs DA AAs As \ E. ord_resolve_rename CAs DA AAs As \ E}" interpretation ord_FO_resolution: inference_system ord_FO_\ . lemma exists_compose: "\x. P (f x) \ \y. P y" by meson lemma finite_ord_FO_resolution_inferences_between: assumes fin_cc: "finite CC" shows "finite (ord_FO_resolution.inferences_between CC C)" proof - let ?CCC = "CC \ {C}" define all_AA where "all_AA = (\D \ ?CCC. atms_of D)" define max_ary where "max_ary = Max (size ` ?CCC)" define CAS where "CAS = {CAs. CAs \ lists ?CCC \ length CAs \ max_ary}" define AS where "AS = {As. As \ lists all_AA \ length As \ max_ary}" define AAS where "AAS = {AAs. AAs \ lists (mset ` AS) \ length AAs \ max_ary}" note defs = all_AA_def max_ary_def CAS_def AS_def AAS_def let ?infer_of = "\CAs DA AAs As. Infer (mset CAs) DA (THE E. \\. ord_resolve_rename CAs DA AAs As \ E)" let ?Z = "{\ | CAs DA AAs As \ E \. \ = Infer (mset CAs) DA E \ ord_resolve_rename CAs DA AAs As \ E \ infer_from ?CCC \ \ C \# prems_of \}" let ?Y = "{Infer (mset CAs) DA E | CAs DA AAs As \ E. ord_resolve_rename CAs DA AAs As \ E \ set CAs \ {DA} \ ?CCC}" let ?X = "{?infer_of CAs DA AAs As | CAs DA AAs As. CAs \ CAS \ DA \ ?CCC \ AAs \ AAS \ As \ AS}" let ?W = "CAS \ ?CCC \ AAS \ AS" have fin_w: "finite ?W" unfolding defs using fin_cc by (simp add: finite_lists_length_le lists_eq_set) have "?Z \ ?Y" by (force simp: infer_from_def) also have "\ \ ?X" proof - { fix CAs DA AAs As \ E assume res_e: "ord_resolve_rename CAs DA AAs As \ E" and da_in: "DA \ ?CCC" and cas_sub: "set CAs \ ?CCC" have "E = (THE E. \\. ord_resolve_rename CAs DA AAs As \ E) \ CAs \ CAS \ AAs \ AAS \ As \ AS" (is "?e \ ?cas \ ?aas \ ?as") proof (intro conjI) show ?e using res_e ord_resolve_rename_unique by (blast intro: the_equality[symmetric]) next show ?cas unfolding CAS_def max_ary_def using cas_sub ord_resolve_rename_max_side_prems[OF res_e] da_in fin_cc by (auto simp add: Max_ge_iff) next show ?aas using res_e proof (cases rule: ord_resolve_rename.cases) case (ord_resolve_rename n \ \s) note len_cas = this(1) and len_aas = this(2) and len_as = this(3) and aas_sub = this(4) and as_sub = this(5) and res_e' = this(8) show ?thesis unfolding AAS_def proof (clarify, intro conjI) show "AAs \ lists (mset ` AS)" unfolding AS_def image_def proof clarsimp fix AA assume "AA \ set AAs" then obtain i where i_lt: "i < n" and aa: "AA = AAs ! i" by (metis in_set_conv_nth len_aas) have casi_in: "CAs ! i \ ?CCC" using i_lt len_cas cas_sub nth_mem by blast have pos_aa_sub: "poss AA \# CAs ! i" using aa aas_sub i_lt by blast then have "set_mset AA \ atms_of (CAs ! i)" by (metis atms_of_poss lits_subseteq_imp_atms_subseteq set_mset_mono) also have aa_sub: "\ \ all_AA" unfolding all_AA_def using casi_in by force finally have aa_sub: "set_mset AA \ all_AA" . have "size AA = size (poss AA)" by simp also have "\ \ size (CAs ! i)" by (rule size_mset_mono[OF pos_aa_sub]) also have "\ \ max_ary" unfolding max_ary_def using fin_cc casi_in by auto finally have sz_aa: "size AA \ max_ary" . let ?As' = "sorted_list_of_multiset AA" have "?As' \ lists all_AA" using aa_sub by auto moreover have "length ?As' \ max_ary" using sz_aa by simp moreover have "AA = mset ?As'" by simp ultimately show "\xa. xa \ lists all_AA \ length xa \ max_ary \ AA = mset xa" by blast qed next have "length AAs = length As" unfolding len_aas len_as .. also have "\ \ size DA" using as_sub size_mset_mono by fastforce also have "\ \ max_ary" unfolding max_ary_def using fin_cc da_in by auto finally show "length AAs \ max_ary" . qed qed next show ?as unfolding AS_def proof (clarify, intro conjI) have "set As \ atms_of DA" using res_e[simplified ord_resolve_rename.simps] by (metis atms_of_negs lits_subseteq_imp_atms_subseteq set_mset_mono set_mset_mset) also have "\ \ all_AA" unfolding all_AA_def using da_in by blast finally show "As \ lists all_AA" unfolding lists_eq_set by simp next have "length As \ size DA" using res_e[simplified ord_resolve_rename.simps] ord_resolve_rename_max_side_prems[OF res_e] by auto also have "size DA \ max_ary" unfolding max_ary_def using fin_cc da_in by auto finally show "length As \ max_ary" . qed qed } then show ?thesis by simp fast qed also have "\ \ (\(CAs, DA, AAs, As). ?infer_of CAs DA AAs As) ` ?W" unfolding image_def Bex_cartesian_product by fast finally show ?thesis unfolding inference_system.inferences_between_def ord_FO_\_def mem_Collect_eq by (fast intro: rev_finite_subset[OF finite_imageI[OF fin_w]]) qed lemma ord_FO_resolution_inferences_between_empty_empty: "ord_FO_resolution.inferences_between {} {#} = {}" unfolding ord_FO_resolution.inferences_between_def inference_system.inferences_between_def infer_from_def ord_FO_\_def using ord_resolve_rename_empty_main_prem by auto subsection \Lifting\ text \ The following corresponds to the passage between Lemmas 4.11 and 4.12. \ context fixes M :: "'a clause set" assumes select: "selection S" begin interpretation selection by (rule select) definition S_M :: "'a literal multiset \ 'a literal multiset" where "S_M C = (if C \ grounding_of_clss M then (SOME C'. \D \. D \ M \ C = D \ \ \ C' = S D \ \ \ is_ground_subst \) else S C)" lemma S_M_grounding_of_clss: assumes "C \ grounding_of_clss M" obtains D \ where "D \ M \ C = D \ \ \ S_M C = S D \ \ \ is_ground_subst \" proof (atomize_elim, unfold S_M_def eqTrueI[OF assms] if_True, rule someI_ex) from assms show "\C' D \. D \ M \ C = D \ \ \ C' = S D \ \ \ is_ground_subst \" by (auto simp: grounding_of_clss_def grounding_of_cls_def) qed lemma S_M_not_grounding_of_clss: "C \ grounding_of_clss M \ S_M C = S C" unfolding S_M_def by simp lemma S_M_selects_subseteq: "S_M C \# C" by (metis S_M_grounding_of_clss S_M_not_grounding_of_clss S_selects_subseteq subst_cls_mono_mset) lemma S_M_selects_neg_lits: "L \# S_M C \ is_neg L" by (metis Melem_subst_cls S_M_grounding_of_clss S_M_not_grounding_of_clss S_selects_neg_lits subst_lit_is_neg) end end text \ The following corresponds to Lemma 4.12: \ lemma map2_add_mset_map: assumes "length AAs' = n" and "length As' = n" shows "map2 add_mset (As' \al \) (AAs' \aml \) = map2 add_mset As' AAs' \aml \" using assms proof (induction n arbitrary: AAs' As') case (Suc n) then have "map2 add_mset (tl (As' \al \)) (tl (AAs' \aml \)) = map2 add_mset (tl As') (tl AAs') \aml \" by simp moreover have Succ: "length (As' \al \) = Suc n" "length (AAs' \aml \) = Suc n" using Suc(3) Suc(2) by auto then have "length (tl (As' \al \)) = n" "length (tl (AAs' \aml \)) = n" by auto then have "length (map2 add_mset (tl (As' \al \)) (tl (AAs' \aml \))) = n" "length (map2 add_mset (tl As') (tl AAs') \aml \) = n" using Suc(2,3) by auto ultimately have "\i < n. tl (map2 add_mset ( (As' \al \)) ((AAs' \aml \))) ! i = tl (map2 add_mset (As') (AAs') \aml \) ! i" using Suc(2,3) Succ by (simp add: map2_tl map_tl subst_atm_mset_list_def del: subst_atm_list_tl) moreover have nn: "length (map2 add_mset ((As' \al \)) ((AAs' \aml \))) = Suc n" "length (map2 add_mset (As') (AAs') \aml \) = Suc n" using Succ Suc by auto ultimately have "\i. i < Suc n \ i > 0 \ map2 add_mset (As' \al \) (AAs' \aml \) ! i = (map2 add_mset As' AAs' \aml \) ! i" by (auto simp: subst_atm_mset_list_def gr0_conv_Suc subst_atm_mset_def) moreover have "add_mset (hd As' \a \) (hd AAs' \am \) = add_mset (hd As') (hd AAs') \am \" unfolding subst_atm_mset_def by auto then have "(map2 add_mset (As' \al \) (AAs' \aml \)) ! 0 = (map2 add_mset (As') (AAs') \aml \) ! 0" using Suc by (simp add: Succ(2) subst_atm_mset_def) ultimately have "\i < Suc n. (map2 add_mset (As' \al \) (AAs' \aml \)) ! i = (map2 add_mset (As') (AAs') \aml \) ! i" using Suc by auto then show ?case using nn list_eq_iff_nth_eq by metis qed auto lemma maximal_wrt_subst: "maximal_wrt (A \a \) (C \ \) \ maximal_wrt A C" unfolding maximal_wrt_def using in_atms_of_subst less_atm_stable by blast lemma strictly_maximal_wrt_subst: "strictly_maximal_wrt (A \a \) (C \ \) \ strictly_maximal_wrt A C" unfolding strictly_maximal_wrt_def using in_atms_of_subst less_atm_stable by blast lemma ground_resolvent_subset: assumes gr_cas: "is_ground_cls_list CAs" and gr_da: "is_ground_cls DA" and res_e: "ord_resolve S CAs DA AAs As \ E" shows "E \# \# (mset CAs) + DA" using res_e proof (cases rule: ord_resolve.cases) case (ord_resolve n Cs D) note da = this(1) and e = this(2) and cas_len = this(3) and cs_len = this(4) and aas_len = this(5) and as_len = this(6) and cas = this(8) and mgu = this(10) then have cs_sub_cas: "\# (mset Cs) \# \# (mset CAs)" using subseteq_list_Union_mset cas_len cs_len by force then have cs_sub_cas: "\# (mset Cs) \# \# (mset CAs)" using subseteq_list_Union_mset cas_len cs_len by force then have gr_cs: "is_ground_cls_list Cs" using gr_cas by simp have d_sub_da: "D \# DA" by (simp add: da) then have gr_d: "is_ground_cls D" using gr_da is_ground_cls_mono by auto have "is_ground_cls (\# (mset Cs) + D)" using gr_cs gr_d by auto with e have "E = \# (mset Cs) + D" by auto then show ?thesis using cs_sub_cas d_sub_da by (auto simp: subset_mset.add_mono) qed lemma ord_resolve_obtain_clauses: assumes res_e: "ord_resolve (S_M S M) CAs DA AAs As \ E" and select: "selection S" and grounding: "{DA} \ set CAs \ grounding_of_clss M" and n: "length CAs = n" and d: "DA = D + negs (mset As)" and c: "(\i < n. CAs ! i = Cs ! i + poss (AAs ! i))" "length Cs = n" "length AAs = n" obtains DA0 \0 CAs0 \s0 As0 AAs0 D0 Cs0 where "length CAs0 = n" "length \s0 = n" "DA0 \ M" "DA0 \ \0 = DA" "S DA0 \ \0 = S_M S M DA" "\CA0 \ set CAs0. CA0 \ M" "CAs0 \\cl \s0 = CAs" "map S CAs0 \\cl \s0 = map (S_M S M) CAs" "is_ground_subst \0" "is_ground_subst_list \s0" "As0 \al \0 = As" "AAs0 \\aml \s0 = AAs" "length As0 = n" "D0 \ \0 = D" "DA0 = D0 + (negs (mset As0))" "S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0" "length Cs0 = n" "Cs0 \\cl \s0 = Cs" "\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)" "length AAs0 = n" using res_e proof (cases rule: ord_resolve.cases) case (ord_resolve n_twin Cs_twins D_twin) note da = this(1) and e = this(2) and cas = this(8) and mgu = this(10) and eligible = this(11) from ord_resolve have "n_twin = n" "D_twin = D" using n d by auto moreover have "Cs_twins = Cs" using c cas n calculation(1) \length Cs_twins = n_twin\ by (auto simp add: nth_equalityI) ultimately have nz: "n \ 0" and cs_len: "length Cs = n" and aas_len: "length AAs = n" and as_len: "length As = n" and da: "DA = D + negs (mset As)" and eligible: "eligible (S_M S M) \ As (D + negs (mset As))" and cas: "\in \ 0\ \length CAs = n\ \length Cs = n\ \length AAs = n\ \length As = n\ interpret S: selection S by (rule select) \ \Obtain FO side premises\ have "\CA \ set CAs. \CA0 \c0. CA0 \ M \ CA0 \ \c0 = CA \ S CA0 \ \c0 = S_M S M CA \ is_ground_subst \c0" using grounding S_M_grounding_of_clss select by (metis (no_types) le_supE subset_iff) then have "\i < n. \CA0 \c0. CA0 \ M \ CA0 \ \c0 = (CAs ! i) \ S CA0 \ \c0 = S_M S M (CAs ! i) \ is_ground_subst \c0" using n by force then obtain \s0f CAs0f where f_p: "\i < n. CAs0f i \ M" "\i < n. (CAs0f i) \ (\s0f i) = (CAs ! i)" "\i < n. S (CAs0f i) \ (\s0f i) = S_M S M (CAs ! i)" "\i < n. is_ground_subst (\s0f i)" using n by (metis (no_types)) define \s0 where "\s0 = map \s0f [0 ..s0 = n" "length CAs0 = n" unfolding \s0_def CAs0_def by auto note n = \length \s0 = n\ \length CAs0 = n\ n \ \The properties we need of the FO side premises\ have CAs0_in_M: "\CA0 \ set CAs0. CA0 \ M" unfolding CAs0_def using f_p(1) by auto have CAs0_to_CAs: "CAs0 \\cl \s0 = CAs" unfolding CAs0_def \s0_def using f_p(2) by (auto simp: n intro: nth_equalityI) have SCAs0_to_SMCAs: "(map S CAs0) \\cl \s0 = map (S_M S M) CAs" unfolding CAs0_def \s0_def using f_p(3) n by (force intro: nth_equalityI) have sub_ground: "\\c0 \ set \s0. is_ground_subst \c0" unfolding \s0_def using f_p n by force then have "is_ground_subst_list \s0" using n unfolding is_ground_subst_list_def by auto \ \Split side premises CAs0 into Cs0 and AAs0\ obtain AAs0 Cs0 where AAs0_Cs0_p: "AAs0 \\aml \s0 = AAs" "length Cs0 = n" "Cs0 \\cl \s0 = Cs" "\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)" "length AAs0 = n" proof - have "\i < n. \AA0. AA0 \am \s0 ! i = AAs ! i \ poss AA0 \# CAs0 ! i" proof (rule, rule) fix i assume "i < n" have "CAs0 ! i \ \s0 ! i = CAs ! i" using \i < n\ \CAs0 \\cl \s0 = CAs\ n by force moreover have "poss (AAs ! i) \# CAs !i" using \i < n\ cas by auto ultimately obtain poss_AA0 where nn: "poss_AA0 \ \s0 ! i = poss (AAs ! i) \ poss_AA0 \# CAs0 ! i" using cas image_mset_of_subset unfolding subst_cls_def by metis then have l: "\L \# poss_AA0. is_pos L" unfolding subst_cls_def by (metis Melem_subst_cls imageE literal.disc(1) literal.map_disc_iff set_image_mset subst_cls_def subst_lit_def) define AA0 where "AA0 = image_mset atm_of poss_AA0" have na: "poss AA0 = poss_AA0" using l unfolding AA0_def by auto then have "AA0 \am \s0 ! i = AAs ! i" using nn by (metis (mono_tags) literal.inject(1) multiset.inj_map_strong subst_cls_poss) moreover have "poss AA0 \# CAs0 ! i" using na nn by auto ultimately show "\AA0. AA0 \am \s0 ! i = AAs ! i \ poss AA0 \# CAs0 ! i" by blast qed - then obtain AAs0f where + then obtain AAs0f where AAs0f_p: "\i < n. AAs0f i \am \s0 ! i = AAs ! i \ (poss (AAs0f i)) \# CAs0 ! i" by metis define AAs0 where "AAs0 = map AAs0f [0 ..length AAs0 = n\ from AAs0_def have "\i < n. AAs0 ! i \am \s0 ! i = AAs ! i" using AAs0f_p by auto then have AAs0_AAs: "AAs0 \\aml \s0 = AAs" using n by (auto intro: nth_equalityI) from AAs0_def have AAs0_in_CAs0: "\i < n. poss (AAs0 ! i) \# CAs0 ! i" using AAs0f_p by auto define Cs0 where "Cs0 = map2 (-) CAs0 (map poss AAs0)" have "length Cs0 = n" using Cs0_def n by auto note n = n \length Cs0 = n\ have "\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)" using AAs0_in_CAs0 Cs0_def n by auto then have "Cs0 \\cl \s0 = Cs" using \CAs0 \\cl \s0 = CAs\ AAs0_AAs cas n by (auto intro: nth_equalityI) show ?thesis - using that + using that \AAs0 \\aml \s0 = AAs\ \Cs0 \\cl \s0 = Cs\ \\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)\ \length AAs0 = n\ \length Cs0 = n\ by blast qed \ \Obtain FO main premise\ have "\DA0 \0. DA0 \ M \ DA = DA0 \ \0 \ S DA0 \ \0 = S_M S M DA \ is_ground_subst \0" using grounding S_M_grounding_of_clss select by (metis le_supE singletonI subsetCE) - then obtain DA0 \0 where + then obtain DA0 \0 where DA0_\0_p: "DA0 \ M \ DA = DA0 \ \0 \ S DA0 \ \0 = S_M S M DA \ is_ground_subst \0" by auto \ \The properties we need of the FO main premise\ have DA0_in_M: "DA0 \ M" using DA0_\0_p by auto have DA0_to_DA: "DA0 \ \0 = DA" using DA0_\0_p by auto have SDA0_to_SMDA: "S DA0 \ \0 = S_M S M DA" using DA0_\0_p by auto have "is_ground_subst \0" using DA0_\0_p by auto \ \Split main premise DA0 into D0 and As0\ obtain D0 As0 where D0As0_p: "As0 \al \0 = As" "length As0 = n" "D0 \ \0 = D" "DA0 = D0 + (negs (mset As0))" "S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0" proof - { assume a: "S_M S M (D + negs (mset As)) = {#} \ length As = (Suc 0) \ maximal_wrt (As ! 0 \a \) ((D + negs (mset As)) \ \)" then have as: "mset As = {#As ! 0#}" by (auto intro: nth_equalityI) then have "negs (mset As) = {#Neg (As ! 0)#}" by (simp add: \mset As = {#As ! 0#}\) then have "DA = D + {#Neg (As ! 0)#}" using da by auto then obtain L where "L \# DA0 \ L \l \0 = Neg (As ! 0)" using DA0_to_DA by (metis Melem_subst_cls mset_subset_eq_add_right single_subset_iff) then have "Neg (atm_of L) \# DA0 \ Neg (atm_of L) \l \0 = Neg (As ! 0)" by (metis Neg_atm_of_iff literal.sel(2) subst_lit_is_pos) then have "[atm_of L] \al \0 = As \ negs (mset [atm_of L]) \# DA0" using as subst_lit_def by auto then have "\As0. As0 \al \0 = As \ negs (mset As0) \# DA0 \ (S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0)" using a by blast } moreover { assume "S_M S M (D + negs (mset As)) = negs (mset As)" then have "negs (mset As) = S DA0 \ \0" using da \S DA0 \ \0 = S_M S M DA\ by auto then have "\As0. negs (mset As0) = S DA0 \ As0 \al \0 = As" using instance_list[of As "S DA0" \0] S.S_selects_neg_lits by auto then have "\As0. As0 \al \0 = As \ negs (mset As0) \# DA0 \ (S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0)" using S.S_selects_subseteq by auto } ultimately have "\As0. As0 \al \0 = As \ (negs (mset As0)) \# DA0 \ (S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0)" using eligible unfolding eligible.simps by auto then obtain As0 where As0_p: "As0 \al \0 = As \ negs (mset As0) \# DA0 \ (S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0)" by blast then have "length As0 = n" using as_len by auto note n = n this have "As0 \al \0 = As" using As0_p by auto define D0 where "D0 = DA0 - negs (mset As0)" then have "DA0 = D0 + negs (mset As0)" using As0_p by auto then have "D0 \ \0 = D" using DA0_to_DA da As0_p by auto have "S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0" using As0_p by blast then show ?thesis using that \As0 \al \0 = As\ \D0 \ \0= D\ \DA0 = D0 + (negs (mset As0))\ \length As0 = n\ by metis qed show ?thesis using that[OF n(2,1) DA0_in_M DA0_to_DA SDA0_to_SMDA CAs0_in_M CAs0_to_CAs SCAs0_to_SMCAs \is_ground_subst \0\ \is_ground_subst_list \s0\ \As0 \al \0 = As\ \AAs0 \\aml \s0 = AAs\ \length As0 = n\ \D0 \ \0 = D\ \DA0 = D0 + (negs (mset As0))\ \S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0\ \length Cs0 = n\ \Cs0 \\cl \s0 = Cs\ \\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)\ \length AAs0 = n\] by auto qed lemma assumes "Pos A \# C" shows "A \ atms_of C" using assms by (simp add: atm_iff_pos_or_neg_lit) lemma ord_resolve_rename_lifting: assumes sel_stable: "\\ C. is_renaming \ \ S (C \ \) = S C \ \" and res_e: "ord_resolve (S_M S M) CAs DA AAs As \ E" and select: "selection S" and grounding: "{DA} \ set CAs \ grounding_of_clss M" obtains \s \ \2 CAs0 DA0 AAs0 As0 E0 \ where "is_ground_subst \" "is_ground_subst_list \s" "is_ground_subst \2" "ord_resolve_rename S CAs0 DA0 AAs0 As0 \ E0" - (* In the previous proofs we have CAs and DA on lhs of equality... which is better? *) - "CAs0 \\cl \s = CAs" "DA0 \ \ = DA" "E0 \ \2 = E" + "CAs0 \\cl \s = CAs" "DA0 \ \ = DA" "E0 \ \2 = E" "{DA0} \ set CAs0 \ M" + "length CAs0 = length CAs" using res_e proof (cases rule: ord_resolve.cases) case (ord_resolve n Cs D) note da = this(1) and e = this(2) and cas_len = this(3) and cs_len = this(4) and aas_len = this(5) and as_len = this(6) and nz = this(7) and cas = this(8) and aas_not_empt = this(9) and mgu = this(10) and eligible = this(11) and str_max = this(12) and sel_empt = this(13) have sel_ren_list_inv: "\\s Cs. length \s = length Cs \ is_renaming_list \s \ map S (Cs \\cl \s) = map S Cs \\cl \s" using sel_stable unfolding is_renaming_list_def by (auto intro: nth_equalityI) note n = \n \ 0\ \length CAs = n\ \length Cs = n\ \length AAs = n\ \length As = n\ interpret S: selection S by (rule select) obtain DA0 \0 CAs0 \s0 As0 AAs0 D0 Cs0 where as0: "length CAs0 = n" "length \s0 = n" "DA0 \ M" "DA0 \ \0 = DA" "S DA0 \ \0 = S_M S M DA" "\CA0 \ set CAs0. CA0 \ M" "CAs0 \\cl \s0 = CAs" "map S CAs0 \\cl \s0 = map (S_M S M) CAs" "is_ground_subst \0" "is_ground_subst_list \s0" "As0 \al \0 = As" "AAs0 \\aml \s0 = AAs" "length As0 = n" "D0 \ \0 = D" "DA0 = D0 + (negs (mset As0))" "S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0) = S DA0" "length Cs0 = n" "Cs0 \\cl \s0 = Cs" "\i < n. CAs0 ! i = Cs0 ! i + poss (AAs0 ! i)" "length AAs0 = n" using ord_resolve_obtain_clauses[of S M CAs DA, OF res_e select grounding n(2) \DA = D + negs (mset As)\ \\i \length Cs = n\ \length AAs = n\, of thesis] by blast note n = \length CAs0 = n\ \length \s0 = n\ \length As0 = n\ \length AAs0 = n\ \length Cs0 = n\ n have "length (renamings_apart (DA0 # CAs0)) = Suc n" using n renamings_apart_length by auto note n = this n define \ where "\ = hd (renamings_apart (DA0 # CAs0))" define \s where "\s = tl (renamings_apart (DA0 # CAs0))" define DA0' where "DA0' = DA0 \ \" define D0' where "D0' = D0 \ \" define As0' where "As0' = As0 \al \" define CAs0' where "CAs0' = CAs0 \\cl \s" define Cs0' where "Cs0' = Cs0 \\cl \s" define AAs0' where "AAs0' = AAs0 \\aml \s" define \0' where "\0' = inv_renaming \ \ \0" define \s0' where "\s0' = map inv_renaming \s \s \s0" have renames_DA0: "is_renaming \" using renamings_apart_length renamings_apart_renaming unfolding \_def by (metis length_greater_0_conv list.exhaust_sel list.set_intros(1) list.simps(3)) have renames_CAs0: "is_renaming_list \s" using renamings_apart_length renamings_apart_renaming unfolding \s_def by (metis is_renaming_list_def length_greater_0_conv list.set_sel(2) list.simps(3)) have "length \s = n" unfolding \s_def using n by auto note n = n \length \s = n\ have "length As0' = n" unfolding As0'_def using n by auto have "length CAs0' = n" using as0(1) n unfolding CAs0'_def by auto have "length Cs0' = n" unfolding Cs0'_def using n by auto have "length AAs0' = n" unfolding AAs0'_def using n by auto have "length \s0' = n" using as0(2) n unfolding \s0'_def by auto note n = \length CAs0' = n\ \length \s0' = n\ \length As0' = n\ \length AAs0' = n\ \length Cs0' = n\ n have DA0'_DA: "DA0' \ \0' = DA" using as0(4) unfolding \0'_def DA0'_def using renames_DA0 by simp have D0'_D: "D0' \ \0' = D" using as0(14) unfolding \0'_def D0'_def using renames_DA0 by simp have As0'_As: "As0' \al \0' = As" using as0(11) unfolding \0'_def As0'_def using renames_DA0 by auto have "S DA0' \ \0' = S_M S M DA" using as0(5) unfolding \0'_def DA0'_def using renames_DA0 sel_stable by auto have CAs0'_CAs: "CAs0' \\cl \s0' = CAs" using as0(7) unfolding CAs0'_def \s0'_def using renames_CAs0 n by auto have Cs0'_Cs: "Cs0' \\cl \s0' = Cs" using as0(18) unfolding Cs0'_def \s0'_def using renames_CAs0 n by auto have AAs0'_AAs: "AAs0' \\aml \s0' = AAs" using as0(12) unfolding \s0'_def AAs0'_def using renames_CAs0 using n by auto have "map S CAs0' \\cl \s0' = map (S_M S M) CAs" unfolding CAs0'_def \s0'_def using as0(8) n renames_CAs0 sel_ren_list_inv by auto have DA0'_split: "DA0' = D0' + negs (mset As0')" using as0(15) DA0'_def D0'_def As0'_def by auto then have D0'_subset_DA0': "D0' \# DA0'" by auto from DA0'_split have negs_As0'_subset_DA0': "negs (mset As0') \# DA0'" by auto have CAs0'_split: "\ii# CAs0' ! i" by auto from CAs0'_split have poss_AAs0'_subset_CAs0': "\i# CAs0' ! i" by auto then have AAs0'_in_atms_of_CAs0': "\i < n. \A\#AAs0' ! i. A \ atms_of (CAs0' ! i)" by (auto simp add: atm_iff_pos_or_neg_lit) have as0': "S_M S M (D + negs (mset As)) \ {#} \ negs (mset As0') = S DA0'" proof - assume a: "S_M S M (D + negs (mset As)) \ {#}" then have "negs (mset As0) \ \ = S DA0 \ \" using as0(16) unfolding \_def by metis then show "negs (mset As0') = S DA0'" using As0'_def DA0'_def using sel_stable[of \ DA0] renames_DA0 by auto qed have vd: "var_disjoint (DA0' # CAs0')" unfolding DA0'_def CAs0'_def using renamings_apart_var_disjoint unfolding \_def \s_def by (metis length_greater_0_conv list.exhaust_sel n(6) substitution.subst_cls_lists_Cons substitution_axioms zero_less_Suc) \ \Introduce ground substitution\ from vd DA0'_DA CAs0'_CAs have "\\. \i < Suc n. \S. S \# (DA0' # CAs0') ! i \ S \ (\0'#\s0') ! i = S \ \" unfolding var_disjoint_def using n by auto then obtain \ where \_p: "\i < Suc n. \S. S \# (DA0' # CAs0') ! i \ S \ (\0'#\s0') ! i = S \ \" by auto have \_p_lit: "\i < Suc n. \L. L \# (DA0' # CAs0') ! i \ L \l (\0'#\s0') ! i = L \l \" proof (rule, rule, rule, rule) fix i :: "nat" and L :: "'a literal" assume a: "i < Suc n" "L \# (DA0' # CAs0') ! i" then have "\S. S \# (DA0' # CAs0') ! i \ S \ (\0' # \s0') ! i = S \ \" using \_p by auto then have "{# L #} \ (\0' # \s0') ! i = {# L #} \ \" using a by (meson single_subset_iff) then show "L \l (\0' # \s0') ! i = L \l \" by auto qed have \_p_atm: "\i < Suc n. \A. A \ atms_of ((DA0' # CAs0') ! i) \ A \a (\0'#\s0') ! i = A \a \" proof (rule, rule, rule, rule) fix i :: "nat" and A :: "'a" assume a: "i < Suc n" "A \ atms_of ((DA0' # CAs0') ! i)" then obtain L where L_p: "atm_of L = A \ L \# (DA0' # CAs0') ! i" unfolding atms_of_def by auto then have "L \l (\0'#\s0') ! i = L \l \" using \_p_lit a by auto then show "A \a (\0' # \s0') ! i = A \a \" using L_p unfolding subst_lit_def by (cases L) auto qed have DA0'_DA: "DA0' \ \ = DA" using DA0'_DA \_p by auto have "D0' \ \ = D" using \_p D0'_D n D0'_subset_DA0' by auto have "As0' \al \ = As" proof (rule nth_equalityI) show "length (As0' \al \) = length As" using n by auto next - show "(As0' \al \) ! i = As ! i" if a: "i < length (As0' \al \)" for i + fix i + show "ial \) \ (As0' \al \) ! i = As ! i" proof - + assume a: "i < length (As0' \al \)" have A_eq: "\A. A \ atms_of DA0' \ A \a \0' = A \a \" using \_p_atm n by force have "As0' ! i \ atms_of DA0'" using negs_As0'_subset_DA0' unfolding atms_of_def using a n by force then have "As0' ! i \a \0' = As0' ! i \a \" using A_eq by simp then show "(As0' \al \) ! i = As ! i" using As0'_As \length As0' = n\ a by auto qed qed + interpret selection + by (rule select) + have "S DA0' \ \ = S_M S M DA" using \S DA0' \ \0' = S_M S M DA\ \_p S.S_selects_subseteq by auto from \_p have \_p_CAs0': "\i < n. (CAs0' ! i) \ (\s0' ! i) = (CAs0'! i) \ \" using n by auto then have "CAs0' \\cl \s0' = CAs0' \cl \" using n by (auto intro: nth_equalityI) then have CAs0'_\_fo_CAs: "CAs0' \cl \ = CAs" using CAs0'_CAs \_p n by auto from \_p have "\i < n. S (CAs0' ! i) \ \s0' ! i = S (CAs0' ! i) \ \" using S.S_selects_subseteq n by auto then have "map S CAs0' \\cl \s0' = map S CAs0' \cl \" using n by (auto intro: nth_equalityI) then have SCAs0'_\_fo_SMCAs: "map S CAs0' \cl \ = map (S_M S M) CAs" using \map S CAs0' \\cl \s0' = map (S_M S M) CAs\ by auto have "Cs0' \cl \ = Cs" proof (rule nth_equalityI) show "length (Cs0' \cl \) = length Cs" using n by auto next - show "(Cs0' \cl \) ! i = Cs ! i" if "i < length (Cs0' \cl \)" for i + fix i + show "icl \) \ (Cs0' \cl \) ! i = Cs ! i" proof - - have a: "i < n" - using that n by force + assume "i < length (Cs0' \cl \)" + then have a: "i < n" + using n by force have "(Cs0' \\cl \s0') ! i = Cs ! i" using Cs0'_Cs a n by force moreover have \_p_CAs0': "\S. S \# CAs0' ! i \ S \ \s0' ! i = S \ \" using \_p a by force have "Cs0' ! i \ \s0' ! i = (Cs0' \cl \) ! i" using \_p_CAs0' \\i# CAs0' ! i\ a n by force then have "(Cs0' \\cl \s0') ! i = (Cs0' \cl \) ! i " using a n by force ultimately show "(Cs0' \cl \) ! i = Cs ! i" by auto qed qed have AAs0'_AAs: "AAs0' \aml \ = AAs" proof (rule nth_equalityI) show "length (AAs0' \aml \) = length AAs" using n by auto next - show "(AAs0' \aml \) ! i = AAs ! i" if a: "i < length (AAs0' \aml \)" for i + fix i + show "iaml \) \ (AAs0' \aml \) ! i = AAs ! i" proof - - have "i < n" - using that n by force + assume a: "i < length (AAs0' \aml \)" + then have "i < n" + using n by force then have "\A. A \ atms_of ((DA0' # CAs0') ! Suc i) \ A \a (\0' # \s0') ! Suc i = A \a \" using \_p_atm n by force then have A_eq: "\A. A \ atms_of (CAs0' ! i) \ A \a \s0' ! i = A \a \" by auto have AAs_CAs0': "\A \# AAs0' ! i. A \ atms_of (CAs0' ! i)" using AAs0'_in_atms_of_CAs0' unfolding atms_of_def using a n by force then have "AAs0' ! i \am \s0' ! i = AAs0' ! i \am \" unfolding subst_atm_mset_def using A_eq unfolding subst_atm_mset_def by auto then show "(AAs0' \aml \) ! i = AAs ! i" using AAs0'_AAs \length AAs0' = n\ \length \s0' = n\ a by auto qed qed \ \Obtain MGU and substitution\ obtain \ \ where \\: "Some \ = mgu (set_mset ` set (map2 add_mset As0' AAs0'))" "\ \ \ = \ \ \" proof - have uu: "is_unifiers \ (set_mset ` set (map2 add_mset (As0' \al \) (AAs0' \aml \)))" using mgu mgu_sound is_mgu_def unfolding \AAs0' \aml \ = AAs\ using \As0' \al \ = As\ by auto have \\uni: "is_unifiers (\ \ \) (set_mset ` set (map2 add_mset As0' AAs0'))" proof - have "set_mset ` set (map2 add_mset As0' AAs0' \aml \) = set_mset ` set (map2 add_mset As0' AAs0') \ass \" unfolding subst_atmss_def subst_atm_mset_list_def using subst_atm_mset_def subst_atms_def by (simp add: image_image subst_atm_mset_def subst_atms_def) then have "is_unifiers \ (set_mset ` set (map2 add_mset As0' AAs0') \ass \)" using uu by (auto simp: n map2_add_mset_map) then show ?thesis using is_unifiers_comp by auto qed then obtain \ where \_p: "Some \ = mgu (set_mset ` set (map2 add_mset As0' AAs0'))" using mgu_complete by (metis (mono_tags, hide_lams) List.finite_set finite_imageI finite_set_mset image_iff) moreover then obtain \ where \_p: "\ \ \ = \ \ \" by (metis (mono_tags, hide_lams) finite_set \\uni finite_imageI finite_set_mset image_iff mgu_sound set_mset_mset substitution_ops.is_mgu_def) (* should be simpler *) ultimately show thesis using that by auto qed \ \Lifting eligibility\ have eligible0': "eligible S \ As0' (D0' + negs (mset As0'))" proof - have "S_M S M (D + negs (mset As)) = negs (mset As) \ S_M S M (D + negs (mset As)) = {#} \ length As = 1 \ maximal_wrt (As ! 0 \a \) ((D + negs (mset As)) \ \)" using eligible unfolding eligible.simps by auto then show ?thesis proof assume "S_M S M (D + negs (mset As)) = negs (mset As)" then have "S_M S M (D + negs (mset As)) \ {#}" using n by force then have "S (D0' + negs (mset As0')) = negs (mset As0')" using as0' DA0'_split by auto then show ?thesis unfolding eligible.simps[simplified] by auto next assume asm: "S_M S M (D + negs (mset As)) = {#} \ length As = 1 \ maximal_wrt (As ! 0 \a \) ((D + negs (mset As)) \ \)" then have "S (D0' + negs (mset As0')) = {#}" using \D0' \ \ = D\[symmetric] \As0' \al \ = As\[symmetric] \S (DA0') \ \ = S_M S M (DA)\ da DA0'_split subst_cls_empty_iff by metis moreover from asm have l: "length As0' = 1" using \As0' \al \ = As\ by auto moreover from asm have "maximal_wrt (As0' ! 0 \a (\ \ \)) ((D0' + negs (mset As0')) \ (\ \ \))" using \As0' \al \ = As\ \D0' \ \ = D\ using l \\ by auto then have "maximal_wrt (As0' ! 0 \a \ \a \) ((D0' + negs (mset As0')) \ \ \ \)" by auto then have "maximal_wrt (As0' ! 0 \a \) ((D0' + negs (mset As0')) \ \)" using maximal_wrt_subst by blast ultimately show ?thesis unfolding eligible.simps[simplified] by auto qed qed \ \Lifting maximality\ have maximality: "\i < n. strictly_maximal_wrt (As0' ! i \a \) (Cs0' ! i \ \)" (* Reformulate in list notation? *) proof - from str_max have "\i < n. strictly_maximal_wrt ((As0' \al \) ! i \a \) ((Cs0' \cl \) ! i \ \)" using \As0' \al \ = As\ \Cs0' \cl \ = Cs\ by simp then have "\i < n. strictly_maximal_wrt (As0' ! i \a (\ \ \)) (Cs0' ! i \ (\ \ \))" using n \\ by simp then have "\i < n. strictly_maximal_wrt (As0' ! i \a \ \a \) (Cs0' ! i \ \ \ \)" by auto then show "\i < n. strictly_maximal_wrt (As0' ! i \a \) (Cs0' ! i \ \)" using strictly_maximal_wrt_subst \\ by blast qed \ \Lifting nothing being selected\ have nothing_selected: "\i < n. S (CAs0' ! i) = {#}" proof - have "\i < n. (map S CAs0' \cl \) ! i = map (S_M S M) CAs ! i" by (simp add: \map S CAs0' \cl \ = map (S_M S M) CAs\) then have "\i < n. S (CAs0' ! i) \ \ = S_M S M (CAs ! i)" using n by auto then have "\i < n. S (CAs0' ! i) \ \ = {#}" using sel_empt \\i < n. S (CAs0' ! i) \ \ = S_M S M (CAs ! i)\ by auto then show "\i < n. S (CAs0' ! i) = {#}" using subst_cls_empty_iff by blast qed \ \Lifting AAs0's non-emptiness\ have "\i < n. AAs0' ! i \ {#}" using n aas_not_empt \AAs0' \aml \ = AAs\ by auto \ \Resolve the lifted clauses\ define E0' where - "E0' = (\# (mset Cs0') + D0') \ \" + "E0' = ((\# (mset Cs0')) + D0') \ \" have res_e0': "ord_resolve S CAs0' DA0' AAs0' As0' \ E0'" using ord_resolve.intros[of CAs0' n Cs0' AAs0' As0' \ S D0', OF _ _ _ _ _ _ \\i < n. AAs0' ! i \ {#}\ \\(1) eligible0' \\i < n. strictly_maximal_wrt (As0' ! i \a \) (Cs0' ! i \ \)\ \\i < n. S (CAs0' ! i) = {#}\] unfolding E0'_def using DA0'_split n \\i by blast \ \Prove resolvent instantiates to ground resolvent\ have e0'\e: "E0' \ \ = E" proof - - have "E0' \ \ = (\# (mset Cs0') + D0') \ (\ \ \)" + have "E0' \ \ = ((\# (mset Cs0')) + D0') \ (\ \ \)" unfolding E0'_def by auto also have "\ = (\# (mset Cs0') + D0') \ (\ \ \)" using \\ by auto also have "\ = (\# (mset Cs) + D) \ \" using \Cs0' \cl \ = Cs\ \D0' \ \ = D\ by auto also have "\ = E" using e by auto finally show e0'\e: "E0' \ \ = E" . qed \ \Replace @{term \} with a true ground substitution\ obtain \2 where ground_\2: "is_ground_subst \2" "E0' \ \2 = E" proof - have "is_ground_cls_list CAs" "is_ground_cls DA" using grounding grounding_ground unfolding is_ground_cls_list_def by auto then have "is_ground_cls E" using res_e ground_resolvent_subset by (force intro: is_ground_cls_mono) then show thesis using that e0'\e make_ground_subst by auto qed + have \length CAs0 = length CAs\ using n by simp \ \Wrap up the proof\ have "ord_resolve S (CAs0 \\cl \s) (DA0 \ \) (AAs0 \\aml \s) (As0 \al \) \ E0'" using res_e0' As0'_def \_def AAs0'_def \s_def DA0'_def \_def CAs0'_def \s_def by simp moreover have "\i# CAs0 ! i" using as0(19) by auto moreover have "negs (mset As0) \# DA0" using local.as0(15) by auto ultimately have "ord_resolve_rename S CAs0 DA0 AAs0 As0 \ E0'" using ord_resolve_rename[of CAs0 n AAs0 As0 DA0 \ \s S \ E0'] \_def \s_def n by auto then show thesis using that[of \0 \s0 \2 CAs0 DA0] \is_ground_subst \0\ \is_ground_subst_list \s0\ \is_ground_subst \2\ \CAs0 \\cl \s0 = CAs\ \DA0 \ \0 = DA\ \E0' \ \2 = E\ \DA0 \ M\ - \\CA \ set CAs0. CA \ M\ by blast + \\CA \ set CAs0. CA \ M\ \length CAs0 = length CAs\ + by blast qed end end diff --git a/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution_Prover.thy b/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution_Prover.thy --- a/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution_Prover.thy +++ b/thys/Ordered_Resolution_Prover/FO_Ordered_Resolution_Prover.thy @@ -1,1545 +1,1544 @@ (* Title: An Ordered Resolution Prover for First-Order Clauses Author: Anders Schlichtkrull , 2016, 2017 Author: Jasmin Blanchette , 2014, 2017 Author: Dmitriy Traytel , 2014 Maintainer: Anders Schlichtkrull *) section \An Ordered Resolution Prover for First-Order Clauses\ theory FO_Ordered_Resolution_Prover imports FO_Ordered_Resolution begin text \ This material is based on Section 4.3 (``A Simple Resolution Prover for First-Order Clauses'') of Bachmair and Ganzinger's chapter. Specifically, it formalizes the RP prover defined in Figure 5 and its related lemmas and theorems, including Lemmas 4.10 and 4.11 and Theorem 4.13 (completeness). \ -(* FIXME: Used only twice, really -- inline? *) definition is_least :: "(nat \ bool) \ nat \ bool" where "is_least P n \ P n \ (\n' < n. \ P n')" lemma least_exists: "P n \ \n. is_least P n" using exists_least_iff unfolding is_least_def by auto text \ The following corresponds to page 42 and 43 of Section 4.3, from the explanation of RP to Lemma 4.10. \ type_synonym 'a state = "'a clause set \ 'a clause set \ 'a clause set" locale FO_resolution_prover = FO_resolution subst_atm id_subst comp_subst renamings_apart atm_of_atms mgu less_atm + selection S for S :: "('a :: wellorder) clause \ 'a clause" and subst_atm :: "'a \ 's \ 'a" and id_subst :: "'s" and comp_subst :: "'s \ 's \ 's" and renamings_apart :: "'a clause list \ 's list" and atm_of_atms :: "'a list \ 'a" and mgu :: "'a set set \ 's option" and less_atm :: "'a \ 'a \ bool" + assumes sel_stable: "\\ C. is_renaming \ \ S (C \ \) = S C \ \" and less_atm_ground: "is_ground_atm A \ is_ground_atm B \ less_atm A B \ A < B" begin fun N_of_state :: "'a state \ 'a clause set" where "N_of_state (N, P, Q) = N" fun P_of_state :: "'a state \ 'a clause set" where "P_of_state (N, P, Q) = P" text \ \O\ denotes relation composition in Isabelle, so the formalization uses \Q\ instead. \ fun Q_of_state :: "'a state \ 'a clause set" where "Q_of_state (N, P, Q) = Q" definition clss_of_state :: "'a state \ 'a clause set" where "clss_of_state St = N_of_state St \ P_of_state St \ Q_of_state St" abbreviation grounding_of_state :: "'a state \ 'a clause set" where "grounding_of_state St \ grounding_of_clss (clss_of_state St)" interpretation ord_FO_resolution: inference_system "ord_FO_\ S" . text \ The following inductive predicate formalizes the resolution prover in Figure 5. \ inductive RP :: "'a state \ 'a state \ bool" (infix "\" 50) where tautology_deletion: "Neg A \# C \ Pos A \# C \ (N \ {C}, P, Q) \ (N, P, Q)" | forward_subsumption: "D \ P \ Q \ subsumes D C \ (N \ {C}, P, Q) \ (N, P, Q)" | backward_subsumption_P: "D \ N \ strictly_subsumes D C \ (N, P \ {C}, Q) \ (N, P, Q)" | backward_subsumption_Q: "D \ N \ strictly_subsumes D C \ (N, P, Q \ {C}) \ (N, P, Q)" | forward_reduction: "D + {#L'#} \ P \ Q \ - L = L' \l \ \ D \ \ \# C \ (N \ {C + {#L#}}, P, Q) \ (N \ {C}, P, Q)" | backward_reduction_P: "D + {#L'#} \ N \ - L = L' \l \ \ D \ \ \# C \ (N, P \ {C + {#L#}}, Q) \ (N, P \ {C}, Q)" | backward_reduction_Q: "D + {#L'#} \ N \ - L = L' \l \ \ D \ \ \# C \ (N, P, Q \ {C + {#L#}}) \ (N, P \ {C}, Q)" | clause_processing: "(N \ {C}, P, Q) \ (N, P \ {C}, Q)" | inference_computation: "N = concls_of (ord_FO_resolution.inferences_between Q C) \ ({}, P \ {C}, Q) \ (N, P, Q \ {C})" lemma final_RP: "\ ({}, {}, Q) \ St" by (auto elim: RP.cases) definition Sup_state :: "'a state llist \ 'a state" where "Sup_state Sts = (Sup_llist (lmap N_of_state Sts), Sup_llist (lmap P_of_state Sts), Sup_llist (lmap Q_of_state Sts))" definition Liminf_state :: "'a state llist \ 'a state" where "Liminf_state Sts = (Liminf_llist (lmap N_of_state Sts), Liminf_llist (lmap P_of_state Sts), Liminf_llist (lmap Q_of_state Sts))" context fixes Sts Sts' :: "'a state llist" assumes Sts: "lfinite Sts" "lfinite Sts'" "\ lnull Sts" "\ lnull Sts'" "llast Sts' = llast Sts" begin lemma N_of_Liminf_state_fin: "N_of_state (Liminf_state Sts') = N_of_state (Liminf_state Sts)" and P_of_Liminf_state_fin: "P_of_state (Liminf_state Sts') = P_of_state (Liminf_state Sts)" and Q_of_Liminf_state_fin: "Q_of_state (Liminf_state Sts') = Q_of_state (Liminf_state Sts)" using Sts by (simp_all add: Liminf_state_def lfinite_Liminf_llist llast_lmap) lemma Liminf_state_fin: "Liminf_state Sts' = Liminf_state Sts" using N_of_Liminf_state_fin P_of_Liminf_state_fin Q_of_Liminf_state_fin by (simp add: Liminf_state_def) end context fixes Sts Sts' :: "'a state llist" assumes Sts: "\ lfinite Sts" "emb Sts Sts'" begin lemma N_of_Liminf_state_inf: "N_of_state (Liminf_state Sts') \ N_of_state (Liminf_state Sts)" and P_of_Liminf_state_inf: "P_of_state (Liminf_state Sts') \ P_of_state (Liminf_state Sts)" and Q_of_Liminf_state_inf: "Q_of_state (Liminf_state Sts') \ Q_of_state (Liminf_state Sts)" using Sts by (simp_all add: Liminf_state_def emb_Liminf_llist_infinite emb_lmap) lemma clss_of_Liminf_state_inf: "clss_of_state (Liminf_state Sts') \ clss_of_state (Liminf_state Sts)" unfolding clss_of_state_def using N_of_Liminf_state_inf P_of_Liminf_state_inf Q_of_Liminf_state_inf by blast end definition fair_state_seq :: "'a state llist \ bool" where "fair_state_seq Sts \ N_of_state (Liminf_state Sts) = {} \ P_of_state (Liminf_state Sts) = {}" text \ The following formalizes Lemma 4.10. \ context fixes Sts :: "'a state llist" assumes deriv: "chain (\) Sts" and - empty_Q0: "Q_of_state (lhd Sts) = {}" + empty_Q0: "Q_of_state (lhd Sts) = {}" (* FIXME: make hypothesis empty_Q0 more local---and is it really needed? *) begin lemmas lhd_lmap_Sts = llist.map_sel(1)[OF chain_not_lnull[OF deriv]] definition S_Q :: "'a clause \ 'a clause" where "S_Q = S_M S (Q_of_state (Liminf_state Sts))" interpretation sq: selection S_Q unfolding S_Q_def using S_M_selects_subseteq S_M_selects_neg_lits selection_axioms by unfold_locales auto interpretation gr: ground_resolution_with_selection S_Q by unfold_locales interpretation sr: standard_redundancy_criterion_reductive gr.ord_\ by unfold_locales interpretation sr: standard_redundancy_criterion_counterex_reducing gr.ord_\ "ground_resolution_with_selection.INTERP S_Q" by unfold_locales text \ The extension of ordered resolution mentioned in 4.10. We let it consist of all sound rules. \ definition ground_sound_\:: "'a inference set" where "ground_sound_\ = {Infer CC D E | CC D E. (\I. I \m CC \ I \ D \ I \ E)}" text \ We prove that we indeed defined an extension. \ lemma gd_ord_\_ngd_ord_\: "gr.ord_\ \ ground_sound_\" unfolding ground_sound_\_def using gr.ord_\_def gr.ord_resolve_sound by fastforce lemma sound_ground_sound_\: "sound_inference_system ground_sound_\" unfolding sound_inference_system_def ground_sound_\_def by auto lemma sat_preserving_ground_sound_\: "sat_preserving_inference_system ground_sound_\" using sound_ground_sound_\ sat_preserving_inference_system.intro sound_inference_system.\_sat_preserving by blast definition sr_ext_Ri :: "'a clause set \ 'a inference set" where "sr_ext_Ri N = sr.Ri N \ (ground_sound_\ - gr.ord_\)" interpretation sr_ext: sat_preserving_redundancy_criterion "ground_sound_\" "sr.Rf" "sr_ext_Ri" unfolding sat_preserving_redundancy_criterion_def sr_ext_Ri_def using sat_preserving_ground_sound_\ redundancy_criterion_standard_extension gd_ord_\_ngd_ord_\ sr.redundancy_criterion_axioms by auto lemma strict_subset_subsumption_redundant_clause: assumes sub: "D \ \ \# C" and ground_\: "is_ground_subst \" shows "C \ sr.Rf (grounding_of_cls D)" proof - from sub have "\I. I \ D \ \ \ I \ C" unfolding true_cls_def by blast moreover have "C > D \ \" using sub by (simp add: subset_imp_less_mset) moreover have "D \ \ \ grounding_of_cls D" using ground_\ by (metis (mono_tags, lifting) mem_Collect_eq substitution_ops.grounding_of_cls_def) - ultimately have "set_mset {#D \ \#} \ grounding_of_cls D" + ultimately have "set_mset {#D \ \#} \ grounding_of_cls D" "(\I. I \m {#D \ \#} \ I \ C)" "(\D'. D' \# {#D \ \#} \ D' < C)" by auto then show ?thesis using sr.Rf_def by blast qed lemma strict_subset_subsumption_redundant_clss: assumes "D \ \ \# C" and "is_ground_subst \" and "D \ CC" shows "C \ sr.Rf (grounding_of_clss CC)" using assms proof - have "C \ sr.Rf (grounding_of_cls D)" using strict_subset_subsumption_redundant_clause assms by auto then show ?thesis using assms unfolding clss_of_state_def grounding_of_clss_def by (metis (no_types) sr.Rf_mono sup_ge1 SUP_absorb contra_subsetD) qed lemma strict_subset_subsumption_grounding_redundant_clss: - assumes + assumes D\_subset_C: "D \ \ \# C" and D_in_St: "D \ CC" shows "grounding_of_cls C \ sr.Rf (grounding_of_clss CC)" proof fix C\ assume "C\ \ grounding_of_cls C" then obtain \ where \_p: "C\ = C \ \ \ is_ground_subst \" unfolding grounding_of_cls_def by auto have D\\C\: "D \ \ \ \ \# C \ \" using D\_subset_C subst_subset_mono by auto then show "C\ \ sr.Rf (grounding_of_clss CC)" - using \_p strict_subset_subsumption_redundant_clss[of D "\ \ \" "C \ \"] D_in_St + using \_p strict_subset_subsumption_redundant_clss[of D "\ \ \" "C \ \"] D_in_St unfolding clss_of_state_def by auto qed lemma subst_cls_eq_grounding_of_cls_subset_eq: assumes "D \ \ = C" shows "grounding_of_cls C \ grounding_of_cls D" proof fix C\' assume "C\' \ grounding_of_cls C" then obtain \' where C\': "C \ \' = C\'" "is_ground_subst \'" unfolding grounding_of_cls_def by auto then have "C \ \' = D \ \ \ \' \ is_ground_subst (\ \ \')" using assms by auto then show "C\' \ grounding_of_cls D" unfolding grounding_of_cls_def using C\'(1) by force qed lemma derive_if_remove_subsumed: - assumes - "D \ clss_of_state St" and + assumes + "D \ clss_of_state St" and "subsumes D C" shows "sr_ext.derive (grounding_of_state St \ grounding_of_cls C) (grounding_of_state St)" proof - from assms obtain \ where "D \ \ = C \ D \ \ \# C" by (auto simp: subsumes_def subset_mset_def) then have "D \ \ = C \ D \ \ \# C" by (simp add: subset_mset_def) then show ?thesis proof assume "D \ \ = C" then have "grounding_of_cls C \ grounding_of_cls D" using subst_cls_eq_grounding_of_cls_subset_eq by simp then have "(grounding_of_state St \ grounding_of_cls C) = grounding_of_state St" using assms unfolding clss_of_state_def grounding_of_clss_def by auto then show ?thesis by (auto intro: sr_ext.derive.intros) next assume a: "D \ \ \# C" then have "grounding_of_cls C \ sr.Rf (grounding_of_state St)" using strict_subset_subsumption_grounding_redundant_clss assms by auto then show ?thesis unfolding clss_of_state_def grounding_of_clss_def by (force intro: sr_ext.derive.intros) qed qed (* FIXME: better name *) lemma reduction_in_concls_of: - assumes + assumes "C\ \ grounding_of_cls C" and "D + {#L'#} \ CC" and "- L = L' \l \" and "D \ \ \# C" shows "C\ \ concls_of (sr_ext.inferences_from (grounding_of_clss (CC \ {C + {#L#}})))" proof - - from assms + from assms obtain \ where \_p: "C\ = C \ \ \ is_ground_subst \" unfolding grounding_of_cls_def by auto define \ where "\ = Infer {#(C + {#L#})\ \#} ((D + {#L'#}) \ \ \ \) (C \ \)" have "(D + {#L'#}) \ \ \ \ \ grounding_of_clss (CC \ {C + {#L#}})" - unfolding grounding_of_clss_def grounding_of_cls_def + unfolding grounding_of_clss_def grounding_of_cls_def by (rule UN_I[of "D + {#L'#}"], use assms(2) clss_of_state_def in simp, metis (mono_tags, lifting) \_p is_ground_comp_subst mem_Collect_eq subst_cls_comp_subst) moreover have "(C + {#L#}) \ \ \ grounding_of_clss (CC \ {C + {#L#}})" using \_p unfolding grounding_of_clss_def grounding_of_cls_def by auto moreover have "\I. I \ D \ \ \ \ + {#- (L \l \)#} \ I \ C \ \ + {#L \l \#} \ I \ D \ \ \ \ + C \ \" by auto then have "\I. I \ (D + {#L'#}) \ \ \ \ \ I \ (C + {#L#}) \ \ \ I \ D \ \ \ \ + C \ \" using assms - by (metis add_mset_add_single subst_cls_add_mset subst_cls_union subst_minus) + by (metis add_mset_add_single subst_cls_add_mset subst_cls_union subst_minus) then have "\I. I \ (D + {#L'#}) \ \ \ \ \ I \ (C + {#L#}) \ \ \ I \ C \ \" using assms by (metis (no_types, lifting) subset_mset.le_iff_add subst_cls_union true_cls_union) then have "\I. I \m {#(D + {#L'#}) \ \ \ \#} \ I \ (C + {#L#}) \ \ \ I \ C \ \" by (meson true_cls_mset_singleton) ultimately have "\ \ sr_ext.inferences_from (grounding_of_clss (CC \ {C + {#L#}}))" unfolding sr_ext.inferences_from_def unfolding ground_sound_\_def infer_from_def \_def by auto then have "C \ \ \ concls_of (sr_ext.inferences_from (grounding_of_clss (CC \ {C + {#L#}})))" using image_iff unfolding \_def by fastforce then show "C\ \ concls_of (sr_ext.inferences_from (grounding_of_clss (CC \ {C + {#L#}})))" using \_p by auto qed lemma reduction_derivable: assumes "D + {#L'#} \ CC" and "- L = L' \l \" and "D \ \ \# C" shows "sr_ext.derive (grounding_of_clss (CC \ {C + {#L#}})) (grounding_of_clss (CC \ {C}))" proof - - from assms have "grounding_of_clss (CC \ {C}) - grounding_of_clss (CC \ {C + {#L#}}) + from assms have "grounding_of_clss (CC \ {C}) - grounding_of_clss (CC \ {C + {#L#}}) \ concls_of (sr_ext.inferences_from (grounding_of_clss (CC \ {C + {#L#}})))" - using reduction_in_concls_of unfolding grounding_of_clss_def clss_of_state_def + using reduction_in_concls_of unfolding grounding_of_clss_def clss_of_state_def by auto moreover have "grounding_of_cls (C + {#L#}) \ sr.Rf (grounding_of_clss (CC \ {C}))" using strict_subset_subsumption_grounding_redundant_clss[of C "id_subst"] by auto - then have "grounding_of_clss (CC \ {C + {#L#}}) - grounding_of_clss (CC \ {C}) + then have "grounding_of_clss (CC \ {C + {#L#}}) - grounding_of_clss (CC \ {C}) \ sr.Rf (grounding_of_clss (CC \ {C}))" unfolding clss_of_state_def grounding_of_clss_def by auto ultimately show "sr_ext.derive (grounding_of_clss (CC \ {C + {#L#}})) (grounding_of_clss (CC \ {C}))" - using sr_ext.derive.intros[of "grounding_of_clss (CC \ {C})" + using sr_ext.derive.intros[of "grounding_of_clss (CC \ {C})" "grounding_of_clss (CC \ {C + {#L#}})"] by auto qed text \ The following corresponds the part of Lemma 4.10 that states we have a theorem proving process: \ lemma RP_ground_derive: "St \ St' \ sr_ext.derive (grounding_of_state St) (grounding_of_state St')" proof (induction rule: RP.induct) case (tautology_deletion A C N P Q) { fix C\ assume "C\ \ grounding_of_cls C" then obtain \ where "C\ = C \ \" unfolding grounding_of_cls_def by auto then have "Neg (A \a \) \# C\ \ Pos (A \a \) \# C\" using tautology_deletion Neg_Melem_subst_atm_subst_cls Pos_Melem_subst_atm_subst_cls by auto then have "C\ \ sr.Rf (grounding_of_state (N, P, Q))" using sr.tautology_Rf by auto } then have "grounding_of_state (N \ {C}, P, Q) - grounding_of_state (N, P, Q) \ sr.Rf (grounding_of_state (N, P, Q))" unfolding clss_of_state_def grounding_of_clss_def by auto moreover have "grounding_of_state (N, P, Q) - grounding_of_state (N \ {C}, P, Q) = {}" unfolding clss_of_state_def grounding_of_clss_def by auto ultimately show ?case using sr_ext.derive.intros[of "grounding_of_state (N, P, Q)" "grounding_of_state (N \ {C}, P, Q)"] by auto next case (forward_subsumption D P Q C N) then show ?case using derive_if_remove_subsumed[of D "(N, P, Q)" C] unfolding grounding_of_clss_def clss_of_state_def by (simp add: sup_commute sup_left_commute) next case (backward_subsumption_P D N C P Q) then show ?case using derive_if_remove_subsumed[of D "(N, P, Q)" C] strictly_subsumes_def unfolding grounding_of_clss_def clss_of_state_def by (simp add: sup_commute sup_left_commute) next case (backward_subsumption_Q D N C P Q) then show ?case using derive_if_remove_subsumed[of D "(N, P, Q)" C] strictly_subsumes_def unfolding grounding_of_clss_def clss_of_state_def by (simp add: sup_commute sup_left_commute) next case (forward_reduction D L' P Q L \ C N) then show ?case using reduction_derivable[of _ _ "N \ P \ Q"] unfolding clss_of_state_def by force next case (backward_reduction_P D L' N L \ C P Q) then show ?case using reduction_derivable[of _ _ "N \ P \ Q"] unfolding clss_of_state_def by force next case (backward_reduction_Q D L' N L \ C P Q) then show ?case using reduction_derivable[of _ _ "N \ P \ Q"] unfolding clss_of_state_def by force next case (clause_processing N C P Q) then show ?case unfolding clss_of_state_def using sr_ext.derive.intros by auto next case (inference_computation N Q C P) { fix E\ assume "E\ \ grounding_of_clss N" then obtain \ E where E_\_p: "E\ = E \ \ \ E \ N \ is_ground_subst \" unfolding grounding_of_clss_def grounding_of_cls_def by auto then have E_concl: "E \ concls_of (ord_FO_resolution.inferences_between Q C)" using inference_computation by auto then obtain \ where \_p: "\ \ ord_FO_\ S \ infer_from (Q \ {C}) \ \ C \# prems_of \ \ concl_of \ = E" unfolding ord_FO_resolution.inferences_between_def by auto then obtain CC CAs D AAs As \ where \_p2: "\ = Infer CC D E \ ord_resolve_rename S CAs D AAs As \ E \ mset CAs = CC" unfolding ord_FO_\_def by auto define \ where "\ = hd (renamings_apart (D # CAs))" define \s where "\s = tl (renamings_apart (D # CAs))" define \_ground where "\_ground = Infer (mset (CAs \\cl \s) \cm \ \cm \) (D \ \ \ \ \ \) (E \ \)" have "\I. I \m mset (CAs \\cl \s) \cm \ \cm \ \ I \ D \ \ \ \ \ \ \ I \ E \ \" using ord_resolve_rename_ground_inst_sound[of _ _ _ _ _ _ _ _ _ _ \] \_def \s_def E_\_p \_p2 by auto then have "\_ground \ {Infer cc d e | cc d e. \I. I \m cc \ I \ d \ I \ e}" unfolding \_ground_def by auto moreover have "set_mset (prems_of \_ground) \ grounding_of_state ({}, P \ {C}, Q)" proof - have "D = C \ D \ Q" unfolding \_ground_def using E_\_p \_p2 \_p unfolding infer_from_def unfolding clss_of_state_def grounding_of_clss_def unfolding grounding_of_cls_def by simp then have "D \ \ \ \ \ \ \ grounding_of_cls C \ (\x \ Q. D \ \ \ \ \ \ \ grounding_of_cls x)" using E_\_p - unfolding grounding_of_cls_def + unfolding grounding_of_cls_def by (metis (mono_tags, lifting) is_ground_comp_subst mem_Collect_eq subst_cls_comp_subst) - then have "(D \ \ \ \ \ \ \ grounding_of_cls C \ - (\x \ P. D \ \ \ \ \ \ \ grounding_of_cls x) \ + then have "(D \ \ \ \ \ \ \ grounding_of_cls C \ + (\x \ P. D \ \ \ \ \ \ \ grounding_of_cls x) \ (\x \ Q. D \ \ \ \ \ \ \ grounding_of_cls x))" by metis - moreover have "\i < length (CAs \\cl \s \cl \ \cl \). ((CAs \\cl \s \cl \ \cl \) ! i) \ - {C \ \ |\. is_ground_subst \} \ + moreover have "\i < length (CAs \\cl \s \cl \ \cl \). ((CAs \\cl \s \cl \ \cl \) ! i) \ + {C \ \ |\. is_ground_subst \} \ ((\C \ P. {C \ \ | \. is_ground_subst \}) \ (\C\Q. {C \ \ | \. is_ground_subst \}))" proof (rule, rule) fix i assume "i < length (CAs \\cl \s \cl \ \cl \)" then have a: "i < length CAs \ i < length \s" by simp moreover from a have "CAs ! i \ {C} \ Q" using \_p2 \_p unfolding infer_from_def - by (metis (no_types, lifting) Un_subset_iff inference.sel(1) set_mset_union + by (metis (no_types, lifting) Un_subset_iff inference.sel(1) set_mset_union sup_commute nth_mem_mset subsetCE) - ultimately have "(CAs \\cl \s \cl \ \cl \) ! i \ - {C \ \ |\. is_ground_subst \} \ - ((CAs \\cl \s \cl \ \cl \) ! i \ (\C\P. {C \ \ |\. is_ground_subst \}) \ + ultimately have "(CAs \\cl \s \cl \ \cl \) ! i \ + {C \ \ |\. is_ground_subst \} \ + ((CAs \\cl \s \cl \ \cl \) ! i \ (\C\P. {C \ \ |\. is_ground_subst \}) \ (CAs \\cl \s \cl \ \cl \) ! i \ (\C \ Q. {C \ \ | \. is_ground_subst \}))" unfolding \_ground_def using E_\_p \_p2 \_p unfolding infer_from_def unfolding clss_of_state_def grounding_of_clss_def unfolding grounding_of_cls_def apply - apply (cases "CAs ! i = C") subgoal apply (rule disjI1) apply (rule Set.CollectI) apply (rule_tac x="(\s ! i) \ \ \ \" in exI) using \s_def using renamings_apart_length apply (auto;fail) done subgoal apply (rule disjI2) apply (rule disjI2) apply (rule_tac a="CAs ! i" in UN_I) subgoal apply blast done subgoal apply (rule Set.CollectI) apply (rule_tac x="(\s ! i) \ \ \ \" in exI) using \s_def using renamings_apart_length apply (auto;fail) done done done - then show "(CAs \\cl \s \cl \ \cl \) ! i \ {C \ \ |\. is_ground_subst \} \ + then show "(CAs \\cl \s \cl \ \cl \) ! i \ {C \ \ |\. is_ground_subst \} \ ((\C \ P. {C \ \ |\. is_ground_subst \}) \ (\C \ Q. {C \ \ |\. is_ground_subst \}))" by blast qed - then have "\x \# mset (CAs \\cl \s \cl \ \cl \). x \ {C \ \ |\. is_ground_subst \} \ + then have "\x \# mset (CAs \\cl \s \cl \ \cl \). x \ {C \ \ |\. is_ground_subst \} \ ((\C \ P. {C \ \ |\. is_ground_subst \}) \ (\C \ Q. {C \ \ |\. is_ground_subst \}))" by (metis (lifting) in_set_conv_nth set_mset_mset) - then have "set_mset (mset (CAs \\cl \s) \cm \ \cm \) \ + then have "set_mset (mset (CAs \\cl \s) \cm \ \cm \) \ grounding_of_cls C \ grounding_of_clss P \ grounding_of_clss Q" unfolding grounding_of_cls_def grounding_of_clss_def using mset_subst_cls_list_subst_cls_mset by auto ultimately show ?thesis unfolding \_ground_def clss_of_state_def grounding_of_clss_def by auto qed ultimately have "E \ \ \ concls_of (sr_ext.inferences_from (grounding_of_state ({}, P \ {C}, Q)))" unfolding sr_ext.inferences_from_def inference_system.inferences_from_def ground_sound_\_def infer_from_def using \_ground_def by (metis (no_types, lifting) imageI inference.sel(3) mem_Collect_eq) then have "E\ \ concls_of (sr_ext.inferences_from (grounding_of_state ({}, P \ {C}, Q)))" using E_\_p by auto } - then have "grounding_of_state (N, P, Q \ {C}) - grounding_of_state ({}, P \ {C}, Q) + then have "grounding_of_state (N, P, Q \ {C}) - grounding_of_state ({}, P \ {C}, Q) \ concls_of (sr_ext.inferences_from (grounding_of_state ({}, P \ {C}, Q)))" unfolding clss_of_state_def grounding_of_clss_def by auto moreover have "grounding_of_state ({}, P \ {C}, Q) - grounding_of_state (N, P, Q \ {C}) = {}" unfolding clss_of_state_def grounding_of_clss_def by auto ultimately show ?case - using sr_ext.derive.intros[of "(grounding_of_state (N, P, Q \ {C}))" + using sr_ext.derive.intros[of "(grounding_of_state (N, P, Q \ {C}))" "(grounding_of_state ({}, P \ {C}, Q))"] by auto qed text \ A useful consequence: \ theorem RP_model: "St \ St' \ I \s grounding_of_state St' \ I \s grounding_of_state St" proof (drule RP_ground_derive, erule sr_ext.derive.cases, hypsubst) let ?gSt = "grounding_of_state St" and ?gSt' = "grounding_of_state St'" assume deduct: "?gSt' - ?gSt \ concls_of (sr_ext.inferences_from ?gSt)" (is "_ \ ?concls") and delete: "?gSt - ?gSt' \ sr.Rf ?gSt'" show "I \s ?gSt' \ I \s ?gSt" proof assume bef: "I \s ?gSt" then have "I \s ?concls" unfolding ground_sound_\_def inference_system.inferences_from_def true_clss_def true_cls_mset_def by (auto simp add: image_def infer_from_def dest!: spec[of _ I]) then have diff: "I \s ?gSt' - ?gSt" using deduct by (blast intro: true_clss_mono) then show "I \s ?gSt'" using bef unfolding true_clss_def by blast next assume aft: "I \s ?gSt'" have "I \s ?gSt' \ sr.Rf ?gSt'" by (rule sr.Rf_model) (metis aft sr.Rf_mono[OF Un_upper1] Diff_eq_empty_iff Diff_subset Un_Diff true_clss_mono true_clss_union) then have "I \s sr.Rf ?gSt'" using true_clss_union by blast then have diff: "I \s ?gSt - ?gSt'" using delete by (blast intro: true_clss_mono) then show "I \s ?gSt" using aft unfolding true_clss_def by blast qed qed text \ Another formulation of the part of Lemma 4.10 that states we have a theorem proving process: \ (* FIXME: rename *) lemma RP_ground_derive_chain: "chain sr_ext.derive (lmap grounding_of_state Sts)" using deriv RP_ground_derive by (simp add: chain_lmap[of "(\)"]) text \ The following is used prove to Lemma 4.11: \ lemma in_Sup_llist_in_nth: "C \ Sup_llist Gs \ \j. enat j < llength Gs \ C \ lnth Gs j" unfolding Sup_llist_def by auto \ \Note: Gs is called Ns in the chapter\ lemma Sup_llist_grounding_of_state_ground: assumes "C \ Sup_llist (lmap grounding_of_state Sts)" shows "is_ground_cls C" proof - have "\j. enat j < llength (lmap grounding_of_state Sts) \ C \ lnth (lmap grounding_of_state Sts) j" using assms in_Sup_llist_in_nth by metis then obtain j where "enat j < llength (lmap grounding_of_state Sts)" "C \ lnth (lmap grounding_of_state Sts) j" by blast then show ?thesis unfolding grounding_of_clss_def grounding_of_cls_def by auto qed lemma Liminf_grounding_of_state_ground: "C \ Liminf_llist (lmap grounding_of_state Sts) \ is_ground_cls C" using Liminf_llist_subset_Sup_llist[of "lmap grounding_of_state Sts"] Sup_llist_grounding_of_state_ground by blast lemma in_Sup_llist_in_Sup_state: assumes "C \ Sup_llist (lmap grounding_of_state Sts)" shows "\D \. D \ clss_of_state (Sup_state Sts) \ D \ \ = C \ is_ground_subst \" proof - from assms obtain i where i_p: "enat i < llength Sts \ C \ lnth (lmap grounding_of_state Sts) i" using in_Sup_llist_in_nth by fastforce then obtain D \ where "D \ clss_of_state (lnth Sts i) \ D \ \ = C \ is_ground_subst \" using assms unfolding grounding_of_clss_def grounding_of_cls_def by fastforce then have "D \ clss_of_state (Sup_state Sts) \ D \ \ = C \ is_ground_subst \" using i_p unfolding Sup_state_def clss_of_state_def by (metis (no_types, lifting) UnCI UnE contra_subsetD N_of_state.simps P_of_state.simps Q_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist) then show ?thesis by auto qed lemma N_of_state_Liminf: "N_of_state (Liminf_state Sts) = Liminf_llist (lmap N_of_state Sts)" and P_of_state_Liminf: "P_of_state (Liminf_state Sts) = Liminf_llist (lmap P_of_state Sts)" unfolding Liminf_state_def by auto lemma eventually_removed_from_N: assumes d_in: "D \ N_of_state (lnth Sts i)" and fair: "fair_state_seq Sts" and i_Sts: "enat i < llength Sts" shows "\l. D \ N_of_state (lnth Sts l) \ D \ N_of_state (lnth Sts (Suc l)) \ i \ l \ enat (Suc l) < llength Sts" proof (rule ccontr) assume a: "\ ?thesis" have "i \ l \ enat l < llength Sts \ D \ N_of_state (lnth Sts l)" for l using d_in by (induction l, blast, metis a Suc_ile_eq le_SucE less_imp_le) then have "D \ Liminf_llist (lmap N_of_state Sts)" unfolding Liminf_llist_def using i_Sts by auto then show False using fair unfolding fair_state_seq_def by (simp add: N_of_state_Liminf) qed lemma eventually_removed_from_P: assumes d_in: "D \ P_of_state (lnth Sts i)" and fair: "fair_state_seq Sts" and i_Sts: "enat i < llength Sts" shows "\l. D \ P_of_state (lnth Sts l) \ D \ P_of_state (lnth Sts (Suc l)) \ i \ l \ enat (Suc l) < llength Sts" proof (rule ccontr) assume a: "\ ?thesis" have "i \ l \ enat l < llength Sts \ D \ P_of_state (lnth Sts l)" for l using d_in by (induction l, blast, metis a Suc_ile_eq le_SucE less_imp_le) then have "D \ Liminf_llist (lmap P_of_state Sts)" unfolding Liminf_llist_def using i_Sts by auto then show False using fair unfolding fair_state_seq_def by (simp add: P_of_state_Liminf) qed (* FIXME: come up with a better name *) lemma instance_if_subsumed_and_in_limit: assumes ns: "Gs = lmap grounding_of_state Sts" and c: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" and (* FIXME: use clss_of_state below *) - d: "D \ N_of_state (lnth Sts i) \ P_of_state (lnth Sts i) \ Q_of_state (lnth Sts i)" + d: "D \ N_of_state (lnth Sts i) \ P_of_state (lnth Sts i) \ Q_of_state (lnth Sts i)" "enat i < llength Sts" "subsumes D C" shows "\\. D \ \ = C \ is_ground_subst \" proof - let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have ground_C: "is_ground_cls C" using c using Liminf_grounding_of_state_ground ns by auto have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto have "\\. D \ \ = C" proof (rule ccontr) assume "\\. D \ \ = C" moreover from d(3) obtain \_proto where "D \ \_proto \# C" unfolding subsumes_def by blast then obtain \ where \_p: "D \ \ \# C \ is_ground_subst \" using ground_C by (metis is_ground_cls_mono make_ground_subst subset_mset.order_refl) ultimately have subsub: "D \ \ \# C" using subset_mset.le_imp_less_or_eq by auto moreover have "is_ground_subst \" using \_p by auto moreover have "D \ clss_of_state (lnth Sts i)" using d unfolding clss_of_state_def by auto ultimately have "C \ sr.Rf (grounding_of_state (lnth Sts i))" using strict_subset_subsumption_redundant_clss by auto then have "C \ sr.Rf (Sup_llist Gs)" using d ns by (metis contra_subsetD llength_lmap lnth_lmap lnth_subset_Sup_llist sr.Rf_mono) then have "C \ sr.Rf (Liminf_llist Gs)" unfolding ns using local.sr_ext.Rf_limit_Sup derivns ns by auto then show False using c by auto qed then obtain \ where "D \ \ = C \ is_ground_subst \" using ground_C by (metis make_ground_subst) then show ?thesis by auto qed lemma from_Q_to_Q_inf: assumes fair: "fair_state_seq Sts" and ns: "Gs = lmap grounding_of_state Sts" and c: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" and d: "D \ Q_of_state (lnth Sts i)" "enat i < llength Sts" "subsumes D C" and d_least: "\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D" shows "D \ Q_of_state (Liminf_state Sts)" proof - let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have ground_C: "is_ground_cls C" using c using Liminf_grounding_of_state_ground ns by auto have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto have "\\. D \ \ = C \ is_ground_subst \" using instance_if_subsumed_and_in_limit ns c d by blast then obtain \ where \: "D \ \ = C" "is_ground_subst \" by auto have in_Sts_in_Sts_Suc: "\l \ i. enat (Suc l) < llength Sts \ D \ Q_of_state (lnth Sts l) \ D \ Q_of_state (lnth Sts (Suc l))" proof (rule, rule, rule, rule) fix l assume len: "i \ l" and llen: "enat (Suc l) < llength Sts" and d_in_q: "D \ Q_of_state (lnth Sts l)" have "lnth Sts l \ lnth Sts (Suc l)" using llen deriv chain_lnth_rel by blast then show "D \ Q_of_state (lnth Sts (Suc l))" proof (cases rule: RP.cases) case (backward_subsumption_Q D' N D_removed P Q) moreover { assume "D_removed = D" then obtain D_subsumes where D_subsumes_p: "D_subsumes \ N \ strictly_subsumes D_subsumes D" using backward_subsumption_Q by auto moreover from D_subsumes_p have "subsumes D_subsumes C" using d subsumes_trans unfolding strictly_subsumes_def by blast moreover from backward_subsumption_Q have "D_subsumes \ clss_of_state (Sup_state Sts)" using D_subsumes_p llen - by (metis (no_types) UnI1 clss_of_state_def N_of_state.simps llength_lmap lnth_lmap + by (metis (no_types) UnI1 clss_of_state_def N_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist rev_subsetD Sup_state_def) ultimately have False using d_least unfolding subsumes_def by auto } ultimately show ?thesis using d_in_q by auto next case (backward_reduction_Q E L' N L \ D' P Q) { assume "D' + {#L#} = D" then have D'_p: "strictly_subsumes D' D \ D' \ ?Ps (Suc l)" using subset_strictly_subsumes[of D' D] backward_reduction_Q by auto then have subc: "subsumes D' C" using d(3) subsumes_trans unfolding strictly_subsumes_def by auto from D'_p have "D' \ clss_of_state (Sup_state Sts)" using llen by (metis (no_types) UnI1 clss_of_state_def P_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist subsetCE sup_ge2 Sup_state_def) then have False using d_least D'_p subc by auto } then show ?thesis using backward_reduction_Q d_in_q by auto qed (use d_in_q in auto) qed have D_in_Sts: "D \ Q_of_state (lnth Sts l)" and D_in_Sts_Suc: "D \ Q_of_state (lnth Sts (Suc l))" if l_i: "l \ i" and enat: "enat (Suc l) < llength Sts" for l proof - show "D \ Q_of_state (lnth Sts l)" using l_i enat apply (induction "l - i" arbitrary: l) subgoal using d by auto subgoal using d(1) in_Sts_in_Sts_Suc by (metis (no_types, lifting) Suc_ile_eq add_Suc_right add_diff_cancel_left' le_SucE le_Suc_ex less_imp_le) done then show "D \ Q_of_state (lnth Sts (Suc l))" using l_i enat in_Sts_in_Sts_Suc by blast qed have "i \ x \ enat x < llength Sts \ D \ Q_of_state (lnth Sts x)" for x apply (cases x) subgoal using d(1) by (auto intro!: exI[of _ i] simp: less_Suc_eq) subgoal for x' using d(1) D_in_Sts_Suc[of x'] by (cases \i \ x'\) (auto simp: not_less_eq_eq) done then have "D \ Liminf_llist (lmap Q_of_state Sts)" unfolding Liminf_llist_def by (auto intro!: exI[of _ i] simp: d) then show ?thesis unfolding Liminf_state_def by auto qed lemma from_P_to_Q: assumes fair: "fair_state_seq Sts" and ns: "Gs = lmap grounding_of_state Sts" and c: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" and d: "D \ P_of_state (lnth Sts i)" "enat i < llength Sts" "subsumes D C" and d_least: "\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D" shows "\l. D \ Q_of_state (lnth Sts l) \ enat l < llength Sts" proof - let ?Ns = "\i. N_of_state (lnth Sts i)" let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have ground_C: "is_ground_cls C" using c using Liminf_grounding_of_state_ground ns by auto have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto have "\\. D \ \ = C \ is_ground_subst \" using instance_if_subsumed_and_in_limit ns c d by blast then obtain \ where \: "D \ \ = C" "is_ground_subst \" by auto obtain l where l_p: "D \ P_of_state (lnth Sts l) \ D \ P_of_state (lnth Sts (Suc l)) \ i \ l \ enat (Suc l) < llength Sts" using fair using eventually_removed_from_P d unfolding ns by auto then have l_Gs: "enat (Suc l) < llength Gs" using ns by auto from l_p have "lnth Sts l \ lnth Sts (Suc l)" using deriv using chain_lnth_rel by auto then show ?thesis proof (cases rule: RP.cases) case (backward_subsumption_P D' N D_twin P Q) note lrhs = this(1,2) and D'_p = this(3,4) - then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N" "?Ps (Suc l) = P" + then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N" "?Ps (Suc l) = P" "?Ps l = P \ {D_twin}" "?Qs (Suc l) = Q" "?Qs l = Q" using l_p by auto note D'_p = D'_p[unfolded twins(1)] then have subc: "subsumes D' C" unfolding strictly_subsumes_def subsumes_def using \ by (metis subst_cls_comp_subst subst_cls_mono_mset) from D'_p have "D' \ clss_of_state (Sup_state Sts)" unfolding twins(2)[symmetric] using l_p by (metis (no_types) UnI1 clss_of_state_def N_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist subsetCE Sup_state_def) then have False using d_least D'_p subc by auto then show ?thesis by auto next case (backward_reduction_P E L' N L \ D' P Q) - then have twins: "D' + {#L#} = D" "?Ns (Suc l) = N" "?Ns l = N" "?Ps (Suc l) = P \ {D'}" + then have twins: "D' + {#L#} = D" "?Ns (Suc l) = N" "?Ns l = N" "?Ps (Suc l) = P \ {D'}" "?Ps l = P \ {D' + {#L#}}" "?Qs (Suc l) = Q" "?Qs l = Q" using l_p by auto then have D'_p: "strictly_subsumes D' D \ D' \ ?Ps (Suc l)" using subset_strictly_subsumes[of D' D] by auto then have subc: "subsumes D' C" using d(3) subsumes_trans unfolding strictly_subsumes_def by auto from D'_p have "D' \ clss_of_state (Sup_state Sts)" using l_p by (metis (no_types) UnI1 clss_of_state_def P_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist subsetCE sup_ge2 Sup_state_def) then have False using d_least D'_p subc by auto then show ?thesis by auto next case (inference_computation N Q D_twin P) - then have twins: "D_twin = D" "?Ps (Suc l) = P" "?Ps l = P \ {D_twin}" + then have twins: "D_twin = D" "?Ps (Suc l) = P" "?Ps l = P \ {D_twin}" "?Qs (Suc l) = Q \ {D_twin}" "?Qs l = Q" using l_p by auto then show ?thesis using d \ l_p by auto qed (use l_p in auto) qed lemma variants_sym: "variants D D' \ variants D' D" unfolding variants_def by auto lemma variants_imp_exists_subtitution: "variants D D' \ \\. D \ \ = D'" unfolding variants_iff_subsumes subsumes_def by (meson strictly_subsumes_def subset_mset_def strict_subset_subst_strictly_subsumes subsumes_def) lemma properly_subsume_variants: assumes "strictly_subsumes E D" and "variants D D'" shows "strictly_subsumes E D'" proof - from assms obtain \ \' where \_\'_p: "D \ \ = D' \ D' \ \' = D" using variants_imp_exists_subtitution variants_sym by metis from assms obtain \'' where "E \ \'' \# D" unfolding strictly_subsumes_def subsumes_def by auto then have "E \ \'' \ \ \# D \ \" using subst_cls_mono_mset by blast then have "E \ (\'' \ \) \# D'" using \_\'_p by auto moreover from assms have n: "(\\. D \ \ \# E)" unfolding strictly_subsumes_def subsumes_def by auto have "\\. D' \ \ \# E" proof assume "\\'''. D' \ \''' \# E" then obtain \''' where "D' \ \''' \# E" by auto then have "D \ (\ \ \''') \# E" using \_\'_p by auto then show False using n by metis qed ultimately show ?thesis unfolding strictly_subsumes_def subsumes_def by metis qed lemma neg_properly_subsume_variants: assumes "\ strictly_subsumes E D" and "variants D D'" shows "\ strictly_subsumes E D'" using assms properly_subsume_variants variants_sym by auto lemma from_N_to_P_or_Q: assumes fair: "fair_state_seq Sts" and ns: "Gs = lmap grounding_of_state Sts" and c: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" and d: "D \ N_of_state (lnth Sts i)" "enat i < llength Sts" "subsumes D C" and d_least: "\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D" - shows "\l D' \'. D' \ P_of_state (lnth Sts l) \ Q_of_state (lnth Sts l) \ - enat l < llength Sts \ - (\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D') \ + shows "\l D' \'. D' \ P_of_state (lnth Sts l) \ Q_of_state (lnth Sts l) \ + enat l < llength Sts \ + (\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D') \ D' \ \' = C \ is_ground_subst \' \ subsumes D' C" proof - let ?Ns = "\i. N_of_state (lnth Sts i)" let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have ground_C: "is_ground_cls C" using c using Liminf_grounding_of_state_ground ns by auto have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto have "\\. D \ \ = C \ is_ground_subst \" using instance_if_subsumed_and_in_limit ns c d by blast then obtain \ where \: "D \ \ = C" "is_ground_subst \" by auto from c have no_taut: "\ (\A. Pos A \# C \ Neg A \# C)" using sr.tautology_Rf by auto have "\l. D \ N_of_state (lnth Sts l) \ D \ N_of_state (lnth Sts (Suc l)) \ i \ l \ enat (Suc l) < llength Sts" using fair using eventually_removed_from_N d unfolding ns by auto then obtain l where l_p: "D \ N_of_state (lnth Sts l) \ D \ N_of_state (lnth Sts (Suc l)) \ i \ l \ enat (Suc l) < llength Sts" by auto then have l_Gs: "enat (Suc l) < llength Gs" using ns by auto from l_p have "lnth Sts l \ lnth Sts (Suc l)" using deriv using chain_lnth_rel by auto then show ?thesis proof (cases rule: RP.cases) case (tautology_deletion A D_twin N P Q) then have "D_twin = D" using l_p by auto then have "Pos (A \a \) \# C \ Neg (A \a \) \# C" using tautology_deletion(3,4) \ by (metis Melem_subst_cls eql_neg_lit_eql_atm eql_pos_lit_eql_atm) then have False using no_taut by metis then show ?thesis by blast next case (forward_subsumption D' P Q D_twin N) note lrhs = this(1,2) and D'_p = this(3,4) - then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N \ {D_twin}" "?Ps (Suc l) = P " + then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N \ {D_twin}" "?Ps (Suc l) = P " "?Ps l = P" "?Qs (Suc l) = Q" "?Qs l = Q" using l_p by auto note D'_p = D'_p[unfolded twins(1)] from D'_p(2) have subs: "subsumes D' C" using d(3) by (blast intro: subsumes_trans) moreover have "D' \ clss_of_state (Sup_state Sts)" using twins D'_p l_p unfolding clss_of_state_def Sup_state_def by simp (metis (no_types) contra_subsetD llength_lmap lnth_lmap lnth_subset_Sup_llist) ultimately have "\ strictly_subsumes D' D" using d_least by auto then have "subsumes D D'" unfolding strictly_subsumes_def using D'_p by auto then have v: "variants D D'" using D'_p unfolding variants_iff_subsumes by auto then have mini: "\E \ {E \ clss_of_state (Sup_state Sts). subsumes E C}. \ strictly_subsumes E D'" using d_least D'_p neg_properly_subsume_variants[of _ D D'] by auto from v have "\\'. D' \ \' = C" using \ variants_imp_exists_subtitution variants_sym by (metis subst_cls_comp_subst) then have "\\'. D' \ \' = C \ is_ground_subst \'" using ground_C by (meson make_ground_subst refl) then obtain \' where \'_p: "D' \ \' = C \ is_ground_subst \'" by metis show ?thesis using D'_p twins l_p subs mini \'_p by auto next case (forward_reduction E L' P Q L \ D' N) - then have twins: "D' + {#L#} = D" "?Ns (Suc l) = N \ {D'}" "?Ns l = N \ {D' + {#L#}}" + then have twins: "D' + {#L#} = D" "?Ns (Suc l) = N \ {D'}" "?Ns l = N \ {D' + {#L#}}" "?Ps (Suc l) = P " "?Ps l = P" "?Qs (Suc l) = Q" "?Qs l = Q" using l_p by auto then have D'_p: "strictly_subsumes D' D \ D' \ ?Ns (Suc l)" using subset_strictly_subsumes[of D' D] by auto then have subc: "subsumes D' C" using d(3) subsumes_trans unfolding strictly_subsumes_def by blast from D'_p have "D' \ clss_of_state (Sup_state Sts)" using l_p by (metis (no_types) UnI1 clss_of_state_def N_of_state.simps llength_lmap lnth_lmap lnth_subset_Sup_llist subsetCE Sup_state_def) then have False using d_least D'_p subc by auto then show ?thesis by auto next case (clause_processing N D_twin P Q) - then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N \ {D}" "?Ps (Suc l) = P \ {D}" + then have twins: "D_twin = D" "?Ns (Suc l) = N" "?Ns l = N \ {D}" "?Ps (Suc l) = P \ {D}" "?Ps l = P" "?Qs (Suc l) = Q" "?Qs l = Q" using l_p by auto then show ?thesis using d \ l_p d_least by blast qed (use l_p in auto) qed lemma eventually_in_Qinf: assumes D_p: "D \ clss_of_state (Sup_state Sts)" "subsumes D C" "\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D" and fair: "fair_state_seq Sts" and (* We could also, we guess, in this proof obtain a D with property D_p(3) from one with only properties D_p(2,3). *) ns: "Gs = lmap grounding_of_state Sts" and c: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" and ground_C: "is_ground_cls C" shows "\D' \'. D' \ Q_of_state (Liminf_state Sts) \ D' \ \' = C \ is_ground_subst \'" proof - let ?Ns = "\i. N_of_state (lnth Sts i)" let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" from D_p obtain i where i_p: "i < llength Sts" "D \ ?Ns i \ D \ ?Ps i \ D \ ?Qs i" unfolding clss_of_state_def Sup_state_def by simp_all (metis (no_types) in_Sup_llist_in_nth llength_lmap lnth_lmap) have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto have "\\. D \ \ = C \ is_ground_subst \" using instance_if_subsumed_and_in_limit[OF ns c] D_p i_p by blast then obtain \ where \: "D \ \ = C" "is_ground_subst \" by blast { assume a: "D \ ?Ns i" then obtain D' \' l where D'_p: "D' \ ?Ps l \ ?Qs l" "D' \ \' = C" "enat l < llength Sts" "is_ground_subst \'" "\E \ {E. E \ (clss_of_state (Sup_state Sts)) \ subsumes E C}. \ strictly_subsumes E D'" "subsumes D' C" using from_N_to_P_or_Q deriv fair ns c i_p(1) D_p(2) D_p(3) by blast then obtain l' where l'_p: "D' \ ?Qs l'" "l' < llength Sts" using from_P_to_Q[OF fair ns c _ D'_p(3) D'_p(6) D'_p(5)] by blast then have "D' \ Q_of_state (Liminf_state Sts)" using from_Q_to_Q_inf[OF fair ns c _ l'_p(2)] D'_p by auto then have ?thesis using D'_p by auto } moreover { assume a: "D \ ?Ps i" then obtain l' where l'_p: "D \ ?Qs l'" "l' < llength Sts" using from_P_to_Q[OF fair ns c a i_p(1) D_p(2) D_p(3)] by auto then have "D \ Q_of_state (Liminf_state Sts)" using from_Q_to_Q_inf[OF fair ns c l'_p(1) l'_p(2)] D_p(3) \(1) \(2) D_p(2) by auto then have ?thesis using D_p \ by auto } moreover { assume a: "D \ ?Qs i" then have "D \ Q_of_state (Liminf_state Sts)" using from_Q_to_Q_inf[OF fair ns c a i_p(1)] \ D_p(2,3) by auto then have ?thesis using D_p \ by auto } ultimately show ?thesis using i_p by auto qed text \ The following corresponds to Lemma 4.11: \ lemma fair_imp_Liminf_minus_Rf_subset_ground_Liminf_state: assumes fair: "fair_state_seq Sts" and ns: "Gs = lmap grounding_of_state Sts" shows "Liminf_llist Gs - sr.Rf (Liminf_llist Gs) \ grounding_of_clss (Q_of_state (Liminf_state Sts))" proof let ?Ns = "\i. N_of_state (lnth Sts i)" let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have SQinf: "clss_of_state (Liminf_state Sts) = Liminf_llist (lmap Q_of_state Sts)" using fair unfolding fair_state_seq_def Liminf_state_def clss_of_state_def by auto fix C assume C_p: "C \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" then have "C \ Sup_llist Gs" using Liminf_llist_subset_Sup_llist[of Gs] by blast then obtain D_proto where "D_proto \ clss_of_state (Sup_state Sts) \ subsumes D_proto C" using in_Sup_llist_in_Sup_state unfolding ns subsumes_def by blast then obtain D where D_p: "D \ clss_of_state (Sup_state Sts)" "subsumes D C" "\E \ {E. E \ clss_of_state (Sup_state Sts) \ subsumes E C}. \ strictly_subsumes E D" using strictly_subsumes_has_minimum[of "{E. E \ clss_of_state (Sup_state Sts) \ subsumes E C}"] by auto have ground_C: "is_ground_cls C" using C_p using Liminf_grounding_of_state_ground ns by auto have "\D' \'. D' \ Q_of_state (Liminf_state Sts) \ D' \ \' = C \ is_ground_subst \'" using eventually_in_Qinf[of D C Gs] using D_p(1) D_p(2) D_p(3) fair ns C_p ground_C by auto then obtain D' \' where D'_p: "D' \ Q_of_state (Liminf_state Sts) \ D' \ \' = C \ is_ground_subst \'" by blast then have "D' \ clss_of_state (Liminf_state Sts)" by (simp add: clss_of_state_def) then have "C \ grounding_of_state (Liminf_state Sts)" unfolding grounding_of_clss_def grounding_of_cls_def using D'_p by auto then show "C \ grounding_of_clss (Q_of_state (Liminf_state Sts))" using SQinf clss_of_state_def fair fair_state_seq_def by auto qed text \ The following corresponds to (one direction of) Theorem 4.13: \ lemma ground_subclauses: assumes "\i < length CAs. CAs ! i = Cs ! i + poss (AAs ! i)" and "length Cs = length CAs" and "is_ground_cls_list CAs" shows "is_ground_cls_list Cs" unfolding is_ground_cls_list_def by (metis assms in_set_conv_nth is_ground_cls_list_def is_ground_cls_union) lemma subseteq_Liminf_state_eventually_always: fixes CC assumes "finite CC" and "CC \ {}" and "CC \ Q_of_state (Liminf_state Sts)" shows "\j. enat j < llength Sts \ (\j' \ enat j. j' < llength Sts \ CC \ Q_of_state (lnth Sts j'))" proof - - from assms(3) have "\C \ CC. \j. enat j < llength Sts \ + from assms(3) have "\C \ CC. \j. enat j < llength Sts \ (\j' \ enat j. j' < llength Sts \ C \ Q_of_state (lnth Sts j'))" unfolding Liminf_state_def Liminf_llist_def by force then obtain f where f_p: "\C \ CC. f C < llength Sts \ (\j' \ enat (f C). j' < llength Sts \ C \ Q_of_state (lnth Sts j'))" by moura define j :: nat where "j = Max (f ` CC)" have "enat j < llength Sts" unfolding j_def using f_p assms(1) by (metis (mono_tags) Max_in assms(2) finite_imageI imageE image_is_empty) moreover have "\C j'. C \ CC \ enat j \ j' \ j' < llength Sts \ C \ Q_of_state (lnth Sts j')" proof (intro allI impI) fix C :: "'a clause" and j' :: nat assume a: "C \ CC" "enat j \ enat j'" "enat j' < llength Sts" then have "f C \ j'" unfolding j_def using assms(1) Max.bounded_iff by auto then show "C \ Q_of_state (lnth Sts j')" using f_p a by auto qed ultimately show ?thesis by auto qed lemma empty_clause_in_Q_of_Liminf_state: assumes empty_in: "{#} \ Liminf_llist (lmap grounding_of_state Sts)" and fair: "fair_state_seq Sts" shows "{#} \ Q_of_state (Liminf_state Sts)" proof - define Gs :: "'a clause set llist" where ns: "Gs = lmap grounding_of_state Sts" from empty_in have in_Liminf_not_Rf: "{#} \ Liminf_llist Gs - sr.Rf (Liminf_llist Gs)" unfolding ns sr.Rf_def by auto then have "{#} \ grounding_of_clss (Q_of_state (Liminf_state Sts))" using fair_imp_Liminf_minus_Rf_subset_ground_Liminf_state[OF fair ns] by auto then show ?thesis unfolding grounding_of_clss_def grounding_of_cls_def by auto qed lemma grounding_of_state_Liminf_state_subseteq: "grounding_of_state (Liminf_state Sts) \ Liminf_llist (lmap grounding_of_state Sts)" proof fix C :: "'a clause" assume "C \ grounding_of_state (Liminf_state Sts)" then obtain D \ where D_\_p: "D \ clss_of_state (Liminf_state Sts)" "D \ \ = C" "is_ground_subst \" unfolding clss_of_state_def grounding_of_clss_def grounding_of_cls_def by auto - then have ii: "D \ Liminf_llist (lmap N_of_state Sts) \ - D \ Liminf_llist (lmap P_of_state Sts) \ + then have ii: "D \ Liminf_llist (lmap N_of_state Sts) \ + D \ Liminf_llist (lmap P_of_state Sts) \ D \ Liminf_llist (lmap Q_of_state Sts)" unfolding clss_of_state_def Liminf_state_def by simp then have "C \ Liminf_llist (lmap grounding_of_clss (lmap N_of_state Sts)) \ C \ Liminf_llist (lmap grounding_of_clss (lmap P_of_state Sts)) \ C \ Liminf_llist (lmap grounding_of_clss (lmap Q_of_state Sts))" unfolding Liminf_llist_def grounding_of_clss_def grounding_of_cls_def apply - apply (erule disjE) subgoal apply (rule disjI1) using D_\_p by auto subgoal apply (erule HOL.disjE) subgoal apply (rule disjI2) apply (rule disjI1) using D_\_p by auto subgoal apply (rule disjI2) apply (rule disjI2) using D_\_p by auto done done then show "C \ Liminf_llist (lmap grounding_of_state Sts)" unfolding Liminf_llist_def clss_of_state_def grounding_of_clss_def by auto qed theorem RP_sound: assumes "{#} \ clss_of_state (Liminf_state Sts)" shows "\ satisfiable (grounding_of_state (lhd Sts))" proof - from assms have "{#} \ grounding_of_state (Liminf_state Sts)" unfolding grounding_of_clss_def by (force intro: ex_ground_subst) then have "{#} \ Liminf_llist (lmap grounding_of_state Sts)" using grounding_of_state_Liminf_state_subseteq by auto then have "\ satisfiable (Liminf_llist (lmap grounding_of_state Sts))" using true_clss_def by auto then have "\ satisfiable (lhd (lmap grounding_of_state Sts))" using sr_ext.sat_limit_iff RP_ground_derive_chain by metis then show ?thesis unfolding lhd_lmap_Sts . qed -lemma ground_ord_resolve_ground: - assumes +lemma ground_ord_resolve_ground: + assumes CAs_p: "gr.ord_resolve CAs DA AAs As E" and ground_cas: "is_ground_cls_list CAs" and ground_da: "is_ground_cls DA" shows "is_ground_cls E" proof - have a1: "atms_of E \ (\CA \ set CAs. atms_of CA) \ atms_of DA" using gr.ord_resolve_atms_of_concl_subset[of CAs DA _ _ E] CAs_p by auto { fix L :: "'a literal" assume "L \# E" then have "atm_of L \ atms_of E" by (meson atm_of_lit_in_atms_of) then have "is_ground_atm (atm_of L)" using a1 ground_cas ground_da is_ground_cls_imp_is_ground_atm is_ground_cls_list_def by auto } then show ?thesis unfolding is_ground_cls_def is_ground_lit_def by simp qed theorem RP_saturated_if_fair: assumes fair: "fair_state_seq Sts" shows "sr.saturated_upto (Liminf_llist (lmap grounding_of_state Sts))" proof - define Gs :: "'a clause set llist" where ns: "Gs = lmap grounding_of_state Sts" let ?N = "\i. grounding_of_state (lnth Sts i)" let ?Ns = "\i. N_of_state (lnth Sts i)" let ?Ps = "\i. P_of_state (lnth Sts i)" let ?Qs = "\i. Q_of_state (lnth Sts i)" have ground_ns_in_ground_limit_st: "Liminf_llist Gs - sr.Rf (Liminf_llist Gs) \ grounding_of_clss (Q_of_state (Liminf_state Sts))" using fair deriv fair_imp_Liminf_minus_Rf_subset_ground_Liminf_state ns by blast have derivns: "chain sr_ext.derive Gs" using RP_ground_derive_chain deriv ns by auto { fix \ :: "'a inference" assume \_p: "\ \ gr.ord_\" let ?CC = "side_prems_of \" let ?DA = "main_prem_of \" let ?E = "concl_of \" - assume a: "set_mset ?CC \ {?DA} + assume a: "set_mset ?CC \ {?DA} \ Liminf_llist (lmap grounding_of_state Sts) - sr.Rf (Liminf_llist (lmap grounding_of_state Sts))" have ground_ground_Liminf: "is_ground_clss (Liminf_llist (lmap grounding_of_state Sts))" using Liminf_grounding_of_state_ground unfolding is_ground_clss_def by auto have ground_cc: "is_ground_clss (set_mset ?CC)" using a ground_ground_Liminf is_ground_clss_def by auto have ground_da: "is_ground_cls ?DA" using a grounding_ground singletonI ground_ground_Liminf by (simp add: Liminf_grounding_of_state_ground) from \_p obtain CAs AAs As where CAs_p: "gr.ord_resolve CAs ?DA AAs As ?E \ mset CAs = ?CC" unfolding gr.ord_\_def by auto have DA_CAs_in_ground_Liminf: "{?DA} \ set CAs \ grounding_of_clss (Q_of_state (Liminf_state Sts))" using a CAs_p unfolding clss_of_state_def using fair unfolding fair_state_seq_def by (metis (no_types, lifting) Un_empty_left ground_ns_in_ground_limit_st a clss_of_state_def ns set_mset_mset subset_trans sup_commute) then have ground_cas: "is_ground_cls_list CAs" using CAs_p unfolding is_ground_cls_list_def by auto then have ground_e: "is_ground_cls ?E" using ground_ord_resolve_ground CAs_p ground_da by auto have "\AAs As \. ord_resolve (S_M S (Q_of_state (Liminf_state Sts))) CAs ?DA AAs As \ ?E" using CAs_p[THEN conjunct1] proof (cases rule: gr.ord_resolve.cases) case (ord_resolve n Cs D) note DA = this(1) and e = this(2) and cas_len = this(3) and cs_len = this(4) and aas_len = this(5) and as_len = this(6) and nz = this(7) and cas = this(8) and aas_not_empt = this(9) and as_aas = this(10) and eligibility = this(11) and str_max = this(12) and sel_empt = this(13) have len_aas_len_as: "length AAs = length As" using aas_len as_len by auto from as_aas have "\iA \# add_mset (As ! i) (AAs ! i). A = As ! i" using ord_resolve by simp then have "\i < n. card (set_mset (add_mset (As ! i) (AAs ! i))) \ Suc 0" using all_the_same by metis then have "\i < length AAs. card (set_mset (add_mset (As ! i) (AAs ! i))) \ Suc 0" using aas_len by auto then have "\AA \ set (map2 add_mset As AAs). card (set_mset AA) \ Suc 0" using set_map2_ex[of AAs As add_mset, OF len_aas_len_as] by auto then have "is_unifiers id_subst (set_mset ` set (map2 add_mset As AAs))" unfolding is_unifiers_def is_unifier_def by auto moreover have "finite (set_mset ` set (map2 add_mset As AAs))" by auto moreover have "\AA \ set_mset ` set (map2 add_mset As AAs). finite AA" by auto ultimately obtain \ where \_p: "Some \ = mgu (set_mset ` set (map2 add_mset As AAs))" using mgu_complete by metis have ground_elig: "gr.eligible As (D + negs (mset As))" using ord_resolve by simp have ground_cs: "\i < n. is_ground_cls (Cs ! i)" using ord_resolve(8) ord_resolve(3,4) ground_cas using ground_subclauses[of CAs Cs AAs] unfolding is_ground_cls_list_def by auto have ground_set_as: "is_ground_atms (set As)" using ord_resolve(1) ground_da by (metis atms_of_negs is_ground_cls_union set_mset_mset is_ground_cls_is_ground_atms_atms_of) then have ground_mset_as: "is_ground_atm_mset (mset As)" unfolding is_ground_atm_mset_def is_ground_atms_def by auto have ground_as: "is_ground_atm_list As" using ground_set_as is_ground_atm_list_def is_ground_atms_def by auto have ground_d: "is_ground_cls D" using ground_da ord_resolve by simp from as_len nz have "atms_of D \ set As \ {}" "finite (atms_of D \ set As)" by auto then have "Max (atms_of D \ set As) \ atms_of D \ set As" using Max_in by metis then have is_ground_Max: "is_ground_atm (Max (atms_of D \ set As))" using ground_d ground_mset_as is_ground_cls_imp_is_ground_atm unfolding is_ground_atm_mset_def by auto then have Max\_is_Max: "\\. Max (atms_of D \ set As) \a \ = Max (atms_of D \ set As)" by auto have ann1: "maximal_wrt (Max (atms_of D \ set As)) (D + negs (mset As))" unfolding maximal_wrt_def by clarsimp (metis Max_less_iff UnCI \atms_of D \ set As \ {}\ \finite (atms_of D \ set As)\ ground_d ground_set_as infinite_growing is_ground_Max is_ground_atms_def is_ground_cls_imp_is_ground_atm less_atm_ground) from ground_elig have ann2: "Max (atms_of D \ set As) \a \ = Max (atms_of D \ set As)" "D \ \ + negs (mset As \am \) = D + negs (mset As)" using is_ground_Max ground_mset_as ground_d by auto from ground_elig have fo_elig: "eligible (S_M S (Q_of_state (Liminf_state Sts))) \ As (D + negs (mset As))" unfolding gr.eligible.simps eligible.simps gr.maximal_wrt_def using ann1 ann2 by (auto simp: S_Q_def) have l: "\i < n. gr.strictly_maximal_wrt (As ! i) (Cs ! i)" using ord_resolve by simp then have "\i < n. strictly_maximal_wrt (As ! i) (Cs ! i)" unfolding gr.strictly_maximal_wrt_def strictly_maximal_wrt_def using ground_as[unfolded is_ground_atm_list_def] ground_cs as_len less_atm_ground by clarsimp (fastforce simp: is_ground_cls_as_atms)+ then have ll: "\i < n. strictly_maximal_wrt (As ! i \a \) (Cs ! i \ \)" by (simp add: ground_as ground_cs as_len) have m: "\i < n. S_Q (CAs ! i) = {#}" using ord_resolve by simp have ground_e: "is_ground_cls (\# (mset Cs) + D)" using ground_d ground_cs ground_e e by simp show ?thesis using ord_resolve.intros[OF cas_len cs_len aas_len as_len nz cas aas_not_empt \_p fo_elig ll] m DA e ground_e unfolding S_Q_def by auto qed then obtain AAs As \ where \_p: "ord_resolve (S_M S (Q_of_state (Liminf_state Sts))) CAs ?DA AAs As \ ?E" by auto then obtain \s' \' \2' CAs' DA' AAs' As' \' E' where s_p: "is_ground_subst \'" "is_ground_subst_list \s'" "is_ground_subst \2'" "ord_resolve_rename S CAs' DA' AAs' As' \' E'" "CAs' \\cl \s' = CAs" "DA' \ \' = ?DA" "E' \ \2' = ?E" "{DA'} \ set CAs' \ Q_of_state (Liminf_state Sts)" using ord_resolve_rename_lifting[OF sel_stable, of "Q_of_state (Liminf_state Sts)" CAs ?DA] \_p selection_axioms DA_CAs_in_ground_Liminf by metis from this(8) have "\j. enat j < llength Sts \ (set CAs' \ {DA'} \ ?Qs j)" unfolding Liminf_llist_def using subseteq_Liminf_state_eventually_always[of "{DA'} \ set CAs'"] by auto then obtain j where j_p: "is_least (\j. enat j < llength Sts \ set CAs' \ {DA'} \ ?Qs j) j" using least_exists[of "\j. enat j < llength Sts \ set CAs' \ {DA'} \ ?Qs j"] by force then have j_p': "enat j < llength Sts" "set CAs' \ {DA'} \ ?Qs j" unfolding is_least_def by auto then have jn0: "j \ 0" using empty_Q0 by (metis bot_eq_sup_iff gr_implies_not_zero insert_not_empty llength_lnull lnth_0_conv_lhd sup.orderE) then have j_adds_CAs': "\ set CAs' \ {DA'} \ ?Qs (j - 1)" "set CAs' \ {DA'} \ ?Qs j" using j_p unfolding is_least_def apply (metis (no_types) One_nat_def Suc_diff_Suc Suc_ile_eq diff_diff_cancel diff_zero less_imp_le less_one neq0_conv zero_less_diff) using j_p'(2) by blast have "lnth Sts (j - 1) \ lnth Sts j" using j_p'(1) jn0 deriv chain_lnth_rel[of _ _ "j - 1"] by force then obtain C' where C'_p: "?Ns (j - 1) = {}" "?Ps (j - 1) = ?Ps j \ {C'}" "?Qs j = ?Qs (j - 1) \ {C'}" "?Ns j = concls_of (ord_FO_resolution.inferences_between (?Qs (j - 1)) C')" "C' \ set CAs' \ {DA'}" "C' \ ?Qs (j - 1)" using j_adds_CAs' by (induction rule: RP.cases) auto have "E' \ ?Ns j" proof - have "E' \ concls_of (ord_FO_resolution.inferences_between (Q_of_state (lnth Sts (j - 1))) C')" unfolding infer_from_def ord_FO_\_def unfolding inference_system.inferences_between_def apply (rule_tac x = "Infer (mset CAs') DA' E'" in image_eqI) subgoal by auto subgoal using s_p(4) unfolding infer_from_def apply (rule ord_resolve_rename.cases) using s_p(4) using C'_p(3) C'_p(5) j_p'(2) apply force done done then show ?thesis using C'_p(4) by auto qed then have "E' \ clss_of_state (lnth Sts j)" using j_p' unfolding clss_of_state_def by auto then have "?E \ grounding_of_state (lnth Sts j)" using s_p(7) s_p(3) unfolding grounding_of_clss_def grounding_of_cls_def by force then have "\ \ sr.Ri (grounding_of_state (lnth Sts j))" using sr.Ri_effective \_p by auto then have "\ \ sr_ext_Ri (?N j)" unfolding sr_ext_Ri_def by auto then have "\ \ sr_ext_Ri (Sup_llist (lmap grounding_of_state Sts))" using j_p' contra_subsetD llength_lmap lnth_lmap lnth_subset_Sup_llist sr_ext.Ri_mono by metis then have "\ \ sr_ext_Ri (Liminf_llist (lmap grounding_of_state Sts))" using sr_ext.Ri_limit_Sup[of Gs] derivns ns by blast } then have "sr_ext.saturated_upto (Liminf_llist (lmap grounding_of_state Sts))" unfolding sr_ext.saturated_upto_def sr_ext.inferences_from_def infer_from_def sr_ext_Ri_def by auto then show ?thesis using gd_ord_\_ngd_ord_\ sr.redundancy_criterion_axioms redundancy_criterion_standard_extension_saturated_upto_iff[of gr.ord_\] unfolding sr_ext_Ri_def by auto qed corollary RP_complete_if_fair: assumes fair: "fair_state_seq Sts" and unsat: "\ satisfiable (grounding_of_state (lhd Sts))" shows "{#} \ Q_of_state (Liminf_state Sts)" proof - have "\ satisfiable (Liminf_llist (lmap grounding_of_state Sts))" unfolding sr_ext.sat_limit_iff[OF RP_ground_derive_chain] by (rule unsat[folded lhd_lmap_Sts[of grounding_of_state]]) moreover have "sr.saturated_upto (Liminf_llist (lmap grounding_of_state Sts))" by (rule RP_saturated_if_fair[OF fair, simplified]) ultimately have "{#} \ Liminf_llist (lmap grounding_of_state Sts)" using sr.saturated_upto_complete_if by auto then show ?thesis using empty_clause_in_Q_of_Liminf_state fair by auto qed end end end diff --git a/thys/Ordered_Resolution_Prover/Lazy_List_Chain.thy b/thys/Ordered_Resolution_Prover/Lazy_List_Chain.thy --- a/thys/Ordered_Resolution_Prover/Lazy_List_Chain.thy +++ b/thys/Ordered_Resolution_Prover/Lazy_List_Chain.thy @@ -1,618 +1,618 @@ (* Title: Relational Chains over Lazy Lists Author: Jasmin Blanchette , 2014, 2017 Author: Dmitriy Traytel , 2017 Author: Anders Schlichtkrull , 2017 Maintainer: Anders Schlichtkrull *) section \Relational Chains over Lazy Lists\ theory Lazy_List_Chain imports "HOL-Library.BNF_Corec" Lazy_List_Liminf begin text \ A chain is a lazy lists of elements such that all pairs of consecutive elements are related by a given relation. A full chain is either an infinite chain or a finite chain that cannot be extended. The inspiration for this theory is Section 4.1 (``Theorem Proving Processes'') of Bachmair and Ganzinger's chapter. \ subsection \Chains\ coinductive chain :: "('a \ 'a \ bool) \ 'a llist \ bool" for R :: "'a \ 'a \ bool" where chain_singleton: "chain R (LCons x LNil)" | chain_cons: "chain R xs \ R x (lhd xs) \ chain R (LCons x xs)" lemma chain_LNil[simp]: "\ chain R LNil" and chain_not_lnull: "chain R xs \ \ lnull xs" by (auto elim: chain.cases) lemma chain_lappend: assumes r_xs: "chain R xs" and r_ys: "chain R ys" and mid: "R (llast xs) (lhd ys)" shows "chain R (lappend xs ys)" proof (cases "lfinite xs") case True then show ?thesis using r_xs mid proof (induct rule: lfinite.induct) case (lfinite_LConsI xs x) note fin = this(1) and ih = this(2) and r_xxs = this(3) and mid = this(4) show ?case proof (cases "xs = LNil") case True then show ?thesis using r_ys mid by simp (rule chain_cons) next case xs_nnil: False have r_xs: "chain R xs" by (metis chain.simps ltl_simps(2) r_xxs xs_nnil) have mid': "R (llast xs) (lhd ys)" by (metis llast_LCons lnull_def mid xs_nnil) have start: "R x (lhd (lappend xs ys))" by (metis (no_types) chain.simps lhd_LCons lhd_lappend chain_not_lnull ltl_simps(2) r_xxs xs_nnil) show ?thesis unfolding lappend_code(2) using ih[OF r_xs mid'] start by (rule chain_cons) qed qed simp qed (simp add: r_xs lappend_inf) lemma chain_length_pos: "chain R xs \ llength xs > 0" by (cases xs) simp+ lemma chain_ldropn: assumes "chain R xs" and "enat n < llength xs" shows "chain R (ldropn n xs)" using assms by (induct n arbitrary: xs, simp, metis chain.cases ldrop_eSuc_ltl ldropn_LNil ldropn_eq_LNil ltl_simps(2) not_less) lemma chain_lnth_rel: assumes chain: "chain R xs" and len: "enat (Suc j) < llength xs" shows "R (lnth xs j) (lnth xs (Suc j))" proof - define ys where "ys = ldropn j xs" have "llength ys > 1" unfolding ys_def using len by (metis One_nat_def funpow_swap1 ldropn_0 ldropn_def ldropn_eq_LNil ldropn_ltl not_less one_enat_def) obtain y0 y1 ys' where ys: "ys = LCons y0 (LCons y1 ys')" unfolding ys_def by (metis Suc_ile_eq ldropn_Suc_conv_ldropn len less_imp_not_less not_less) have "chain R ys" unfolding ys_def using Suc_ile_eq chain chain_ldropn len less_imp_le by blast then have "R y0 y1" unfolding ys by (auto elim: chain.cases) then show ?thesis using ys_def unfolding ys by (metis ldropn_Suc_conv_ldropn ldropn_eq_LConsD llist.inject) qed lemma infinite_chain_lnth_rel: assumes "\ lfinite c" and "chain r c" shows "r (lnth c i) (lnth c (Suc i))" using assms chain_lnth_rel lfinite_conv_llength_enat by force lemma lnth_rel_chain: assumes "\ lnull xs" and "\j. enat (j + 1) < llength xs \ R (lnth xs j) (lnth xs (j + 1))" shows "chain R xs" using assms proof (coinduction arbitrary: xs rule: chain.coinduct) case chain note nnul = this(1) and nth_chain = this(2) show ?case proof (cases "lnull (ltl xs)") case True have "xs = LCons (lhd xs) LNil" using nnul True by (simp add: llist.expand) then show ?thesis by blast next case nnul': False moreover have "xs = LCons (lhd xs) (ltl xs)" using nnul by simp moreover have "\j. enat (j + 1) < llength (ltl xs) \ R (lnth (ltl xs) j) (lnth (ltl xs) (j + 1))" using nnul nth_chain by (metis Suc_eq_plus1 ldrop_eSuc_ltl ldropn_Suc_conv_ldropn ldropn_eq_LConsD lnth_ltl) moreover have "R (lhd xs) (lhd (ltl xs))" using nnul' nnul nth_chain[rule_format, of 0, simplified] by (metis ldropn_0 ldropn_Suc_conv_ldropn ldropn_eq_LConsD lhd_LCons_ltl lhd_conv_lnth lnth_Suc_LCons ltl_simps(2)) ultimately show ?thesis by blast qed qed lemma chain_lmap: assumes "\x y. R x y \ R' (f x) (f y)" and "chain R xs" shows "chain R' (lmap f xs)" using assms proof (coinduction arbitrary: xs) case chain then have "(\y. xs = LCons y LNil) \ (\ys x. xs = LCons x ys \ chain R ys \ R x (lhd ys))" using chain.simps[of R xs] by auto then show ?case proof assume "\ys x. xs = LCons x ys \ chain R ys \ R x (lhd ys)" then have "\ys x. lmap f xs = LCons x ys \ (\xs. ys = lmap f xs \ (\x y. R x y \ R' (f x) (f y)) \ chain R xs) \ R' x (lhd ys)" using chain by (metis (no_types) lhd_LCons llist.distinct(1) llist.exhaust_sel llist.map_sel(1) lmap_eq_LNil chain_not_lnull ltl_lmap ltl_simps(2)) then show ?thesis by auto qed auto qed lemma chain_mono: assumes "\x y. R x y \ R' x y" and "chain R xs" shows "chain R' xs" using assms by (rule chain_lmap[of _ _ "\x. x", unfolded llist.map_ident]) lemma lfinite_chain_imp_rtranclp_lhd_llast: "lfinite xs \ chain R xs \ R\<^sup>*\<^sup>* (lhd xs) (llast xs)" proof (induct rule: lfinite.induct) case (lfinite_LConsI xs x) note fin_xs = this(1) and ih = this(2) and r_x_xs = this(3) show ?case proof (cases "xs = LNil") case xs_nnil: False then have r_xs: "chain R xs" using r_x_xs by (blast elim: chain.cases) then show ?thesis using ih[OF r_xs] xs_nnil r_x_xs by (metis chain.cases converse_rtranclp_into_rtranclp lhd_LCons llast_LCons chain_not_lnull ltl_simps(2)) qed simp qed simp lemma tranclp_imp_exists_finite_chain_list: "R\<^sup>+\<^sup>+ x y \ \xs. chain R (llist_of (x # xs @ [y]))" proof (induct rule: tranclp.induct) case (r_into_trancl x y) then have "chain R (llist_of (x # [] @ [y]))" by (auto intro: chain.intros) then show ?case by blast next case (trancl_into_trancl x y z) note rstar_xy = this(1) and ih = this(2) and r_yz = this(3) obtain xs where xs: "chain R (llist_of (x # xs @ [y]))" using ih by blast define ys where "ys = xs @ [y]" have "chain R (llist_of (x # ys @ [z]))" unfolding ys_def using r_yz chain_lappend[OF xs chain_singleton, of z] by (auto simp: lappend_llist_of_LCons llast_LCons) then show ?case by blast qed inductive_cases chain_consE: "chain R (LCons x xs)" inductive_cases chain_nontrivE: "chain R (LCons x (LCons y xs))" primrec prepend where "prepend [] ys = ys" | "prepend (x # xs) ys = LCons x (prepend xs ys)" lemma lnull_prepend[simp]: "lnull (prepend xs ys) = (xs = [] \ lnull ys)" by (induct xs) auto lemma lhd_prepend[simp]: "lhd (prepend xs ys) = (if xs \ [] then hd xs else lhd ys)" by (induct xs) auto lemma prepend_LNil[simp]: "prepend xs LNil = llist_of xs" by (induct xs) auto lemma lfinite_prepend[simp]: "lfinite (prepend xs ys) \ lfinite ys" by (induct xs) auto lemma llength_prepend[simp]: "llength (prepend xs ys) = length xs + llength ys" by (induct xs) (auto simp: enat_0 iadd_Suc eSuc_enat[symmetric]) lemma llast_prepend[simp]: "\ lnull ys \ llast (prepend xs ys) = llast ys" by (induct xs) (auto simp: llast_LCons) lemma prepend_prepend: "prepend xs (prepend ys zs) = prepend (xs @ ys) zs" by (induct xs) auto lemma chain_prepend: "chain R (llist_of zs) \ last zs = lhd xs \ chain R xs \ chain R (prepend zs (ltl xs))" by (induct zs; cases xs) (auto split: if_splits simp: lnull_def[symmetric] intro!: chain_cons elim!: chain_consE) lemma lmap_prepend[simp]: "lmap f (prepend xs ys) = prepend (map f xs) (lmap f ys)" by (induct xs) auto lemma lset_prepend[simp]: "lset (prepend xs ys) = set xs \ lset ys" by (induct xs) auto lemma prepend_LCons: "prepend xs (LCons y ys) = prepend (xs @ [y]) ys" by (induct xs) auto lemma lnth_prepend: "lnth (prepend xs ys) i = (if i < length xs then nth xs i else lnth ys (i - length xs))" by (induct xs arbitrary: i) (auto simp: lnth_LCons' nth_Cons') theorem lfinite_less_induct[consumes 1, case_names less]: assumes fin: "lfinite xs" and step: "\xs. lfinite xs \ (\zs. llength zs < llength xs \ P zs) \ P xs" shows "P xs" using fin proof (induct "the_enat (llength xs)" arbitrary: xs rule: less_induct) case (less xs) show ?case using less(2) by (intro step[OF less(2)] less(1)) (auto dest!: lfinite_llength_enat simp: eSuc_enat elim!: less_enatE llength_eq_enat_lfiniteD) qed theorem lfinite_prepend_induct[consumes 1, case_names LNil prepend]: assumes "lfinite xs" and LNil: "P LNil" and prepend: "\xs. lfinite xs \ (\zs. (\ys. xs = prepend ys zs \ ys \ []) \ P zs) \ P xs" shows "P xs" using assms(1) proof (induct xs rule: lfinite_less_induct) case (less xs) from less(1) show ?case by (cases xs) (force simp: LNil neq_Nil_conv dest: lfinite_llength_enat intro!: prepend[of "LCons _ _"] intro: less)+ qed coinductive emb :: "'a llist \ 'a llist \ bool" where "lfinite xs \ emb LNil xs" | "emb xs ys \ emb (LCons x xs) (prepend zs (LCons x ys))" inductive_cases emb_LConsE: "emb (LCons z zs) ys" inductive_cases emb_LNil1E: "emb LNil ys" inductive_cases emb_LNil2E: "emb xs LNil" lemma emb_lfinite: assumes "emb xs ys" shows "lfinite ys \ lfinite xs" proof assume "lfinite xs" then show "lfinite ys" using assms by (induct xs arbitrary: ys rule: lfinite_induct) (auto simp: lnull_def neq_LNil_conv elim!: emb_LNil1E emb_LConsE) next assume "lfinite ys" then show "lfinite xs" using assms proof (induction ys arbitrary: xs rule: lfinite_less_induct) case (less ys) from less.prems \lfinite ys\ show ?case by (cases xs) (auto simp: eSuc_enat elim!: emb_LNil1E emb_LConsE less.IH[rotated] dest!: lfinite_llength_enat) qed qed inductive prepend_cong1 for X where prepend_cong1_base: "X xs \ prepend_cong1 X xs" | prepend_cong1_prepend: "prepend_cong1 X ys \ prepend_cong1 X (prepend xs ys)" lemma emb_prepend_coinduct[rotated, case_names emb]: assumes "(\x1 x2. X x1 x2 \ (\xs. x1 = LNil \ x2 = xs \ lfinite xs) \ (\xs ys x zs. x1 = LCons x xs \ x2 = prepend zs (LCons x ys) \ (prepend_cong1 (X xs) ys \ emb xs ys)))" (is "\x1 x2. X x1 x2 \ ?bisim x1 x2") shows "X x1 x2 \ emb x1 x2" proof (erule emb.coinduct[OF prepend_cong1_base]) fix xs zs assume "prepend_cong1 (X xs) zs" then show "?bisim xs zs" by (induct zs rule: prepend_cong1.induct) (erule assms, force simp: prepend_prepend) qed context begin private coinductive chain' for R where "chain' R (LCons x LNil)" | "chain R (llist_of (x # zs @ [lhd xs])) \ chain' R xs \ chain' R (LCons x (prepend zs xs))" private lemma chain_imp_chain': "chain R xs \ chain' R xs" proof (coinduction arbitrary: xs rule: chain'.coinduct) case chain' then show ?case proof (cases rule: chain.cases) case (chain_cons zs z) then show ?thesis by (intro disjI2 exI[of _ z] exI[of _ "[]"] exI[of _ "zs"]) (auto intro: chain.intros) qed simp qed private lemma chain'_imp_chain: "chain' R xs \ chain R xs" proof (coinduction arbitrary: xs rule: chain.coinduct) case chain then show ?case proof (cases rule: chain'.cases) case (2 y zs ys) then show ?thesis by (intro disjI2 exI[of _ "prepend zs ys"] exI[of _ y]) (force dest!: neq_Nil_conv[THEN iffD1] elim: chain.cases chain_nontrivE intro: chain'.intros) qed simp qed private lemma chain_chain': "chain = chain'" unfolding fun_eq_iff by (metis chain_imp_chain' chain'_imp_chain) lemma chain_prepend_coinduct[case_names chain]: "X x \ (\x. X x \ (\z. x = LCons z LNil) \ (\y xs zs. x = LCons y (prepend zs xs) \ (X xs \ chain R xs) \ chain R (llist_of (y # zs @ [lhd xs])))) \ chain R x" by (subst chain_chain', erule chain'.coinduct) (force simp: chain_chain') end context fixes R :: "'a \ 'a \ bool" begin private definition pick where "pick x y = (SOME xs. chain R (llist_of (x # xs @ [y])))" private lemma pick[simp]: assumes "R\<^sup>+\<^sup>+ x y" shows "chain R (llist_of (x # pick x y @ [y]))" unfolding pick_def using tranclp_imp_exists_finite_chain_list[THEN someI_ex, OF assms] by auto private friend_of_corec prepend where - "prepend xs ys = (case xs of [] \ + "prepend xs ys = (case xs of [] \ (case ys of LNil \ LNil | LCons x xs \ LCons x xs) | x # xs' \ LCons x (prepend xs' ys))" by (simp split: list.splits llist.splits) transfer_prover private corec wit where "wit xs = (case xs of LCons x (LCons y xs) \ LCons x (prepend (pick x y) (wit (LCons y xs))) | _ \ xs)" private lemma wit_LNil[simp]: "wit LNil = LNil" and wit_lsingleton[simp]: "wit (LCons x LNil) = LCons x LNil" and wit_LCons2: "wit (LCons x (LCons y xs)) = (LCons x (prepend (pick x y) (wit (LCons y xs))))" by (subst wit.code; auto)+ private lemma lnull_wit[simp]: "lnull (wit xs) \ lnull xs" by (subst wit.code) (auto split: llist.splits simp: Let_def) private lemma lhd_wit[simp]: "chain R\<^sup>+\<^sup>+ xs \ lhd (wit xs) = lhd xs" by (erule chain.cases; subst wit.code) (auto split: llist.splits simp: Let_def) private lemma LNil_eq_iff_lnull: "LNil = xs \ lnull xs" by (cases xs) auto lemma emb_wit[simp]: "chain R\<^sup>+\<^sup>+ xs \ emb xs (wit xs)" proof (coinduction arbitrary: xs rule: emb_prepend_coinduct) case (emb xs) then show ?case proof (cases rule: chain.cases) case (chain_cons zs z) then show ?thesis by (subst (2) wit.code) (auto split: llist.splits intro!: exI[of _ "[]"] exI[of _ "_ :: _ llist"] prepend_cong1_prepend[OF prepend_cong1_base]) qed (auto intro!: exI[of _ LNil] exI[of _ "[]"] emb.intros) qed private lemma lfinite_wit[simp]: assumes "chain R\<^sup>+\<^sup>+ xs" shows "lfinite (wit xs) \ lfinite xs" using emb_wit emb_lfinite assms by blast private lemma llast_wit[simp]: assumes "chain R\<^sup>+\<^sup>+ xs" shows "llast (wit xs) = llast xs" proof (cases "lfinite xs") case True from this assms show ?thesis proof (induct rule: lfinite.induct) case (lfinite_LConsI xs x) then show ?case by (cases xs) (auto simp: wit_LCons2 llast_LCons elim: chain_nontrivE) qed auto qed (auto simp: llast_linfinite assms) lemma chain_tranclp_imp_exists_chain: "chain R\<^sup>+\<^sup>+ xs \ \ys. chain R ys \ emb xs ys \ lhd ys = lhd xs \ llast ys = llast xs" proof (intro exI[of _ "wit xs"] conjI, coinduction arbitrary: xs rule: chain_prepend_coinduct) case chain then show ?case by (subst (1 2) wit.code) (erule chain.cases; force split: llist.splits dest: pick) qed auto lemma emb_lset_mono[rotated]: "x \ lset xs \ emb xs ys \ x \ lset ys" by (induct x xs arbitrary: ys rule: llist.set_induct) (auto elim!: emb_LConsE) lemma emb_Ball_lset_antimono: assumes "emb Xs Ys" shows "\Y \ lset Ys. x \ Y \ \X \ lset Xs. x \ X" using emb_lset_mono[OF assms] by blast lemma emb_lfinite_antimono[rotated]: "lfinite ys \ emb xs ys \ lfinite xs" by (induct ys arbitrary: xs rule: lfinite_prepend_induct) (force elim!: emb_LNil2E simp: LNil_eq_iff_lnull prepend_LCons elim: emb.cases)+ lemma emb_Liminf_llist_mono_aux: assumes "emb Xs Ys" and "\ lfinite Xs" and "\ lfinite Ys" and "\j\i. x \ lnth Ys j" shows "\j\i. x \ lnth Xs j" using assms proof (induct i arbitrary: Xs Ys rule: less_induct) case (less i) then show ?case proof (cases i) case 0 then show ?thesis using emb_Ball_lset_antimono[OF less(2), of x] less(5) unfolding Ball_def in_lset_conv_lnth simp_thms not_lfinite_llength[OF less(3)] not_lfinite_llength[OF less(4)] enat_ord_code subset_eq by blast next case [simp]: (Suc nat) from less(2,3) obtain xs as b bs where [simp]: "Xs = LCons b xs" "Ys = prepend as (LCons b bs)" and "emb xs bs" by (auto elim: emb.cases) have IH: "\k\j. x \ lnth xs k" if "\k\j. x \ lnth bs k" "j < i" for j using that less(1)[OF _ \emb xs bs\] less(3,4) by auto from less(5) have "\k\i - length as - 1. x \ lnth xs k" by (intro IH allI) (drule spec[of _ "_ + length as + 1"], auto simp: lnth_prepend lnth_LCons') then show ?thesis by (auto simp: lnth_LCons') qed qed lemma emb_Liminf_llist_infinite: assumes "emb Xs Ys" and "\ lfinite Xs" shows "Liminf_llist Ys \ Liminf_llist Xs" proof - from assms have "\ lfinite Ys" using emb_lfinite_antimono by blast with assms show ?thesis unfolding Liminf_llist_def by (auto simp: not_lfinite_llength dest: emb_Liminf_llist_mono_aux) qed lemma emb_lmap: "emb xs ys \ emb (lmap f xs) (lmap f ys)" proof (coinduction arbitrary: xs ys rule: emb.coinduct) case emb show ?case proof (cases xs) case xs: (LCons x xs') obtain ysa0 and zs0 where ys: "ys = prepend zs0 (LCons x ysa0)" and emb': "emb xs' ysa0" using emb_LConsE[OF emb[unfolded xs]] by metis let ?xa = "f x" let ?xsa = "lmap f xs'" let ?zs = "map f zs0" let ?ysa = "lmap f ysa0" have "lmap f xs = LCons ?xa ?xsa" unfolding xs by simp moreover have "lmap f ys = prepend ?zs (LCons ?xa ?ysa)" unfolding ys by simp moreover have "\xsa ysa. ?xsa = lmap f xsa \ ?ysa = lmap f ysa \ emb xsa ysa" using emb' by blast ultimately show ?thesis by blast qed (simp add: emb_lfinite[OF emb]) qed end lemma chain_inf_llist_if_infinite_chain_function: assumes "\i. r (f (Suc i)) (f i)" shows "\ lfinite (inf_llist f) \ chain r\\ (inf_llist f)" using assms by (simp add: lnth_rel_chain) lemma infinite_chain_function_iff_infinite_chain_llist: "(\f. \i. r (f (Suc i)) (f i)) \ (\c. \ lfinite c \ chain r\\ c)" using chain_inf_llist_if_infinite_chain_function infinite_chain_lnth_rel by blast lemma wfP_iff_no_infinite_down_chain_llist: "wfP r \ (\c. \ lfinite c \ chain r\\ c)" proof - have "wfP r \ wf {(x, y). r x y}" unfolding wfP_def by auto also have "\ \ (\f. \i. (f (Suc i), f i) \ {(x, y). r x y})" using wf_iff_no_infinite_down_chain by blast also have "\ \ (\f. \i. r (f (Suc i)) (f i))" by auto also have "\ \ (\c. \lfinite c \ chain r\\ c)" using infinite_chain_function_iff_infinite_chain_llist by blast finally show ?thesis by auto qed subsection \Full Chains\ coinductive full_chain :: "('a \ 'a \ bool) \ 'a llist \ bool" for R :: "'a \ 'a \ bool" where full_chain_singleton: "(\y. \ R x y) \ full_chain R (LCons x LNil)" | full_chain_cons: "full_chain R xs \ R x (lhd xs) \ full_chain R (LCons x xs)" lemma full_chain_LNil[simp]: "\ full_chain R LNil" and full_chain_not_lnull: "full_chain R xs \ \ lnull xs" by (auto elim: full_chain.cases) lemma full_chain_ldropn: assumes full: "full_chain R xs" and "enat n < llength xs" shows "full_chain R (ldropn n xs)" using assms by (induct n arbitrary: xs, simp, metis full_chain.cases ldrop_eSuc_ltl ldropn_LNil ldropn_eq_LNil ltl_simps(2) not_less) lemma full_chain_iff_chain: "full_chain R xs \ chain R xs \ (lfinite xs \ (\y. \ R (llast xs) y))" proof (intro iffI conjI impI allI; (elim conjE)?) assume full: "full_chain R xs" show chain: "chain R xs" using full by (coinduction arbitrary: xs) (auto elim: full_chain.cases) { fix y assume "lfinite xs" then obtain n where suc_n: "Suc n = llength xs" by (metis chain chain_length_pos lessE less_enatE lfinite_conv_llength_enat) have "full_chain R (ldropn n xs)" by (rule full_chain_ldropn[OF full]) (use suc_n Suc_ile_eq in force) moreover have "ldropn n xs = LCons (llast xs) LNil" using suc_n by (metis enat_le_plus_same(2) enat_ord_simps(2) gen_llength_def ldropn_Suc_conv_ldropn ldropn_all lessI llast_ldropn llast_singleton llength_code) ultimately show "\ R (llast xs) y" by (auto elim: full_chain.cases) } next assume "chain R xs" and "lfinite xs \ (\y. \ R (llast xs) y)" then show "full_chain R xs" by (coinduction arbitrary: xs) (erule chain.cases, simp, metis lfinite_LConsI llast_LCons) qed lemma full_chain_imp_chain: "full_chain R xs \ chain R xs" using full_chain_iff_chain by blast lemma full_chain_length_pos: "full_chain R xs \ llength xs > 0" by (fact chain_length_pos[OF full_chain_imp_chain]) lemma full_chain_lnth_rel: "full_chain R xs \ enat (Suc j) < llength xs \ R (lnth xs j) (lnth xs (Suc j))" by (fact chain_lnth_rel[OF full_chain_imp_chain]) inductive_cases full_chain_consE: "full_chain R (LCons x xs)" inductive_cases full_chain_nontrivE: "full_chain R (LCons x (LCons y xs))" lemma full_chain_tranclp_imp_exists_full_chain: assumes full: "full_chain R\<^sup>+\<^sup>+ xs" shows "\ys. full_chain R ys \ emb xs ys \ lhd ys = lhd xs \ llast ys = llast xs" proof - obtain ys where ys: "chain R ys" "emb xs ys" "lhd ys = lhd xs" "llast ys = llast xs" using full_chain_imp_chain[OF full] chain_tranclp_imp_exists_chain by blast have "full_chain R ys" using ys(1,4) emb_lfinite[OF ys(2)] full unfolding full_chain_iff_chain by auto then show ?thesis using ys(2-4) by auto qed end diff --git a/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy b/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy --- a/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy +++ b/thys/Ordered_Resolution_Prover/Standard_Redundancy.thy @@ -1,339 +1,339 @@ (* Title: The Standard Redundancy Criterion Author: Jasmin Blanchette , 2014, 2017 Author: Dmitriy Traytel , 2014 Author: Anders Schlichtkrull , 2017 Maintainer: Anders Schlichtkrull *) section \The Standard Redundancy Criterion\ theory Standard_Redundancy imports Proving_Process begin text \ This material is based on Section 4.2.2 (``The Standard Redundancy Criterion'') of Bachmair and Ganzinger's chapter. \ locale standard_redundancy_criterion = inference_system \ for \ :: "('a :: wellorder) inference set" begin definition redundant_infer :: "'a clause set \ 'a inference \ bool" where "redundant_infer N \ \ \DD. set_mset DD \ N \ (\I. I \m DD + side_prems_of \ \ I \ concl_of \) \ (\D. D \# DD \ D < main_prem_of \)" definition Rf :: "'a clause set \ 'a clause set" where "Rf N = {C. \DD. set_mset DD \ N \ (\I. I \m DD \ I \ C) \ (\D. D \# DD \ D < C)}" definition Ri :: "'a clause set \ 'a inference set" where "Ri N = {\ \ \. redundant_infer N \}" lemma tautology_Rf: assumes "Pos A \# C" assumes "Neg A \# C" shows "C \ Rf N" proof - have "set_mset {#} \ N \ (\I. I \m {#} \ I \ C) \ (\D. D \# {#} \ D < C)" using assms by auto then show "C \ Rf N" unfolding Rf_def by blast qed lemma tautology_redundant_infer: assumes pos: "Pos A \# concl_of \" and neg: "Neg A \# concl_of \" shows "redundant_infer N \" by (metis empty_iff empty_subsetI neg pos pos_neg_in_imp_true redundant_infer_def set_mset_empty) lemma contradiction_Rf: "{#} \ N \ Rf N = UNIV - {{#}}" unfolding Rf_def by force text \ The following results correspond to Lemma 4.5. The lemma \wlog_non_Rf\ generalizes the core of the argument. \ lemma Rf_mono: "N \ N' \ Rf N \ Rf N'" unfolding Rf_def by auto lemma wlog_non_Rf: assumes ex: "\DD. set_mset DD \ N \ (\I. I \m DD + CC \ I \ E) \ (\D'. D' \# DD \ D' < D)" shows "\DD. set_mset DD \ N - Rf N \ (\I. I \m DD + CC \ I \ E) \ (\D'. D' \# DD \ D' < D)" proof - from ex obtain DD0 where dd0: "DD0 \ {DD. set_mset DD \ N \ (\I. I \m DD + CC \ I \ E) \ (\D'. D' \# DD \ D' < D)}" by blast have "\DD. set_mset DD \ N \ (\I. I \m DD + CC \ I \ E) \ (\D'. D' \# DD \ D' < D) \ (\DD'. set_mset DD' \ N \ (\I. I \m DD' + CC \ I \ E) \ (\D'. D' \# DD' \ D' < D) \ DD \ DD')" using wf_eq_minimal[THEN iffD1, rule_format, OF wf_less_multiset dd0] unfolding not_le[symmetric] by blast then obtain DD where dd_subs_n: "set_mset DD \ N" and ddcc_imp_e: "\I. I \m DD + CC \ I \ E" and dd_lt_d: "\D'. D' \# DD \ D' < D" and d_min: "\DD'. set_mset DD' \ N \ (\I. I \m DD' + CC \ I \ E) \ (\D'. D' \# DD' \ D' < D) \ DD \ DD'" by blast have "\Da. Da \# DD \ Da \ Rf N" proof clarify fix Da assume da_in_dd: "Da \# DD" and da_rf: "Da \ Rf N" from da_rf obtain DD' where dd'_subs_n: "set_mset DD' \ N" and dd'_imp_da: "\I. I \m DD' \ I \ Da" and dd'_lt_da: "\D'. D' \# DD' \ D' < Da" unfolding Rf_def by blast define DDa where "DDa = DD - {#Da#} + DD'" have "set_mset DDa \ N" unfolding DDa_def using dd_subs_n dd'_subs_n by (meson contra_subsetD in_diffD subsetI union_iff) moreover have "\I. I \m DDa + CC \ I \ E" using dd'_imp_da ddcc_imp_e da_in_dd unfolding DDa_def true_cls_mset_def by (metis in_remove1_mset_neq union_iff) moreover have "\D'. D' \# DDa \ D' < D" using dd_lt_d dd'_lt_da da_in_dd unfolding DDa_def by (metis insert_DiffM2 order.strict_trans union_iff) moreover have "DDa < DD" unfolding DDa_def by (meson da_in_dd dd'_lt_da mset_lt_single_right_iff single_subset_iff union_le_diff_plus) ultimately show False using d_min unfolding less_eq_multiset_def by (auto intro!: antisym) qed then show ?thesis using dd_subs_n ddcc_imp_e dd_lt_d by auto qed lemma Rf_imp_ex_non_Rf: assumes "C \ Rf N" shows "\CC. set_mset CC \ N - Rf N \ (\I. I \m CC \ I \ C) \ (\C'. C' \# CC \ C' < C)" using assms by (auto simp: Rf_def intro: wlog_non_Rf[of _ "{#}", simplified]) lemma Rf_subs_Rf_diff_Rf: "Rf N \ Rf (N - Rf N)" proof fix C assume c_rf: "C \ Rf N" then obtain CC where cc_subs: "set_mset CC \ N - Rf N" and cc_imp_c: "\I. I \m CC \ I \ C" and cc_lt_c: "\C'. C' \# CC \ C' < C" using Rf_imp_ex_non_Rf by blast have "\D. D \# CC \ D \ Rf N" using cc_subs by (simp add: subset_iff) then have cc_nr: "\C DD. C \# CC \ set_mset DD \ N \ \I. I \m DD \ I \ C \ \D. D \# DD \ ~ D < C" unfolding Rf_def by auto metis have "set_mset CC \ N" using cc_subs by auto - then have "set_mset CC \ + then have "set_mset CC \ N - {C. \DD. set_mset DD \ N \ (\I. I \m DD \ I \ C) \ (\D. D \# DD \ D < C)}" using cc_nr by auto then show "C \ Rf (N - Rf N)" using cc_imp_c cc_lt_c unfolding Rf_def by auto qed lemma Rf_eq_Rf_diff_Rf: "Rf N = Rf (N - Rf N)" by (metis Diff_subset Rf_mono Rf_subs_Rf_diff_Rf subset_antisym) text \ The following results correspond to Lemma 4.6. \ lemma Ri_mono: "N \ N' \ Ri N \ Ri N'" unfolding Ri_def redundant_infer_def by auto lemma Ri_subs_Ri_diff_Rf: "Ri N \ Ri (N - Rf N)" proof fix \ assume \_ri: "\ \ Ri N" then obtain CC D E where \: "\ = Infer CC D E" by (cases \) have cc: "CC = side_prems_of \" and d: "D = main_prem_of \" and e: "E = concl_of \" unfolding \ by simp_all obtain DD where "set_mset DD \ N" and "\I. I \m DD + CC \ I \ E" and "\C. C \# DD \ C < D" using \_ri unfolding Ri_def redundant_infer_def cc d e by blast then obtain DD' where "set_mset DD' \ N - Rf N" and "\I. I \m DD' + CC \ I \ E" and "\D'. D' \# DD' \ D' < D" using wlog_non_Rf by atomize_elim blast then show "\ \ Ri (N - Rf N)" using \_ri unfolding Ri_def redundant_infer_def d cc e by blast qed lemma Ri_eq_Ri_diff_Rf: "Ri N = Ri (N - Rf N)" by (metis Diff_subset Ri_mono Ri_subs_Ri_diff_Rf subset_antisym) lemma Ri_subset_\: "Ri N \ \" unfolding Ri_def by blast lemma Rf_indep: "N' \ Rf N \ Rf N \ Rf (N - N')" by (metis Diff_cancel Diff_eq_empty_iff Diff_mono Rf_eq_Rf_diff_Rf Rf_mono) lemma Ri_indep: "N' \ Rf N \ Ri N \ Ri (N - N')" by (metis Diff_mono Ri_eq_Ri_diff_Rf Ri_mono order_refl) lemma Rf_model: assumes "I \s N - Rf N" shows "I \s N" proof - have "I \s Rf (N - Rf N)" unfolding true_clss_def by (subst Rf_def, simp add: true_cls_mset_def, metis assms subset_eq true_clss_def) then have "I \s Rf N" using Rf_subs_Rf_diff_Rf true_clss_mono by blast then show ?thesis using assms by (metis Un_Diff_cancel true_clss_union) qed lemma Rf_sat: "satisfiable (N - Rf N) \ satisfiable N" by (metis Rf_model) text \ The following corresponds to Theorem 4.7: \ sublocale redundancy_criterion \ Rf Ri by unfold_locales (rule Ri_subset_\, (elim Rf_mono Ri_mono Rf_indep Ri_indep Rf_sat)+) end locale standard_redundancy_criterion_reductive = standard_redundancy_criterion + reductive_inference_system begin text \ The following corresponds to Theorem 4.8: \ lemma Ri_effective: assumes in_\: "\ \ \" and concl_of_in_n_un_rf_n: "concl_of \ \ N \ Rf N" shows "\ \ Ri N" proof - obtain CC D E where \: "\ = Infer CC D E" by (cases \) then have cc: "CC = side_prems_of \" and d: "D = main_prem_of \" and e: "E = concl_of \" unfolding \ by simp_all note e_in_n_un_rf_n = concl_of_in_n_un_rf_n[folded e] { assume "E \ N" moreover have "E < D" using \_reductive e d in_\ by auto ultimately have "set_mset {#E#} \ N" and "\I. I \m {#E#} + CC \ I \ E" and "\D'. D' \# {#E#} \ D' < D" by simp_all then have "redundant_infer N \" using redundant_infer_def cc d e by blast } moreover { assume "E \ Rf N" then obtain DD where dd_sset: "set_mset DD \ N" and dd_imp_e: "\I. I \m DD \ I \ E" and dd_lt_e: "\C'. C' \# DD \ C' < E" unfolding Rf_def by blast from dd_lt_e have "\Da. Da \# DD \ Da < D" using d e in_\ \_reductive less_trans by blast then have "redundant_infer N \" using redundant_infer_def dd_sset dd_imp_e cc d e by blast } ultimately show "\ \ Ri N" using in_\ e_in_n_un_rf_n unfolding Ri_def by blast qed sublocale effective_redundancy_criterion \ Rf Ri unfolding effective_redundancy_criterion_def by (intro conjI redundancy_criterion_axioms, unfold_locales, rule Ri_effective) lemma contradiction_Rf: "{#} \ N \ Ri N = \" unfolding Ri_def redundant_infer_def using \_reductive le_multiset_empty_right by (force intro: exI[of _ "{#{#}#}"] le_multiset_empty_left) end locale standard_redundancy_criterion_counterex_reducing = standard_redundancy_criterion + counterex_reducing_inference_system begin text \ The following result corresponds to Theorem 4.9. \ lemma saturated_upto_complete_if: assumes satur: "saturated_upto N" and unsat: "\ satisfiable N" shows "{#} \ N" proof (rule ccontr) assume ec_ni_n: "{#} \ N" define M where "M = N - Rf N" have ec_ni_m: "{#} \ M" unfolding M_def using ec_ni_n by fast have "I_of M \s M" proof (rule ccontr) assume "\ I_of M \s M" then obtain D where d_in_m: "D \ M" and d_cex: "\ I_of M \ D" and d_min: "\C. C \ M \ C < D \ I_of M \ C" using ex_min_counterex by meson then obtain \ CC E where \: "\ = Infer CC D E" and cc_subs_m: "set_mset CC \ M" and cc_true: "I_of M \m CC" and \_in: "\ \ \" and e_cex: "\ I_of M \ E" and e_lt_d: "E < D" using \_counterex_reducing[OF ec_ni_m] not_less by metis have cc: "CC = side_prems_of \" and d: "D = main_prem_of \" and e: "E = concl_of \" unfolding \ by simp_all have "\ \ Ri N" by (rule subsetD[OF satur[unfolded saturated_upto_def inferences_from_def infer_from_def]]) (simp add: \_in d_in_m cc_subs_m cc[symmetric] d[symmetric] M_def[symmetric]) then have "\ \ Ri M" unfolding M_def using Ri_indep by fast then obtain DD where dd_subs_m: "set_mset DD \ M" and dd_cc_imp_d: "\I. I \m DD + CC \ I \ E" and dd_lt_d: "\C. C \# DD \ C < D" unfolding Ri_def redundant_infer_def cc d e by blast from dd_subs_m dd_lt_d have "I_of M \m DD" using d_min unfolding true_cls_mset_def by (metis contra_subsetD) then have "I_of M \ E" using dd_cc_imp_d cc_true by auto then show False using e_cex by auto qed then have "I_of M \s N" using M_def Rf_model by blast then show False using unsat by blast qed theorem saturated_upto_complete: assumes "saturated_upto N" shows "\ satisfiable N \ {#} \ N" using assms saturated_upto_complete_if true_clss_def by auto end end