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,1545 @@ (* 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) = {}" (* 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" "(\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 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 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 "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 "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 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 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) 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#}}) \ 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 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}) \ 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})" "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_redundant by auto + 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 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) \ (\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 \} \ ((\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 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 \}) \ (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 \} \ ((\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 \} \ ((\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 \) \ 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) \ 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}))" "(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)" "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 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" "?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'}" "?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}" "?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') \ 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_redundant by auto + 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 " "?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#}}" "?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}" "?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 \ (\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) \ 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 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} \ 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/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,333 +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 -(* FIXME: Make a definition *) -abbreviation redundant_infer :: "'a clause set \ 'a inference \ bool" where +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_redundant: +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 \ 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 by auto + 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 cc d e by blast + 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 d cc e by blast + 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 cc d e by blast + 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 dd_sset dd_imp_e cc d e by blast + 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 using \_reductive le_multiset_empty_right + 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 cc d e by blast + 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