Theory Probability_Inequality_Completeness
chapter ‹ Introduction ›
theory Probability_Inequality_Completeness
imports
"Suppes_Theorem.Probability_Logic"
begin
no_notation FuncSet.funcset (infixr "→" 60)
text ‹ We introduce a novel logical calculus and prove completeness for
probability inequalities. This is a vast generalization of ∗‹Suppes' Theorem›
which lays the foundation for this theory.›
text ‹ We provide two new logical judgements: ∗‹measure deduction› ‹($⊢)› and
∗‹counting deduction› ‹(#⊢)›. Both judgements capture a notion of ∗‹measure›
or quantity. In both cases premises must be partially or completely ∗‹consumed›
in sense to prove multiple conclusions. That is to say, a portion of the
premises must be used to prove each conclusion which cannot be reused. Counting
deduction counts the number of times a particular conclusion can be proved
(as the name implies), while measure deduction includes multiple, different
conclusions which must be proven via the premises. ›
text ‹ We also introduce an abstract notion of MaxSAT, which is the
maximal number of clauses in a list of clauses that can be simultaneously
satisfied. ›
text ‹ We show the following are equivalent:
▪ ‹❙∼ Γ $⊢ ❙∼ Φ›
▪ ‹(❙∼ Γ @ Φ) #⊢ (length Φ) ⊥›
▪ ‹MaxSAT (❙∼ Γ @ Φ) ≤ length Γ›
▪ ‹∀ δ ∈ dirac_measures. (∑φ←Φ. δ φ) ≤ (∑γ←Γ. δ γ)›
▪ ‹∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)›
›
text ‹ In the special case of MaxSAT, we show the following are
equivalent:
▪ ‹MaxSAT (❙∼ Γ @ Φ) + c ≤ length Γ›
▪ ‹∀ δ ∈ dirac_measures. (∑φ←Φ. δ φ) + c ≤ (∑γ←Γ. δ γ)›
▪ ‹∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)›
›
chapter ‹ Measure Deduction and Counting Deduction ›
section ‹ Definition of Measure Deduction ›
text ‹ To start, we introduce a common combinator for modifying functions
that take two arguments. ›
definition uncurry :: "('a ⇒ 'b ⇒ 'c) ⇒ 'a × 'b ⇒ 'c"
where uncurry_def [simp]: "uncurry f = (λ (x, y). f x y)"
text ‹ Our new logical calculus is a recursively defined relation ‹($⊢)›
using ∗‹list deduction› \<^term>‹(:⊢)›. ›
text ‹ We call our new logical relation ∗‹measure deduction›: ›
primrec (in classical_logic)
measure_deduction :: "'a list ⇒ 'a list ⇒ bool" (infix "$⊢" 60)
where
"Γ $⊢ [] = True"
| "Γ $⊢ (φ # Φ) =
(∃ Ψ. mset (map snd Ψ) ⊆# mset Γ
∧ map (uncurry (⊔)) Ψ :⊢ φ
∧ map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ) $⊢ Φ)"
text ‹ Let us briefly analyze what the above definition is saying. ›
text ‹ From the above we must find a special list-of-pairs ‹Ψ›,
which we refer to as a ∗‹witness›, in order to establish
\<^term>‹Γ $⊢ (φ # Φ)›. ›
text ‹ We may motivate measure deduction as follows. In the simplest case
we know ‹𝒫 φ ≤ 𝒫 ψ + Σ› if and only if
‹𝒫 ( χ ⊔ φ ) + 𝒫 ( ∼ χ ⊔ φ ) ≤ 𝒫 ψ + Σ›, or equivalently
‹𝒫 ( χ ⊔ φ ) + 𝒫 ( χ → φ ) ≤ 𝒫 ψ + Σ›. So it suffices to prove
‹𝒫 ( χ ⊔ φ ) ≤ 𝒫 ψ› and ‹𝒫 ( χ → φ ) ≤ Σ ›. Here ‹[(χ,φ)]›
is like the ∗‹witness› in our recursive definition, which reflects the
‹∃ Ψ. …› formula is our definition. The fact that measure deduction
reflects proving theorems in the theory of inequalities of probability
logic is the elementary intuition behind the soundness theorem we will
ultimately prove in \S\ref{subsubsec:measure-deduction-soundness}. ›
text ‹ A key difference from the simple motivation above is that, as in the
case of Suppes' Theorem where we prove ‹ ❙∼ Γ :⊢ ∼ φ › if and only if
‹𝒫 φ ≤ (∑ γ ← Γ . 𝒫 γ)› for all ‹𝒫›, soundness in this context means
‹ ❙∼ Γ $⊢ ❙∼ Φ › implies ‹∀ 𝒫. (∑γ←Γ. 𝒫 γ) ≥ (∑φ←Φ. 𝒫 φ) ›. ›
text ‹ Another way of thinking about measure deduction is to think of ‹Γ›
and ‹Σ› as bags of balls of soft clay and \<^term>‹Γ $⊢ Σ› meaning that
we have shown ‹Γ› is ∗‹heavier than› ‹Σ› (ignoring, for the moment,
that \<^term>‹($⊢)› is not totally ordered). We have a scale \<^term>‹(:⊢)›
that lets us weigh several things on the left and one thing on the
right at a time. We go through each clay ball ‹σ› in ‹Σ› one at a
time without replacement, putting ‹σ› on the right of the scale. Then,
we take a bunch of clay balls from ‹Γ›, cut them up as necessary (that
is the ‹ψ ⊔ γ› trick using the witness ‹Ψ›), and show they are heavier
using our scale. We take the parts ‹ψ → γ› that we didn't use and put
them back in our bag ‹Γ›. We will be able to reuse them later. If we
can do this trick for every element ‹σ› in ‹Σ› successively using
combinations of split leftovers in ‹Γ›, then we can show ‹Γ› is
heavier than ‹Σ› (i.e., \<^term>‹Γ $⊢ Σ›). ›
section ‹ Definition of the Stronger Theory Relation ›
text ‹ We next turn to looking at a subrelation of \<^term>‹($⊢)›, which
we call the ∗‹stronger theory› relation ‹(≼)›. Here we construe a
∗‹theory› as a list of propositions. We say theory ‹Γ› is
∗‹stronger than› ‹Σ› where, for each element ‹σ› in ‹Σ›, we can take
an element ‹γ› of ‹Γ› ∗‹without replacement› such that ‹⊢ γ → σ›. ›
text ‹ To motivate this notion, let's reuse the metaphor that ‹Γ› and ‹Σ›
are bags of balls of clay, and we need to show ‹Γ› is heavier without
simply weighing the two bags. A sufficient (but incomplete) approach
is to take each ball of clay ‹σ› in ‹Σ› and find another ball of clay
‹γ› in ‹Γ› (without replacement) that is heavier. This simple approach
avoids the complexity of iteratively cutting up balls of clay. ›
definition (in implication_logic)
stronger_theory_relation :: "'a list ⇒ 'a list ⇒ bool" (infix "≼" 100)
where
"Σ ≼ Γ =
(∃ Φ. map snd Φ = Σ
∧ mset (map fst Φ) ⊆# mset Γ
∧ (∀ (γ,σ) ∈ set Φ. ⊢ γ → σ))"
abbreviation (in implication_logic)
stronger_theory_relation_op :: "'a list ⇒ 'a list ⇒ bool" (infix "≽" 100)
where
"Γ ≽ Σ ≡ Σ ≼ Γ"
section ‹ The Stronger Theory Relation is a Preorder ›
text ‹ Next, we show that \<^term>‹(≼)› is a preorder by establishing reflexivity
and transitivity. ›
text ‹ We first prove the following lemma with respect to multisets and
stronger theories. ›
lemma (in implication_logic) msub_stronger_theory_intro:
assumes "mset Σ ⊆# mset Γ"
shows "Σ ≼ Γ"
proof -
let ?ΔΣ = "map (λ x. (x,x)) Σ"
have "map snd ?ΔΣ = Σ"
by (induct Σ, simp, simp)
moreover have "map fst ?ΔΣ = Σ"
by (induct Σ, simp, simp)
hence "mset (map fst ?ΔΣ) ⊆# mset Γ"
using assms by simp
moreover have "∀ (γ,σ) ∈ set ?ΔΣ. ⊢ γ → σ"
by (induct Σ, simp, simp,
metis list_implication.simps(1) list_implication_axiom_k)
ultimately show ?thesis using stronger_theory_relation_def by (simp, blast)
qed
text ‹ The ∗‹reflexive› property immediately follows: ›
lemma (in implication_logic) stronger_theory_reflexive [simp]: "Γ ≼ Γ"
using msub_stronger_theory_intro by auto
lemma (in implication_logic) weakest_theory [simp]: "[] ≼ Γ"
using msub_stronger_theory_intro by auto
lemma (in implication_logic) stronger_theory_empty_list_intro [simp]:
assumes "Γ ≼ []"
shows "Γ = []"
using assms stronger_theory_relation_def by simp
text ‹ Next, we turn to proving transitivity. We first prove two permutation
theorems. ›
lemma (in implication_logic) stronger_theory_right_permutation:
assumes "Γ ⇌ Δ"
and "Σ ≼ Γ"
shows "Σ ≼ Δ"
proof -
from assms(1) have "mset Γ = mset Δ"
by simp
thus ?thesis
using assms(2) stronger_theory_relation_def
by fastforce
qed
lemma (in implication_logic) stronger_theory_left_permutation:
assumes "Σ ⇌ Δ"
and "Σ ≼ Γ"
shows "Δ ≼ Γ"
proof -
have "∀ Σ Γ. Σ ⇌ Δ ⟶ Σ ≼ Γ ⟶ Δ ≼ Γ"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ Γ
assume "Σ ⇌ (δ # Δ)" "Σ ≼ Γ"
from this obtain Φ where Φ:
"map snd Φ = Σ"
"mset (map fst Φ) ⊆# mset Γ"
"∀ (γ,δ) ∈ set Φ. ⊢ γ → δ"
using stronger_theory_relation_def by fastforce
with ‹Σ ⇌ (δ # Δ)› have "δ ∈# mset (map snd Φ)"
by fastforce
from this obtain γ where γ: "(γ, δ) ∈# mset Φ"
by (induct Φ, fastforce+)
let ?Φ⇩0 = "remove1 (γ, δ) Φ"
let ?Σ⇩0 = "map snd ?Φ⇩0"
from γ Φ(2) have "mset (map fst ?Φ⇩0) ⊆# mset (remove1 γ Γ)"
by (metis ex_mset
list_subtract_monotonic
list_subtract_mset_homomorphism
mset_remove1
remove1_pairs_list_projections_fst)
moreover have "mset ?Φ⇩0 ⊆# mset Φ" by simp
with Φ(3) have "∀ (γ,δ) ∈ set ?Φ⇩0. ⊢ γ → δ" by fastforce
ultimately have "?Σ⇩0 ≼ remove1 γ Γ"
unfolding stronger_theory_relation_def by blast
moreover have "Δ ⇌ (remove1 δ Σ)" using ‹Σ ⇌ (δ # Δ)›
by (metis perm_remove_perm perm_sym remove_hd)
moreover from γ Φ(1) have "mset ?Σ⇩0 = mset (remove1 δ Σ)"
using remove1_pairs_list_projections_snd
by fastforce
hence "?Σ⇩0 ⇌ remove1 δ Σ"
by blast
ultimately have "Δ ≼ remove1 γ Γ" using Cons
by presburger
from this obtain Ψ⇩0 where Ψ⇩0:
"map snd Ψ⇩0 = Δ"
"mset (map fst Ψ⇩0) ⊆# mset (remove1 γ Γ)"
"∀ (γ,δ) ∈ set Ψ⇩0. ⊢ γ → δ"
using stronger_theory_relation_def by fastforce
let ?Ψ = "(γ, δ) # Ψ⇩0"
have "map snd ?Ψ = (δ # Δ)"
by (simp add: Ψ⇩0(1))
moreover have "mset (map fst ?Ψ) ⊆# mset (γ # (remove1 γ Γ))"
using Ψ⇩0(2) by auto
moreover from γ Φ(3) Ψ⇩0(3) have "∀ (γ,σ) ∈ set ?Ψ. ⊢ γ → σ" by auto
ultimately have "(δ # Δ) ≼ (γ # (remove1 γ Γ))"
unfolding stronger_theory_relation_def by metis
moreover from γ Φ(2) have "γ ∈# mset Γ"
using mset_subset_eqD by fastforce
hence "(γ # (remove1 γ Γ)) ⇌ Γ"
by auto
ultimately have "(δ # Δ) ≼ Γ"
using stronger_theory_right_permutation by blast
}
then show ?case by blast
qed
with assms show ?thesis by blast
qed
lemma (in implication_logic) stronger_theory_transitive:
assumes "Σ ≼ Δ" and "Δ ≼ Γ"
shows "Σ ≼ Γ"
proof -
have "∀ Δ Γ. Σ ≼ Δ ⟶ Δ ≼ Γ ⟶ Σ ≼ Γ"
proof (induct Σ)
case Nil
then show ?case using stronger_theory_relation_def by simp
next
case (Cons σ Σ)
{
fix Δ Γ
assume "(σ # Σ) ≼ Δ" "Δ ≼ Γ"
from this obtain Φ where Φ:
"map snd Φ = σ # Σ"
"mset (map fst Φ) ⊆# mset Δ"
"∀ (δ,σ) ∈ set Φ. ⊢ δ → σ"
using stronger_theory_relation_def by (simp, metis)
let ?δ = "fst (hd Φ)"
from Φ(1) have "Φ ≠ []" by (induct Φ, simp+)
hence "?δ ∈# mset (map fst Φ)" by (induct Φ, simp+)
with Φ(2) have "?δ ∈# mset Δ" by (meson mset_subset_eqD)
hence "mset (map fst (remove1 (hd Φ) Φ)) ⊆# mset (remove1 ?δ Δ)"
using ‹Φ ≠ []› Φ(2)
by (simp,
metis
diff_single_eq_union
hd_in_set
image_mset_add_mset
insert_subset_eq_iff
set_mset_mset)
moreover have "remove1 (hd Φ) Φ = tl Φ"
using ‹Φ ≠ []›
by (induct Φ, simp+)
moreover from Φ(1) have "map snd (tl Φ) = Σ"
by (simp add: map_tl)
moreover from Φ(3) have "∀ (δ,σ) ∈ set (tl Φ). ⊢ δ → σ"
by (simp add: ‹Φ ≠ []› list.set_sel(2))
ultimately have "Σ ≼ remove1 ?δ Δ"
using stronger_theory_relation_def by auto
from ‹?δ ∈# mset Δ› have "?δ # (remove1 ?δ Δ) ⇌ Δ"
by fastforce
with ‹Δ ≼ Γ› have "(?δ # (remove1 ?δ Δ)) ≼ Γ"
using stronger_theory_left_permutation perm_sym by blast
from this obtain Ψ where Ψ:
"map snd Ψ = (?δ # (remove1 ?δ Δ))"
"mset (map fst Ψ) ⊆# mset Γ"
"∀ (γ,δ) ∈ set Ψ. ⊢ γ → δ"
using stronger_theory_relation_def by (simp, metis)
let ?γ = "fst (hd Ψ)"
from Ψ(1) have "Ψ ≠ []" by (induct Ψ, simp+)
hence "?γ ∈# mset (map fst Ψ)" by (induct Ψ, simp+)
with Ψ(2) have "?γ ∈# mset Γ" by (meson mset_subset_eqD)
hence "mset (map fst (remove1 (hd Ψ) Ψ)) ⊆# mset (remove1 ?γ Γ)"
using ‹Ψ ≠ []› Ψ(2)
by (simp,
metis
diff_single_eq_union
hd_in_set
image_mset_add_mset
insert_subset_eq_iff
set_mset_mset)
moreover from ‹Ψ ≠ []› have "remove1 (hd Ψ) Ψ = tl Ψ"
by (induct Ψ, simp+)
moreover from Ψ(1) have "map snd (tl Ψ) = (remove1 ?δ Δ)"
by (simp add: map_tl)
moreover from Ψ(3) have "∀ (γ,δ) ∈ set (tl Ψ). ⊢ γ → δ"
by (simp add: ‹Ψ ≠ []› list.set_sel(2))
ultimately have "remove1 ?δ Δ ≼ remove1 ?γ Γ"
using stronger_theory_relation_def by auto
with ‹Σ ≼ remove1 ?δ Δ› Cons.hyps have "Σ ≼ remove1 ?γ Γ"
by blast
from this obtain Ω⇩0 where Ω⇩0:
"map snd Ω⇩0 = Σ"
"mset (map fst Ω⇩0) ⊆# mset (remove1 ?γ Γ)"
"∀ (γ,σ) ∈ set Ω⇩0. ⊢ γ → σ"
using stronger_theory_relation_def by (simp, metis)
let ?Ω = "(?γ, σ) # Ω⇩0"
from Ω⇩0(1) have "map snd ?Ω = σ # Σ" by simp
moreover from Ω⇩0(2) have "mset (map fst ?Ω) ⊆# mset (?γ # (remove1 ?γ Γ))"
by simp
moreover from Φ(1) Ψ(1) have "σ = snd (hd Φ)" "?δ = snd (hd Ψ)" by fastforce+
with Φ(3) Ψ(3) ‹Φ ≠ []› ‹Ψ ≠ []› hd_in_set have "⊢ ?δ → σ" "⊢ ?γ → ?δ"
by fastforce+
hence "⊢ ?γ → σ" using modus_ponens hypothetical_syllogism by blast
with Ω⇩0(3) have "∀ (γ,σ) ∈ set ?Ω. ⊢ γ → σ"
by auto
ultimately have "(σ # Σ) ≼ (?γ # (remove1 ?γ Γ))"
unfolding stronger_theory_relation_def
by metis
moreover from ‹?γ ∈# mset Γ› have "(?γ # (remove1 ?γ Γ)) ⇌ Γ"
by force
ultimately have "(σ # Σ) ≼ Γ"
using stronger_theory_right_permutation
by blast
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
section ‹ The Stronger Theory Relation is a Subrelation of of Measure Deduction ›
text ‹ Next, we show that ‹ Γ ≽ Σ › implies ‹Γ $⊢ Σ›. Before doing so we
establish several helpful properties regarding the stronger theory
relation \<^term>‹(≽)›. ›
lemma (in implication_logic) stronger_theory_witness:
assumes "σ ∈ set Σ"
shows "Σ ≼ Γ = (∃ γ ∈ set Γ. ⊢ γ → σ ∧ (remove1 σ Σ) ≼ (remove1 γ Γ))"
proof (rule iffI)
assume "Σ ≼ Γ"
from this obtain Φ where Φ:
"map snd Φ = Σ"
"mset (map fst Φ) ⊆# mset Γ"
"∀ (γ,σ) ∈ set Φ. ⊢ γ → σ"
unfolding stronger_theory_relation_def by blast
from assms Φ(1) obtain γ where γ: "(γ, σ) ∈# mset Φ"
by (induct Φ, fastforce+)
hence "γ ∈# mset (map fst Φ)" by force
hence "γ ∈# mset Γ" using Φ(2)
by (meson mset_subset_eqD)
moreover
let ?Φ⇩0 = "remove1 (γ, σ) Φ"
let ?Σ⇩0 = "map snd ?Φ⇩0"
from γ Φ(2) have "mset (map fst ?Φ⇩0) ⊆# mset (remove1 γ Γ)"
by (metis
ex_mset
list_subtract_monotonic
list_subtract_mset_homomorphism
remove1_pairs_list_projections_fst
mset_remove1)
moreover have "mset ?Φ⇩0 ⊆# mset Φ" by simp
with Φ(3) have "∀ (γ,σ) ∈ set ?Φ⇩0. ⊢ γ → σ" by fastforce
ultimately have "?Σ⇩0 ≼ remove1 γ Γ"
unfolding stronger_theory_relation_def by blast
moreover from γ Φ(1) have "mset ?Σ⇩0 = mset (remove1 σ Σ)"
using remove1_pairs_list_projections_snd
by fastforce
hence "?Σ⇩0 ⇌ remove1 σ Σ"
by linarith
ultimately have "remove1 σ Σ ≼ remove1 γ Γ"
using stronger_theory_left_permutation
by blast
moreover from γ Φ(3) have "⊢ γ → σ" by (simp, fast)
moreover from γ Φ(2) have "γ ∈# mset Γ"
using mset_subset_eqD by fastforce
ultimately show "∃ γ ∈ set Γ. ⊢ γ → σ ∧ (remove1 σ Σ) ≼ (remove1 γ Γ)" by auto
next
assume "∃ γ ∈ set Γ. ⊢ γ → σ ∧ (remove1 σ Σ) ≼ (remove1 γ Γ)"
from this obtain Φ γ where γ: "γ ∈ set Γ" "⊢ γ → σ"
and Φ: "map snd Φ = (remove1 σ Σ)"
"mset (map fst Φ) ⊆# mset (remove1 γ Γ)"
"∀ (γ,σ) ∈ set Φ. ⊢ γ → σ"
unfolding stronger_theory_relation_def by blast
let ?Φ = "(γ, σ) # Φ"
from Φ(1) have "map snd ?Φ = σ # (remove1 σ Σ)" by simp
moreover from Φ(2) γ(1) have "mset (map fst ?Φ) ⊆# mset Γ"
by (simp add: insert_subset_eq_iff)
moreover from Φ(3) γ(2) have "∀ (γ,σ) ∈ set ?Φ. ⊢ γ → σ"
by auto
ultimately have "(σ # (remove1 σ Σ)) ≼ Γ"
unfolding stronger_theory_relation_def by metis
moreover from assms have "σ # (remove1 σ Σ) ⇌ Σ"
by force
ultimately show "Σ ≼ Γ"
using stronger_theory_left_permutation by blast
qed
lemma (in implication_logic) stronger_theory_cons_witness:
"(σ # Σ) ≼ Γ = (∃ γ ∈ set Γ. ⊢ γ → σ ∧ Σ ≼ (remove1 γ Γ))"
proof -
have "σ ∈# mset (σ # Σ)" by simp
hence "(σ # Σ) ≼ Γ = (∃ γ ∈ set Γ. ⊢ γ → σ ∧ (remove1 σ (σ # Σ)) ≼ (remove1 γ Γ))"
by (meson list.set_intros(1) stronger_theory_witness)
thus ?thesis by simp
qed
lemma (in implication_logic) stronger_theory_left_cons:
assumes "(σ # Σ) ≼ Γ"
shows "Σ ≼ Γ"
proof -
from assms obtain Φ where Φ:
"map snd Φ = σ # Σ"
"mset (map fst Φ) ⊆# mset Γ"
"∀ (δ,σ) ∈ set Φ. ⊢ δ → σ"
using stronger_theory_relation_def by (simp, metis)
let ?Φ' = "remove1 (hd Φ) Φ"
from Φ(1) have "map snd ?Φ' = Σ" by (induct Φ, simp+)
moreover from Φ(2) have "mset (map fst ?Φ') ⊆# mset Γ"
by (metis diff_subset_eq_self
list_subtract.simps(1)
list_subtract.simps(2)
list_subtract_mset_homomorphism
map_monotonic
subset_mset.dual_order.trans)
moreover from Φ(3) have "∀ (δ,σ) ∈ set ?Φ'. ⊢ δ → σ" by fastforce
ultimately show ?thesis unfolding stronger_theory_relation_def by blast
qed
lemma (in implication_logic) stronger_theory_right_cons:
assumes "Σ ≼ Γ"
shows "Σ ≼ (γ # Γ)"
proof -
from assms obtain Φ where Φ:
"map snd Φ = Σ"
"mset (map fst Φ) ⊆# mset Γ"
"∀(γ, σ)∈set Φ. ⊢ γ → σ"
unfolding stronger_theory_relation_def
by auto
hence "mset (map fst Φ) ⊆# mset (γ # Γ)"
by (metis Diff_eq_empty_iff_mset
list_subtract.simps(2)
list_subtract_mset_homomorphism
mset_zero_iff remove1.simps(1))
with Φ(1) Φ(3) show ?thesis
unfolding stronger_theory_relation_def
by auto
qed
lemma (in implication_logic) stronger_theory_left_right_cons:
assumes "⊢ γ → σ"
and "Σ ≼ Γ"
shows "(σ # Σ) ≼ (γ # Γ)"
proof -
from assms(2) obtain Φ where Φ:
"map snd Φ = Σ"
"mset (map fst Φ) ⊆# mset Γ"
"∀(γ, σ)∈set Φ. ⊢ γ → σ"
unfolding stronger_theory_relation_def
by auto
let ?Φ = "(γ, σ) # Φ"
from assms(1) Φ have
"map snd ?Φ = σ # Σ"
"mset (map fst ?Φ) ⊆# mset (γ # Γ)"
"∀(γ, σ)∈set ?Φ. ⊢ γ → σ"
by fastforce+
thus ?thesis
unfolding stronger_theory_relation_def
by metis
qed
lemma (in implication_logic) stronger_theory_relation_alt_def:
"Σ ≼ Γ = (∃Φ. mset (map snd Φ) = mset Σ ∧
mset (map fst Φ) ⊆# mset Γ ∧
(∀(γ, σ)∈set Φ. ⊢ γ → σ))"
proof (induct Γ arbitrary: Σ)
case Nil
then show ?case
using stronger_theory_empty_list_intro
stronger_theory_reflexive
by (simp, blast)
next
case (Cons γ Γ)
have "Σ ≼ (γ # Γ) = (∃Φ. mset (map snd Φ) = mset Σ ∧
mset (map fst Φ) ⊆# mset (γ # Γ) ∧
(∀(γ, σ) ∈ set Φ. ⊢ γ → σ))"
proof (rule iffI)
assume "Σ ≼ (γ # Γ)"
thus "∃Φ. mset (map snd Φ) = mset Σ ∧
mset (map fst Φ) ⊆# mset (γ # Γ) ∧
(∀(γ, σ)∈set Φ. ⊢ γ → σ)"
unfolding stronger_theory_relation_def
by metis
next
assume "∃Φ. mset (map snd Φ) = mset Σ ∧
mset (map fst Φ) ⊆# mset (γ # Γ) ∧
(∀(γ, σ)∈set Φ. ⊢ γ → σ)"
from this obtain Φ where Φ:
"mset (map snd Φ) = mset Σ"
"mset (map fst Φ) ⊆# mset (γ # Γ)"
"∀(γ, σ)∈set Φ. ⊢ γ → σ"
by metis
show "Σ ≼ (γ # Γ)"
proof (cases "∃ σ. (γ, σ) ∈ set Φ")
assume "∃ σ. (γ, σ) ∈ set Φ"
from this obtain σ where σ: "(γ, σ) ∈ set Φ" by auto
let ?Φ = "remove1 (γ, σ) Φ"
from σ have "mset (map snd ?Φ) = mset (remove1 σ Σ)"
using Φ(1) remove1_pairs_list_projections_snd by force+
moreover
from σ have "mset (map fst ?Φ) = mset (remove1 γ (map fst Φ))"
using Φ(1) remove1_pairs_list_projections_fst by force+
with Φ(2) have "mset (map fst ?Φ) ⊆# mset Γ"
by (simp add: subset_eq_diff_conv)
moreover from Φ(3) have "∀(γ, σ)∈set ?Φ. ⊢ γ → σ"
by fastforce
ultimately have "remove1 σ Σ ≼ Γ" using Cons by blast
from this obtain Ψ where Ψ:
"map snd Ψ = remove1 σ Σ"
"mset (map fst Ψ) ⊆# mset Γ"
"∀(γ, σ)∈set Ψ. ⊢ γ → σ"
unfolding stronger_theory_relation_def
by blast
let ?Ψ = "(γ, σ) # Ψ"
from Ψ have "map snd ?Ψ = σ # (remove1 σ Σ)"
"mset (map fst ?Ψ) ⊆# mset (γ # Γ)"
by simp+
moreover from Φ(3) σ have "⊢ γ → σ" by auto
with Ψ(3) have "∀(γ, σ)∈set ?Ψ. ⊢ γ → σ" by auto
ultimately have "(σ # (remove1 σ Σ)) ≼ (γ # Γ)"
unfolding stronger_theory_relation_def
by metis
moreover
have "σ ∈ set Σ"
by (metis Φ(1) σ set_mset_mset set_zip_rightD zip_map_fst_snd)
hence "Σ ⇌ σ # (remove1 σ Σ)"
by auto
hence "Σ ≼ (σ # (remove1 σ Σ))"
using stronger_theory_reflexive
stronger_theory_right_permutation
by blast
ultimately show ?thesis
using stronger_theory_transitive
by blast
next
assume "∄σ. (γ, σ) ∈ set Φ"
hence "γ ∉ set (map fst Φ)" by fastforce
with Φ(2) have "mset (map fst Φ) ⊆# mset Γ"
by (metis diff_single_trivial
in_multiset_in_set
insert_DiffM2
mset_remove1
remove_hd
subset_eq_diff_conv)
hence "Σ ≼ Γ"
using Cons Φ(1) Φ(3)
by blast
thus ?thesis
using stronger_theory_right_cons
by auto
qed
qed
thus ?case by auto
qed
lemma (in implication_logic) stronger_theory_deduction_monotonic:
assumes "Σ ≼ Γ"
and "Σ :⊢ φ"
shows "Γ :⊢ φ"
using assms
proof (induct Σ arbitrary: φ)
case Nil
then show ?case
by (simp add: list_deduction_weaken)
next
case (Cons σ Σ)
assume "(σ # Σ) ≼ Γ" "(σ # Σ) :⊢ φ"
hence "Σ :⊢ σ → φ" "Σ ≼ Γ"
using
list_deduction_theorem
stronger_theory_left_cons
by (blast, metis)
with Cons have "Γ :⊢ σ → φ" by blast
moreover
have "σ ∈ set (σ # Σ)" by auto
with ‹(σ # Σ) ≼ Γ› obtain γ where γ: "γ ∈ set Γ" "⊢ γ → σ"
using stronger_theory_witness by blast
hence "Γ :⊢ σ"
using
list_deduction_modus_ponens
list_deduction_reflection
list_deduction_weaken
by blast
ultimately have "Γ :⊢ φ"
using list_deduction_modus_ponens by blast
then show ?case by blast
qed
lemma (in classical_logic) measure_msub_left_monotonic:
assumes "mset Σ ⊆# mset Γ"
and "Σ $⊢ Φ"
shows "Γ $⊢ Φ"
using assms
proof (induct Φ arbitrary: Σ Γ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
from this obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset Σ"
"map (uncurry (⊔)) Ψ :⊢ φ"
"map (uncurry (→)) Ψ @ Σ ⊖ (map snd Ψ) $⊢ Φ"
using measure_deduction.simps(2) by blast
let ?Ψ = "map snd Ψ"
let ?Ψ' = "map (uncurry (→)) Ψ"
let ?Σ' = "?Ψ' @ (Σ ⊖ ?Ψ)"
let ?Γ' = "?Ψ' @ (Γ ⊖ ?Ψ)"
from Ψ have "mset ?Ψ ⊆# mset Γ"
using ‹mset Σ ⊆# mset Γ› subset_mset.trans by blast
moreover have "mset (Σ ⊖ ?Ψ) ⊆# mset (Γ ⊖ ?Ψ)"
by (metis ‹mset Σ ⊆# mset Γ› list_subtract_monotonic)
hence "mset ?Σ' ⊆# mset ?Γ'"
by simp
with Cons.hyps Ψ(3) have "?Γ' $⊢ Φ" by blast
ultimately have "Γ $⊢ (φ # Φ)"
using Ψ(2) by fastforce
then show ?case
by simp
qed
lemma (in classical_logic) witness_weaker_theory:
assumes "mset (map snd Σ) ⊆# mset Γ"
shows "map (uncurry (⊔)) Σ ≼ Γ"
proof -
have "∀ Γ. mset (map snd Σ) ⊆# mset Γ ⟶ map (uncurry (⊔)) Σ ≼ Γ"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
{
fix Γ
assume "mset (map snd (σ # Σ)) ⊆# mset Γ"
hence "mset (map snd Σ) ⊆# mset (remove1 (snd σ) Γ)"
by (simp add: insert_subset_eq_iff)
with Cons have "map (uncurry (⊔)) Σ ≼ remove1 (snd σ) Γ" by blast
moreover have "uncurry (⊔) = (λ σ. fst σ ⊔ snd σ)" by fastforce
hence "uncurry (⊔) σ = fst σ ⊔ snd σ" by simp
moreover have "⊢ snd σ → (fst σ ⊔ snd σ)"
unfolding disjunction_def
by (simp add: axiom_k)
ultimately have "map (uncurry (⊔)) (σ # Σ) ≼ (snd σ # (remove1 (snd σ) Γ))"
by (simp add: stronger_theory_left_right_cons)
moreover have "mset (snd σ # (remove1 (snd σ) Γ)) = mset Γ"
using ‹mset (map snd (σ # Σ)) ⊆# mset Γ›
by (simp, meson insert_DiffM mset_subset_eq_insertD)
ultimately have "map (uncurry (⊔)) (σ # Σ) ≼ Γ"
unfolding stronger_theory_relation_alt_def
by simp
}
then show ?case by blast
qed
with assms show ?thesis by simp
qed
lemma (in implication_logic) stronger_theory_combine:
assumes "Φ ≼ Δ"
and "Ψ ≼ Γ"
shows "(Φ @ Ψ) ≼ (Δ @ Γ)"
proof -
have "∀ Φ. Φ ≼ Δ ⟶ (Φ @ Ψ) ≼ (Δ @ Γ)"
proof (induct Δ)
case Nil
then show ?case
using assms(2) stronger_theory_empty_list_intro by fastforce
next
case (Cons δ Δ)
{
fix Φ
assume "Φ ≼ (δ # Δ)"
from this obtain Σ where Σ:
"map snd Σ = Φ"
"mset (map fst Σ) ⊆# mset (δ # Δ)"
"∀ (δ,φ) ∈ set Σ. ⊢ δ → φ"
unfolding stronger_theory_relation_def
by blast
have "(Φ @ Ψ) ≼ ((δ # Δ) @ Γ)"
proof (cases "∃ φ . (δ, φ) ∈ set Σ")
assume "∃ φ . (δ, φ) ∈ set Σ"
from this obtain φ where φ: "(δ, φ) ∈ set Σ" by auto
let ?Σ = "remove1 (δ, φ) Σ"
from φ Σ(1) have "mset (map snd ?Σ) = mset (remove1 φ Φ)"
using remove1_pairs_list_projections_snd by fastforce
moreover from φ have "mset (map fst ?Σ) = mset (remove1 δ (map fst Σ))"
using remove1_pairs_list_projections_fst by fastforce
hence "mset (map fst ?Σ) ⊆# mset Δ"
using Σ(2) mset.simps(1) subset_eq_diff_conv by force
moreover from Σ(3) have "∀ (δ,φ) ∈ set ?Σ. ⊢ δ → φ" by auto
ultimately have "remove1 φ Φ ≼ Δ"
unfolding stronger_theory_relation_alt_def by blast
hence "(remove1 φ Φ @ Ψ) ≼ (Δ @ Γ)" using Cons by auto
from this obtain Ω where Ω:
"map snd Ω = (remove1 φ Φ) @ Ψ"
"mset (map fst Ω) ⊆# mset (Δ @ Γ)"
"∀ (α,β) ∈ set Ω. ⊢ α → β"
unfolding stronger_theory_relation_def
by blast
let ?Ω = "(δ, φ) # Ω"
have "map snd ?Ω = φ # remove1 φ Φ @ Ψ"
using Ω(1) by simp
moreover have "mset (map fst ?Ω) ⊆# mset ((δ # Δ) @ Γ)"
using Ω(2) by simp
moreover have "⊢ δ → φ"
using Σ(3) φ by blast
hence "∀ (α,β) ∈ set ?Ω. ⊢ α → β" using Ω(3) by auto
ultimately have "(φ # remove1 φ Φ @ Ψ) ≼ ((δ # Δ) @ Γ)"
by (metis stronger_theory_relation_def)
moreover have "φ ∈ set Φ"
using Σ(1) φ by force
hence "(φ # remove1 φ Φ) ⇌ Φ"
by force
hence "(φ # remove1 φ Φ @ Ψ) ⇌ Φ @ Ψ"
by (metis append_Cons perm_append2)
ultimately show ?thesis
using stronger_theory_left_permutation by blast
next
assume "∄φ. (δ, φ) ∈ set Σ"
hence "δ ∉ set (map fst Σ)"
"mset Δ + add_mset δ (mset []) = mset (δ # Δ)"
by auto
hence "mset (map fst Σ) ⊆# mset Δ"
by (metis (no_types) ‹mset (map fst Σ) ⊆# mset (δ # Δ)›
diff_single_trivial
mset.simps(1)
set_mset_mset
subset_eq_diff_conv)
with Σ(1) Σ(3) have "Φ ≼ Δ"
unfolding stronger_theory_relation_def
by blast
hence "(Φ @ Ψ) ≼ (Δ @ Γ)" using Cons by auto
then show ?thesis
by (simp add: stronger_theory_right_cons)
qed
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
text ‹ We now turn to proving that \<^term>‹(≽)› is a subrelation of \<^term>‹(:⊢)›. ›
lemma (in classical_logic) stronger_theory_to_measure_deduction:
assumes "Γ ≽ Σ"
shows "Γ $⊢ Σ"
proof -
have "∀ Γ. Σ ≼ Γ ⟶ Γ $⊢ Σ"
proof (induct Σ)
case Nil
then show ?case by fastforce
next
case (Cons σ Σ)
{
fix Γ
assume "(σ # Σ) ≼ Γ"
from this obtain γ where γ: "γ ∈ set Γ" "⊢ γ → σ" "Σ ≼ (remove1 γ Γ)"
using stronger_theory_cons_witness by blast
let ?Φ = "[(γ,γ)]"
from γ Cons have "(remove1 γ Γ) $⊢ Σ" by blast
moreover have "mset (remove1 γ Γ) ⊆# mset (map (uncurry (→)) ?Φ @ Γ ⊖ (map snd ?Φ))"
by simp
ultimately have "map (uncurry (→)) ?Φ @ Γ ⊖ (map snd ?Φ) $⊢ Σ"
using measure_msub_left_monotonic by blast
moreover have "map (uncurry (⊔)) ?Φ :⊢ σ"
by (simp, metis γ(2)
Peirces_law
disjunction_def
list_deduction_def
list_deduction_modus_ponens
list_deduction_weaken
list_implication.simps(1)
list_implication.simps(2))
moreover from γ(1) have "mset (map snd ?Φ) ⊆# mset Γ" by simp
ultimately have "Γ $⊢ (σ # Σ)"
using measure_deduction.simps(2) by blast
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
section ‹ Measure Deduction is a Preorder ›
text ‹ We next show that measure deduction is a preorder. ›
text ‹ Reflexivity follows immediately because \<^term>‹(≼)› is a subrelation
and is itself reflexive. ›
theorem (in classical_logic) measure_reflexive: "Γ $⊢ Γ"
by (simp add: stronger_theory_to_measure_deduction)
text ‹ Transitivity is complicated. It requires constructing many witnesses
and involves a lot of metatheorems. Below we provide various witness
constructions that allow us to establish \<^term>‹Γ $⊢ Λ ⟹ Λ $⊢ Δ ⟹ Γ $⊢ Δ›. ›
primrec (in implication_logic)
first_component :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔄")
where
"𝔄 Ψ [] = []"
| "𝔄 Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ 𝔄 Ψ Δ
| Some ψ ⇒ ψ # (𝔄 (remove1 ψ Ψ) Δ))"
primrec (in implication_logic)
second_component :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔅")
where
"𝔅 Ψ [] = []"
| "𝔅 Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ 𝔅 Ψ Δ
| Some ψ ⇒ δ # (𝔅 (remove1 ψ Ψ) Δ))"
lemma (in implication_logic) first_component_second_component_mset_connection:
"mset (map (uncurry (→)) (𝔄 Ψ Δ)) = mset (map snd (𝔅 Ψ Δ))"
proof -
have "∀ Ψ. mset (map (uncurry (→)) (𝔄 Ψ Δ)) = mset (map snd (𝔅 Ψ Δ))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map (uncurry (→)) (𝔄 Ψ (δ # Δ))) =
mset (map snd (𝔅 Ψ (δ # Δ)))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis using Cons by simp
next
case False
from this obtain ψ where
"find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
"uncurry (→) ψ = snd δ"
using find_Some_predicate
by fastforce
then show ?thesis using Cons by simp
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) second_component_right_empty [simp]:
"𝔅 [] Δ = []"
by (induct Δ, simp+)
lemma (in implication_logic) first_component_msub:
"mset (𝔄 Ψ Δ) ⊆# mset Ψ"
proof -
have "∀ Ψ. mset (𝔄 Ψ Δ) ⊆# mset Ψ"
proof(induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (𝔄 Ψ (δ # Δ)) ⊆# mset Ψ"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis using Cons by simp
next
case False
from this obtain ψ where
ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
"ψ ∈ set Ψ"
using find_Some_set_membership
by fastforce
have "mset (𝔄 (remove1 ψ Ψ) Δ) ⊆# mset (remove1 ψ Ψ)"
using Cons by metis
thus ?thesis using ψ by (simp add: insert_subset_eq_iff)
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) second_component_msub:
"mset (𝔅 Ψ Δ) ⊆# mset Δ"
proof -
have "∀Ψ. mset (𝔅 Ψ Δ) ⊆# mset Δ"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (𝔅 Ψ (δ # Δ)) ⊆# mset (δ # Δ)"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None",
simp,
metis add_mset_remove_trivial
diff_subset_eq_self
subset_mset.order_trans,
auto)
}
thus ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) second_component_snd_projection_msub:
"mset (map snd (𝔅 Ψ Δ)) ⊆# mset (map (uncurry (→)) Ψ)"
proof -
have "∀Ψ. mset (map snd (𝔅 Ψ Δ)) ⊆# mset (map (uncurry (→)) Ψ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map snd (𝔅 Ψ (δ # Δ))) ⊆# mset (map (uncurry (→)) Ψ)"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis
using Cons by simp
next
case False
from this obtain ψ where ψ:
"find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = Some ψ"
by auto
hence "𝔅 Ψ (δ # Δ) = δ # (𝔅 (remove1 ψ Ψ) Δ)"
using ψ by fastforce
with Cons have "mset (map snd (𝔅 Ψ (δ # Δ))) ⊆#
mset ((snd δ) # map (uncurry (→)) (remove1 ψ Ψ))"
by (simp, metis mset_map mset_remove1)
moreover from ψ have "snd δ = (uncurry (→)) ψ"
using find_Some_predicate by fastforce
ultimately have
"mset (map snd (𝔅 Ψ (δ # Δ))) ⊆#
mset (map (uncurry (→)) (ψ # (remove1 ψ Ψ)))"
by simp
thus ?thesis
by (metis
first_component_msub
first_component_second_component_mset_connection
map_monotonic)
qed
}
thus ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) second_component_diff_msub:
assumes "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
shows "mset (map snd (Δ ⊖ (𝔅 Ψ Δ))) ⊆# mset (Γ ⊖ (map snd Ψ))"
proof -
have "∀ Ψ Γ. mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ⟶
mset (map snd (Δ ⊖ (𝔅 Ψ Δ))) ⊆# mset (Γ ⊖ (map snd Ψ))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ Γ
assume ♢: "mset (map snd (δ # Δ)) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ)"
have "mset (map snd ((δ # Δ) ⊖ 𝔅 Ψ (δ # Δ))) ⊆# mset (Γ ⊖ map snd Ψ)"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
hence A: "snd δ ∉ set (map (uncurry (→)) Ψ)"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
then show ?case
by (cases "uncurry (→) ψ = snd δ", simp+)
qed
moreover have
"mset (map snd Δ)
⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) - {#snd δ#}"
using ♢ insert_subset_eq_iff by fastforce
ultimately have
"mset (map snd Δ)
⊆# mset (map (uncurry (→)) Ψ @ (remove1 (snd δ) Γ)
⊖ map snd Ψ)"
by (metis (no_types)
mset_remove1
union_code
list_subtract.simps(2)
list_subtract_remove1_cons_perm
remove1_append)
hence B: "mset (map snd (Δ ⊖ (𝔅 Ψ Δ))) ⊆# mset (remove1 (snd δ) Γ ⊖ (map snd Ψ))"
using Cons by blast
have C: "snd δ ∈# mset (snd δ # map snd Δ @
(map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) ⊖ (snd δ # map snd Δ))"
by (meson in_multiset_in_set list.set_intros(1))
have "mset (map snd (δ # Δ))
+ (mset (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ)
- mset (map snd (δ # Δ)))
= mset (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ)"
using ♢ subset_mset.add_diff_inverse by blast
then have "snd δ ∈# mset (map (uncurry (→)) Ψ) + (mset Γ - mset (map snd Ψ))"
using C by simp
with A have "snd δ ∈ set Γ"
by (metis (no_types) diff_subset_eq_self
in_multiset_in_set
subset_mset.add_diff_inverse
union_iff)
have D: "𝔅 Ψ Δ = 𝔅 Ψ (δ # Δ)"
using ‹find (λψ. uncurry (→) ψ = snd δ) Ψ = None›
by simp
obtain diff :: "'a list ⇒ 'a list ⇒ 'a list" where
"∀x0 x1. (∃v2. x1 @ v2 ⇌ x0) = (x1 @ diff x0 x1 ⇌ x0)"
by moura
then have E:
"mset (map snd (𝔅 Ψ (δ # Δ))
@ diff (map (uncurry (→)) Ψ) (map snd (𝔅 Ψ (δ # Δ))))
= mset (map (uncurry (→)) Ψ)"
by (meson second_component_snd_projection_msub mset_le_perm_append)
have F: "∀a m ma. (add_mset (a::'a) m ⊆# ma) = (a ∈# ma ∧ m ⊆# ma - {#a#})"
using insert_subset_eq_iff by blast
then have "snd δ ∈# mset (map snd (𝔅 Ψ (δ # Δ))
@ diff (map (uncurry (→)) Ψ) (map snd (𝔅 Ψ (δ # Δ))))
+ mset (Γ ⊖ map snd Ψ)"
using E ♢ by force
then have "snd δ ∈# mset (Γ ⊖ map snd Ψ)"
using A E by (metis (no_types) in_multiset_in_set union_iff)
then have G: "add_mset (snd δ) (mset (map snd (Δ ⊖ 𝔅 Ψ Δ))) ⊆# mset (Γ ⊖ map snd Ψ)"
using B F by force
have H: "∀ps psa f. ¬ mset (ps::('a × 'a) list) ⊆# mset psa ∨
mset ((map f psa::'a list) ⊖ map f ps) = mset (map f (psa ⊖ ps))"
using map_list_subtract_mset_equivalence by blast
have "snd δ ∉# mset (map snd (𝔅 Ψ (δ # Δ)))
+ mset (diff (map (uncurry (→)) Ψ) (map snd (𝔅 Ψ (δ # Δ))))"
using A E by auto
then have "add_mset (snd δ) (mset (map snd (Δ ⊖ 𝔅 Ψ Δ)))
= mset (map snd (δ # Δ) ⊖ map snd (𝔅 Ψ (δ # Δ)))"
using D H second_component_msub by auto
then show ?thesis
using G H by (metis (no_types) second_component_msub)
next
case False
from this obtain ψ where ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by auto
let ?Ψ' = "remove1 ψ Ψ"
let ?Γ' = "remove1 (snd ψ) Γ"
have "snd δ = uncurry (→) ψ"
"ψ ∈ set Ψ"
"mset ((δ # Δ) ⊖ 𝔅 Ψ (δ # Δ)) =
mset (Δ ⊖ 𝔅 ?Ψ' Δ)"
using ψ find_Some_predicate find_Some_set_membership
by fastforce+
moreover
have "mset (Γ ⊖ map snd Ψ) = mset (?Γ' ⊖ map snd ?Ψ')"
by (simp, metis ‹ψ ∈ set Ψ› image_mset_add_mset in_multiset_in_set insert_DiffM)
moreover
obtain search :: "('a × 'a) list ⇒ ('a × 'a ⇒ bool) ⇒ 'a × 'a" where
"∀xs P. (∃x. x ∈ set xs ∧ P x) = (search xs P ∈ set xs ∧ P (search xs P))"
by moura
then have "∀p ps. (find p ps ≠ None ∨ (∀pa. pa ∉ set ps ∨ ¬ p pa))
∧ (find p ps = None ∨ search ps p ∈ set ps ∧ p (search ps p))"
by (metis (full_types) find_None_iff)
then have "(find (λp. uncurry (→) p = snd δ) Ψ ≠ None
∨ (∀p. p ∉ set Ψ ∨ uncurry (→) p ≠ snd δ))
∧ (find (λp. uncurry (→) p = snd δ) Ψ = None
∨ search Ψ (λp. uncurry (→) p = snd δ) ∈ set Ψ
∧ uncurry (→) (search Ψ (λp. uncurry (→) p = snd δ)) = snd δ)"
by blast
hence "snd δ ∈ set (map (uncurry (→)) Ψ)"
by (metis (no_types) False image_eqI image_set)
moreover
have A: "add_mset (uncurry (→) ψ) (image_mset snd (mset Δ))
= image_mset snd (add_mset δ (mset Δ))"
by (simp add: ‹snd δ = uncurry (→) ψ›)
have B: "{#snd δ#} ⊆# image_mset (uncurry (→)) (mset Ψ)"
using ‹snd δ ∈ set (map (uncurry (→)) Ψ)› by force
have "image_mset (uncurry (→)) (mset Ψ) - {#snd δ#}
= image_mset (uncurry (→)) (mset (remove1 ψ Ψ))"
by (simp add: ‹ψ ∈ set Ψ› ‹snd δ = uncurry (→) ψ› image_mset_Diff)
then have "mset (map snd (Δ ⊖ 𝔅 (remove1 ψ Ψ) Δ))
⊆# mset (remove1 (snd ψ) Γ ⊖ map snd (remove1 ψ Ψ))"
by (metis (no_types)
A B ♢ Cons.hyps
calculation(1)
calculation(4)
insert_subset_eq_iff
mset.simps(2)
mset_map
subset_mset.diff_add_assoc2
union_code)
ultimately show ?thesis by fastforce
qed
}
then show ?case by blast
qed
thus ?thesis using assms by auto
qed
primrec (in classical_logic)
merge_witness :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔍")
where
"𝔍 Ψ [] = Ψ"
| "𝔍 Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ δ # 𝔍 Ψ Δ
| Some ψ ⇒ (fst δ ⊓ fst ψ, snd ψ) # (𝔍 (remove1 ψ Ψ) Δ))"
lemma (in classical_logic) merge_witness_right_empty [simp]:
"𝔍 [] Δ = Δ"
by (induct Δ, simp+)
lemma (in classical_logic) second_component_merge_witness_snd_projection:
"mset (map snd Ψ @ map snd (Δ ⊖ (𝔅 Ψ Δ))) = mset (map snd (𝔍 Ψ Δ))"
proof -
have "∀ Ψ. mset (map snd Ψ @ map snd (Δ ⊖ (𝔅 Ψ Δ))) = mset (map snd (𝔍 Ψ Δ))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map snd Ψ @ map snd ((δ # Δ) ⊖ 𝔅 Ψ (δ # Δ))) =
mset (map snd (𝔍 Ψ (δ # Δ)))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis
using Cons
by (simp,
metis (no_types, lifting)
ab_semigroup_add_class.add_ac(1)
add_mset_add_single
image_mset_single
image_mset_union
second_component_msub
subset_mset.add_diff_assoc2)
next
case False
from this obtain ψ where ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by auto
moreover have "ψ ∈ set Ψ"
by (meson ψ find_Some_set_membership)
moreover
let ?Ψ' = "remove1 ψ Ψ"
from Cons have
"mset (map snd ?Ψ' @ map snd (Δ ⊖ 𝔅 ?Ψ' Δ)) =
mset (map snd (𝔍 ?Ψ' Δ))"
by blast
ultimately show ?thesis
by (simp,
metis (no_types, lifting)
add_mset_remove_trivial_eq
image_mset_add_mset
in_multiset_in_set
union_mset_add_mset_left)
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in classical_logic) second_component_merge_witness_stronger_theory:
"(map (uncurry (→)) Δ @ map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ Δ)) ≼
map (uncurry (→)) (𝔍 Ψ Δ)"
proof -
have "∀ Ψ. (map (uncurry (→)) Δ @
map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ Δ)) ≼
map (uncurry (→)) (𝔍 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case
by simp
next
case (Cons δ Δ)
{
fix Ψ
have "⊢ (uncurry (→)) δ → (uncurry (→)) δ"
using axiom_k modus_ponens implication_absorption by blast
have
"(map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ (δ # Δ))) ≼
map (uncurry (→)) (𝔍 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
thus ?thesis
using Cons
‹⊢ (uncurry (→)) δ → (uncurry (→)) δ›
by (simp, metis stronger_theory_left_right_cons)
next
case False
from this obtain ψ where ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by auto
from ψ have "snd δ = uncurry (→) ψ"
using find_Some_predicate by fastforce
from ψ ‹snd δ = uncurry (→) ψ› have
"mset (map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ (δ # Δ))) =
mset (map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) (remove1 ψ Ψ) ⊖
map snd (𝔅 (remove1 ψ Ψ) Δ))"
by (simp add: find_Some_set_membership image_mset_Diff)
hence
"(map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ (δ # Δ))) ≼
(map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) (remove1 ψ Ψ) ⊖ map snd (𝔅 (remove1 ψ Ψ) Δ))"
by (simp add: msub_stronger_theory_intro)
with Cons ‹⊢ (uncurry (→)) δ → (uncurry (→)) δ› have
"(map (uncurry (→)) (δ # Δ) @
map (uncurry (→)) Ψ ⊖ map snd (𝔅 Ψ (δ # Δ)))
≼ ((uncurry (→)) δ # map (uncurry (→)) (𝔍 (remove1 ψ Ψ) Δ))"
using stronger_theory_left_right_cons
stronger_theory_transitive
by fastforce
moreover
let ?α = "fst δ"
let ?β = "fst ψ"
let ?γ = "snd ψ"
have "uncurry (→) = (λ δ. fst δ → snd δ)" by fastforce
with ψ have "(uncurry (→)) δ = ?α → ?β → ?γ"
using find_Some_predicate by fastforce
hence "⊢ ((?α ⊓ ?β) → ?γ) → (uncurry (→)) δ"
using biconditional_def curry_uncurry by auto
with ψ have
"((uncurry (→)) δ # map (uncurry (→)) (𝔍 (remove1 ψ Ψ) Δ)) ≼
map (uncurry (→)) (𝔍 Ψ (δ # Δ))"
using stronger_theory_left_right_cons by auto
ultimately show ?thesis
using stronger_theory_transitive
by blast
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in classical_logic) merge_witness_msub_intro:
assumes "mset (map snd Ψ) ⊆# mset Γ"
and "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
shows "mset (map snd (𝔍 Ψ Δ)) ⊆# mset Γ"
proof -
have "∀Ψ Γ. mset (map snd Ψ) ⊆# mset Γ ⟶
mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ⟶
mset (map snd (𝔍 Ψ Δ)) ⊆# mset Γ"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ :: "('a × 'a) list"
fix Γ :: "'a list"
assume ♢: "mset (map snd Ψ) ⊆# mset Γ"
"mset (map snd (δ # Δ)) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
have "mset (map snd (𝔍 Ψ (δ # Δ))) ⊆# mset Γ"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
hence "snd δ ∉ set (map (uncurry (→)) Ψ)"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
hence "uncurry (→) ψ ≠ snd δ" by fastforce
with Cons show ?case by fastforce
qed
with ♢(2) have "snd δ ∈# mset (Γ ⊖ map snd Ψ)"
using mset_subset_eq_insertD by fastforce
with ♢(1) have "mset (map snd Ψ) ⊆# mset (remove1 (snd δ) Γ)"
by (metis list_subtract_mset_homomorphism
mset_remove1
single_subset_iff
subset_mset.add_diff_assoc
subset_mset.add_diff_inverse
subset_mset.le_iff_add)
moreover
have "add_mset (snd δ) (mset (Γ ⊖ map snd Ψ) - {#snd δ#}) = mset (Γ ⊖ map snd Ψ)"
by (meson ‹snd δ ∈# mset (Γ ⊖ map snd Ψ)› insert_DiffM)
then have "image_mset snd (mset Δ) - (mset Γ - add_mset (snd δ) (image_mset snd (mset Ψ)))
⊆# {#x → y. (x, y) ∈# mset Ψ#}"
using ♢(2) by (simp, metis add_mset_diff_bothsides
list_subtract_mset_homomorphism
mset_map subset_eq_diff_conv)
hence "mset (map snd Δ)
⊆# mset (map (uncurry (→)) Ψ @ (remove1 (snd δ) Γ) ⊖ (map snd Ψ))"
using subset_eq_diff_conv by (simp, blast)
ultimately have "mset (map snd (𝔍 Ψ Δ)) ⊆# mset (remove1 (snd δ) Γ)"
using Cons by blast
hence "mset (map snd (δ # (𝔍 Ψ Δ))) ⊆# mset Γ"
by (simp, metis ‹snd δ ∈# mset (Γ ⊖ map snd Ψ)›
cancel_ab_semigroup_add_class.diff_right_commute
diff_single_trivial
insert_subset_eq_iff
list_subtract_mset_homomorphism
multi_drop_mem_not_eq)
with ‹find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None›
show ?thesis
by simp
next
case False
from this obtain ψ where ψ:
"find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by fastforce
let ?χ = "fst ψ"
let ?γ = "snd ψ"
have "uncurry (→) = (λ ψ. fst ψ → snd ψ)"
by fastforce
moreover
from this have "uncurry (→) ψ = ?χ → ?γ" by fastforce
with ψ have A: "(?χ, ?γ) ∈ set Ψ"
and B: "snd δ = ?χ → ?γ"
using find_Some_predicate
by (simp add: find_Some_set_membership, fastforce)
let ?Ψ' = "remove1 (?χ, ?γ) Ψ"
from B ♢(2) have
"mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) - {# ?χ → ?γ #}"
by (simp add: insert_subset_eq_iff)
moreover
have "mset (map (uncurry (→)) Ψ)
= add_mset (case (fst ψ, snd ψ) of (x, xa) ⇒ x → xa)
(image_mset (uncurry (→)) (mset (remove1 (fst ψ, snd ψ) Ψ)))"
by (metis (no_types)
A
image_mset_add_mset
in_multiset_in_set
insert_DiffM
mset_map
mset_remove1
uncurry_def)
ultimately have
"mset (map snd Δ) ⊆# mset (map (uncurry (→)) ?Ψ' @ Γ ⊖ map snd Ψ)"
using
add_diff_cancel_left'
add_diff_cancel_right
diff_diff_add_mset
diff_subset_eq_self
mset_append
subset_eq_diff_conv
subset_mset.diff_add
by auto
moreover from A B ♢
have "mset (Γ ⊖ map snd Ψ) = mset((remove1 ?γ Γ) ⊖ (remove1 ?γ (map snd Ψ)))"
using
image_eqI
prod.sel(2)
set_map
by force
with A have
"mset (Γ ⊖ map snd Ψ) = mset((remove1 ?γ Γ) ⊖ (map snd ?Ψ'))"
by (metis
remove1_pairs_list_projections_snd
in_multiset_in_set
list_subtract_mset_homomorphism
mset_remove1)
ultimately have
"mset (map snd Δ) ⊆# mset (map (uncurry (→)) ?Ψ'
@ (remove1 ?γ Γ)
⊖ map snd ?Ψ')"
by simp
hence "mset (map snd (𝔍 ?Ψ' Δ)) ⊆# mset (remove1 ?γ Γ)"
using Cons ♢(1) A
by (metis (no_types, lifting)
image_mset_add_mset
in_multiset_in_set
insert_DiffM
insert_subset_eq_iff
mset_map mset_remove1
prod.collapse)
with ♢(1) A have "mset (map snd (𝔍 ?Ψ' Δ)) + {# ?γ #} ⊆# mset Γ"
by (metis add_mset_add_single
image_eqI
insert_subset_eq_iff
mset_remove1
mset_subset_eqD
set_map
set_mset_mset
snd_conv)
hence "mset (map snd ((fst δ ⊓ ?χ, ?γ) # (𝔍 ?Ψ' Δ))) ⊆# mset Γ"
by simp
moreover from ψ have
"𝔍 Ψ (δ # Δ) = (fst δ ⊓ ?χ, ?γ) # (𝔍 ?Ψ' Δ)"
by simp
ultimately show ?thesis by simp
qed
}
thus ?case by blast
qed
with assms show ?thesis by blast
qed
lemma (in classical_logic) right_merge_witness_stronger_theory:
"map (uncurry (⊔)) Δ ≼ map (uncurry (⊔)) (𝔍 Ψ Δ)"
proof -
have "∀ Ψ. map (uncurry (⊔)) Δ ≼ map (uncurry (⊔)) (𝔍 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "map (uncurry (⊔)) (δ # Δ) ≼ map (uncurry (⊔)) (𝔍 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
hence "𝔍 Ψ (δ # Δ) = δ # 𝔍 Ψ Δ"
by simp
moreover have "⊢ (uncurry (⊔)) δ → (uncurry (⊔)) δ"
by (metis axiom_k axiom_s modus_ponens)
ultimately show ?thesis using Cons
by (simp add: stronger_theory_left_right_cons)
next
case False
from this obtain ψ where ψ:
"find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by fastforce
let ?χ = "fst ψ"
let ?γ = "snd ψ"
let ?μ = "fst δ"
have "uncurry (→) = (λ ψ. fst ψ → snd ψ)"
"uncurry (⊔) = (λ δ. fst δ ⊔ snd δ)"
by fastforce+
hence "uncurry (⊔) δ = ?μ ⊔ (?χ → ?γ)"
using ψ find_Some_predicate
by fastforce
moreover
{
fix μ χ γ
have "⊢ ((μ ⊓ χ) ⊔ γ) → (μ ⊔ (χ → γ))"
proof -
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ((❙⟨μ❙⟩ ⊓ ❙⟨χ❙⟩) ⊔ ❙⟨γ❙⟩) → (❙⟨μ❙⟩ ⊔ (❙⟨χ❙⟩ → ❙⟨γ❙⟩))"
by fastforce
hence "⊢ ❙⦇ ((❙⟨μ❙⟩ ⊓ ❙⟨χ❙⟩) ⊔ ❙⟨γ❙⟩) → (❙⟨μ❙⟩ ⊔ (❙⟨χ❙⟩ → ❙⟨γ❙⟩)) ❙⦈"
using propositional_semantics by blast
thus ?thesis
by simp
qed
}
ultimately show ?thesis
using Cons ψ stronger_theory_left_right_cons
by simp
qed
}
thus ?case by blast
qed
thus ?thesis by blast
qed
lemma (in classical_logic) left_merge_witness_stronger_theory:
"map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔍 Ψ Δ)"
proof -
have "∀ Ψ. map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔍 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case
by simp
next
case (Cons δ Δ)
{
fix Ψ
have "map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔍 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis
using Cons stronger_theory_right_cons
by auto
next
case False
from this obtain ψ where ψ:
"find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
by fastforce
let ?χ = "fst ψ"
let ?γ = "snd ψ"
let ?μ = "fst δ"
have "uncurry (→) = (λ ψ. fst ψ → snd ψ)"
"uncurry (⊔) = (λ δ. fst δ ⊔ snd δ)"
by fastforce+
hence
"uncurry (⊔) δ = ?μ ⊔ (?χ → ?γ)"
"uncurry (⊔) ψ = ?χ ⊔ ?γ"
using ψ find_Some_predicate
by fastforce+
moreover
{
fix μ χ γ
have "⊢ ((μ ⊓ χ) ⊔ γ) → (χ ⊔ γ)"
proof -
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ((❙⟨μ❙⟩ ⊓ ❙⟨χ❙⟩) ⊔ ❙⟨γ❙⟩) → (❙⟨χ❙⟩ ⊔ ❙⟨γ❙⟩)"
by fastforce
hence "⊢ ❙⦇ ((❙⟨μ❙⟩ ⊓ ❙⟨χ❙⟩) ⊔ ❙⟨γ❙⟩) → (❙⟨χ❙⟩ ⊔ ❙⟨γ❙⟩) ❙⦈"
using propositional_semantics by blast
thus ?thesis
by simp
qed
}
ultimately have
"map (uncurry (⊔)) (ψ # (remove1 ψ Ψ)) ≼
map (uncurry (⊔)) (𝔍 Ψ (δ # Δ))"
using Cons ψ stronger_theory_left_right_cons
by simp
moreover from ψ have "ψ ∈ set Ψ"
by (simp add: find_Some_set_membership)
hence "mset (map (uncurry (⊔)) (ψ # (remove1 ψ Ψ))) =
mset (map (uncurry (⊔)) Ψ)"
by (metis insert_DiffM
mset.simps(2)
mset_map
mset_remove1
set_mset_mset)
hence "map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (ψ # (remove1 ψ Ψ))"
by (simp add: msub_stronger_theory_intro)
ultimately show ?thesis
using stronger_theory_transitive by blast
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in classical_logic) measure_empty_deduction:
"[] $⊢ Φ = (∀ φ ∈ set Φ. ⊢ φ)"
by (induct Φ, simp, rule iffI, fastforce+)
lemma (in classical_logic) measure_stronger_theory_left_monotonic:
assumes "Σ ≼ Γ"
and "Σ $⊢ Φ"
shows "Γ $⊢ Φ"
using assms
proof (induct Φ arbitrary: Σ Γ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
from this obtain Ψ Δ where
Ψ: "mset (map snd Ψ) ⊆# mset Σ"
"map (uncurry (⊔)) Ψ :⊢ φ"
"map (uncurry (→)) Ψ @ Σ ⊖ (map snd Ψ) $⊢ Φ"
and
Δ: "map snd Δ = Σ"
"mset (map fst Δ) ⊆# mset Γ"
"∀ (γ,σ) ∈ set Δ. ⊢ γ → σ"
unfolding stronger_theory_relation_def
by fastforce
from ‹mset (map snd Ψ) ⊆# mset Σ›
‹map snd Δ = Σ›
obtain Ω where Ω:
"map (λ (ψ, σ, _). (ψ, σ)) Ω = Ψ"
"mset (map (λ (_, σ, γ). (γ, σ)) Ω) ⊆# mset Δ"
using triple_list_exists by blast
let ?Θ = "map (λ (ψ, _, γ). (ψ, γ)) Ω"
have "map snd ?Θ = map fst (map (λ (_, σ, γ). (γ, σ)) Ω)"
by auto
hence "mset (map snd ?Θ) ⊆# mset Γ"
using Ω(2) Δ(2) map_monotonic subset_mset.order_trans
by metis
moreover have "map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) ?Θ"
proof -
let ?Φ = "map (λ (ψ, σ, γ). (ψ ⊔ γ, ψ ⊔ σ)) Ω"
have "map snd ?Φ = map (uncurry (⊔)) Ψ"
using Ω(1) by fastforce
moreover have "map fst ?Φ = map (uncurry (⊔)) ?Θ"
by fastforce
hence "mset (map fst ?Φ) ⊆# mset (map (uncurry (⊔)) ?Θ)"
by (metis subset_mset.dual_order.refl)
moreover
have "mset (map (λ(ψ, σ, _). (ψ, σ)) Ω) ⊆# mset Ψ"
using Ω(1) by simp
hence "∀ (φ,χ) ∈ set ?Φ. ⊢ φ → χ" using Ω(2)
proof (induct Ω)
case Nil
then show ?case by simp
next
case (Cons ω Ω)
let ?Φ = "map (λ (ψ, σ, γ). (ψ ⊔ γ, ψ ⊔ σ)) (ω # Ω)"
let ?Φ' = "map (λ (ψ, σ, γ). (ψ ⊔ γ, ψ ⊔ σ)) Ω"
have "mset (map (λ(ψ, σ, _). (ψ, σ)) Ω) ⊆# mset Ψ"
"mset (map (λ(_, σ, γ). (γ, σ)) Ω) ⊆# mset Δ"
using Cons.prems(1) Cons.prems(2) subset_mset.dual_order.trans by fastforce+
with Cons have "∀ (φ,χ) ∈ set ?Φ'. ⊢ φ → χ" by fastforce
moreover
let ?ψ = "(λ (ψ, _, _). ψ) ω"
let ?σ = "(λ (_, σ, _). σ) ω"
let ?γ = "(λ (_, _, γ). γ) ω"
have "(λ(_, σ, γ). (γ, σ)) = (λ ω. ((λ (_, _, γ). γ) ω,(λ (_, σ, _). σ) ω))" by auto
hence "(λ(_, σ, γ). (γ, σ)) ω = (?γ, ?σ)" by metis
hence "⊢ ?γ → ?σ"
using Cons.prems(2) mset_subset_eqD Δ(3)
by fastforce
hence "⊢ (?ψ ⊔ ?γ) → (?ψ ⊔ ?σ)"
unfolding disjunction_def
using modus_ponens hypothetical_syllogism
by blast
moreover have
"(λ(ψ, σ, γ). (ψ ⊔ γ, ψ ⊔ σ)) =
(λ ω. (((λ (ψ, _, _). ψ) ω) ⊔ ((λ (_, _, γ). γ) ω),
((λ (ψ, _, _). ψ) ω) ⊔ ((λ (_, σ, _). σ) ω)))"
by auto
hence "(λ(ψ, σ, γ). (ψ ⊔ γ, ψ ⊔ σ)) ω = ((?ψ ⊔ ?γ), (?ψ ⊔ ?σ))" by metis
ultimately show ?case by simp
qed
ultimately show ?thesis
unfolding stronger_theory_relation_def
by blast
qed
hence "map (uncurry (⊔)) ?Θ :⊢ φ"
using Ψ(2)
stronger_theory_deduction_monotonic
[where Σ="map (uncurry (⊔)) Ψ"
and Γ="map (uncurry (⊔)) ?Θ"
and φ=φ]
by metis
moreover have
"(map (uncurry (→)) Ψ @ Σ ⊖ (map snd Ψ)) ≼
(map (uncurry (→)) ?Θ @ Γ ⊖ (map snd ?Θ))"
proof -
have "map (uncurry (→)) Ψ ≼ map (uncurry (→)) ?Θ"
proof -
let ?Φ = "map (λ (ψ, σ, γ). (ψ → γ, ψ → σ)) Ω"
have "map snd ?Φ = map (uncurry (→)) Ψ"
using Ω(1) by fastforce
moreover have "map fst ?Φ = map (uncurry (→)) ?Θ"
by fastforce
hence "mset (map fst ?Φ) ⊆# mset (map (uncurry (→)) ?Θ)"
by (metis subset_mset.dual_order.refl)
moreover
have "mset (map (λ(ψ, σ, _). (ψ, σ)) Ω) ⊆# mset Ψ"
using Ω(1) by simp
hence "∀ (φ,χ) ∈ set ?Φ. ⊢ φ → χ" using Ω(2)
proof (induct Ω)
case Nil
then show ?case by simp
next
case (Cons ω Ω)
let ?Φ = "map (λ (ψ, σ, γ). (ψ → γ, ψ → σ)) (ω # Ω)"
let ?Φ' = "map (λ (ψ, σ, γ). (ψ → γ, ψ → σ)) Ω"
have "mset (map (λ(ψ, σ, _). (ψ, σ)) Ω) ⊆# mset Ψ"
"mset (map (λ(_, σ, γ). (γ, σ)) Ω) ⊆# mset Δ"
using Cons.prems(1) Cons.prems(2) subset_mset.dual_order.trans by fastforce+
with Cons have "∀ (φ,χ) ∈ set ?Φ'. ⊢ φ → χ" by fastforce
moreover
let ?ψ = "(λ (ψ, _, _). ψ) ω"
let ?σ = "(λ (_, σ, _). σ) ω"
let ?γ = "(λ (_, _, γ). γ) ω"
have "(λ(_, σ, γ). (γ, σ)) = (λ ω. ((λ (_, _, γ). γ) ω,(λ (_, σ, _). σ) ω))" by auto
hence "(λ(_, σ, γ). (γ, σ)) ω = (?γ, ?σ)" by metis
hence "⊢ ?γ → ?σ"
using Cons.prems(2) mset_subset_eqD Δ(3)
by fastforce
hence "⊢ (?ψ → ?γ) → (?ψ → ?σ)"
using modus_ponens hypothetical_syllogism
by blast
moreover have
"(λ(ψ, σ, γ). (ψ → γ, ψ → σ)) =
(λ ω. (((λ (ψ, _, _). ψ) ω) → ((λ (_, _, γ). γ) ω),
((λ (ψ, _, _). ψ) ω) → ((λ (_, σ, _). σ) ω)))"
by auto
hence "(λ(ψ, σ, γ). (ψ → γ, ψ → σ)) ω = ((?ψ → ?γ), (?ψ → ?σ))" by metis
ultimately show ?case by simp
qed
ultimately show ?thesis
unfolding stronger_theory_relation_def
by blast
qed
moreover
have "(Σ ⊖ (map snd Ψ)) ≼ (Γ ⊖ (map snd ?Θ))"
proof -
let ?Δ = "Δ ⊖ (map (λ (_, σ, γ). (γ, σ)) Ω)"
have "mset (map fst ?Δ) ⊆# mset (Γ ⊖ (map snd ?Θ))"
using Δ(2)
by (metis Ω(2)
‹map snd (map (λ(ψ, _, γ). (ψ, γ)) Ω) =
map fst (map (λ(_, σ, γ). (γ, σ)) Ω)›
list_subtract_monotonic
map_list_subtract_mset_equivalence)
moreover
from Ω(2) have "mset ?Δ ⊆# mset Δ" by simp
hence "∀ (γ,σ) ∈ set ?Δ. ⊢ γ → σ"
using Δ(3)
by (metis mset_subset_eqD set_mset_mset)
moreover
have "map snd (map (λ(_, σ, γ). (γ, σ)) Ω) = map snd Ψ"
using Ω(1)
by (induct Ω, simp, fastforce)
hence "mset (map snd ?Δ) = mset (Σ ⊖ (map snd Ψ))"
by (metis Δ(1) Ω(2) map_list_subtract_mset_equivalence)
ultimately show ?thesis
by (metis stronger_theory_relation_alt_def)
qed
ultimately show ?thesis using stronger_theory_combine by blast
qed
hence "map (uncurry (→)) ?Θ @ Γ ⊖ (map snd ?Θ) $⊢ Φ"
using Ψ(3) Cons by blast
ultimately show ?case
by (metis measure_deduction.simps(2))
qed
lemma (in classical_logic) merge_witness_measure_deduction_intro:
assumes "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
and "map (uncurry (→)) Δ @ (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) ⊖ map snd Δ $⊢ Φ"
(is "?Γ⇩0 $⊢ Φ")
shows "map (uncurry (→)) (𝔍 Ψ Δ) @ Γ ⊖ map snd (𝔍 Ψ Δ) $⊢ Φ"
(is "?Γ $⊢ Φ")
proof -
let ?Σ = "𝔅 Ψ Δ"
let ?A = "map (uncurry (→)) Δ"
let ?B = "map (uncurry (→)) Ψ"
let ?C = "map snd ?Σ"
let ?D = "Γ ⊖ (map snd Ψ)"
let ?E = "map snd (Δ ⊖ ?Σ)"
have Σ: "mset ?Σ ⊆# mset Δ"
"mset ?C ⊆# mset ?B"
"mset ?E ⊆# mset ?D"
using assms(1)
second_component_msub
second_component_snd_projection_msub
second_component_diff_msub
by simp+
moreover
from calculation have
"image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
⊆# mset Γ - image_mset snd (mset Ψ)"
by simp
hence "mset Γ - image_mset snd (mset Ψ)
- image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
+ image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
= mset Γ - image_mset snd (mset Ψ)"
using subset_mset.diff_add by blast
then have "image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
+ ({#x → y. (x, y) ∈# mset Ψ#}
+ (mset Γ - (image_mset snd (mset Ψ)
+ image_mset snd (mset Δ - mset (𝔅 Ψ Δ)))))
= {#x → y. (x, y) ∈# mset Ψ#} + (mset Γ - image_mset snd (mset Ψ))"
by (simp add: union_commute)
with calculation have "mset ?Γ⇩0 = mset (?A @ (?B ⊖ ?C) @ (?D ⊖ ?E))"
by (simp, metis (no_types) add_diff_cancel_left image_mset_union subset_mset.diff_add)
moreover have "(?A @ (?B ⊖ ?C)) ≼ map (uncurry (→)) (𝔍 Ψ Δ)"
using second_component_merge_witness_stronger_theory by simp
moreover have "mset (?D ⊖ ?E) = mset (Γ ⊖ map snd (𝔍 Ψ Δ))"
using second_component_merge_witness_snd_projection
by simp
with calculation have "(?A @ (?B ⊖ ?C) @ (?D ⊖ ?E)) ≼ ?Γ"
by (metis
(no_types, lifting)
stronger_theory_combine
append.assoc
list_subtract_mset_homomorphism
msub_stronger_theory_intro
map_list_subtract_mset_containment
map_list_subtract_mset_equivalence
mset_subset_eq_add_right
subset_mset.add_diff_inverse
subset_mset.diff_add_assoc2)
ultimately have "?Γ⇩0 ≼ ?Γ"
unfolding stronger_theory_relation_alt_def
by simp
thus ?thesis
using assms(2) measure_stronger_theory_left_monotonic
by blast
qed
lemma (in classical_logic) measure_formula_right_split:
"Γ $⊢ (ψ ⊔ φ # ψ → φ # Φ) = Γ $⊢ (φ # Φ)"
proof (rule iffI)
assume "Γ $⊢ (φ # Φ)"
from this obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset Γ"
"map (uncurry (⊔)) Ψ :⊢ φ"
"(map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) $⊢ Φ"
by auto
let ?Ψ⇩1 = "zip (map (λ (χ,γ). ψ ⊔ χ) Ψ) (map snd Ψ)"
let ?Γ⇩1 = "map (uncurry (→)) ?Ψ⇩1 @ Γ ⊖ (map snd ?Ψ⇩1)"
let ?Ψ⇩2 = "zip (map (λ (χ,γ). ψ → χ) Ψ) (map (uncurry (→)) ?Ψ⇩1)"
let ?Γ⇩2 = "map (uncurry (→)) ?Ψ⇩2 @ ?Γ⇩1 ⊖ (map snd ?Ψ⇩2)"
have "map (uncurry (→)) Ψ ≼ map (uncurry (→)) ?Ψ⇩2"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons δ Ψ)
let ?χ = "fst δ"
let ?γ = "snd δ"
let ?Ψ⇩1 = "zip (map (λ (χ,γ). ψ ⊔ χ) Ψ) (map snd Ψ)"
let ?Ψ⇩2 = "zip (map (λ (χ,γ). ψ → χ) Ψ) (map (uncurry (→)) ?Ψ⇩1)"
let ?T⇩1 = "λ Ψ. map (uncurry (→)) (zip (map (λ (χ,γ). ψ ⊔ χ) Ψ) (map snd Ψ))"
let ?T⇩2 = "λ Ψ. map (uncurry (→)) (zip (map (λ (χ,γ). ψ → χ) Ψ) (?T⇩1 Ψ))"
{
fix δ :: "'a × 'a"
have "(λ (χ,γ). ψ ⊔ χ) = (λ δ. ψ ⊔ (fst δ))"
"(λ (χ,γ). ψ → χ) = (λ δ. ψ → (fst δ))"
by fastforce+
note functional_identities = this
have "(λ (χ,γ). ψ ⊔ χ) δ = ψ ⊔ (fst δ)"
"(λ (χ,γ). ψ → χ) δ = ψ → (fst δ)"
by (simp add: functional_identities)+
}
hence "?T⇩2 (δ # Ψ) = ((ψ → ?χ) → (ψ ⊔ ?χ) → ?γ) # (map (uncurry (→)) ?Ψ⇩2)"
by simp
moreover have "map (uncurry (→)) (δ # Ψ) = (?χ → ?γ) # map (uncurry (→)) Ψ"
by (simp add: case_prod_beta)
moreover
{
fix χ ψ γ
have "⊢ ((ψ → χ) → (ψ ⊔ χ) → γ) ↔ (χ → γ)"
proof -
have "∀ 𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ((❙⟨ψ❙⟩ → ❙⟨χ❙⟩) → (❙⟨ψ❙⟩ ⊔ ❙⟨χ❙⟩) → ❙⟨γ❙⟩) ↔ (❙⟨χ❙⟩ → ❙⟨γ❙⟩)"
by fastforce
hence "⊢ ❙⦇ ((❙⟨ψ❙⟩ → ❙⟨χ❙⟩) → (❙⟨ψ❙⟩ ⊔ ❙⟨χ❙⟩) → ❙⟨γ❙⟩) ↔ (❙⟨χ❙⟩ → ❙⟨γ❙⟩) ❙⦈"
using propositional_semantics by blast
thus ?thesis by simp
qed
}
hence identity: "⊢ ((ψ → ?χ) → (ψ ⊔ ?χ) → ?γ) → (?χ → ?γ)"
using biconditional_def by auto
assume "map (uncurry (→)) Ψ ≼ map (uncurry (→)) ?Ψ⇩2"
with identity have "((?χ → ?γ) # map (uncurry (→)) Ψ) ≼
(((ψ → ?χ) → (ψ ⊔ ?χ) → ?γ) # (map (uncurry (→)) ?Ψ⇩2))"
using stronger_theory_left_right_cons by blast
ultimately show ?case by simp
qed
hence "(map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ≼
((map (uncurry (→)) ?Ψ⇩2) @ Γ ⊖ (map snd Ψ))"
using stronger_theory_combine stronger_theory_reflexive by blast
moreover have "mset ?Γ⇩2 = mset ((map (uncurry (→)) ?Ψ⇩2) @ Γ ⊖ (map snd ?Ψ⇩1))"
by simp
ultimately have "(map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ≼ ?Γ⇩2"
by (simp add: stronger_theory_relation_def)
hence "?Γ⇩2 $⊢ Φ"
using Ψ(3) measure_stronger_theory_left_monotonic by blast
moreover
have "(map (uncurry (⊔)) ?Ψ⇩2) :⊢ ψ → φ"
proof -
let ?Γ = "map (λ (χ, γ). (ψ → χ) ⊔ (ψ ⊔ χ) → γ) Ψ"
let ?Σ = "map (λ (χ, γ). (ψ → (χ ⊔ γ))) Ψ"
have "map (uncurry (⊔)) ?Ψ⇩2 = ?Γ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons χ Ψ)
have "(λ φ. (case φ of (χ, γ) ⇒ ψ → χ) ⊔ (case φ of (χ, γ) ⇒ ψ ⊔ χ) → snd φ) =
(λ φ. (case φ of (χ, γ) ⇒ ψ → χ ⊔ (ψ ⊔ χ) → γ))"
by fastforce
hence "(case χ of (χ, γ) ⇒ ψ → χ) ⊔ (case χ of (χ, γ) ⇒ ψ ⊔ χ) → snd χ =
(case χ of (χ, γ) ⇒ ψ → χ ⊔ (ψ ⊔ χ) → γ)"
by metis
with Cons show ?case by simp
qed
moreover have "?Σ ≼ ?Γ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons δ Ψ)
let ?α = "(λ (χ, γ). (ψ → χ) ⊔ (ψ ⊔ χ) → γ) δ"
let ?β = "(λ (χ, γ). (ψ → (χ ⊔ γ))) δ"
let ?χ = "fst δ"
let ?γ = "snd δ"
have "(λ δ. (case δ of (χ, γ) ⇒ ψ → χ ⊔ (ψ ⊔ χ) → γ)) =
(λ δ. ψ → fst δ ⊔ (ψ ⊔ fst δ) → snd δ)"
"(λ δ. (case δ of (χ, γ) ⇒ ψ → (χ ⊔ γ))) = (λ δ. ψ → (fst δ ⊔ snd δ))"
by fastforce+
hence "?α = (ψ → ?χ) ⊔ (ψ ⊔ ?χ) → ?γ"
"?β = ψ → (?χ ⊔ ?γ)"
by metis+
moreover
{
fix ψ χ γ
have "⊢ ((ψ → χ) ⊔ (ψ ⊔ χ) → γ) → (ψ → (χ ⊔ γ))"
proof -
have "∀ 𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ((❙⟨ψ❙⟩ → ❙⟨χ❙⟩) ⊔ (❙⟨ψ❙⟩ ⊔ ❙⟨χ❙⟩) → ❙⟨γ❙⟩) → (❙⟨ψ❙⟩ → (❙⟨χ❙⟩ ⊔ ❙⟨γ❙⟩))"
by fastforce
hence "⊢ ❙⦇ ((❙⟨ψ❙⟩ → ❙⟨χ❙⟩) ⊔ (❙⟨ψ❙⟩ ⊔ ❙⟨χ❙⟩) → ❙⟨γ❙⟩) → (❙⟨ψ❙⟩ → (❙⟨χ❙⟩ ⊔ ❙⟨γ❙⟩)) ❙⦈"
using propositional_semantics by blast
thus ?thesis by simp
qed
}
ultimately have "⊢ ?α → ?β" by simp
thus ?case
using Cons
stronger_theory_left_right_cons
by simp
qed
moreover have "∀ φ. (map (uncurry (⊔)) Ψ) :⊢ φ ⟶ ?Σ :⊢ ψ → φ"
proof (induct Ψ)
case Nil
then show ?case
using axiom_k modus_ponens
by fastforce
next
case (Cons δ Ψ)
let ?δ' = "(λ (χ, γ). (ψ → (χ ⊔ γ))) δ"
let ?Σ = "map (λ (χ, γ). (ψ → (χ ⊔ γ))) Ψ"
let ?Σ' = "map (λ (χ, γ). (ψ → (χ ⊔ γ))) (δ # Ψ)"
{
fix φ
assume "map (uncurry (⊔)) (δ # Ψ) :⊢ φ"
hence "map (uncurry (⊔)) Ψ :⊢ (uncurry (⊔)) δ → φ"
using list_deduction_theorem
by simp
hence "?Σ :⊢ ψ → (uncurry (⊔)) δ → φ"
using Cons
by blast
moreover
{
fix α β γ
have "⊢ (α → β → γ) → ((α → β) → α → γ)"
using axiom_s by auto
}
ultimately have "?Σ :⊢ (ψ → (uncurry (⊔)) δ) → ψ → φ"
using list_deduction_weaken [where ?Γ="?Σ"]
list_deduction_modus_ponens [where ?Γ="?Σ"]
by metis
moreover
have "(λ δ. ψ → (uncurry (⊔)) δ) = (λ δ. (λ (χ, γ). (ψ → (χ ⊔ γ))) δ)"
by fastforce
ultimately have "?Σ :⊢ (λ (χ, γ). (ψ → (χ ⊔ γ))) δ → ψ → φ"
by metis
hence "?Σ' :⊢ ψ → φ"
using list_deduction_theorem
by simp
}
then show ?case by simp
qed
with Ψ(2) have "?Σ :⊢ ψ → φ"
by blast
ultimately show ?thesis
using stronger_theory_deduction_monotonic by auto
qed
moreover have "mset (map snd ?Ψ⇩2) ⊆# mset ?Γ⇩1" by simp
ultimately have "?Γ⇩1 $⊢ (ψ → φ # Φ)" using measure_deduction.simps(2) by blast
moreover have "⊢ (map (uncurry (⊔)) Ψ :→ φ) → (map (uncurry (⊔)) ?Ψ⇩1) :→ (ψ ⊔ φ)"
proof (induct Ψ)
case Nil
then show ?case
unfolding disjunction_def
using axiom_k modus_ponens
by fastforce
next
case (Cons ν Ψ)
let ?Δ = "map (uncurry (⊔)) Ψ"
let ?Δ' = "map (uncurry (⊔)) (ν # Ψ)"
let ?Σ = "map (uncurry (⊔)) (zip (map (λ (χ,γ). ψ ⊔ χ) Ψ) (map snd Ψ))"
let ?Σ' = "map (uncurry (⊔)) (zip (map (λ (χ,γ). ψ ⊔ χ) (ν # Ψ)) (map snd (ν # Ψ)))"
have "⊢ (?Δ' :→ φ) → (uncurry (⊔)) ν → ?Δ :→ φ"
by (simp, metis axiom_k axiom_s modus_ponens)
with Cons have "⊢ (?Δ' :→ φ) → (uncurry (⊔)) ν → ?Σ :→ (ψ ⊔ φ)"
using hypothetical_syllogism modus_ponens
by blast
hence "(?Δ' :→ φ) # ((uncurry (⊔)) ν) # ?Σ :⊢ ψ ⊔ φ"
by (simp add: list_deduction_def)
moreover have "set ((?Δ' :→ φ) # ((uncurry (⊔)) ν) # ?Σ) =
set (((uncurry (⊔)) ν) # (?Δ' :→ φ) # ?Σ)"
by fastforce
ultimately have "((uncurry (⊔)) ν) # (?Δ' :→ φ) # ?Σ :⊢ ψ ⊔ φ"
using list_deduction_monotonic by blast
hence "(?Δ' :→ φ) # ?Σ :⊢ ((uncurry (⊔)) ν) → (ψ ⊔ φ)"
using list_deduction_theorem
by simp
moreover
let ?χ = "fst ν"
let ?γ = "snd ν"
have "(λ ν . (uncurry (⊔)) ν) = (λ ν. fst ν ⊔ snd ν)"
by fastforce
hence "(uncurry (⊔)) ν = ?χ ⊔ ?γ" by simp
ultimately have "(?Δ' :→ φ) # ?Σ :⊢ (?χ ⊔ ?γ) → (ψ ⊔ φ)" by simp
moreover
{
fix α β δ γ
have "⊢ ((β ⊔ α) → (γ ⊔ δ)) → ((γ ⊔ β) ⊔ α) → (γ ⊔ δ)"
proof -
have "∀ 𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ((❙⟨β❙⟩ ⊔ ❙⟨α❙⟩) → (❙⟨γ❙⟩ ⊔ ❙⟨δ❙⟩)) → ((❙⟨γ❙⟩ ⊔ ❙⟨β❙⟩) ⊔ ❙⟨α❙⟩) → (❙⟨γ❙⟩ ⊔ ❙⟨δ❙⟩)"
by fastforce
hence "⊢ ❙⦇ ((❙⟨β❙⟩ ⊔ ❙⟨α❙⟩) → (❙⟨γ❙⟩ ⊔ ❙⟨δ❙⟩)) → ((❙⟨γ❙⟩ ⊔ ❙⟨β❙⟩) ⊔ ❙⟨α❙⟩) → (❙⟨γ❙⟩ ⊔ ❙⟨δ❙⟩) ❙⦈"
using propositional_semantics by blast
thus ?thesis by simp
qed
}
hence "(?Δ' :→ φ) # ?Σ :⊢ ((?χ ⊔ ?γ) → (ψ ⊔ φ)) → ((ψ ⊔ ?χ) ⊔ ?γ) → (ψ ⊔ φ)"
using list_deduction_weaken by blast
ultimately have "(?Δ' :→ φ) # ?Σ :⊢ ((ψ ⊔ ?χ) ⊔ ?γ) → (ψ ⊔ φ)"
using list_deduction_modus_ponens by blast
hence "((ψ ⊔ ?χ) ⊔ ?γ) # (?Δ' :→ φ) # ?Σ :⊢ ψ ⊔ φ"
using list_deduction_theorem
by simp
moreover have "set (((ψ ⊔ ?χ) ⊔ ?γ) # (?Δ' :→ φ) # ?Σ) =
set ((?Δ' :→ φ) # ((ψ ⊔ ?χ) ⊔ ?γ) # ?Σ)"
by fastforce
moreover have
"map (uncurry (⊔)) (ν # Ψ) :→ φ
# (ψ ⊔ fst ν) ⊔ snd ν
# map (uncurry (⊔)) (zip (map (λ(_, a). ψ ⊔ a) Ψ) (map snd Ψ)) :⊢ (ψ ⊔ fst ν) ⊔ snd ν"
by (meson list.set_intros(1)
list_deduction_monotonic
list_deduction_reflection
set_subset_Cons)
ultimately have "(?Δ' :→ φ) # ((ψ ⊔ ?χ) ⊔ ?γ) # ?Σ :⊢ ψ ⊔ φ"
using list_deduction_modus_ponens list_deduction_monotonic by blast
moreover
have "(λ ν. ψ ⊔ fst ν) = (λ (χ, γ). ψ ⊔ χ)"
by fastforce
hence "ψ ⊔ fst ν = (λ (χ, γ). ψ ⊔ χ) ν"
by metis
hence "((ψ ⊔ ?χ) ⊔ ?γ) # ?Σ = ?Σ'"
by simp
ultimately have "(?Δ' :→ φ) # ?Σ' :⊢ ψ ⊔ φ" by simp
then show ?case by (simp add: list_deduction_def)
qed
with Ψ(2) have "map (uncurry (⊔)) ?Ψ⇩1 :⊢ (ψ ⊔ φ)"
unfolding list_deduction_def
using modus_ponens
by blast
moreover have "mset (map snd ?Ψ⇩1) ⊆# mset Γ" using Ψ(1) by simp
ultimately show "Γ $⊢ (ψ ⊔ φ # ψ → φ # Φ)"
using measure_deduction.simps(2) by blast
next
assume "Γ $⊢ (ψ ⊔ φ # ψ → φ # Φ)"
from this obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset Γ"
"map (uncurry (⊔)) Ψ :⊢ ψ ⊔ φ"
"map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ) $⊢ (ψ → φ # Φ)"
using measure_deduction.simps(2) by blast
let ?Γ' = "map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)"
from Ψ obtain Δ where Δ:
"mset (map snd Δ) ⊆# mset ?Γ'"
"map (uncurry (⊔)) Δ :⊢ ψ → φ"
"(map (uncurry (→)) Δ @ ?Γ' ⊖ (map snd Δ)) $⊢ Φ"
using measure_deduction.simps(2) by blast
let ?Ω = "𝔍 Ψ Δ"
have "mset (map snd ?Ω) ⊆# mset Γ"
using Δ(1) Ψ(1) merge_witness_msub_intro
by blast
moreover have "map (uncurry (⊔)) ?Ω :⊢ φ"
proof -
have "map (uncurry (⊔)) ?Ω :⊢ ψ ⊔ φ"
"map (uncurry (⊔)) ?Ω :⊢ ψ → φ"
using Ψ(2) Δ(2)
stronger_theory_deduction_monotonic
right_merge_witness_stronger_theory
left_merge_witness_stronger_theory
by blast+
moreover
have "⊢ (ψ ⊔ φ) → (ψ → φ) → φ"
unfolding disjunction_def
using modus_ponens excluded_middle_elimination flip_implication
by blast
ultimately show ?thesis
using list_deduction_weaken list_deduction_modus_ponens
by blast
qed
moreover have "map (uncurry (→)) ?Ω @ Γ ⊖ (map snd ?Ω) $⊢ Φ"
using Δ(1) Δ(3) Ψ(1) merge_witness_measure_deduction_intro by blast
ultimately show "Γ $⊢ (φ # Φ)"
using measure_deduction.simps(2) by blast
qed
primrec (in implication_logic)
X_witness :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔛")
where
"𝔛 Ψ [] = []"
| "𝔛 Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ δ # 𝔛 Ψ Δ
| Some ψ ⇒ (fst ψ → fst δ, snd ψ) # (𝔛 (remove1 ψ Ψ) Δ))"
primrec (in implication_logic)
X_component :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔛⇩∙")
where
"𝔛⇩∙ Ψ [] = []"
| "𝔛⇩∙ Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ 𝔛⇩∙ Ψ Δ
| Some ψ ⇒ (fst ψ → fst δ, snd ψ) # (𝔛⇩∙ (remove1 ψ Ψ) Δ))"
primrec (in implication_logic)
Y_witness :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔜")
where
"𝔜 Ψ [] = Ψ"
| "𝔜 Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ 𝔜 Ψ Δ
| Some ψ ⇒ (fst ψ, (fst ψ → fst δ) → snd ψ) #
(𝔜 (remove1 ψ Ψ) Δ))"
primrec (in implication_logic)
Y_component :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔜⇩∙")
where
"𝔜⇩∙ Ψ [] = []"
| "𝔜⇩∙ Ψ (δ # Δ) =
(case find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ of
None ⇒ 𝔜⇩∙ Ψ Δ
| Some ψ ⇒ (fst ψ, (fst ψ → fst δ) → snd ψ) #
(𝔜⇩∙ (remove1 ψ Ψ) Δ))"
lemma (in implication_logic) X_witness_right_empty [simp]:
"𝔛 [] Δ = Δ"
by (induct Δ, simp+)
lemma (in implication_logic) Y_witness_right_empty [simp]:
"𝔜 [] Δ = []"
by (induct Δ, simp+)
lemma (in implication_logic) X_witness_map_snd_decomposition:
"mset (map snd (𝔛 Ψ Δ)) = mset (map snd ((𝔄 Ψ Δ) @ (Δ ⊖ (𝔅 Ψ Δ))))"
proof -
have "∀Ψ. mset (map snd (𝔛 Ψ Δ)) = mset (map snd ((𝔄 Ψ Δ) @ (Δ ⊖ (𝔅 Ψ Δ))))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map snd (𝔛 Ψ (δ # Δ)))
= mset (map snd (𝔄 Ψ (δ # Δ) @ (δ # Δ) ⊖ 𝔅 Ψ (δ # Δ)))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None",
simp,
metis (no_types, lifting)
add_mset_add_single
image_mset_single
image_mset_union
mset_subset_eq_multiset_union_diff_commute
second_component_msub,
fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) Y_witness_map_snd_decomposition:
"mset (map snd (𝔜 Ψ Δ)) = mset (map snd ((Ψ ⊖ (𝔄 Ψ Δ)) @ (𝔜⇩∙ Ψ Δ)))"
proof -
have "∀ Ψ. mset (map snd (𝔜 Ψ Δ)) = mset (map snd ((Ψ ⊖ (𝔄 Ψ Δ)) @ (𝔜⇩∙ Ψ Δ)))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map snd (𝔜 Ψ (δ # Δ))) = mset (map snd (Ψ ⊖ 𝔄 Ψ (δ # Δ) @ 𝔜⇩∙ Ψ (δ # Δ)))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None", fastforce+)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) X_witness_msub:
assumes "mset (map snd Ψ) ⊆# mset Γ"
and "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
shows "mset (map snd (𝔛 Ψ Δ)) ⊆# mset Γ"
proof -
have "mset (map snd (Δ ⊖ (𝔅 Ψ Δ))) ⊆# mset (Γ ⊖ (map snd Ψ))"
using assms second_component_diff_msub by blast
moreover have "mset (map snd (𝔄 Ψ Δ)) ⊆# mset (map snd Ψ)"
using first_component_msub
by (simp add: image_mset_subseteq_mono)
moreover have "mset ((map snd Ψ) @ (Γ ⊖ map snd Ψ)) = mset Γ"
using assms(1)
by simp
moreover have "image_mset snd (mset (𝔄 Ψ Δ)) + image_mset snd (mset (Δ ⊖ 𝔅 Ψ Δ))
= mset (map snd (𝔛 Ψ Δ))"
using X_witness_map_snd_decomposition by force
ultimately
show ?thesis
by (metis (no_types) mset_append mset_map subset_mset.add_mono)
qed
lemma (in implication_logic) Y_component_msub:
"mset (map snd (𝔜⇩∙ Ψ Δ)) ⊆# mset (map (uncurry (→)) (𝔛 Ψ Δ))"
proof -
have "∀ Ψ. mset (map snd (𝔜⇩∙ Ψ Δ)) ⊆# mset (map (uncurry (→)) (𝔛 Ψ Δ))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (map snd (𝔜⇩∙ Ψ (δ # Δ))) ⊆# mset (map (uncurry (→)) (𝔛 Ψ (δ # Δ)))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None",
simp, metis add_mset_add_single
mset_subset_eq_add_left
subset_mset.order_trans,
fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) Y_witness_msub:
assumes "mset (map snd Ψ) ⊆# mset Γ"
and "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
shows "mset (map snd (𝔜 Ψ Δ)) ⊆#
mset (map (uncurry (→)) (𝔛 Ψ Δ) @ Γ ⊖ map snd (𝔛 Ψ Δ))"
proof -
have A: "image_mset snd (mset Ψ) ⊆# mset Γ" using assms by simp
have B: "image_mset snd (mset (𝔄 Ψ Δ)) + image_mset snd (mset Δ - mset (𝔅 Ψ Δ)) ⊆# mset Γ"
using A X_witness_map_snd_decomposition assms(2) X_witness_msub by auto
have "mset Γ - image_mset snd (mset Ψ) = mset (Γ ⊖ map snd Ψ)"
by simp
then have C: "mset (map snd (Δ ⊖ 𝔅 Ψ Δ)) + image_mset snd (mset Ψ) ⊆# mset Γ"
using A by (metis (full_types) assms(2) second_component_diff_msub subset_mset.le_diff_conv2)
have "image_mset snd (mset (Ψ ⊖ 𝔄 Ψ Δ)) + image_mset snd (mset (𝔄 Ψ Δ)) = image_mset snd (mset Ψ)"
by (metis (no_types) image_mset_union
list_subtract_mset_homomorphism
first_component_msub
subset_mset.diff_add)
then have "image_mset snd (mset Ψ - mset (𝔄 Ψ Δ))
+ (image_mset snd (mset (𝔄 Ψ Δ)) + image_mset snd (mset Δ - mset (𝔅 Ψ Δ)))
= mset (map snd (Δ ⊖ 𝔅 Ψ Δ)) + image_mset snd (mset Ψ)"
by (simp add: union_commute)
then have "image_mset snd (mset Ψ - mset (𝔄 Ψ Δ))
⊆# mset Γ - (image_mset snd (mset (𝔄 Ψ Δ)) + image_mset snd (mset Δ - mset (𝔅 Ψ Δ)))"
by (metis (no_types) B C subset_mset.le_diff_conv2)
hence "mset (map snd (Ψ ⊖ 𝔄 Ψ Δ)) ⊆# mset (Γ ⊖ map snd (𝔛 Ψ Δ))"
using assms X_witness_map_snd_decomposition
by simp
thus ?thesis
using Y_component_msub
Y_witness_map_snd_decomposition
by (simp add: mset_subset_eq_mono_add union_commute)
qed
lemma (in classical_logic) X_witness_right_stronger_theory:
"map (uncurry (⊔)) Δ ≼ map (uncurry (⊔)) (𝔛 Ψ Δ)"
proof -
have "∀ Ψ. map (uncurry (⊔)) Δ ≼ map (uncurry (⊔)) (𝔛 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "map (uncurry (⊔)) (δ # Δ) ≼ map (uncurry (⊔)) (𝔛 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis
using Cons
by (simp add: stronger_theory_left_right_cons
trivial_implication)
next
case False
from this obtain ψ where
ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
"ψ ∈ set Ψ"
"(fst ψ → snd ψ) = snd δ"
using find_Some_set_membership
find_Some_predicate
by fastforce
let ?Ψ' = "remove1 ψ Ψ"
let ?α = "fst ψ"
let ?β = "snd ψ"
let ?γ = "fst δ"
have "map (uncurry (⊔)) Δ ≼ map (uncurry (⊔)) (𝔛 ?Ψ' Δ)"
using Cons by simp
moreover
have "(uncurry (⊔)) = (λ δ. fst δ ⊔ snd δ)" by fastforce
hence "(uncurry (⊔)) δ = ?γ ⊔ (?α → ?β)" using ψ(3) by fastforce
moreover
{
fix α β γ
have "⊢ (α → γ ⊔ β) → (γ ⊔ (α → β))"
proof -
let ?φ = "(❙⟨α❙⟩ → ❙⟨γ❙⟩ ⊔ ❙⟨β❙⟩) → (❙⟨γ❙⟩ ⊔ (❙⟨α❙⟩ → ❙⟨β❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
hence "⊢ (?α → ?γ ⊔ ?β) → (?γ ⊔ (?α → ?β))" by simp
ultimately
show ?thesis using ψ
by (simp add: stronger_theory_left_right_cons)
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in classical_logic) Y_witness_left_stronger_theory:
"map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔜 Ψ Δ)"
proof -
have "∀ Ψ. map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔜 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) (𝔜 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
then show ?thesis using Cons by simp
next
case False
from this obtain ψ where
ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
"ψ ∈ set Ψ"
"(uncurry (⊔)) ψ = fst ψ ⊔ snd ψ"
using find_Some_set_membership
by fastforce
let ?φ = "fst ψ ⊔ (fst ψ → fst δ) → snd ψ"
let ?Ψ' = "remove1 ψ Ψ"
have "map (uncurry (⊔)) ?Ψ' ≼ map (uncurry (⊔)) (𝔜 ?Ψ' Δ)"
using Cons by simp
moreover
{
fix α β γ
have "⊢ (α ⊔ (α → γ) → β) → (α ⊔ β)"
proof -
let ?φ = "(❙⟨α❙⟩ ⊔ (❙⟨α❙⟩ → ❙⟨γ❙⟩) → ❙⟨β❙⟩) → (❙⟨α❙⟩ ⊔ ❙⟨β❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
hence "⊢ ?φ → (uncurry (⊔)) ψ" using ψ(3) by auto
ultimately
have "map (uncurry (⊔)) (ψ # ?Ψ') ≼ (?φ # map (uncurry (⊔)) (𝔜 ?Ψ' Δ))"
by (simp add: stronger_theory_left_right_cons)
moreover
from ψ have "mset (map (uncurry (⊔)) (ψ # ?Ψ')) = mset (map (uncurry (⊔)) Ψ)"
by (metis mset_map perm_remove)
ultimately show ?thesis
using stronger_theory_relation_alt_def ψ(1) by auto
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) X_witness_second_component_diff_decomposition:
"mset (𝔛 Ψ Δ) = mset (𝔛⇩∙ Ψ Δ @ Δ ⊖ 𝔅 Ψ Δ)"
proof -
have "∀ Ψ. mset (𝔛 Ψ Δ) = mset (𝔛⇩∙ Ψ Δ @ Δ ⊖ 𝔅 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (𝔛 Ψ (δ # Δ)) =
mset (𝔛⇩∙ Ψ (δ # Δ) @ (δ # Δ) ⊖ 𝔅 Ψ (δ # Δ))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None",
simp, metis add_mset_add_single second_component_msub subset_mset.diff_add_assoc2,
fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) Y_witness_first_component_diff_decomposition:
"mset (𝔜 Ψ Δ) = mset (Ψ ⊖ 𝔄 Ψ Δ @ 𝔜⇩∙ Ψ Δ)"
proof -
have "∀ Ψ. mset (𝔜 Ψ Δ) = mset (Ψ ⊖ 𝔄 Ψ Δ @ 𝔜⇩∙ Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "mset (𝔜 Ψ (δ # Δ)) =
mset (Ψ ⊖ 𝔄 Ψ (δ # Δ) @ 𝔜⇩∙ Ψ (δ # Δ))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None", simp, fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) Y_witness_right_stronger_theory:
"map (uncurry (→)) Δ ≼ map (uncurry (→)) (𝔜 Ψ Δ ⊖ (Ψ ⊖ 𝔄 Ψ Δ) @ (Δ ⊖ 𝔅 Ψ Δ))"
proof -
let ?𝔣 = "λΨ Δ. (Ψ ⊖ 𝔄 Ψ Δ)"
let ?𝔤 = "λ Ψ Δ. (Δ ⊖ 𝔅 Ψ Δ)"
have "∀ Ψ. map (uncurry (→)) Δ ≼ map (uncurry (→)) (𝔜 Ψ Δ ⊖ ?𝔣 Ψ Δ @ ?𝔤 Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
let ?δ = "(uncurry (→)) δ"
{
fix Ψ
have "map (uncurry (→)) (δ # Δ)
≼ map (uncurry (→)) (𝔜 Ψ (δ # Δ) ⊖ ?𝔣 Ψ (δ # Δ) @ ?𝔤 Ψ (δ # Δ))"
proof (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None")
case True
moreover
from Cons have
"map (uncurry (→)) (δ # Δ) ≼ map (uncurry (→)) (δ # 𝔜 Ψ Δ ⊖ ?𝔣 Ψ Δ @ ?𝔤 Ψ Δ)"
by (simp add: stronger_theory_left_right_cons trivial_implication)
moreover
have "mset (map (uncurry (→)) (δ # 𝔜 Ψ Δ ⊖ ?𝔣 Ψ Δ @ ?𝔤 Ψ Δ))
= mset (map (uncurry (→)) (𝔜 Ψ Δ ⊖ ?𝔣 Ψ Δ @ ((δ # Δ) ⊖ 𝔅 Ψ Δ)))"
by (simp,
metis (no_types, lifting)
add_mset_add_single
image_mset_single
image_mset_union
second_component_msub
mset_subset_eq_multiset_union_diff_commute)
moreover have
"∀Ψ Φ. Ψ ≼ Φ
= (∃Σ. map snd Σ = Ψ
∧ mset (map fst Σ) ⊆# mset Φ
∧ (∀ξ. ξ ∉ set Σ ∨ ⊢ (uncurry (→) ξ)))"
by (simp add: Ball_def_raw stronger_theory_relation_def)
moreover have
"((uncurry (→) δ) # map (uncurry (→)) Δ)
≼ ((uncurry (→) δ) # map (uncurry (→)) (𝔜 Ψ Δ ⊖ (?𝔣 Ψ Δ))
@ map (uncurry (→)) (?𝔤 Ψ Δ))"
using calculation by auto
ultimately show ?thesis
by (simp, metis union_mset_add_mset_right)
next
case False
from this obtain ψ where
ψ: "find (λψ. uncurry (→) ψ = snd δ) Ψ = Some ψ"
"uncurry (→) ψ = snd δ"
using find_Some_predicate
by fastforce
let ?α = "fst ψ"
let ?β = "fst δ"
let ?γ = "snd ψ"
have "(λ δ. fst δ → snd δ) = uncurry (→)" by fastforce
hence "?β → ?α → ?γ = uncurry (→) δ" using ψ(2) by metis
moreover
let ?A = "𝔜 (remove1 ψ Ψ) Δ"
let ?B = "𝔄 (remove1 ψ Ψ) Δ"
let ?C = "𝔅 (remove1 ψ Ψ) Δ"
let ?D = "?A ⊖ ((remove1 ψ Ψ) ⊖ ?B)"
have "mset ((remove1 ψ Ψ) ⊖ ?B) ⊆# mset ?A"
using Y_witness_first_component_diff_decomposition by simp
{
assume "mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)) ⊆# mset (𝔜 (remove1 ψ Ψ) Δ)"
moreover have B: "∀Φ Ψ. ∃Δ. Ψ ⊆# Φ ⟶ Ψ + Δ = Φ"
by (metis subset_mset.le_iff_add)
moreover obtain f where
A: "mset (𝔜 (remove1 ψ Ψ) Δ)
- (mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
= f (mset (𝔜 (remove1 ψ Ψ) Δ))
(mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))"
by blast
ultimately obtain g where
B: "∀ p. add_mset p (mset (𝔜 (remove1 ψ Ψ) Δ))
- (mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
= add_mset p
(g (mset (𝔜 (remove1 ψ Ψ) Δ))
(mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ))))"
by (metis add_diff_cancel_left' union_mset_add_mset_right)
have "g (mset (𝔜 (remove1 ψ Ψ) Δ))
(mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
= add_mset (fst ψ, (fst ψ → fst δ) → snd ψ)
(mset (𝔜 (remove1 ψ Ψ) Δ))
- (mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
- {#(fst ψ, (fst ψ → fst δ) → snd ψ)#}"
by (simp add: B)
then have C:
"g (mset (𝔜 (remove1 ψ Ψ) Δ))
(mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
= mset (𝔜 (remove1 ψ Ψ) Δ)
- (mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))"
by simp
let ?S⇩1 =
"{# x → y.
(x, y) ∈# add_mset (fst ψ, (fst ψ → fst δ) → snd ψ)
(mset (𝔜 (remove1 ψ Ψ) Δ))
- (mset Ψ - add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
#}"
let ?S⇩2 =
"add_mset
(fst ψ → (fst ψ → fst δ) → snd ψ)
{# x → y.
(x, y) ∈# mset (𝔜 (remove1 ψ Ψ) Δ)
- (mset Ψ
- add_mset ψ (mset (𝔄 (remove1 ψ Ψ) Δ)))
#}"
have "?S⇩1 = ?S⇩2"
using A C by (simp add: B)
}
hence "mset (map (uncurry (→))
(((?α, (?α → ?β) → ?γ) # ?A) ⊖ remove1 ψ (Ψ ⊖ ?B)
@ (remove1 δ ((δ # Δ) ⊖ ?C))))
= mset ((?α → (?α → ?β) → ?γ) # map (uncurry (→)) (?D @ (Δ ⊖ ?C)))"
using
add_mset_add_single
image_mset_add_mset
prod.simps(2)
subset_mset.diff_add_assoc2
‹mset (remove1 ψ Ψ ⊖ 𝔄 (remove1 ψ Ψ) Δ) ⊆# mset (𝔜 (remove1 ψ Ψ) Δ)›
by fastforce
moreover
have "⊢ (?α → (?α → ?β) → ?γ) → ?β → ?α → ?γ"
proof -
let ?Γ = "[(?α → (?α → ?β) → ?γ), ?β, ?α]"
have "?Γ :⊢ ?α → (?α → ?β) → ?γ"
"?Γ :⊢ ?α"
by (simp add: list_deduction_reflection)+
hence "?Γ :⊢ (?α → ?β) → ?γ"
using list_deduction_modus_ponens by blast
moreover have "?Γ :⊢ ?β"
by (simp add: list_deduction_reflection)
hence "?Γ :⊢ ?α → ?β"
using axiom_k list_deduction_modus_ponens list_deduction_weaken by blast
ultimately have "?Γ :⊢ ?γ"
using list_deduction_modus_ponens by blast
thus ?thesis
unfolding list_deduction_def by simp
qed
hence "(?β → ?α → ?γ # map (uncurry (→)) Δ) ≼
(?α → (?α → ?β) → ?γ # map (uncurry (→)) (?D @ (Δ ⊖ ?C)))"
using Cons stronger_theory_left_right_cons by blast
ultimately show ?thesis
using ψ by (simp add: stronger_theory_relation_alt_def)
qed
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in implication_logic) xcomponent_ycomponent_connection:
"map (uncurry (→)) (𝔛⇩∙ Ψ Δ) = map snd (𝔜⇩∙ Ψ Δ)"
proof -
have "∀ Ψ. map (uncurry (→)) (𝔛⇩∙ Ψ Δ) = map snd (𝔜⇩∙ Ψ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Ψ
have "map (uncurry (→)) (𝔛⇩∙ Ψ (δ # Δ)) = map snd (𝔜⇩∙ Ψ (δ # Δ))"
using Cons
by (cases "find (λ ψ. (uncurry (→)) ψ = snd δ) Ψ = None", simp, fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in classical_logic) xwitness_ywitness_measure_deduction_intro:
assumes "mset (map snd Ψ) ⊆# mset Γ"
and "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ))"
and "map (uncurry (→)) Δ @ (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) ⊖ map snd Δ $⊢ Φ"
(is "?Γ⇩0 $⊢ Φ")
shows "map (uncurry (→)) (𝔜 Ψ Δ) @
(map (uncurry (→)) (𝔛 Ψ Δ) @ Γ ⊖ map snd (𝔛 Ψ Δ)) ⊖
map snd (𝔜 Ψ Δ) $⊢ Φ"
(is "?Γ $⊢ Φ")
proof -
let ?A = "map (uncurry (→)) (𝔜 Ψ Δ)"
let ?B = "map (uncurry (→)) (𝔛 Ψ Δ)"
let ?C = "Ψ ⊖ 𝔄 Ψ Δ"
let ?D = "map (uncurry (→)) ?C"
let ?E = "Δ ⊖ 𝔅 Ψ Δ"
let ?F = "map (uncurry (→)) ?E"
let ?G = "map snd (𝔅 Ψ Δ)"
let ?H = "map (uncurry (→)) (𝔛⇩∙ Ψ Δ)"
let ?I = "𝔄 Ψ Δ"
let ?J = "map snd (𝔛 Ψ Δ)"
let ?K = "map snd (𝔜 Ψ Δ)"
have "mset (map (uncurry (→)) (𝔜 Ψ Δ ⊖ ?C @ ?E)) = mset (?A ⊖ ?D @ ?F)"
by (simp add: Y_witness_first_component_diff_decomposition)
hence "(map (uncurry (→)) Δ) ≼ (?A ⊖ ?D @ ?F)"
using Y_witness_right_stronger_theory
stronger_theory_relation_alt_def
by (simp, metis (no_types, lifting))
hence "?Γ⇩0 ≼ ((?A ⊖ ?D @ ?F) @ (map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) ⊖ map snd Δ)"
using stronger_theory_combine stronger_theory_reflexive by blast
moreover
have ♠: "mset ?G ⊆# mset (map (uncurry (→)) Ψ)"
"mset (𝔅 Ψ Δ) ⊆# mset Δ"
"mset (map snd ?E) ⊆# mset (Γ ⊖ map snd Ψ)"
"mset (map (uncurry (→)) Ψ ⊖ ?G) = mset ?D"
"mset ?D ⊆# mset ?A"
"mset (map snd ?I) ⊆# mset (map snd Ψ)"
"mset (map snd ?I) ⊆# mset Γ"
"mset (map snd (?I @ ?E)) = mset ?J"
using second_component_msub
second_component_diff_msub
second_component_snd_projection_msub
first_component_second_component_mset_connection
X_witness_map_snd_decomposition
by (simp,
simp,
metis assms(2),
simp add: image_mset_Diff first_component_msub,
simp add: Y_witness_first_component_diff_decomposition,
simp add: image_mset_subseteq_mono first_component_msub,
metis assms(1) first_component_msub map_monotonic subset_mset.dual_order.trans,
simp)
hence "mset Δ - mset (𝔅 Ψ Δ) + mset (𝔅 Ψ Δ) = mset Δ"
by simp
hence ♡: "{#x → y. (x, y) ∈# mset Ψ#} + (mset Γ - image_mset snd (mset Ψ))
- image_mset snd (mset Δ)
= {#x → y. (x, y) ∈# mset Ψ#} + (mset Γ - image_mset snd (mset Ψ))
- image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
- image_mset snd (mset (𝔅 Ψ Δ))"
"image_mset snd (mset Ψ - mset (𝔄 Ψ Δ)) + image_mset snd (mset (𝔄 Ψ Δ))
= image_mset snd (mset Ψ)"
using ♠
by (metis (no_types) diff_diff_add_mset image_mset_union,
metis (no_types) image_mset_union first_component_msub subset_mset.diff_add)
then have "mset Γ - image_mset snd (mset Ψ)
- image_mset snd (mset Δ - mset (𝔅 Ψ Δ))
= mset Γ - (image_mset snd (mset Ψ - mset (𝔄 Ψ Δ))
+ image_mset snd (mset (𝔛 Ψ Δ)))"
using ♠ by (simp, metis (full_types) diff_diff_add_mset)
hence "mset ((map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ) ⊖ map snd Δ)
= mset (?D @ (Γ ⊖ ?J) ⊖ map snd ?C)"
using ♡ ♠ by (simp, metis (no_types) add.commute subset_mset.add_diff_assoc)
ultimately have "?Γ⇩0 ≼ ((?A ⊖ ?D @ ?F) @ ?D @ (Γ ⊖ ?J) ⊖ map snd ?C)"
unfolding stronger_theory_relation_alt_def
by simp
moreover
have "mset ?F = mset (?B ⊖ ?H)"
"mset ?D ⊆# mset ?A"
"mset (map snd (Ψ ⊖ ?I)) ⊆# mset (Γ ⊖ ?J)"
by (simp add: X_witness_second_component_diff_decomposition,
simp add: Y_witness_first_component_diff_decomposition,
simp, metis (no_types, lifting)
♡(2) ♠(8) add.assoc assms(1) assms(2) image_mset_union
X_witness_msub merge_witness_msub_intro
second_component_merge_witness_snd_projection
mset_map
subset_mset.le_diff_conv2
union_code)
hence "mset ((?A ⊖ ?D @ ?F) @ ?D @ (Γ ⊖ ?J) ⊖ map snd ?C)
= mset (?A @ (?B ⊖ ?H @ Γ ⊖ ?J) ⊖ map snd ?C)"
"mset ?H ⊆# mset ?B"
"{#x → y. (x, y) ∈# mset (𝔛⇩∙ Ψ Δ)#} = mset (map snd (𝔜⇩∙ Ψ Δ))"
by (simp add: subset_mset.diff_add_assoc,
simp add: X_witness_second_component_diff_decomposition,
metis xcomponent_ycomponent_connection mset_map uncurry_def)
hence "mset ((?A ⊖ ?D @ ?F) @ ?D @ (Γ ⊖ ?J) ⊖ map snd ?C)
= mset (?A @ (?B @ Γ ⊖ ?J) ⊖ (?H @ map snd ?C))"
"{#x → y. (x, y) ∈# mset (𝔛⇩∙ Ψ Δ)#} + image_mset snd (mset Ψ - mset (𝔄 Ψ Δ))
= mset (map snd (𝔜 Ψ Δ))"
using Y_witness_map_snd_decomposition
by (simp add: subset_mset.diff_add_assoc, force)
hence "mset ((?A ⊖ ?D @ ?F) @ ?D @ (Γ ⊖ ?J) ⊖ map snd ?C)
= mset (?A @ (?B @ Γ ⊖ ?J) ⊖ ?K)"
by (simp)
ultimately have "?Γ⇩0 ≼ (?A @ (?B @ Γ ⊖ ?J) ⊖ ?K)"
unfolding stronger_theory_relation_alt_def
by metis
thus ?thesis
using assms(3) measure_stronger_theory_left_monotonic
by blast
qed
lemma (in classical_logic) measure_cons_cons_right_permute:
assumes "Γ $⊢ (φ # ψ # Φ)"
shows "Γ $⊢ (ψ # φ # Φ)"
proof -
from assms obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset Γ"
"map (uncurry (⊔)) Ψ :⊢ φ"
"map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ) $⊢ (ψ # Φ)"
by fastforce
let ?Γ⇩0 = "map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)"
from Ψ(3) obtain Δ where Δ:
"mset (map snd Δ) ⊆# mset ?Γ⇩0"
"map (uncurry (⊔)) Δ :⊢ ψ"
"(map (uncurry (→)) Δ @ ?Γ⇩0 ⊖ (map snd Δ)) $⊢ Φ"
using measure_deduction.simps(2) by blast
let ?Ψ' = "𝔛 Ψ Δ"
let ?Γ⇩1 = "map (uncurry (→)) ?Ψ' @ Γ ⊖ (map snd ?Ψ')"
let ?Δ' = "𝔜 Ψ Δ"
have "(map (uncurry (→)) ?Δ' @ ?Γ⇩1 ⊖ (map snd ?Δ')) $⊢ Φ"
"map (uncurry (⊔)) Ψ ≼ map (uncurry (⊔)) ?Δ'"
using Ψ(1) Δ(1) Δ(3)
xwitness_ywitness_measure_deduction_intro
Y_witness_left_stronger_theory
by auto
hence "?Γ⇩1 $⊢ (φ # Φ)"
using Ψ(1) Ψ(2) Δ(1)
Y_witness_msub measure_deduction.simps(2)
stronger_theory_deduction_monotonic
by blast
thus ?thesis
using Ψ(1) Δ(1) Δ(2)
X_witness_msub
X_witness_right_stronger_theory
measure_deduction.simps(2)
stronger_theory_deduction_monotonic
by blast
qed
lemma (in classical_logic) measure_cons_remove1:
assumes "φ ∈ set Φ"
shows "Γ $⊢ Φ = Γ $⊢ (φ # (remove1 φ Φ))"
proof -
from ‹φ ∈ set Φ›
have "∀ Γ. Γ $⊢ Φ = Γ $⊢ (φ # (remove1 φ Φ))"
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons χ Φ)
{
fix Γ
have "Γ $⊢ (χ # Φ) = Γ $⊢ (φ # (remove1 φ (χ # Φ)))"
proof (cases "χ = φ")
case True
then show ?thesis by simp
next
case False
hence "φ ∈ set Φ"
using Cons.prems by simp
with Cons.hyps have "Γ $⊢ (χ # Φ) = Γ $⊢ (χ # φ # (remove1 φ Φ))"
by fastforce
hence "Γ $⊢ (χ # Φ) = Γ $⊢ (φ # χ # (remove1 φ Φ))"
using measure_cons_cons_right_permute by blast
then show ?thesis using ‹χ ≠ φ› by simp
qed
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
lemma (in classical_logic) witness_stronger_theory:
assumes "mset (map snd Ψ) ⊆# mset Γ"
shows "(map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ≼ Γ"
proof -
have "∀ Γ. mset (map snd Ψ) ⊆# mset Γ ⟶ (map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ)) ≼ Γ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?γ = "snd ψ"
{
fix Γ
assume "mset (map snd (ψ # Ψ)) ⊆# mset Γ"
hence "mset (map snd Ψ) ⊆# mset (remove1 (snd ψ) Γ)"
by (simp add: insert_subset_eq_iff)
with Cons have
"(map (uncurry (→)) Ψ @ (remove1 (snd ψ) Γ) ⊖ (map snd Ψ)) ≼ (remove1 ?γ Γ)"
by blast
hence "(map (uncurry (→)) Ψ @ Γ ⊖ (map snd (ψ # Ψ))) ≼ (remove1 ?γ Γ)"
by (simp add: stronger_theory_relation_alt_def)
moreover
have "(uncurry (→)) = (λ ψ. fst ψ → snd ψ)"
by fastforce
hence "⊢ ?γ → uncurry (→) ψ"
using axiom_k by simp
ultimately have
"(map (uncurry (→)) (ψ # Ψ) @ Γ ⊖ (map snd (ψ # Ψ))) ≼ (?γ # (remove1 ?γ Γ))"
using stronger_theory_left_right_cons by auto
hence "(map (uncurry (→)) (ψ # Ψ) @ Γ ⊖ (map snd (ψ # Ψ))) ≼ Γ"
using stronger_theory_relation_alt_def
‹mset (map snd (ψ # Ψ)) ⊆# mset Γ›
mset_subset_eqD
by fastforce
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
lemma (in classical_logic) measure_msub_weaken:
assumes "mset Ψ ⊆# mset Φ"
and "Γ $⊢ Φ"
shows "Γ $⊢ Ψ"
proof -
have "∀Ψ Γ. mset Ψ ⊆# mset Φ ⟶ Γ $⊢ Φ ⟶ Γ $⊢ Ψ"
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
{
fix Ψ Γ
assume "mset Ψ ⊆# mset (φ # Φ)"
"Γ $⊢ (φ # Φ)"
hence "Γ $⊢ Φ"
using measure_deduction.simps(2)
measure_stronger_theory_left_monotonic
witness_stronger_theory
by blast
have "Γ $⊢ Ψ"
proof (cases "φ ∈ set Ψ")
case True
hence "mset (remove1 φ Ψ) ⊆# mset Φ"
using ‹mset Ψ ⊆# mset (φ # Φ)›
subset_eq_diff_conv
by force
hence "∀Γ. Γ $⊢ Φ ⟶ Γ $⊢ (remove1 φ Ψ)"
using Cons by blast
hence "Γ $⊢ (φ # (remove1 φ Ψ))"
using ‹Γ $⊢ (φ # Φ)› by fastforce
then show ?thesis
using ‹φ ∈ set Ψ›
measure_cons_remove1
by blast
next
case False
have "mset Ψ ⊆# mset Φ + add_mset φ (mset [])"
using ‹mset Ψ ⊆# mset (φ # Φ)› by auto
hence "mset Ψ ⊆# mset Φ"
by (metis (no_types) False
diff_single_trivial
in_multiset_in_set mset.simps(1)
subset_eq_diff_conv)
then show ?thesis
using ‹Γ $⊢ Φ› Cons
by blast
qed
}
then show ?case by blast
qed
with assms show ?thesis by blast
qed
lemma (in classical_logic) measure_stronger_theory_right_antitonic:
assumes "Ψ ≼ Φ"
and "Γ $⊢ Φ"
shows "Γ $⊢ Ψ"
proof -
have "∀Ψ Γ. Ψ ≼ Φ ⟶ Γ $⊢ Φ ⟶ Γ $⊢ Ψ"
proof (induct Φ)
case Nil
then show ?case
using measure_deduction.simps(1)
stronger_theory_empty_list_intro
by blast
next
case (Cons φ Φ)
{
fix Ψ Γ
assume "Γ $⊢ (φ # Φ)"
"Ψ ≼ (φ # Φ)"
from this obtain Σ where
Σ: "map snd Σ = Ψ"
"mset (map fst Σ) ⊆# mset (φ # Φ)"
"∀(φ,ψ)∈set Σ. ⊢ φ → ψ"
unfolding stronger_theory_relation_def
by auto
hence "Γ $⊢ Ψ"
proof (cases "φ ∈ set (map fst Σ)")
case True
from this obtain ψ where "(φ,ψ) ∈ set Σ"
by (induct Σ, simp, fastforce)
hence A: "mset (map snd (remove1 (φ, ψ) Σ)) = mset (remove1 ψ Ψ)"
and B: "mset (map fst (remove1 (φ, ψ) Σ)) ⊆# mset Φ"
using Σ remove1_pairs_list_projections_snd
remove1_pairs_list_projections_fst
subset_eq_diff_conv
by fastforce+
have "∀(φ,ψ)∈set (remove1 (φ, ψ) Σ). ⊢ φ → ψ"
using Σ(3) by fastforce+
hence "(remove1 ψ Ψ) ≼ Φ"
unfolding stronger_theory_relation_alt_def using A B by blast
moreover
from ‹Γ $⊢ (φ # Φ)› obtain Δ where
Δ: "mset (map snd Δ) ⊆# mset Γ"
"map (uncurry (⊔)) Δ :⊢ φ"
"(map (uncurry (→)) Δ @ Γ ⊖ (map snd Δ)) $⊢ Φ"
by auto
ultimately have "(map (uncurry (→)) Δ @ Γ ⊖ (map snd Δ)) $⊢ remove1 ψ Ψ"
using Cons by blast
moreover have "map (uncurry (⊔)) Δ :⊢ ψ"
using Δ(2) Σ(3) ‹(φ,ψ) ∈ set Σ›
list_deduction_weaken
list_deduction_modus_ponens
by blast
ultimately have ‹Γ $⊢ (ψ # (remove1 ψ Ψ))›
using Δ(1) by auto
moreover from ‹(φ,ψ) ∈ set Σ› Σ(1) have "ψ ∈ set Ψ"
by force
hence "mset Ψ ⊆# mset (ψ # (remove1 ψ Ψ))"
by auto
ultimately show ?thesis using measure_msub_weaken by blast
next
case False
hence "mset (map fst Σ) ⊆# mset Φ"
using Σ(2)
by (simp,
metis add_mset_add_single
diff_single_trivial
mset_map set_mset_mset
subset_eq_diff_conv)
hence "Ψ ≼ Φ"
using Σ(1) Σ(3)
unfolding stronger_theory_relation_def
by auto
moreover from ‹Γ $⊢ (φ # Φ)› have "Γ $⊢ Φ"
using measure_deduction.simps(2)
measure_stronger_theory_left_monotonic
witness_stronger_theory
by blast
ultimately show ?thesis using Cons by blast
qed
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
lemma (in classical_logic) measure_witness_right_split:
assumes "mset (map snd Ψ) ⊆# mset Φ"
shows "Γ $⊢ (map (uncurry (⊔)) Ψ @ map (uncurry (→)) Ψ @ Φ ⊖ (map snd Ψ)) = Γ $⊢ Φ"
proof -
have "∀ Γ Φ. mset (map snd Ψ) ⊆# mset Φ ⟶
Γ $⊢ Φ = Γ $⊢ (map (uncurry (⊔)) Ψ @ map (uncurry (→)) Ψ @ Φ ⊖ (map snd Ψ))"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
{
fix Γ Φ
let ?χ = "fst ψ"
let ?φ = "snd ψ"
let ?Φ' = "map (uncurry (⊔)) (ψ # Ψ) @
map (uncurry (→)) (ψ # Ψ) @
Φ ⊖ map snd (ψ # Ψ)"
let ?Φ⇩0 = "map (uncurry (⊔)) Ψ @
map (uncurry (→)) Ψ @
(remove1 ?φ Φ) ⊖ map snd Ψ"
assume "mset (map snd (ψ # Ψ)) ⊆# mset Φ"
hence "mset (map snd Ψ) ⊆# mset (remove1 ?φ Φ)"
"mset (?φ # remove1 ?φ Φ) = mset Φ"
by (simp add: insert_subset_eq_iff)+
hence "Γ $⊢ Φ = Γ $⊢ (?φ # remove1 ?φ Φ)"
"∀ Γ. Γ $⊢ (remove1 ?φ Φ) = Γ $⊢ ?Φ⇩0"
by (metis list.set_intros(1) measure_cons_remove1 set_mset_mset,
metis Cons.hyps)
moreover
have "(uncurry (⊔)) = (λ ψ. fst ψ ⊔ snd ψ)"
"(uncurry (→)) = (λ ψ. fst ψ → snd ψ)"
by fastforce+
hence "mset ?Φ' ⊆# mset (?χ ⊔ ?φ # ?χ → ?φ # ?Φ⇩0)"
"mset (?χ ⊔ ?φ # ?χ → ?φ # ?Φ⇩0) ⊆# mset ?Φ'"
(is "mset ?X ⊆# mset ?Y")
by fastforce+
hence "Γ $⊢ ?Φ' = Γ $⊢ (?φ # ?Φ⇩0)"
using measure_formula_right_split
measure_msub_weaken
by blast
ultimately have "Γ $⊢ Φ = Γ $⊢ ?Φ'"
by fastforce
}
then show ?case by blast
qed
with assms show ?thesis by blast
qed
primrec (in classical_logic)
submerge_witness :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔈")
where
"𝔈 Σ [] = map (λ σ. (⊥, (uncurry (⊔)) σ)) Σ"
| "𝔈 Σ (δ # Δ) =
(case find (λ σ. (uncurry (→)) σ = snd δ) Σ of
None ⇒ 𝔈 Σ Δ
| Some σ ⇒ (fst σ, (fst δ ⊓ fst σ) ⊔ snd σ) # (𝔈 (remove1 σ Σ) Δ))"
lemma (in classical_logic) submerge_witness_stronger_theory_left:
"map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔈 Σ Δ)"
proof -
have "∀ Σ. map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔈 Σ Δ)"
proof (induct Δ)
case Nil
{
fix Σ
{
fix φ
have "⊢ (⊥ ⊔ φ) → φ"
unfolding disjunction_def
using ex_falso_quodlibet modus_ponens excluded_middle_elimination by blast
}
note tautology = this
have "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔈 Σ [])"
by (induct Σ,
simp,
simp add: stronger_theory_left_right_cons tautology)
}
then show ?case by auto
next
case (Cons δ Δ)
{
fix Σ
have "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔈 Σ (δ # Δ))"
proof (cases "find (λ σ. (uncurry (→)) σ = snd δ) Σ = None")
case True
then show ?thesis using Cons by simp
next
case False
from this obtain σ where
σ: "find (λσ. uncurry (→) σ = snd δ) Σ = Some σ"
"uncurry (→) σ = snd δ"
"σ ∈ set Σ"
using find_Some_predicate find_Some_set_membership
by fastforce
{
fix α β γ
have "⊢ (α ⊔ (γ ⊓ α) ⊔ β) → (α ⊔ β)"
proof -
let ?φ = "(❙⟨α❙⟩ ⊔ (❙⟨γ❙⟩ ⊓ ❙⟨α❙⟩) ⊔ ❙⟨β❙⟩) → (❙⟨α❙⟩ ⊔ ❙⟨β❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
note tautology = this
let ?α = "fst σ"
let ?β = "snd σ"
let ?γ = "fst δ"
have "(uncurry (⊔)) = (λ σ. fst σ ⊔ snd σ)" by fastforce
hence "(uncurry (⊔)) σ = ?α ⊔ ?β" by simp
hence A: "⊢ (?α ⊔ (?γ ⊓ ?α) ⊔ ?β) → (uncurry (⊔)) σ" using tautology by simp
moreover
have "map (uncurry (⊔)) (remove1 σ Σ)
≼ map (uncurry (⊔)) (𝔈 (remove1 σ Σ) Δ)"
using Cons by simp
ultimately have A:
"map (uncurry (⊔)) (σ # (remove1 σ Σ))
≼ (?α ⊔ (?γ ⊓ ?α) ⊔ ?β # map (uncurry (⊔)) (𝔈 (remove1 σ Σ) Δ))"
using stronger_theory_left_right_cons by fastforce
from σ(3) have "mset Σ = mset (σ # (remove1 σ Σ))"
by simp
hence "mset (map (uncurry (⊔)) Σ) = mset (map (uncurry (⊔)) (σ # (remove1 σ Σ)))"
by (metis mset_map)
hence B: "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (σ # (remove1 σ Σ))"
by (simp add: msub_stronger_theory_intro)
have "( fst σ
⊔ (fst δ ⊓ fst σ)
⊔ snd σ # map (λ(x, y). x ⊔ y) (𝔈 (remove1 σ Σ) Δ)) ≽ map (λ(x, y). x ⊔ y) Σ"
by (metis
(no_types, lifting)
A B
stronger_theory_transitive
uncurry_def)
thus ?thesis using A B σ by simp
qed
}
then show ?case by auto
qed
thus ?thesis by blast
qed
lemma (in classical_logic) submerge_witness_msub:
"mset (map snd (𝔈 Σ Δ)) ⊆# mset (map (uncurry (⊔)) (𝔍 Σ Δ))"
proof -
have "∀ Σ. mset (map snd (𝔈 Σ Δ)) ⊆# mset (map (uncurry (⊔)) (𝔍 Σ Δ))"
proof (induct Δ)
case Nil
{
fix Σ
have "mset (map snd (𝔈 Σ [])) ⊆#
mset (map (uncurry (⊔)) (𝔍 Σ []))"
by (induct Σ, simp+)
}
then show ?case by blast
next
case (Cons δ Δ)
{
fix Σ
have "mset (map snd (𝔈 Σ (δ # Δ))) ⊆#
mset (map (uncurry (⊔)) (𝔍 Σ (δ # Δ)))"
using Cons
by (cases "find (λ σ. (uncurry (→)) σ = snd δ) Σ = None",
simp,
meson diff_subset_eq_self
insert_subset_eq_iff
mset_subset_eq_add_mset_cancel
subset_mset.dual_order.trans,
fastforce)
}
then show ?case by blast
qed
thus ?thesis by blast
qed
lemma (in classical_logic) submerge_witness_stronger_theory_right:
"map (uncurry (⊔)) Δ
≼ (map (uncurry (→)) (𝔈 Σ Δ) @ map (uncurry (⊔)) (𝔍 Σ Δ) ⊖ map snd (𝔈 Σ Δ))"
proof -
have "∀ Σ. map (uncurry (⊔)) Δ
≼ (map (uncurry (→)) (𝔈 Σ Δ) @ map (uncurry (⊔)) (𝔍 Σ Δ) ⊖ map snd (𝔈 Σ Δ))"
proof(induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ
have "map (uncurry (⊔)) (δ # Δ) ≼
( map (uncurry (→)) (𝔈 Σ (δ # Δ))
@ map (uncurry (⊔)) (𝔍 Σ (δ # Δ))
⊖ map snd (𝔈 Σ (δ # Δ)))"
proof (cases "find (λ σ. (uncurry (→)) σ = snd δ) Σ = None")
case True
from Cons obtain Φ where Φ:
"map snd Φ = map (uncurry (⊔)) Δ"
"mset (map fst Φ) ⊆#
mset (map (uncurry (→)) (𝔈 Σ Δ)
@ map (uncurry (⊔)) (𝔍 Σ Δ) ⊖ map snd (𝔈 Σ Δ))"
"∀(γ, σ)∈set Φ. ⊢ γ → σ"
unfolding stronger_theory_relation_def
by fastforce
let ?Φ' = "(uncurry (⊔) δ, (uncurry (⊔)) δ) # Φ"
have "map snd ?Φ' = map (uncurry (⊔)) (δ # Δ)" using Φ(1) by simp
moreover
from Φ(2) have A:
"image_mset fst (mset Φ)
⊆# {#x → y. (x, y) ∈# mset (𝔈 Σ Δ)#}
+ ({#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#} - image_mset snd (mset (𝔈 Σ Δ)))"
by simp
have "image_mset snd (mset (𝔈 Σ Δ)) ⊆# {#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#}"
using submerge_witness_msub by force
then have B: "{#case δ of (x, xa) ⇒ x ⊔ xa#}
⊆# add_mset (case δ of (x, xa) ⇒ x ⊔ xa)
{#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#} - image_mset snd (mset (𝔈 Σ Δ))"
by (metis add_mset_add_single subset_mset.le_add_diff)
have "add_mset (case δ of (x, xa) ⇒ x ⊔ xa) {#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#}
- image_mset snd (mset (𝔈 Σ Δ)) - {#case δ of (x, xa) ⇒ x ⊔ xa#}
= {#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#} - image_mset snd (mset (𝔈 Σ Δ))"
by force
then have "add_mset (case δ of (x, xa) ⇒ x ⊔ xa) (image_mset fst (mset Φ))
- (add_mset (case δ of (x, xa) ⇒ x ⊔ xa) {#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#}
- image_mset snd (mset (𝔈 Σ Δ)))
⊆# {#x → y. (x, y) ∈# mset (𝔈 Σ Δ)#}"
using A B by (metis (no_types) add_mset_add_single
subset_eq_diff_conv
subset_mset.diff_diff_right)
hence "add_mset (case δ of (x, xa) ⇒ x ⊔ xa) (image_mset fst (mset Φ))
⊆# {#x → y. (x, y) ∈# mset (𝔈 Σ Δ)#}
+ (add_mset (case δ of (x, xa) ⇒ x ⊔ xa) {#x ⊔ y. (x, y) ∈# mset (𝔍 Σ Δ)#}
- image_mset snd (mset (𝔈 Σ Δ)))"
using subset_eq_diff_conv by blast
hence
"mset (map fst ?Φ') ⊆#
mset (map (uncurry (→)) (𝔈 Σ (δ # Δ))
@ map (uncurry (⊔)) (𝔍 Σ (δ # Δ))
⊖ map snd (𝔈 Σ (δ # Δ)))"
using True Φ(2)
by simp
moreover have "∀(γ, σ)∈set ?Φ'. ⊢ γ → σ"
using Φ(3) trivial_implication by auto
ultimately show ?thesis
unfolding stronger_theory_relation_def
by blast
next
case False
from this obtain σ where
σ: "find (λσ. uncurry (→) σ = snd δ) Σ = Some σ"
"uncurry (→) σ = snd δ"
using find_Some_predicate
by fastforce
moreover from Cons have
"map (uncurry (⊔)) Δ ≼
(map (uncurry (→)) (𝔈 (remove1 σ Σ) Δ) @
remove1 ((fst δ ⊓ fst σ) ⊔ snd σ)
(((fst δ ⊓ fst σ) ⊔ snd σ # map (uncurry (⊔)) (𝔍 (remove1 σ Σ) Δ))
⊖ map snd (𝔈 (remove1 σ Σ) Δ)))"
unfolding stronger_theory_relation_alt_def
by simp
moreover
{
fix α β γ
have "⊢ (α → ((γ ⊓ α) ⊔ β)) → (γ ⊔ (α → β))"
proof -
let ?φ = "(❙⟨α❙⟩ → ((❙⟨γ❙⟩ ⊓ ❙⟨α❙⟩) ⊔ ❙⟨β❙⟩)) → (❙⟨γ❙⟩ ⊔ (❙⟨α❙⟩ → ❙⟨β❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
note tautology = this
let ?α = "fst σ"
let ?β = "snd σ"
let ?γ = "fst δ"
have "(λ δ. uncurry (⊔) δ) = (λ δ. fst δ ⊔ snd δ)"
"(λ σ. uncurry (→) σ) = (λ σ. fst σ → snd σ)" by fastforce+
hence "(uncurry (⊔) δ) = (?γ ⊔ (?α → ?β))" using σ(2) by simp
hence "⊢ (?α → ((?γ ⊓ ?α) ⊔ ?β)) → (uncurry (⊔) δ)" using tautology by auto
ultimately show ?thesis
using stronger_theory_left_right_cons
by fastforce
qed
}
then show ?case by auto
qed
thus ?thesis by simp
qed
lemma (in classical_logic) merge_witness_cons_measure_deduction:
assumes "map (uncurry (⊔)) Σ :⊢ φ"
and "mset (map snd Δ) ⊆# mset (map (uncurry (→)) Σ @ Γ ⊖ map snd Σ)"
and "map (uncurry (⊔)) Δ $⊢ Φ"
shows "map (uncurry (⊔)) (𝔍 Σ Δ) $⊢ (φ # Φ)"
proof -
let ?Σ' = "𝔈 Σ Δ"
let ?Γ = "map (uncurry (→)) ?Σ' @ map (uncurry (⊔)) (𝔍 Σ Δ) ⊖ map snd ?Σ'"
have "?Γ $⊢ Φ"
using assms(3)
submerge_witness_stronger_theory_right
measure_stronger_theory_left_monotonic
by blast
moreover have "map (uncurry (⊔)) ?Σ' :⊢ φ"
using assms(1)
stronger_theory_deduction_monotonic
submerge_witness_stronger_theory_left
by blast
ultimately show ?thesis
using submerge_witness_msub
by fastforce
qed
primrec (in classical_logic)
recover_witness_A :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔓")
where
"𝔓 Σ [] = Σ"
| "𝔓 Σ (δ # Δ) =
(case find (λ σ. snd σ = (uncurry (⊔)) δ) Σ of
None ⇒ 𝔓 Σ Δ
| Some σ ⇒ (fst σ ⊔ fst δ, snd δ) # (𝔓 (remove1 σ Σ) Δ))"
primrec (in classical_logic)
recover_complement_A :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔓⇧C")
where
"𝔓⇧C Σ [] = []"
| "𝔓⇧C Σ (δ # Δ) =
(case find (λ σ. snd σ = (uncurry (⊔)) δ) Σ of
None ⇒ δ # 𝔓⇧C Σ Δ
| Some σ ⇒ (𝔓⇧C (remove1 σ Σ) Δ))"
primrec (in classical_logic)
recover_witness_B :: "('a × 'a) list ⇒ ('a × 'a) list ⇒ ('a × 'a) list" ("𝔔")
where
"𝔔 Σ [] = []"
| "𝔔 Σ (δ # Δ) =
(case find (λ σ. (snd σ) = (uncurry (⊔)) δ) Σ of
None ⇒ δ # 𝔔 Σ Δ
| Some σ ⇒ (fst δ, (fst σ ⊔ fst δ) → snd δ) # (𝔔 (remove1 σ Σ) Δ))"
lemma (in classical_logic) recover_witness_A_left_stronger_theory:
"map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔓 Σ Δ)"
proof -
have "∀ Σ. map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔓 Σ Δ)"
proof (induct Δ)
case Nil
{
fix Σ
have "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔓 Σ [])"
by(induct Σ, simp+)
}
then show ?case by auto
next
case (Cons δ Δ)
{
fix Σ
have "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (𝔓 Σ (δ # Δ))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
then show ?thesis using Cons by simp
next
case False
from this obtain σ where
σ: "find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
"snd σ = uncurry (⊔) δ"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
let ?α = "fst σ"
let ?β = "fst δ"
let ?γ = "snd δ"
have "uncurry (⊔) = (λδ. fst δ ⊔ snd δ)" by fastforce
hence "⊢ ((?α ⊔ ?β) ⊔ ?γ) → uncurry (⊔) σ"
using σ(2) biconditional_def disjunction_associativity
by auto
moreover
have "map (uncurry (⊔)) (remove1 σ Σ)
≼ map (uncurry (⊔)) (𝔓 (remove1 σ Σ) Δ)"
using Cons by simp
ultimately have "map (uncurry (⊔)) (σ # (remove1 σ Σ))
≼ map (uncurry (⊔)) (𝔓 Σ (δ # Δ))"
using σ(1)
by (simp, metis stronger_theory_left_right_cons)
moreover
from σ(3) have "mset Σ = mset (σ # (remove1 σ Σ))"
by simp
hence "mset (map (uncurry (⊔)) Σ) = mset (map (uncurry (⊔)) (σ # (remove1 σ Σ)))"
by (metis mset_map)
hence "map (uncurry (⊔)) Σ ≼ map (uncurry (⊔)) (σ # (remove1 σ Σ))"
by (simp add: msub_stronger_theory_intro)
ultimately show ?thesis
using stronger_theory_transitive by blast
qed
}
then show ?case by blast
qed
thus ?thesis by auto
qed
lemma (in classical_logic) recover_witness_A_mset_equiv:
assumes "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
shows "mset (map snd (𝔓 Σ Δ @ 𝔓⇧C Σ Δ)) = mset (map snd Δ)"
proof -
have "∀ Σ. mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)
⟶ mset (map snd (𝔓 Σ Δ @ 𝔓⇧C Σ Δ)) = mset (map snd Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ :: "('a × 'a) list"
assume ⋆: "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) (δ # Δ))"
have "mset (map snd (𝔓 Σ (δ # Δ) @ 𝔓⇧C Σ (δ # Δ))) = mset (map snd (δ # Δ))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
hence "uncurry (⊔) δ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
then show ?case
by (cases "(uncurry (⊔)) δ = snd σ", fastforce+)
qed
moreover have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ) + {#uncurry (⊔) δ#}"
using ⋆ by fastforce
ultimately have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
by (metis diff_single_trivial
in_multiset_in_set
subset_eq_diff_conv)
then show ?thesis using Cons True by simp
next
case False
from this obtain σ where
σ: "find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
"snd σ = uncurry (⊔) δ"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
have A: "mset (map snd Σ)
⊆# mset (map (uncurry (⊔)) Δ) + add_mset (uncurry (⊔) δ) (mset [])"
using ⋆ by auto
have "(fst σ, uncurry (⊔) δ) ∈# mset Σ"
by (metis (no_types) σ(2) σ(3) prod.collapse set_mset_mset)
then have B: "mset (map snd (remove1 (fst σ, uncurry (⊔) δ) Σ))
= mset (map snd Σ) - {#uncurry (⊔) δ#}"
by (meson remove1_pairs_list_projections_snd)
have "(fst σ, uncurry (⊔) δ) = σ"
by (metis σ(2) prod.collapse)
then have "mset (map snd Σ) - add_mset (uncurry (⊔) δ) (mset [])
= mset (map snd (remove1 σ Σ))"
using B by simp
hence "mset (map snd (remove1 σ Σ)) ⊆# mset (map (uncurry (⊔)) Δ)"
using A by (metis (no_types) subset_eq_diff_conv)
with σ(1) Cons show ?thesis by simp
qed
}
then show ?case by simp
qed
with assms show ?thesis by blast
qed
lemma (in classical_logic) recover_witness_B_stronger_theory:
assumes "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
shows "(map (uncurry (→)) Σ @ map (uncurry (⊔)) Δ ⊖ map snd Σ)
≼ map (uncurry (⊔)) (𝔔 Σ Δ)"
proof -
have "∀ Σ. mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)
⟶ (map (uncurry (→)) Σ @ map (uncurry (⊔)) Δ ⊖ map snd Σ)
≼ map (uncurry (⊔)) (𝔔 Σ Δ)"
proof(induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ :: "('a × 'a) list"
assume ⋆: "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) (δ # Δ))"
have "(map (uncurry (→)) Σ @ map (uncurry (⊔)) (δ # Δ) ⊖ map snd Σ)
≼ map (uncurry (⊔)) (𝔔 Σ (δ # Δ))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
hence "uncurry (⊔) δ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
then show ?case
by (cases "uncurry (⊔) δ = snd σ", fastforce+)
qed
hence "mset (map (uncurry (→)) Σ @ (map (uncurry (⊔)) (δ # Δ)) ⊖ map snd Σ)
= mset (uncurry (⊔) δ # map (uncurry (→)) Σ
@ map (uncurry (⊔)) Δ ⊖ map snd Σ)"
"mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
using ⋆
by (simp, simp,
metis add_mset_add_single
diff_single_trivial
image_set
mset_map
set_mset_mset
subset_eq_diff_conv)
moreover from this have
"(map (uncurry (→)) Σ @ map (uncurry (⊔)) Δ ⊖ map snd Σ)
≼ map (uncurry (⊔)) (𝔔 Σ Δ)"
using Cons
by auto
hence "(uncurry (⊔) δ # map (uncurry (→)) Σ @ map (uncurry (⊔)) Δ ⊖ map snd Σ)
≼ map (uncurry (⊔)) (𝔔 Σ (δ # Δ))"
using True
by (simp add: stronger_theory_left_right_cons trivial_implication)
ultimately show ?thesis
unfolding stronger_theory_relation_alt_def
by simp
next
case False
let ?Γ = "map (uncurry (→)) Σ @ (map (uncurry (⊔)) (δ # Δ)) ⊖ map snd Σ"
from False obtain σ where
σ: "find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
"snd σ = uncurry (⊔) δ"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
let ?Γ⇩0 = "map (uncurry (→)) (remove1 σ Σ)
@ (map (uncurry (⊔)) Δ) ⊖ map snd (remove1 σ Σ)"
let ?α = "fst σ"
let ?β = "fst δ"
let ?γ = "snd δ"
have "uncurry (⊔) = (λ σ. fst σ ⊔ snd σ)"
"uncurry (→) = (λ σ. fst σ → snd σ)"
by fastforce+
hence "uncurry (→) σ = ?α → (?β ⊔ ?γ)"
using σ(2)
by simp
from σ(3) have "mset (σ # (remove1 σ Σ)) = mset Σ" by simp
hence ♠: "mset (map snd (σ # (remove1 σ Σ))) = mset (map snd Σ)"
"mset (map (uncurry (→)) (σ # (remove1 σ Σ))) = mset (map (uncurry (→)) Σ)"
by (metis mset_map)+
hence "mset ?Γ = mset (map (uncurry (→)) (σ # (remove1 σ Σ))
@ (uncurry (⊔) δ # map (uncurry (⊔)) Δ)
⊖ map snd (σ # (remove1 σ Σ)))"
by simp
hence "?Γ ≼ (?α → (?β ⊔ ?γ) # ?Γ⇩0)"
using σ(2) ‹uncurry (→) σ = ?α → (?β ⊔ ?γ)›
by (simp add: msub_stronger_theory_intro)
moreover have "mset (map snd (remove1 σ Σ)) ⊆# mset (map (uncurry (⊔)) Δ)"
using ♠(1)
by (simp,
metis (no_types, lifting)
⋆ σ(2)
list.simps(9)
mset.simps(2)
mset_map
uncurry_def
mset_subset_eq_add_mset_cancel)
with Cons have ♡: "?Γ⇩0 ≼ map (uncurry (⊔)) (𝔔 (remove1 σ Σ) Δ)" by simp
{
fix α β γ
have "⊢ (β ⊔ (α ⊔ β) → γ) → (α → (β ⊔ γ))"
proof -
let ?φ = "(❙⟨β❙⟩ ⊔ (❙⟨α❙⟩ ⊔ ❙⟨β❙⟩) → ❙⟨γ❙⟩) → (❙⟨α❙⟩ → (❙⟨β❙⟩ ⊔ ❙⟨γ❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
hence "⊢ (?β ⊔ (?α ⊔ ?β) → ?γ) → (?α → (?β ⊔ ?γ))"
by simp
hence "(?α → (?β ⊔ ?γ) # ?Γ⇩0) ≼ map (uncurry (⊔)) (𝔔 Σ (δ # Δ))"
using σ(1) ♡
by (simp, metis stronger_theory_left_right_cons)
ultimately show ?thesis
using stronger_theory_transitive by blast
qed
}
then show ?case by simp
qed
thus ?thesis using assms by blast
qed
lemma (in classical_logic) recover_witness_B_mset_equiv:
assumes "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
shows "mset (map snd (𝔔 Σ Δ))
= mset (map (uncurry (→)) (𝔓 Σ Δ) @ map snd Δ ⊖ map snd (𝔓 Σ Δ))"
proof -
have "∀ Σ. mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)
⟶ mset (map snd (𝔔 Σ Δ)) = mset (map (uncurry (→)) (𝔓 Σ Δ) @ map snd (𝔓⇧C Σ Δ))"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ :: "('a × 'a) list"
assume ⋆: "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) (δ # Δ))"
have "mset (map snd (𝔔 Σ (δ # Δ)))
= mset (map (uncurry (→)) (𝔓 Σ (δ # Δ)) @ map snd (𝔓⇧C Σ (δ # Δ)))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
hence "uncurry (⊔) δ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
then show ?case
by (cases "(uncurry (⊔)) δ = snd σ", fastforce+)
qed
moreover have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ) + {#uncurry (⊔) δ#}"
using ⋆ by force
ultimately have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
by (metis diff_single_trivial in_multiset_in_set subset_eq_diff_conv)
then show ?thesis using True Cons by simp
next
case False
from this obtain σ where
σ: "find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
"snd σ = uncurry (⊔) δ"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
hence "(fst σ, uncurry (⊔) δ) ∈# mset Σ"
by (metis (full_types) prod.collapse set_mset_mset)
then have "mset (map snd (remove1 (fst σ, uncurry (⊔) δ) Σ))
= mset (map snd Σ) - {#uncurry (⊔) δ#}"
by (meson remove1_pairs_list_projections_snd)
moreover have
"mset (map snd Σ)
⊆# mset (map (uncurry (⊔)) Δ) + add_mset (uncurry (⊔) δ) (mset [])"
using ⋆ by force
ultimately have "mset (map snd (remove1 σ Σ))
⊆# mset (map (uncurry (⊔)) Δ)"
by (metis (no_types) σ(2) mset.simps(1) prod.collapse subset_eq_diff_conv)
with σ(1) Cons show ?thesis by simp
qed
}
then show ?case by blast
qed
thus ?thesis
using assms recover_witness_A_mset_equiv
by (simp, metis add_diff_cancel_left')
qed
lemma (in classical_logic) recover_witness_B_right_stronger_theory:
"map (uncurry (→)) Δ ≼ map (uncurry (→)) (𝔔 Σ Δ)"
proof -
have "∀ Σ. map (uncurry (→)) Δ ≼ map (uncurry (→)) (𝔔 Σ Δ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
{
fix Σ
have "map (uncurry (→)) (δ # Δ) ≼ map (uncurry (→)) (𝔔 Σ (δ # Δ))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
then show ?thesis
using Cons
by (simp add: stronger_theory_left_right_cons trivial_implication)
next
case False
from this obtain σ where σ:
"find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
by fastforce
let ?α = "fst δ"
let ?β = "snd δ"
let ?γ = "fst σ"
have "uncurry (→) = (λδ. fst δ → snd δ)" by fastforce
hence "uncurry (→) δ = ?α → ?β" by auto
moreover have "⊢ (?α → (?γ ⊔ ?α) → ?β) → ?α → ?β"
unfolding disjunction_def
using axiom_k axiom_s modus_ponens flip_implication
by blast
ultimately show ?thesis
using Cons σ
by (simp add: stronger_theory_left_right_cons)
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in classical_logic) recoverWitnesses_mset_equiv:
assumes "mset (map snd Δ) ⊆# mset Γ"
and "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
shows "mset (Γ ⊖ map snd Δ)
= mset ((map (uncurry (→)) (𝔓 Σ Δ) @ Γ ⊖ map snd (𝔓 Σ Δ)) ⊖ map snd (𝔔 Σ Δ))"
proof -
have "mset (Γ ⊖ map snd Δ) = mset (Γ ⊖ map snd (𝔓⇧C Σ Δ) ⊖ map snd (𝔓 Σ Δ))"
using assms(2) recover_witness_A_mset_equiv
by (simp add: union_commute)
moreover have "∀ Σ. mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)
⟶ mset (Γ ⊖ map snd (𝔓⇧C Σ Δ))
= (mset ((map (uncurry (→)) (𝔓 Σ Δ) @ Γ) ⊖ map snd (𝔔 Σ Δ)))"
using assms(1)
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
from Cons.prems have "snd δ ∈ set Γ"
using mset_subset_eqD by fastforce
from Cons.prems have ♡: "mset (map snd Δ) ⊆# mset Γ"
using subset_mset.dual_order.trans
by fastforce
{
fix Σ :: "('a × 'a) list"
assume ⋆: "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) (δ # Δ))"
have "mset (Γ ⊖ map snd (𝔓⇧C Σ (δ # Δ)))
= mset ((map (uncurry (→)) (𝔓 Σ (δ # Δ)) @ Γ) ⊖ map snd (𝔔 Σ (δ # Δ)))"
proof (cases "find (λ σ. snd σ = uncurry (⊔) δ) Σ = None")
case True
hence "uncurry (⊔) δ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
then show ?case
by (cases "(uncurry (⊔)) δ = snd σ", fastforce+)
qed
moreover have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ) + {#uncurry (⊔) δ#}"
using ⋆ by auto
ultimately have "mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
by (metis (full_types) diff_single_trivial in_multiset_in_set subset_eq_diff_conv)
with Cons.hyps ♡ have "mset (Γ ⊖ map snd (𝔓⇧C Σ Δ))
= mset ((map (uncurry (→)) (𝔓 Σ Δ) @ Γ) ⊖ map snd (𝔔 Σ Δ))"
by simp
thus ?thesis using True ‹snd δ ∈ set Γ› by simp
next
case False
from this obtain σ where σ:
"find (λσ. snd σ = uncurry (⊔) δ) Σ = Some σ"
"snd σ = uncurry (⊔) δ"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
with ⋆ have "mset (map snd (remove1 σ Σ)) ⊆# mset (map (uncurry (⊔)) Δ)"
by (simp, metis (no_types, lifting)
add_mset_remove_trivial_eq
image_mset_add_mset
in_multiset_in_set
mset_subset_eq_add_mset_cancel)
with Cons.hyps have "mset (Γ ⊖ map snd (𝔓⇧C (remove1 σ Σ) Δ))
= mset ((map (uncurry (→)) (𝔓 (remove1 σ Σ) Δ) @ Γ)
⊖ map snd (𝔔 (remove1 σ Σ) Δ))"
using ♡ by blast
then show ?thesis using σ by simp
qed
}
then show ?case by blast
qed
moreover have "image_mset snd (mset (𝔓⇧C Σ Δ)) = mset (map snd Δ ⊖ map snd (𝔓 Σ Δ))"
using assms(2) recover_witness_A_mset_equiv
by (simp, metis (no_types) diff_union_cancelL list_subtract_mset_homomorphism mset_map)
then have "mset Γ - (image_mset snd (mset (𝔓⇧C Σ Δ)) + image_mset snd (mset (𝔓 Σ Δ)))
= {#x → y. (x, y) ∈# mset (𝔓 Σ Δ)#}
+ (mset Γ - image_mset snd (mset (𝔓 Σ Δ))) - image_mset snd (mset (𝔔 Σ Δ))"
using calculation
assms(2)
recover_witness_A_mset_equiv
recover_witness_B_mset_equiv
by fastforce
ultimately
show ?thesis
using assms recover_witness_A_mset_equiv
by simp
qed
theorem (in classical_logic) measure_deduction_generalized_witness:
"Γ $⊢ (Φ @ Ψ) = (∃ Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ Φ ∧
(map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ)) $⊢ Ψ)"
proof -
have "∀ Γ Ψ. Γ $⊢ (Φ @ Ψ) = (∃ Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ Φ ∧
(map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ)) $⊢ Ψ)"
proof (induct Φ)
case Nil
{
fix Γ Ψ
have "Γ $⊢ ([] @ Ψ) = (∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ [] ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ)"
proof (rule iffI)
assume "Γ $⊢ ([] @ Ψ)"
moreover
have "Γ $⊢ ([] @ Ψ) = (mset (map snd []) ⊆# mset Γ ∧
map (uncurry (⊔)) [] $⊢ [] ∧
map (uncurry (→)) [] @ Γ ⊖ (map snd []) $⊢ Ψ)"
by simp
ultimately show "∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ [] ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ"
by metis
next
assume "∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ [] ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ"
from this obtain Σ where
Σ: "mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ ([] @ Ψ)"
by fastforce
hence "(map (uncurry (→)) Σ @ Γ ⊖ map snd Σ) ≼ Γ"
using witness_stronger_theory by auto
with Σ(2) show "Γ $⊢ ([] @ Ψ)"
using measure_stronger_theory_left_monotonic by blast
qed
}
then show ?case by blast
next
case (Cons φ Φ)
{
fix Γ Ψ
have "Γ $⊢ ((φ # Φ) @ Ψ) = (∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ (φ # Φ) ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ)"
proof (rule iffI)
assume "Γ $⊢ ((φ # Φ) @ Ψ)"
from this obtain Σ where
Σ: "mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ φ"
"map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ) $⊢ (Φ @ Ψ)"
(is "?Γ⇩0 $⊢ (Φ @ Ψ)")
by auto
from this(3) obtain Δ where
Δ: "mset (map snd Δ) ⊆# mset ?Γ⇩0"
"map (uncurry (⊔)) Δ $⊢ Φ"
"map (uncurry (→)) Δ @ ?Γ⇩0 ⊖ (map snd Δ) $⊢ Ψ"
using Cons
by auto
let ?Σ' = "𝔍 Σ Δ"
have "map (uncurry (⊔)) ?Σ' $⊢ (φ # Φ)"
using Δ(1) Δ(2) Σ(2) merge_witness_cons_measure_deduction by blast
moreover have "mset (map snd ?Σ') ⊆# mset Γ"
using Δ(1) Σ(1) merge_witness_msub_intro by blast
moreover have "map (uncurry (→)) ?Σ' @ Γ ⊖ map snd ?Σ' $⊢ Ψ"
using Δ(1) Δ(3) merge_witness_measure_deduction_intro by blast
ultimately show
"∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ (φ # Φ) ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ"
by fast
next
assume "∃Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ $⊢ (φ # Φ) ∧
map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ"
from this obtain Δ where Δ:
"mset (map snd Δ) ⊆# mset Γ"
"map (uncurry (⊔)) Δ $⊢ (φ # Φ)"
"map (uncurry (→)) Δ @ Γ ⊖ map snd Δ $⊢ Ψ"
by auto
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset (map (uncurry (⊔)) Δ)"
"map (uncurry (⊔)) Σ :⊢ φ"
"map (uncurry (→)) Σ @ (map (uncurry (⊔)) Δ) ⊖ map snd Σ $⊢ Φ"
by auto
let ?Ω = "𝔓 Σ Δ"
let ?Ξ = "𝔔 Σ Δ"
let ?Γ⇩0 = "map (uncurry (→)) ?Ω @ Γ ⊖ map snd ?Ω"
let ?Γ⇩1 = "map (uncurry (→)) ?Ξ @ ?Γ⇩0 ⊖ map snd ?Ξ"
have "mset (Γ ⊖ map snd Δ) = mset (?Γ⇩0 ⊖ map snd ?Ξ)"
using Δ(1) Σ(1) recoverWitnesses_mset_equiv by blast
hence "(Γ ⊖ map snd Δ) ≼ (?Γ⇩0 ⊖ map snd ?Ξ)"
by (simp add: msub_stronger_theory_intro)
hence "?Γ⇩1 $⊢ Ψ"
using Δ(3) measure_stronger_theory_left_monotonic
stronger_theory_combine
recover_witness_B_right_stronger_theory
by blast
moreover
have "mset (map snd ?Ξ) ⊆# mset ?Γ⇩0"
using Σ(1) Δ(1) recover_witness_B_mset_equiv
by (simp,
metis list_subtract_monotonic
list_subtract_mset_homomorphism
mset_map)
moreover
have "map (uncurry (⊔)) ?Ξ $⊢ Φ"
using Σ(1) recover_witness_B_stronger_theory
Σ(3) measure_stronger_theory_left_monotonic by blast
ultimately have "?Γ⇩0 $⊢ (Φ @ Ψ)"
using Cons by fast
moreover
have "mset (map snd ?Ω) ⊆# mset (map snd Δ)"
using Σ(1) recover_witness_A_mset_equiv
by (simp, metis mset_subset_eq_add_left)
hence "mset (map snd ?Ω) ⊆# mset Γ" using Δ(1) by simp
moreover
have "map (uncurry (⊔)) ?Ω :⊢ φ"
using Σ(2)
recover_witness_A_left_stronger_theory
stronger_theory_deduction_monotonic
by blast
ultimately show "Γ $⊢ ((φ # Φ) @ Ψ)"
by (simp, blast)
qed
}
then show ?case by metis
qed
thus ?thesis by blast
qed
lemma (in classical_logic) measure_list_deduction_antitonic:
assumes "Γ $⊢ Ψ"
and "Ψ :⊢ φ"
shows "Γ :⊢ φ"
using assms
proof (induct Ψ arbitrary: Γ φ)
case Nil
then show ?case
using list_deduction_weaken
by simp
next
case (Cons ψ Ψ)
hence "Ψ :⊢ ψ → φ"
using list_deduction_theorem by blast
from ‹Γ $⊢ (ψ # Ψ)› obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ ψ"
"map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Ψ"
by auto
hence "Γ :⊢ ψ → φ"
using
measure_stronger_theory_left_monotonic
witness_stronger_theory
‹Ψ :⊢ ψ → φ›
Cons
by blast
moreover
have "Γ :⊢ ψ"
using Σ(1) Σ(2)
stronger_theory_deduction_monotonic
witness_weaker_theory
by blast
ultimately show ?case using list_deduction_modus_ponens by auto
qed
text ‹ Finally, we may establish that \<^term>‹($⊢)› is transitive. ›
theorem (in classical_logic) measure_transitive:
assumes "Γ $⊢ Λ"
and "Λ $⊢ Δ"
shows "Γ $⊢ Δ"
using assms
proof (induct Δ arbitrary: Γ Λ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset Λ"
"map (uncurry (⊔)) Σ :⊢ δ"
"map (uncurry (→)) Σ @ Λ ⊖ map snd Σ $⊢ Δ"
by auto
hence "Γ $⊢ (map (uncurry (⊔)) Σ @ map (uncurry (→)) Σ @ Λ ⊖ (map snd Σ))"
using Cons measure_witness_right_split
by simp
from this obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset Γ"
"map (uncurry (⊔)) Ψ $⊢ map (uncurry (⊔)) Σ"
"map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ $⊢ (map (uncurry (→)) Σ @ Λ ⊖ map snd Σ)"
using measure_deduction_generalized_witness
by fastforce
have "map (uncurry (→)) Ψ @ Γ ⊖ map snd Ψ $⊢ Δ"
using Σ(3) Ψ(3) Cons
by auto
moreover
have "map (uncurry (⊔)) Ψ :⊢ δ"
using Ψ(2) Σ(2) measure_list_deduction_antitonic
by blast
ultimately show ?case
using Ψ(1)
by fastforce
qed
section ‹ Measure Deduction Cancellation Rules ›
text ‹ In this chapter we go over how to cancel formulae occurring in
measure deduction judgements. ›
text ‹ The first observation is that tautologies can always be canceled on
either side of the turnstile. ›
lemma (in classical_logic) measure_tautology_right_cancel:
assumes "⊢ φ"
shows "Γ $⊢ (φ # Φ) = Γ $⊢ Φ"
proof (rule iffI)
assume "Γ $⊢ (φ # Φ)"
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ φ"
"map (uncurry (→)) Σ @ Γ ⊖ map snd Σ $⊢ Φ"
by auto
thus "Γ $⊢ Φ"
using measure_stronger_theory_left_monotonic
witness_stronger_theory
by blast
next
assume "Γ $⊢ Φ"
hence "map (uncurry (→)) [] @ Γ ⊖ map snd [] $⊢ Φ"
"mset (map snd []) ⊆# mset Γ"
"map (uncurry (⊔)) [] :⊢ φ"
using assms
by simp+
thus "Γ $⊢ (φ # Φ)"
using measure_deduction.simps(2)
by blast
qed
lemma (in classical_logic) measure_tautology_left_cancel [simp]:
assumes "⊢ γ"
shows "(γ # Γ) $⊢ Φ = Γ $⊢ Φ"
proof (rule iffI)
assume "(γ # Γ) $⊢ Φ"
moreover have "Γ $⊢ Γ"
by (simp add: stronger_theory_to_measure_deduction)
hence "Γ $⊢ (γ # Γ)"
using assms measure_tautology_right_cancel
by simp
ultimately show "Γ $⊢ Φ"
using measure_transitive by blast
next
assume "Γ $⊢ Φ"
moreover have "mset Γ ⊆# mset (γ # Γ)"
by simp
hence "(γ # Γ) $⊢ Γ"
using msub_stronger_theory_intro
stronger_theory_to_measure_deduction
by blast
ultimately show "(γ # Γ) $⊢ Φ"
using measure_transitive by blast
qed
lemma (in classical_logic) measure_deduction_one_collapse:
"Γ $⊢ [φ] = Γ :⊢ φ"
proof (rule iffI)
assume "Γ $⊢ [φ]"
from this obtain Σ where
Σ: "mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ φ"
by auto
hence "map (uncurry (⊔)) Σ ≼ Γ"
using witness_weaker_theory by blast
thus "Γ :⊢ φ" using Σ(2)
using stronger_theory_deduction_monotonic by blast
next
assume "Γ :⊢ φ"
let ?Σ = "map (λ γ. (⊥, γ)) Γ"
have "Γ ≼ map (uncurry (⊔)) ?Σ"
proof (induct Γ)
case Nil
then show ?case by simp
next
case (Cons γ Γ)
have "⊢ (⊥ ⊔ γ) → γ"
unfolding disjunction_def
using ex_falso_quodlibet modus_ponens excluded_middle_elimination
by blast
then show ?case using Cons
by (simp add: stronger_theory_left_right_cons)
qed
hence "map (uncurry (⊔)) ?Σ :⊢ φ"
using ‹Γ :⊢ φ› stronger_theory_deduction_monotonic by blast
moreover have "mset (map snd ?Σ) ⊆# mset Γ" by (induct Γ, simp+)
ultimately show "Γ $⊢ [φ]"
using measure_deduction.simps(1)
measure_deduction.simps(2)
by blast
qed
text ‹ ∗‹Split cases›, which are occurrences of ‹ψ ⊔ φ # ψ → φ # …›,
also cancel and simplify to just ‹φ # …›. We previously established
@{thm measure_formula_right_split [no_vars] } as part of the proof
of transitivity. ›
lemma (in classical_logic) measure_formula_left_split:
"ψ ⊔ φ # ψ → φ # Γ $⊢ Φ = φ # Γ $⊢ Φ"
proof (rule iffI)
assume "φ # Γ $⊢ Φ"
have "ψ ⊔ φ # ψ → φ # Γ $⊢ (ψ ⊔ φ # ψ → φ # Γ)"
using stronger_theory_to_measure_deduction
stronger_theory_reflexive
by blast
hence "ψ ⊔ φ # ψ → φ # Γ $⊢ (φ # Γ)"
using measure_formula_right_split by blast
with ‹φ # Γ $⊢ Φ› show "ψ ⊔ φ # ψ → φ # Γ $⊢ Φ"
using measure_transitive by blast
next
assume "ψ ⊔ φ # ψ → φ # Γ $⊢ Φ"
have "φ # Γ $⊢ (φ # Γ)"
using stronger_theory_to_measure_deduction
stronger_theory_reflexive
by blast
hence "φ # Γ $⊢ (ψ ⊔ φ # ψ → φ # Γ)"
using measure_formula_right_split by blast
with ‹ψ ⊔ φ # ψ → φ # Γ $⊢ Φ› show "φ # Γ $⊢ Φ"
using measure_transitive by blast
qed
lemma (in classical_logic) measure_witness_left_split [simp]:
assumes "mset (map snd Σ) ⊆# mset Γ"
shows "(map (uncurry (⊔)) Σ @ map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ)) $⊢ Φ = Γ $⊢ Φ"
using assms
proof (induct Σ arbitrary: Γ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
let ?χ = "fst σ"
let ?γ = "snd σ"
let ?Γ⇩0 = "map (uncurry (⊔)) Σ @ map (uncurry (→)) Σ @ Γ ⊖ map snd (σ # Σ)"
let ?Γ' = "map (uncurry (⊔)) (σ # Σ) @ map (uncurry (→)) (σ # Σ) @ Γ ⊖ map snd (σ # Σ)"
assume "mset (map snd (σ # Σ)) ⊆# mset Γ"
hence A: "add_mset (snd σ) (image_mset snd (mset Σ)) ⊆# mset Γ" by simp
hence B: "image_mset snd (mset Σ) + (mset Γ - image_mset snd (mset Σ))
= add_mset (snd σ) (image_mset snd (mset Σ))
+ (mset Γ - add_mset (snd σ) (image_mset snd (mset Σ)))"
by (metis (no_types) mset_subset_eq_insertD subset_mset.add_diff_inverse subset_mset_def)
have "{#x → y. (x, y) ∈# mset Σ#}
+ mset Γ - add_mset (snd σ) (image_mset snd (mset Σ))
= {#x → y. (x, y) ∈# mset Σ#}
+ (mset Γ - add_mset (snd σ) (image_mset snd (mset Σ)))"
using A subset_mset.diff_add_assoc by blast
hence "{#x → y. (x, y) ∈# mset Σ#} + (mset Γ - image_mset snd (mset Σ))
= add_mset (snd σ) ({#x → y. (x, y) ∈# mset Σ#}
+ mset Γ - add_mset (snd σ) (image_mset snd (mset Σ)))"
using B by auto
hence C:
"mset (map snd Σ) ⊆# mset Γ"
"mset (map (uncurry (⊔)) Σ @ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ)
= mset (?γ # ?Γ⇩0)"
using ‹mset (map snd (σ # Σ)) ⊆# mset Γ›
subset_mset.dual_order.trans
by (fastforce+)
hence "Γ $⊢ Φ = (?χ ⊔ ?γ # ?χ → ?γ # ?Γ⇩0) $⊢ Φ"
proof -
have "∀Γ Δ. ¬ mset (map snd Σ) ⊆# mset Γ
∨ ¬ Γ $⊢ Φ
∨ ¬ mset (map (uncurry (⊔)) Σ
@ map (uncurry (→)) Σ
@ Γ ⊖ map snd Σ)
⊆# mset Δ
∨ Δ $⊢ Φ"
using Cons.hyps measure_msub_left_monotonic by blast
moreover
{
assume "¬ Γ $⊢ Φ"
then have "∃Δ. mset (snd σ # map (uncurry (⊔)) Σ
@ map (uncurry (→)) Σ
@ Γ ⊖ map snd (σ # Σ))
⊆# mset Δ
∧ ¬ Γ $⊢ Φ
∧ ¬ Δ $⊢ Φ"
by (metis (no_types) Cons.hyps C subset_mset.dual_order.refl)
then have ?thesis
using measure_formula_left_split measure_msub_left_monotonic by blast
}
ultimately show ?thesis
by (metis (full_types) C measure_formula_left_split subset_mset.dual_order.refl)
qed
moreover
have "(uncurry (⊔)) = (λ ψ. fst ψ ⊔ snd ψ)"
"(uncurry (→)) = (λ ψ. fst ψ → snd ψ)"
by fastforce+
hence "mset ?Γ' = mset (?χ ⊔ ?γ # ?χ → ?γ # ?Γ⇩0)"
by fastforce
hence "(?χ ⊔ ?γ # ?χ → ?γ # ?Γ⇩0) $⊢ Φ = ?Γ' $⊢ Φ"
by (metis
(mono_tags, lifting)
measure_msub_left_monotonic
subset_mset.dual_order.refl)
ultimately have "Γ $⊢ Φ = ?Γ' $⊢ Φ"
by fastforce
then show ?case by blast
qed
text ‹ We now have enough to establish the cancellation rule for \<^term>‹($⊢)›. ›
lemma (in classical_logic) measure_cancel: "(Δ @ Γ) $⊢ (Δ @ Φ) = Γ $⊢ Φ"
proof -
{
fix Δ Γ Φ
assume "Γ $⊢ Φ"
hence "(Δ @ Γ) $⊢ (Δ @ Φ)"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
let ?Σ = "[(δ, δ)]"
have "map (uncurry (⊔)) ?Σ :⊢ δ"
unfolding disjunction_def list_deduction_def
by (simp add: Peirces_law)
moreover have "mset (map snd ?Σ) ⊆# mset (δ # Δ)" by simp
moreover have "map (uncurry (→)) ?Σ @ ((δ # Δ) @ Γ) ⊖ map snd ?Σ $⊢ (Δ @ Φ)"
using Cons
by (simp add: trivial_implication)
moreover have "map snd [(δ, δ)] = [δ]" by force
ultimately show ?case
by (metis (no_types) measure_deduction.simps(2)
append_Cons
list.set_intros(1)
mset.simps(1)
mset.simps(2)
mset_subset_eq_single
set_mset_mset)
qed
} note forward_direction = this
{
assume "(Δ @ Γ) $⊢ (Δ @ Φ)"
hence "Γ $⊢ Φ"
proof (induct Δ)
case Nil
then show ?case by simp
next
case (Cons δ Δ)
have "mset ((δ # Δ) @ Φ) = mset ((Δ @ Φ) @ [δ])" by simp
with Cons.prems have "((δ # Δ) @ Γ) $⊢ ((Δ @ Φ) @ [δ])"
by (metis measure_msub_weaken
subset_mset.dual_order.refl)
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset ((δ # Δ) @ Γ)"
"map (uncurry (⊔)) Σ $⊢ (Δ @ Φ)"
"map (uncurry (→)) Σ @ ((δ # Δ) @ Γ) ⊖ map snd Σ $⊢ [δ]"
by (metis append_assoc measure_deduction_generalized_witness)
show ?case
proof (cases "find (λ σ. snd σ = δ) Σ = None")
case True
hence "δ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
then show ?case by (cases "snd σ = δ", simp+)
qed
with Σ(1) have "mset (map snd Σ) ⊆# mset (Δ @ Γ)"
by (simp, metis add_mset_add_single
diff_single_trivial
mset_map
set_mset_mset
subset_eq_diff_conv)
thus ?thesis
using measure_stronger_theory_left_monotonic
witness_weaker_theory
Cons.hyps Σ(2)
by blast
next
case False
from this obtain σ χ where
σ: "σ = (χ, δ)"
"σ ∈ set Σ"
using find_Some_predicate
find_Some_set_membership
by fastforce
let ?Σ' = "remove1 σ Σ"
let ?Σ⇩A = "map (uncurry (⊔)) ?Σ'"
let ?Σ⇩B = "map (uncurry (→)) ?Σ'"
have "mset Σ = mset (?Σ' @ [(χ, δ)])"
"mset Σ = mset ((χ, δ) # ?Σ')"
using σ by simp+
hence "mset (map (uncurry (⊔)) Σ) = mset (map (uncurry (⊔)) (?Σ' @ [(χ, δ)]))"
"mset (map snd Σ) = mset (map snd ((χ, δ) # ?Σ'))"
"mset (map (uncurry (→)) Σ) = mset (map (uncurry (→)) ((χ, δ) # ?Σ'))"
by (metis mset_map)+
hence "mset (map (uncurry (⊔)) Σ) = mset (?Σ⇩A @ [χ ⊔ δ])"
"mset (map (uncurry (→)) Σ @ ((δ # Δ) @ Γ) ⊖ map snd Σ)
= mset (χ → δ # ?Σ⇩B @ (Δ @ Γ) ⊖ map snd ?Σ')"
by simp+
hence
"?Σ⇩A @ [χ ⊔ δ] $⊢ (Δ @ Φ)"
"χ → δ # (?Σ⇩B @ (Δ @ Γ) ⊖ map snd ?Σ') $⊢ [δ]"
using Σ(2) Σ(3)
by (metis measure_msub_left_monotonic subset_mset.dual_order.refl, simp)
moreover
have "⊢ ((χ → δ) → δ) → (χ ⊔ δ)"
unfolding disjunction_def
using modus_ponens
pseudo_scotus
flip_hypothetical_syllogism
by blast
ultimately have "(?Σ⇩A @ ?Σ⇩B @ (Δ @ Γ) ⊖ map snd ?Σ') $⊢ (Δ @ Φ)"
using measure_deduction_one_collapse
list_deduction_theorem
list_deduction_modus_ponens
list_deduction_weaken
forward_direction
measure_transitive
by meson
moreover
have "δ = snd σ"
"snd σ ∈ set (map snd Σ)"
by (simp add: σ(1), simp add: σ(2))
with Σ(1) have "mset (map snd (remove1 σ Σ)) ⊆# mset (remove1 δ ((δ # Δ) @ Γ))"
by (metis insert_DiffM
insert_subset_eq_iff
mset_remove1
σ(1) σ(2)
remove1_pairs_list_projections_snd
set_mset_mset)
hence "mset (map snd (remove1 σ Σ)) ⊆# mset (Δ @ Γ)" by simp
ultimately show ?thesis
using measure_witness_left_split Cons.hyps
by blast
qed
qed
}
with forward_direction show ?thesis by auto
qed
lemma (in classical_logic) measure_biconditional_cancel:
assumes "⊢ γ ↔ φ"
shows "(γ # Γ) $⊢ (φ # Φ) = Γ $⊢ Φ"
proof -
from assms have "(γ # Φ) ≼ (φ # Φ)" "(φ # Φ) ≼ (γ # Φ)"
unfolding biconditional_def
by (simp add: stronger_theory_left_right_cons)+
hence "(γ # Φ) $⊢ (φ # Φ)"
"(φ # Φ) $⊢ (γ # Φ)"
using stronger_theory_to_measure_deduction by blast+
moreover
have "Γ $⊢ Φ = (γ # Γ) $⊢ (γ # Φ)"
by (metis append_Cons append_Nil measure_cancel)+
ultimately
have "Γ $⊢ Φ ⟹ γ # Γ $⊢ (φ # Φ)"
"γ # Γ $⊢ (φ # Φ) ⟹ Γ $⊢ Φ"
using measure_transitive by blast+
thus ?thesis by blast
qed
section ‹ Measure Deduction Substitution Rules ›
text ‹ Just like conventional deduction, if two formulae are equivalent then
they may be substituted for one another. ›
lemma (in classical_logic) right_measure_sub:
assumes "⊢ φ ↔ ψ"
shows "Γ $⊢ (φ # Φ) = Γ $⊢ (ψ # Φ)"
proof -
have "Γ $⊢ (φ # Φ) = (ψ # Γ) $⊢ (ψ # φ # Φ)"
using measure_cancel [where Δ="[ψ]" and Γ="Γ" and Φ="φ # Φ"] by simp
also have "... = (ψ # Γ) $⊢ (φ # ψ # Φ)"
using measure_cons_cons_right_permute by blast
also have "... = Γ $⊢ (ψ # Φ)"
using assms biconditional_symmetry_rule measure_biconditional_cancel by blast
finally show ?thesis .
qed
lemma (in classical_logic) left_measure_sub:
assumes "⊢ γ ↔ χ"
shows "(γ # Γ) $⊢ Φ = (χ # Γ) $⊢ Φ"
proof -
have "(γ # Γ) $⊢ Φ = (χ # γ # Γ) $⊢ (χ # Φ)"
using measure_cancel [where Δ="[χ]" and Γ="(γ # Γ)" and Φ="Φ"] by simp
also have "... = (γ # χ # Γ) $⊢ (χ # Φ)"
using
measure_cons_cons_right_permute
stronger_theory_to_measure_deduction
measure_transitive
stronger_theory_reflexive
by blast
also have "... = (χ # Γ) $⊢ Φ"
using assms biconditional_symmetry_rule measure_biconditional_cancel by blast
finally show ?thesis .
qed
section ‹ Measure Deduction Sum Rules ›
text ‹ We next establish analogues of the rule in probability that
‹𝒫 α + 𝒫 β = 𝒫 (α ⊔ β) + 𝒫 (α ⊓ β)›. This equivalence holds for
both sides of the \<^term>‹($⊢)› turnstile. ›
lemma (in classical_logic) right_measure_sum_rule:
"Γ $⊢ (α # β # Φ) = Γ $⊢ (α ⊔ β # α ⊓ β # Φ)"
proof -
have A: "mset (α ⊔ β # β → α # β # Φ) = mset (β → α # β # α ⊔ β # Φ)" by simp
have B: "⊢ (β → α) ↔ (β → (α ⊓ β))"
proof -
let ?φ = "(❙⟨β❙⟩ → ❙⟨α❙⟩) ↔ (❙⟨β❙⟩ → (❙⟨α❙⟩ ⊓ ❙⟨β❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
have C: "⊢ β ↔ (β ⊔ (α ⊓ β))"
proof -
let ?φ = "❙⟨β❙⟩ ↔ (❙⟨β❙⟩ ⊔ (❙⟨α❙⟩ ⊓ ❙⟨β❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
have "Γ $⊢ (α # β # Φ) = Γ $⊢ (β ⊔ α # β → α # β # Φ)"
using measure_formula_right_split by blast
also have "... = Γ $⊢ (α ⊔ β # β → α # β # Φ)"
using disjunction_commutativity right_measure_sub by blast
also have "... = Γ $⊢ (β → α # β # α ⊔ β # Φ)"
by (metis A measure_msub_weaken subset_mset.dual_order.refl)
also have "... = Γ $⊢ (β → (α ⊓ β) # β # α ⊔ β # Φ)"
using B right_measure_sub by blast
also have "... = Γ $⊢ (β # β → (α ⊓ β) # α ⊔ β # Φ)"
using measure_cons_cons_right_permute by blast
also have "... = Γ $⊢ (β ⊔ (α ⊓ β) # β → (α ⊓ β) # α ⊔ β # Φ)"
using C right_measure_sub by blast
also have "... = Γ $⊢ (α ⊓ β # α ⊔ β # Φ)"
using measure_formula_right_split by blast
finally show ?thesis
using measure_cons_cons_right_permute by blast
qed
lemma (in classical_logic) left_measure_sum_rule:
"(α # β # Γ) $⊢ Φ = (α ⊔ β # α ⊓ β # Γ) $⊢ Φ"
proof -
have ⋆: "mset (α ⊔ β # α ⊓ β # α # β # Γ) = mset (α # β # α ⊔ β # α ⊓ β # Γ)" by simp
have "(α # β # Γ) $⊢ Φ = (α ⊔ β # α ⊓ β # α # β # Γ) $⊢ (α ⊔ β # α ⊓ β # Φ)"
using measure_cancel [where Δ="[α ⊔ β, α ⊓ β]" and Γ="(α # β # Γ)" and Φ="Φ"] by simp
also have "... = (α ⊔ β # α ⊓ β # α # β # Γ) $⊢ (α # β # Φ)"
using right_measure_sum_rule by blast
also have "... = (α # β # α ⊔ β # α ⊓ β # Γ) $⊢ (α # β # Φ)"
by (metis ⋆ measure_msub_left_monotonic subset_mset.dual_order.refl)
also have "... = (α ⊔ β # α ⊓ β # Γ) $⊢ Φ"
using measure_cancel [where Δ="[α, β]" and Γ="(α ⊔ β # α ⊓ β # Γ)" and Φ="Φ"] by simp
finally show ?thesis .
qed
section ‹ Measure Deduction Exchange Rule ›
text ‹ As we will see, a key result is that we can move formulae from the
right hand side of the \<^term>‹($⊢)› turnstile to the left. ›
text ‹ We observe a novel logical principle, which we call ∗‹exchange›.
This principle follows immediately from the split rules and cancellation
rules. ›
lemma (in classical_logic) measure_exchange:
"(γ # Γ) $⊢ (φ # Φ) = (φ → γ # Γ) $⊢ (γ → φ # Φ)"
proof -
have "(γ # Γ) $⊢ (φ # Φ) = (φ ⊔ γ # φ → γ # Γ) $⊢ (γ ⊔ φ # γ → φ # Φ)"
using measure_formula_left_split
measure_formula_right_split
by blast+
thus ?thesis
using measure_biconditional_cancel
disjunction_commutativity
by blast
qed
text ‹ The exchange rule allows us to prove an analogue of the rule in
classical logic that ‹ Γ :⊢ φ = (∼ φ # Γ) :⊢ ⊥ › for measure
deduction. ›
theorem (in classical_logic) measure_negation_swap:
"Γ $⊢ (φ # Φ) = (∼ φ # Γ) $⊢ (⊥ # Φ)"
proof -
have "Γ $⊢ (φ # Φ) = (⊥ # Γ) $⊢ (⊥ # φ # Φ)"
by (metis append_Cons append_Nil measure_cancel)
also have "... = (⊥ # Γ) $⊢ (φ # ⊥ # Φ)"
using measure_cons_cons_right_permute by blast
also have "... = (∼ φ # Γ) $⊢ (⊥ → φ # ⊥ # Φ)"
unfolding negation_def
using measure_exchange
by blast
also have "... = (∼ φ # Γ) $⊢ (⊥ # Φ)"
using ex_falso_quodlibet
measure_tautology_right_cancel
by blast
finally show ?thesis .
qed
section ‹ Definition of Counting Deduction ›
text ‹ The theorem @{thm measure_negation_swap [no_vars]} gives rise to
another kind of judgement: ∗‹how many times can a list of premises
‹Γ› prove a formula ‹φ›?›. We call this kind of judgment ∗‹counting
deduction›. As with measure deduction, bits of ‹Γ› get "used up"
with each dispatched conclusion. ›
primrec (in classical_logic)
counting_deduction :: "'a list ⇒ nat ⇒ 'a ⇒ bool" ("_ #⊢ _ _" [60,100,59] 60)
where
"Γ #⊢ 0 φ = True"
| "Γ #⊢ (Suc n) φ = (∃ Ψ. mset (map snd Ψ) ⊆# mset Γ ∧
map (uncurry (⊔)) Ψ :⊢ φ ∧
map (uncurry (→)) Ψ @ Γ ⊖ (map snd Ψ) #⊢ n φ)"
section ‹ Converting Back and Forth from Counting Deduction to Measure Deduction ›
text ‹ We next show how to convert back and forth from counting deduction to
measure deduction. ›
text ‹ First, we show that trivially counting deduction is a special case of
measure deduction. ›
lemma (in classical_logic) counting_deduction_to_measure_deduction:
"Γ #⊢ n φ = Γ $⊢ (replicate n φ)"
by (induct n arbitrary: Γ, simp+)
text ‹ We next prove a few helpful lemmas regarding counting deduction. ›
lemma (in classical_logic) counting_deduction_tautology_weaken:
assumes "⊢ φ"
shows "Γ #⊢ n φ"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
hence "Γ $⊢ (φ # replicate n φ)"
using assms
counting_deduction_to_measure_deduction
measure_tautology_right_cancel
by blast
hence "Γ $⊢ replicate (Suc n) φ"
by simp
then show ?case
using counting_deduction_to_measure_deduction
by blast
qed
lemma (in classical_logic) counting_deduction_weaken:
assumes "n ≤ m"
and "Γ #⊢ m φ"
shows "Γ #⊢ n φ"
proof -
have "Γ $⊢ replicate m φ"
using assms(2) counting_deduction_to_measure_deduction
by blast
hence "Γ $⊢ replicate n φ"
by (metis append_Nil2
assms(1)
le_iff_add
measure_deduction.simps(1)
measure_deduction_generalized_witness
replicate_add)
thus ?thesis
using counting_deduction_to_measure_deduction
by blast
qed
lemma (in classical_logic) counting_deduction_implication:
assumes "⊢ φ → ψ"
and "Γ #⊢ n φ"
shows "Γ #⊢ n ψ"
proof -
have "replicate n ψ ≼ replicate n φ"
using stronger_theory_left_right_cons assms(1)
by (induct n, auto)
thus ?thesis
using assms(2)
measure_stronger_theory_right_antitonic
counting_deduction_to_measure_deduction
by blast
qed
text ‹ Finally, we use @{thm measure_negation_swap [no_vars]} to prove
that measure deduction reduces to counting deduction. ›
theorem (in classical_logic) measure_deduction_to_counting_deduction:
"Γ $⊢ Φ = (❙∼ Φ @ Γ) #⊢ (length Φ) ⊥"
proof -
have "∀ Ψ. Γ $⊢ (Φ @ Ψ) = (❙∼ Φ @ Γ) $⊢ (replicate (length Φ) ⊥ @ Ψ)"
proof (induct Φ arbitrary: Γ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
{
fix Ψ
have "Γ $⊢ ((φ # Φ) @ Ψ) = (∼ φ # Γ) $⊢ (⊥ # Φ @ Ψ)"
using measure_negation_swap by auto
moreover have "mset (Φ @ (⊥ # Ψ)) = mset (⊥ # Φ @ Ψ)"
by simp
ultimately have "Γ $⊢ ((φ # Φ) @ Ψ) = (∼ φ # Γ) $⊢ (Φ @ (⊥ # Ψ))"
by (metis measure_msub_weaken subset_mset.order_refl)
hence
"Γ $⊢ ((φ # Φ) @ Ψ)
= (❙∼ Φ @ (∼ φ # Γ)) $⊢ (replicate (length Φ) ⊥ @ (⊥ # Ψ))"
using Cons
by blast
moreover have
"mset (❙∼ Φ @ (∼ φ # Γ)) = mset (❙∼ (φ # Φ) @ Γ)"
"mset (replicate (length Φ) ⊥ @ (⊥ # Ψ))
= mset (replicate (length (φ # Φ)) ⊥ @ Ψ)"
by simp+
ultimately have
"Γ $⊢ ((φ # Φ) @ Ψ) = ❙∼ (φ # Φ) @ Γ $⊢ (replicate (length (φ # Φ)) ⊥ @ Ψ)"
by (metis
append.assoc
append_Cons
append_Nil
length_Cons
replicate_append_same
list_subtract.simps(1)
map_ident replicate_Suc
measure_msub_left_monotonic
map_list_subtract_mset_containment)
}
then show ?case by blast
qed
thus ?thesis
by (metis append_Nil2 counting_deduction_to_measure_deduction)
qed
section ‹ Measure Deduction Soundess \label{subsubsec:measure-deduction-soundness} ›
text ‹ The last major result for measure deduction we have to show is
∗‹soundness›. That is, judgments in measure deduction of
lists of formulae can be translated into tautologies for inequalities
of finitely additive probability measures over those same formulae
(using the same underlying classical logic). ›
lemma (in classical_logic) negated_measure_deduction:
"❙∼ Γ $⊢ (φ # Φ) =
(∃ Ψ. mset (map fst Ψ) ⊆# mset Γ ∧
❙∼ (map (uncurry (∖)) Ψ) :⊢ φ ∧
❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ (map fst Ψ)) $⊢ Φ)"
proof (rule iffI)
assume "❙∼ Γ $⊢ (φ # Φ)"
from this obtain Ψ where Ψ:
"mset (map snd Ψ) ⊆# mset (❙∼ Γ)"
"map (uncurry (⊔)) Ψ :⊢ φ"
"map (uncurry (→)) Ψ @ ❙∼ Γ ⊖ map snd Ψ $⊢ Φ"
using measure_deduction.simps(2)
by metis
from this obtain Δ where Δ:
"mset Δ ⊆# mset Γ"
"map snd Ψ = ❙∼ Δ"
unfolding map_negation_def
using mset_sub_map_list_exists [where f="∼" and Γ="Γ"]
by metis
let ?Ψ = "zip Δ (map fst Ψ)"
from Δ(2) have "map fst ?Ψ = Δ"
unfolding map_negation_def
by (metis length_map map_fst_zip)
with Δ(1) have "mset (map fst ?Ψ) ⊆# mset Γ"
by simp
moreover have "∀ Δ. map snd Ψ = ❙∼ Δ ⟶
map (uncurry (⊔)) Ψ ≼ ❙∼ (map (uncurry (∖)) (zip Δ (map fst Ψ)))"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?ψ = "fst ψ"
{
fix Δ
assume "map snd (ψ # Ψ) = ❙∼ Δ"
from this obtain γ where γ: "∼ γ = snd ψ" "γ = hd Δ" by auto
from ‹map snd (ψ # Ψ) = ❙∼ Δ› have "map snd Ψ = ❙∼ (tl Δ)" by auto
with Cons.hyps have
"map (uncurry (⊔)) Ψ ≼ ❙∼ (map (uncurry (∖)) (zip (tl Δ) (map fst Ψ)))"
by auto
moreover
{
fix ψ γ
have "⊢ ∼(γ ∖ ψ) → (ψ ⊔ ∼ γ)"
unfolding disjunction_def
subtraction_def
conjunction_def
negation_def
by (meson modus_ponens
flip_implication
hypothetical_syllogism)
} note tautology = this
have "uncurry (⊔) = (λ ψ. (fst ψ) ⊔ (snd ψ))"
by fastforce
with γ have "uncurry (⊔) ψ = ?ψ ⊔ ∼ γ"
by simp
with tautology have "⊢ ∼(γ ∖ ?ψ) → uncurry (⊔) ψ"
by simp
ultimately have "map (uncurry (⊔)) (ψ # Ψ) ≼
❙∼ (map (uncurry (∖)) ((zip ((hd Δ) # (tl Δ)) (map fst (ψ # Ψ)))))"
using stronger_theory_left_right_cons γ(2)
by simp
hence "map (uncurry (⊔)) (ψ # Ψ) ≼
❙∼ (map (uncurry (∖)) (zip Δ (map fst (ψ # Ψ))))"
using ‹map snd (ψ # Ψ) = ❙∼ Δ› by force
}
thus ?case by blast
qed
with Ψ(2) Δ(2) have "❙∼ (map (uncurry (∖)) ?Ψ) :⊢ φ"
using stronger_theory_deduction_monotonic by blast
moreover
have "(map (uncurry (→)) Ψ @ ❙∼ Γ ⊖ map snd Ψ) ≼
❙∼ (map (uncurry (⊓)) ?Ψ @ Γ ⊖ (map fst ?Ψ))"
proof -
from Δ(1) have "mset (❙∼ Γ ⊖ ❙∼ Δ) = mset (❙∼ (Γ ⊖ Δ))"
by (simp add: image_mset_Diff)
hence "mset (❙∼ Γ ⊖ map snd Ψ) = mset (❙∼ (Γ ⊖ map fst ?Ψ))"
using Ψ(1) Δ(2) ‹map fst ?Ψ = Δ› by simp
hence "(❙∼ Γ ⊖ map snd Ψ) ≼ ❙∼ (Γ ⊖ map fst ?Ψ)"
by (simp add: msub_stronger_theory_intro)
moreover have "∀ Δ. map snd Ψ = ❙∼ Δ ⟶
map (uncurry (→)) Ψ ≼ ❙∼ (map (uncurry (⊓)) (zip Δ (map fst Ψ)))"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?ψ = "fst ψ"
{
fix Δ
assume "map snd (ψ # Ψ) = ❙∼ Δ"
from this obtain γ where γ: "∼ γ = snd ψ" "γ = hd Δ" by auto
from ‹map snd (ψ # Ψ) = ❙∼ Δ› have "map snd Ψ = ❙∼ (tl Δ)" by auto
with Cons.hyps have
"map (uncurry (→)) Ψ ≼ ❙∼ (map (uncurry (⊓)) (zip (tl Δ) (map fst Ψ)))"
by simp
moreover
{
fix ψ γ
have "⊢ ∼(γ ⊓ ψ) → (ψ → ∼ γ)"
unfolding disjunction_def
conjunction_def
negation_def
by (meson modus_ponens
flip_implication
hypothetical_syllogism)
} note tautology = this
have "(uncurry (→)) = (λ ψ. (fst ψ) → (snd ψ))"
by fastforce
with γ have "uncurry (→) ψ = ?ψ → ∼ γ"
by simp
with tautology have "⊢ ∼(γ ⊓ ?ψ) → (uncurry (→)) ψ"
by simp
ultimately have "map (uncurry (→)) (ψ # Ψ) ≼
❙∼ (map (uncurry (⊓)) ((zip ((hd Δ) # (tl Δ)) (map fst (ψ # Ψ)))))"
using stronger_theory_left_right_cons γ(2)
by simp
hence "map (uncurry (→)) (ψ # Ψ) ≼
❙∼ (map (uncurry (⊓)) (zip Δ (map fst (ψ # Ψ))))"
using ‹map snd (ψ # Ψ) = ❙∼ Δ› by force
}
then show ?case by blast
qed
ultimately have "(map (uncurry (→)) Ψ @ ❙∼ Γ ⊖ map snd Ψ) ≼
(❙∼ (map (uncurry (⊓)) ?Ψ) @ ❙∼ (Γ ⊖ (map fst ?Ψ)))"
using stronger_theory_combine Δ(2)
by metis
thus ?thesis by simp
qed
hence "❙∼ (map (uncurry (⊓)) ?Ψ @ Γ ⊖ (map fst ?Ψ)) $⊢ Φ"
using Ψ(3) measure_stronger_theory_left_monotonic
by blast
ultimately show "∃Ψ. mset (map fst Ψ) ⊆# mset Γ ∧
❙∼ (map (uncurry (∖)) Ψ) :⊢ φ ∧
❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ (map fst Ψ)) $⊢ Φ"
by metis
next
assume "∃Ψ. mset (map fst Ψ) ⊆# mset Γ ∧
❙∼ (map (uncurry (∖)) Ψ) :⊢ φ ∧
❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ map fst Ψ) $⊢ Φ"
from this obtain Ψ where Ψ:
"mset (map fst Ψ) ⊆# mset Γ"
"❙∼ (map (uncurry (∖)) Ψ) :⊢ φ"
"❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ map fst Ψ) $⊢ Φ"
by auto
let ?Ψ = "zip (map snd Ψ) (❙∼ (map fst Ψ))"
from Ψ(1) have "mset (map snd ?Ψ) ⊆# mset (❙∼ Γ)"
by (simp, metis image_mset_subseteq_mono multiset.map_comp)
moreover have "❙∼ (map (uncurry (∖)) Ψ) ≼ map (uncurry (⊔)) ?Ψ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?γ = "fst ψ"
let ?ψ = "snd ψ"
{
fix ψ γ
have "⊢ (ψ ⊔ ∼ γ) → ∼(γ ∖ ψ)"
unfolding disjunction_def
subtraction_def
conjunction_def
negation_def
by (meson modus_ponens
flip_implication
hypothetical_syllogism)
} note tautology = this
have "∼ ∘ uncurry (∖) = (λ ψ. ∼ ((fst ψ) ∖ (snd ψ)))"
"uncurry (⊔) = (λ (ψ,γ). ψ ⊔ γ)"
by fastforce+
with tautology have "⊢ uncurry (⊔) (?ψ, ∼ ?γ) → (∼ ∘ uncurry (∖)) ψ"
by fastforce
with Cons.hyps have
"((∼ ∘ uncurry (∖)) ψ # ❙∼ (map (uncurry (∖)) Ψ)) ≼
(uncurry (⊔) (?ψ, ∼ ?γ) # map (uncurry (⊔)) (zip (map snd Ψ) (❙∼ (map fst Ψ))))"
using stronger_theory_left_right_cons by blast
thus ?case by simp
qed
with Ψ(2) have "map (uncurry (⊔)) ?Ψ :⊢ φ"
using stronger_theory_deduction_monotonic by blast
moreover have "❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ map fst Ψ) ≼
(map (uncurry (→)) ?Ψ @ ❙∼ Γ ⊖ map snd ?Ψ)"
proof -
have "❙∼ (map (uncurry (⊓)) Ψ) ≼ map (uncurry (→)) ?Ψ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?γ = "fst ψ"
let ?ψ = "snd ψ"
{
fix ψ γ
have "⊢ (ψ → ∼ γ) → ∼(γ ⊓ ψ)"
unfolding disjunction_def
conjunction_def
negation_def
by (meson modus_ponens
flip_implication
hypothetical_syllogism)
} note tautology = this
have "∼ ∘ uncurry (⊓) = (λ ψ. ∼ ((fst ψ) ⊓ (snd ψ)))"
"uncurry (→) = (λ (ψ,γ). ψ → γ)"
by fastforce+
with tautology have "⊢ uncurry (→) (?ψ, ∼ ?γ) → (∼ ∘ uncurry (⊓)) ψ"
by fastforce
with Cons.hyps have
"((∼ ∘ uncurry (⊓)) ψ # ❙∼ (map (uncurry (⊓)) Ψ)) ≼
(uncurry (→) (?ψ, ∼ ?γ) # map (uncurry (→)) (zip (map snd Ψ) (❙∼ (map fst Ψ))))"
using stronger_theory_left_right_cons by blast
then show ?case by simp
qed
moreover have "mset (❙∼ (Γ ⊖ map fst Ψ)) = mset (❙∼ Γ ⊖ map snd ?Ψ)"
using Ψ(1)
by (simp add: image_mset_Diff multiset.map_comp)
hence "❙∼ (Γ ⊖ map fst Ψ) ≼ (❙∼ Γ ⊖ map snd ?Ψ)"
using
stronger_theory_reflexive
stronger_theory_right_permutation
by blast
ultimately show ?thesis
using stronger_theory_combine
by simp
qed
hence "map (uncurry (→)) ?Ψ @ ❙∼ Γ ⊖ map snd ?Ψ $⊢ Φ"
using Ψ(3) measure_stronger_theory_left_monotonic by blast
ultimately show "❙∼ Γ $⊢ (φ # Φ)"
using measure_deduction.simps(2) by blast
qed
lemma (in probability_logic) measure_deduction_soundness:
assumes "❙∼ Γ $⊢ ❙∼ Φ"
shows "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
proof -
have "∀ Γ. ❙∼ Γ $⊢ ❙∼ Φ ⟶ (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
proof (induct Φ)
case Nil
then show ?case
by (simp, metis (full_types) ex_map_conv probability_non_negative sum_list_nonneg)
next
case (Cons φ Φ)
{
fix Γ
assume "❙∼ Γ $⊢ ❙∼ (φ # Φ)"
hence "❙∼ Γ $⊢ (∼ φ # ❙∼ Φ)" by simp
from this obtain Ψ where Ψ:
"mset (map fst Ψ) ⊆# mset Γ"
"❙∼ (map (uncurry (∖)) Ψ) :⊢ ∼ φ"
"❙∼ (map (uncurry (⊓)) Ψ @ Γ ⊖ (map fst Ψ)) $⊢ ❙∼ Φ"
using negated_measure_deduction by blast
let ?Γ = "Γ ⊖ (map fst Ψ)"
let ?Ψ⇩1 = "map (uncurry (∖)) Ψ"
let ?Ψ⇩2 = "map (uncurry (⊓)) Ψ"
have "(∑φ'←Φ. 𝒫 φ') ≤ (∑φ←(?Ψ⇩2 @ ?Γ). 𝒫 φ)"
using Cons Ψ(3) by blast
moreover
have "𝒫 φ ≤ (∑φ←?Ψ⇩1. 𝒫 φ)"
using Ψ(2)
biconditional_weaken
list_deduction_def
map_negation_list_implication
set_deduction_base_theory
implication_list_summation_inequality
by blast
ultimately have "(∑φ'←(φ # Φ). 𝒫 φ') ≤ (∑γ ←(?Ψ⇩1 @ ?Ψ⇩2 @ ?Γ). 𝒫 γ)"
by simp
moreover have "(∑φ'←(?Ψ⇩1 @ ?Ψ⇩2). 𝒫 φ') = (∑γ←(map fst Ψ). 𝒫 γ)"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
let ?Ψ⇩1 = "map (uncurry (∖)) Ψ"
let ?Ψ⇩2 = "map (uncurry (⊓)) Ψ"
let ?ψ⇩1 = "uncurry (∖) ψ"
let ?ψ⇩2 = "uncurry (⊓) ψ"
assume "(∑φ'←(?Ψ⇩1 @ ?Ψ⇩2). 𝒫 φ') = (∑γ←(map fst Ψ). 𝒫 γ)"
moreover
{
let ?γ = "fst ψ"
let ?ψ = "snd ψ"
have "uncurry (∖) = (λ ψ. (fst ψ) ∖ (snd ψ))"
"uncurry (⊓) = (λ ψ. (fst ψ) ⊓ (snd ψ))"
by fastforce+
moreover have "𝒫 ?γ = 𝒫 (?γ ∖ ?ψ) + 𝒫 (?γ ⊓ ?ψ)"
by (simp add: subtraction_identity)
ultimately have "𝒫 ?γ = 𝒫 ?ψ⇩1 + 𝒫 ?ψ⇩2"
by simp
}
moreover have "mset (?ψ⇩1 # ?ψ⇩2 # (?Ψ⇩1 @ ?Ψ⇩2)) =
mset (map (uncurry (∖)) (ψ # Ψ) @ map (uncurry (⊓)) (ψ # Ψ))"
(is "mset _ = mset ?rhs")
by simp
hence "(∑φ' ← (?ψ⇩1 # ?ψ⇩2 # (?Ψ⇩1 @ ?Ψ⇩2)). 𝒫 φ') = (∑γ ← ?rhs. 𝒫 γ)"
by auto
ultimately show ?case by simp
qed
moreover have "mset ((map fst Ψ) @ ?Γ) = mset Γ"
using Ψ(1)
by simp
hence "(∑φ'←((map fst Ψ) @ ?Γ). 𝒫 φ') = (∑γ←Γ. 𝒫 γ)"
by (metis mset_map sum_mset_sum_list)
ultimately have "(∑φ'←(φ # Φ). 𝒫 φ') ≤ (∑γ←Γ. 𝒫 γ)"
by simp
}
then show ?case by blast
qed
thus ?thesis using assms by blast
qed
chapter ‹ MaxSAT \label{subsec:abstract-maxsat} ›
text ‹ We turn now to showing that counting deduction reduces to
MaxSAT, the problem of finding the maximal number of
satisfiable clauses in a list of clauses. ›
section ‹ Definition of Relative Maximal Clause Collections ›
text ‹ Given a list of assumptions ‹Φ› and formula ‹φ›, we can think of those
maximal sublists of ‹Φ› that do not prove ‹φ›. While in practice we
will care about ‹φ = ⊥›, we provide a general definition in the more
general axiom class @{class implication_logic}. ›
definition (in implication_logic) relative_maximals :: "'a list ⇒ 'a ⇒ 'a list set" ("ℳ")
where
"ℳ Γ φ =
{ Φ. mset Φ ⊆# mset Γ
∧ ¬ Φ :⊢ φ
∧ (∀ Ψ. mset Ψ ⊆# mset Γ ⟶ ¬ Ψ :⊢ φ ⟶ length Ψ ≤ length Φ) }"
lemma (in implication_logic) relative_maximals_finite: "finite (ℳ Γ φ)"
proof -
{
fix Φ
assume "Φ ∈ ℳ Γ φ"
hence "set Φ ⊆ set Γ"
"length Φ ≤ length Γ"
unfolding relative_maximals_def
using mset_subset_eqD
length_sub_mset
mset_eq_length
by fastforce+
}
hence "ℳ Γ φ ⊆ {xs. set xs ⊆ set Γ ∧ length xs ≤ length Γ}"
by auto
moreover
have "finite {xs. set xs ⊆ set Γ ∧ length xs ≤ length Γ}"
using finite_lists_length_le by blast
ultimately show ?thesis using rev_finite_subset by auto
qed
text ‹ We know that ‹φ› is not a tautology if and only if the set of relative
maximal sublists has an element. ›
lemma (in implication_logic) relative_maximals_existence:
"(¬ ⊢ φ) = (∃ Σ. Σ ∈ ℳ Γ φ)"
proof (rule iffI)
assume "¬ ⊢ φ"
show "∃Σ. Σ ∈ ℳ Γ φ"
proof (rule ccontr)
assume "∄Σ. Σ ∈ ℳ Γ φ"
hence ♢: "∀ Φ. mset Φ ⊆# mset Γ ⟶
¬ Φ :⊢ φ ⟶
(∃Ψ. mset Ψ ⊆# mset Γ ∧ ¬ Ψ :⊢ φ ∧ length Ψ > length Φ)"
unfolding relative_maximals_def
by fastforce
{
fix n
have "∃ Ψ. mset Ψ ⊆# mset Γ ∧ ¬ Ψ :⊢ φ ∧ length Ψ > n"
using ♢
by (induct n,
metis
‹¬ ⊢ φ›
list.size(3)
list_deduction_base_theory
mset.simps(1)
subset_mset.zero_le,
metis
Nat.lessE
Suc_less_eq)
}
hence "∃ Ψ. mset Ψ ⊆# mset Γ ∧ length Ψ > length Γ"
by auto
thus "False"
using size_mset_mono by fastforce
qed
next
assume "∃Σ. Σ ∈ ℳ Γ φ"
thus "¬ ⊢ φ"
unfolding relative_maximals_def
using list_deduction_weaken
by blast
qed
lemma (in implication_logic) relative_maximals_complement_deduction:
assumes "Φ ∈ ℳ Γ φ"
and "ψ ∈ set (Γ ⊖ Φ)"
shows "Φ :⊢ ψ → φ"
proof (rule ccontr)
assume "¬ Φ :⊢ ψ → φ"
hence "¬ (ψ # Φ) :⊢ φ"
by (simp add: list_deduction_theorem)
moreover
have "mset Φ ⊆# mset Γ" "ψ ∈# mset (Γ ⊖ Φ)"
using assms
unfolding relative_maximals_def
by (blast, meson in_multiset_in_set)
hence "mset (ψ # Φ) ⊆# mset Γ"
by (simp, metis add_mset_add_single
mset_subset_eq_mono_add_left_cancel
mset_subset_eq_single
subset_mset.add_diff_inverse)
ultimately have "length (ψ # Φ) ≤ length (Φ)"
using assms
unfolding relative_maximals_def
by blast
thus "False"
by simp
qed
lemma (in implication_logic) relative_maximals_set_complement [simp]:
assumes "Φ ∈ ℳ Γ φ"
shows "set (Γ ⊖ Φ) = set Γ - set Φ"
proof (rule equalityI)
show "set (Γ ⊖ Φ) ⊆ set Γ - set Φ"
proof (rule subsetI)
fix ψ
assume "ψ ∈ set (Γ ⊖ Φ)"
moreover from this have "Φ :⊢ ψ → φ"
using assms
using relative_maximals_complement_deduction
by blast
hence "ψ ∉ set Φ"
using assms
list_deduction_modus_ponens
list_deduction_reflection
relative_maximals_def
by blast
ultimately show "ψ ∈ set Γ - set Φ"
using list_subtract_set_trivial_upper_bound [where Γ="Γ" and Φ="Φ"]
by blast
qed
next
show "set Γ - set Φ ⊆ set (Γ ⊖ Φ)"
by (simp add: list_subtract_set_difference_lower_bound)
qed
lemma (in implication_logic) relative_maximals_complement_equiv:
assumes "Φ ∈ ℳ Γ φ"
and "ψ ∈ set Γ"
shows "Φ :⊢ ψ → φ = (ψ ∉ set Φ)"
proof (rule iffI)
assume "Φ :⊢ ψ → φ"
thus "ψ ∉ set Φ"
using assms(1)
list_deduction_modus_ponens
list_deduction_reflection
relative_maximals_def
by blast
next
assume "ψ ∉ set Φ"
thus "Φ :⊢ ψ → φ"
using assms relative_maximals_complement_deduction
by auto
qed
lemma (in implication_logic) maximals_length_equiv:
assumes "Φ ∈ ℳ Γ φ"
and "Ψ ∈ ℳ Γ φ"
shows "length Φ = length Ψ"
using assms
by (simp add: dual_order.antisym relative_maximals_def)
lemma (in implication_logic) maximals_list_subtract_length_equiv:
assumes "Φ ∈ ℳ Γ φ"
and "Ψ ∈ ℳ Γ φ"
shows "length (Γ ⊖ Φ) = length (Γ ⊖ Ψ)"
proof -
have "length Φ = length Ψ"
using assms maximals_length_equiv
by blast
moreover
have "mset Φ ⊆# mset Γ"
"mset Ψ ⊆# mset Γ"
using assms relative_maximals_def by blast+
hence "length (Γ ⊖ Φ) = length Γ - length Φ"
"length (Γ ⊖ Ψ) = length Γ - length Ψ"
by (metis list_subtract_mset_homomorphism size_Diff_submset size_mset)+
ultimately show ?thesis by metis
qed
text ‹ We can think of \<^term>‹Γ :⊢ φ› as saying "the relative maximal sublists
of ‹Γ› are not the entire list".›
lemma (in implication_logic) relative_maximals_max_list_deduction:
"Γ :⊢ φ = (∀ Φ ∈ ℳ Γ φ. 1 ≤ length (Γ ⊖ Φ))"
proof cases
assume "⊢ φ"
hence "Γ :⊢ φ" "ℳ Γ φ = {}"
unfolding relative_maximals_def
by (simp add: list_deduction_weaken)+
then show ?thesis by blast
next
assume "¬ ⊢ φ"
from this obtain Ω where Ω: "Ω ∈ ℳ Γ φ"
using relative_maximals_existence by blast
from this have "mset Ω ⊆# mset Γ"
unfolding relative_maximals_def by blast
hence ♢: "length (Γ ⊖ Ω) = length Γ - length Ω"
by (metis list_subtract_mset_homomorphism
size_Diff_submset
size_mset)
show ?thesis
proof (cases "Γ :⊢ φ")
assume "Γ :⊢ φ"
from Ω have "mset Ω ⊂# mset Γ"
by (metis (no_types, lifting)
Diff_cancel
Diff_eq_empty_iff
‹Γ :⊢ φ›
list_deduction_monotonic
relative_maximals_def
mem_Collect_eq
mset_eq_setD
subset_mset.dual_order.not_eq_order_implies_strict)
hence "length Ω < length Γ"
using mset_subset_size by fastforce
hence "1 ≤ length Γ - length Ω"
by (simp add: Suc_leI)
with ♢ have "1 ≤ length (Γ ⊖ Ω)"
by simp
with ‹Γ :⊢ φ› Ω show ?thesis
by (metis maximals_list_subtract_length_equiv)
next
assume "¬ Γ :⊢ φ"
moreover have "mset Γ ⊆# mset Γ"
by simp
moreover have "length Ω ≤ length Γ"
using ‹mset Ω ⊆# mset Γ› length_sub_mset mset_eq_length
by fastforce
ultimately have "length Ω = length Γ"
using Ω
unfolding relative_maximals_def
by (simp add: dual_order.antisym)
hence "1 > length (Γ ⊖ Ω)"
using ♢
by simp
with ‹¬ Γ :⊢ φ› Ω show ?thesis
by fastforce
qed
qed
section ‹ Definition of MaxSAT \label{subsubsec:maxsat-definition}›
text ‹ We next turn to defining an abstract form of MaxSAT, which is
largest the number of simultaneously satisfiable propositions in a
list of propositions. ›
text ‹ Unlike conventional MaxSAT, we don't actually work at the
∗‹semantic› level, i.e. constructing a model for the Tarski truth
relation ‹⊨›. Instead, we just count the elements in a maximal,
consistent sublist (i.e., a maximal sub list ‹Σ› such that \<^term>‹¬ Σ :⊢ ⊥›)
of the list of assumptions ‹Γ› we have at hand. ›
text ‹ Because we do not work at the semantic level, computing if ‹MaxSAT Γ ≤ n›
is not in general CoNP-Complete, as it is classically classified
@{cite gareySimplifiedNPcompleteGraph1976}. In the special case that
the underlying logic is the ∗‹classical propositional calculus›, then
the complexity is CoNP-Complete. But we could imagine the underlying
logic to be linear temporal logic or even first order logic. In such
cases the complexity class would be higher in the complexity hierarchy. ›
definition (in implication_logic) relative_MaxSAT :: "'a list ⇒ 'a ⇒ nat" ("¦ _ ¦⇩_" [45])
where
"(¦ Γ ¦⇩φ) = (if ℳ Γ φ = {} then 0 else Max { length Φ | Φ. Φ ∈ ℳ Γ φ })"
abbreviation (in classical_logic) MaxSAT :: "'a list ⇒ nat"
where
"MaxSAT Γ ≡ ¦ Γ ¦⇩⊥"
definition (in implication_logic) complement_relative_MaxSAT :: "'a list ⇒ 'a ⇒ nat" ("∥ _ ∥⇩_" [45])
where
"(∥ Γ ∥⇩φ) = length Γ - ¦ Γ ¦⇩φ"
lemma (in implication_logic) relative_MaxSAT_intro:
assumes "Φ ∈ ℳ Γ φ"
shows "length Φ = ¦ Γ ¦⇩φ"
proof -
have "∀ n ∈ { length Ψ | Ψ. Ψ ∈ ℳ Γ φ }. n ≤ length Φ"
"length Φ ∈ { length Ψ | Ψ. Ψ ∈ ℳ Γ φ }"
using assms relative_maximals_def
by auto
moreover
have "finite { length Ψ | Ψ. Ψ ∈ ℳ Γ φ }"
using finite_imageI relative_maximals_finite
by simp
ultimately have "Max { length Ψ | Ψ. Ψ ∈ ℳ Γ φ } = length Φ"
using Max_eqI
by blast
thus ?thesis
using assms relative_MaxSAT_def
by auto
qed
lemma (in implication_logic) complement_relative_MaxSAT_intro:
assumes "Φ ∈ ℳ Γ φ"
shows "length (Γ ⊖ Φ) = ∥ Γ ∥⇩φ"
proof -
have "mset Φ ⊆# mset Γ"
using assms
unfolding relative_maximals_def
by auto
moreover from this have "length (Γ ⊖ Φ) = length Γ - length Φ"
by (metis list_subtract_mset_homomorphism size_Diff_submset size_mset)
ultimately show ?thesis
unfolding complement_relative_MaxSAT_def
by (metis assms relative_MaxSAT_intro)
qed
lemma (in implication_logic) length_MaxSAT_decomposition:
"length Γ = (¦ Γ ¦⇩φ) + ∥ Γ ∥⇩φ"
proof (cases "ℳ Γ φ = {}")
case True
then show ?thesis
unfolding relative_MaxSAT_def
complement_relative_MaxSAT_def
by simp
next
case False
from this obtain Φ where "Φ ∈ ℳ Γ φ"
by fast
moreover from this have "mset Φ ⊆# mset Γ"
unfolding relative_maximals_def
by auto
moreover from this have "length (Γ ⊖ Φ) = length Γ - length Φ"
by (metis list_subtract_mset_homomorphism size_Diff_submset size_mset)
ultimately show ?thesis
unfolding complement_relative_MaxSAT_def
using list_subtract_msub_eq relative_MaxSAT_intro
by fastforce
qed
section ‹ Reducing Counting Deduction to MaxSAT ›
text ‹ Here we present a major result: counting deduction may be reduced to
MaxSAT. ›
primrec MaxSAT_optimal_pre_witness :: "'a list ⇒ ('a list × 'a) list" ("𝔙")
where
"𝔙 [] = []"
| "𝔙 (ψ # Ψ) = (Ψ, ψ) # 𝔙 Ψ"
lemma MaxSAT_optimal_pre_witness_element_inclusion:
"∀ (Δ,δ) ∈ set (𝔙 Ψ). set (𝔙 Δ) ⊆ set (𝔙 Ψ)"
by (induct Ψ, fastforce+)
lemma MaxSAT_optimal_pre_witness_nonelement:
assumes "length Δ ≥ length Ψ"
shows "(Δ,δ) ∉ set (𝔙 Ψ)"
using assms
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
hence "Ψ ≠ Δ" by auto
then show ?case using Cons by simp
qed
lemma MaxSAT_optimal_pre_witness_distinct: "distinct (𝔙 Ψ)"
by (induct Ψ, simp, simp add: MaxSAT_optimal_pre_witness_nonelement)
lemma MaxSAT_optimal_pre_witness_length_iff_eq:
"∀ (Δ,δ) ∈ set (𝔙 Ψ). ∀ (Σ,σ) ∈ set (𝔙 Ψ). (length Δ = length Σ) = ((Δ, δ) = (Σ,σ))"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
{
fix Δ
fix δ
assume "(Δ,δ) ∈ set (𝔙 (ψ # Ψ))"
and "length Δ = length Ψ"
hence "(Δ,δ) = (Ψ, ψ)"
by (simp add: MaxSAT_optimal_pre_witness_nonelement)
}
hence "∀ (Δ,δ) ∈ set (𝔙 (ψ # Ψ)). (length Δ = length Ψ) = ((Δ,δ) = (Ψ,ψ))"
by blast
with Cons show ?case
by auto
qed
lemma mset_distinct_msub_down:
assumes "mset A ⊆# mset B"
and "distinct B"
shows "distinct A"
using assms
by (meson distinct_append mset_le_perm_append perm_distinct_iff)
lemma mset_remdups_set_sub_iff:
"(mset (remdups A) ⊆# mset (remdups B)) = (set A ⊆ set B)"
proof -
have "∀B. (mset (remdups A) ⊆# mset (remdups B)) = (set A ⊆ set B)"
proof (induct A)
case Nil
then show ?case by simp
next
case (Cons a A)
then show ?case
proof (cases "a ∈ set A")
case True
then show ?thesis using Cons by auto
next
case False
{
fix B
have "(mset (remdups (a # A)) ⊆# mset (remdups B)) = (set (a # A) ⊆ set B)"
proof (rule iffI)
assume assm: "mset (remdups (a # A)) ⊆# mset (remdups B)"
hence "mset (remdups A) ⊆# mset (remdups B) - {#a#}"
using False
by (simp add: insert_subset_eq_iff)
hence "mset (remdups A) ⊆# mset (remdups (removeAll a B))"
by (metis diff_subset_eq_self
distinct_remdups
distinct_remove1_removeAll
mset_distinct_msub_down
mset_remove1
set_eq_iff_mset_eq_distinct
set_remdups set_removeAll)
hence "set A ⊆ set (removeAll a B)"
using Cons.hyps by blast
moreover from assm False have "a ∈ set B"
using mset_subset_eq_insertD by fastforce
ultimately show "set (a # A) ⊆ set B"
by auto
next
assume assm: "set (a # A) ⊆ set B"
hence "set A ⊆ set (removeAll a B)" using False
by auto
hence "mset (remdups A) ⊆# mset (remdups B) - {#a#}"
by (metis Cons.hyps
distinct_remdups
mset_remdups_subset_eq
mset_remove1 remove_code(1)
set_remdups set_remove1_eq
set_removeAll
subset_mset.dual_order.trans)
moreover from assm False have "a ∈ set B" by auto
ultimately show "mset (remdups (a # A)) ⊆# mset (remdups B)"
by (simp add: False insert_subset_eq_iff)
qed
}
then show ?thesis by simp
qed
qed
thus ?thesis by blast
qed
lemma range_characterization:
"(mset X = mset [0..<length X]) = (distinct X ∧ (∀ x ∈ set X. x < length X))"
proof (rule iffI)
assume "mset X = mset [0..<length X]"
thus "distinct X ∧ (∀x∈set X. x < length X)"
by (metis atLeastLessThan_iff count_mset_0_iff distinct_count_atmost_1 distinct_upt set_upt)
next
assume "distinct X ∧ (∀x∈set X. x < length X)"
moreover
{
fix n
have "∀ X. n = length X ⟶
distinct X ∧ (∀x∈set X. x < length X) ⟶
mset X = mset [0..<length X]"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
{
fix X
assume A: "n + 1 = length X"
and B: "distinct X"
and C: "∀x∈set X. x < length X"
have "n ∈ set X"
proof (rule ccontr)
assume "n ∉ set X"
from A have A': "n = length (tl X)"
by simp
from B have B': "distinct (tl X)"
by (simp add: distinct_tl)
have C': "∀x∈set (tl X). x < length (tl X)"
by (metis
A
A'
C
‹n ∉ set X›
Suc_eq_plus1
Suc_le_eq
Suc_le_mono
le_less
list.set_sel(2)
list.size(3)
nat.simps(3))
from A' B' C' Suc have "mset (tl X) = mset [0..<n]"
by blast
from A have "X = hd X # tl X"
by (metis Suc_eq_plus1 list.exhaust_sel list.size(3) nat.simps(3))
with B ‹mset (tl X) = mset [0..<n]› have "hd X ∉ set [0..<n]"
by (metis distinct.simps(2) mset_eq_setD)
hence "hd X ≥ n" by simp
with C ‹n ∉ set X› ‹X = hd X # tl X› show "False"
by (metis A Suc_eq_plus1 Suc_le_eq le_neq_trans list.set_intros(1) not_less)
qed
let ?X' = "remove1 n X"
have A': "n = length ?X'"
by (metis A ‹n ∈ set X› diff_add_inverse2 length_remove1)
have B': "distinct ?X'"
by (simp add: B)
have C': "∀x∈set ?X'. x < length ?X'"
by (metis A A' B C
DiffE
Suc_eq_plus1
Suc_le_eq
Suc_le_mono
le_neq_trans
set_remove1_eq
singletonI)
hence "mset ?X' = mset [0..<n]"
using A' B' C' Suc
by auto
hence "mset (n # ?X') = mset [0..<n+1]"
by simp
hence "mset X = mset [0..<length X]"
by (metis A ‹n ∈ set X› perm_remove)
}
then show ?case by fastforce
qed
}
ultimately show "mset X = mset [0..<length X]"
by blast
qed
lemma distinct_pigeon_hole:
fixes X :: "nat list"
assumes "distinct X"
and "X ≠ []"
shows "∃ n ∈ set X. n + 1 ≥ length X"
proof (rule ccontr)
assume ⋆: "¬ (∃ n ∈ set X. length X ≤ n + 1)"
hence "∀ n ∈ set X. n < length X" by fastforce
hence "mset X = mset [0..<length X]"
using assms(1) range_characterization
by fastforce
with assms(2) have "length X - 1 ∈ set X"
by (metis
diff_zero
last_in_set
last_upt
length_greater_0_conv
length_upt mset_eq_setD)
with ⋆ show False
by (metis One_nat_def Suc_eq_plus1 Suc_pred le_refl length_pos_if_in_set)
qed
lemma MaxSAT_optimal_pre_witness_pigeon_hole:
assumes "mset Σ ⊆# mset (𝔙 Ψ)"
and "Σ ≠ []"
shows "∃ (Δ, δ) ∈ set Σ. length Δ + 1 ≥ length Σ"
proof -
have "distinct Σ"
using assms
MaxSAT_optimal_pre_witness_distinct
mset_distinct_msub_down
by blast
with assms(1) have "distinct (map (length ∘ fst) Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
hence "mset Σ ⊆# mset (𝔙 Ψ)"
"distinct Σ"
by (metis mset.simps(2) mset_subset_eq_insertD subset_mset_def, simp)
with Cons.hyps have "distinct (map (λa. length (fst a)) Σ)" by simp
moreover
obtain δ Δ where "σ = (Δ, δ)"
by fastforce
hence "(Δ, δ) ∈ set (𝔙 Ψ)"
using Cons.prems mset_subset_eq_insertD
by fastforce
hence "∀ (Σ,σ) ∈ set (𝔙 Ψ). (length Δ = length Σ) = ((Δ, δ) = (Σ, σ))"
using MaxSAT_optimal_pre_witness_length_iff_eq [where Ψ="Ψ"]
by fastforce
hence "∀ (Σ,σ) ∈ set Σ. (length Δ = length Σ) = ((Δ, δ) = (Σ, σ))"
using ‹mset Σ ⊆# mset (𝔙 Ψ)›
by (metis (no_types, lifting) Un_iff mset_le_perm_append perm_set_eq set_append)
hence "length (fst σ) ∉ set (map (λa. length (fst a)) Σ)"
using Cons.prems(2) ‹σ = (Δ, δ)›
by fastforce
ultimately show ?case by simp
qed
moreover have "length (map (length ∘ fst) Σ) = length Σ" by simp
moreover have "map (length ∘ fst) Σ ≠ []" using assms by simp
ultimately show ?thesis
using distinct_pigeon_hole
by fastforce
qed
abbreviation (in classical_logic)
MaxSAT_optimal_witness :: "'a ⇒ 'a list ⇒ ('a × 'a) list" ("𝔚")
where "𝔚 φ Ξ ≡ map (λ(Ψ,ψ). (Ψ :→ φ, ψ)) (𝔙 Ξ)"
abbreviation (in classical_logic)
disjunction_MaxSAT_optimal_witness :: "'a ⇒ 'a list ⇒ 'a list" ("𝔚⇩⊔")
where "𝔚⇩⊔ φ Ψ ≡ map (uncurry (⊔)) (𝔚 φ Ψ)"
abbreviation (in classical_logic)
implication_MaxSAT_optimal_witness :: "'a ⇒ 'a list ⇒ 'a list" ("𝔚⇩→")
where "𝔚⇩→ φ Ψ ≡ map (uncurry (→)) (𝔚 φ Ψ)"
lemma (in classical_logic) MaxSAT_optimal_witness_conjunction_identity:
"⊢ ⨅ (𝔚⇩⊔ φ Ψ) ↔ (φ ⊔ ⨅ Ψ)"
proof (induct Ψ)
case Nil
then show ?case
unfolding biconditional_def
disjunction_def
using axiom_k
modus_ponens
verum_tautology
by (simp, blast)
next
case (Cons ψ Ψ)
have "⊢ (Ψ :→ φ) ↔ (⨅ Ψ → φ)"
by (simp add: list_curry_uncurry)
hence "⊢ ⨅ (map (uncurry (⊔)) (𝔚 φ (ψ # Ψ)))
↔ ((⨅ Ψ → φ ⊔ ψ) ⊓ ⨅ (map (uncurry (⊔)) (𝔚 φ Ψ)))"
unfolding biconditional_def
using conjunction_monotonic
disjunction_monotonic
by simp
moreover have "⊢ ((⨅ Ψ → φ ⊔ ψ) ⊓ ⨅ (map (uncurry (⊔)) (𝔚 φ Ψ)))
↔ ((⨅ Ψ → φ ⊔ ψ) ⊓ (φ ⊔ ⨅ Ψ))"
using Cons.hyps biconditional_conjunction_weaken_rule
by blast
moreover
{
fix φ ψ χ
have "⊢ ((χ → φ ⊔ ψ) ⊓ (φ ⊔ χ)) ↔ (φ ⊔ (ψ ⊓ χ))"
proof -
let ?φ = "((❙⟨χ❙⟩ → ❙⟨φ❙⟩ ⊔ ❙⟨ψ❙⟩) ⊓ (❙⟨φ❙⟩ ⊔ ❙⟨χ❙⟩)) ↔ (❙⟨φ❙⟩ ⊔ (❙⟨ψ❙⟩ ⊓ ❙⟨χ❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
ultimately have "⊢ ⨅ (map (uncurry (⊔)) (𝔚 φ (ψ # Ψ))) ↔ (φ ⊔ (ψ ⊓ ⨅ Ψ))"
using biconditional_transitivity_rule
by blast
then show ?case by simp
qed
lemma (in classical_logic) MaxSAT_optimal_witness_deduction:
"⊢ 𝔚⇩⊔ φ Ψ :→ φ ↔ Ψ :→ φ"
proof -
have "⊢ 𝔚⇩⊔ φ Ψ :→ φ ↔ (⨅ (𝔚⇩⊔ φ Ψ) → φ)"
by (simp add: list_curry_uncurry)
moreover
{
fix α β γ
have "⊢ (α ↔ β) → ((α → γ) ↔ (β → γ))"
proof -
let ?φ = "(❙⟨α❙⟩ ↔ ❙⟨β❙⟩) → ((❙⟨α❙⟩ → ❙⟨γ❙⟩) ↔ (❙⟨β❙⟩ → ❙⟨γ❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
ultimately have "⊢ 𝔚⇩⊔ φ Ψ :→ φ ↔ ((φ ⊔ ⨅ Ψ) → φ)"
using modus_ponens
biconditional_transitivity_rule
MaxSAT_optimal_witness_conjunction_identity
by blast
moreover
{
fix α β
have "⊢ ((α ⊔ β) → α) ↔ (β → α)"
proof -
let ?φ = "((❙⟨α❙⟩ ⊔ ❙⟨β❙⟩) → ❙⟨α❙⟩) ↔ (❙⟨β❙⟩ → ❙⟨α❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
}
ultimately have "⊢ 𝔚⇩⊔ φ Ψ :→ φ ↔ (⨅ Ψ → φ)"
using biconditional_transitivity_rule by blast
thus ?thesis
using biconditional_symmetry_rule
biconditional_transitivity_rule
list_curry_uncurry
by blast
qed
lemma (in classical_logic) optimal_witness_split_identity:
"⊢ (𝔚⇩⊔ φ (ψ # Ξ)) :→ φ → (𝔚⇩→ φ (ψ # Ξ)) :→ φ → Ξ :→ φ"
proof (induct Ξ)
case Nil
have "⊢ ((φ ⊔ ψ) → φ) → ((φ → ψ) → φ) → φ"
proof -
let ?φ = "((❙⟨φ❙⟩ ⊔ ❙⟨ψ❙⟩) → ❙⟨φ❙⟩) → ((❙⟨φ❙⟩ → ❙⟨ψ❙⟩) → ❙⟨φ❙⟩) → ❙⟨φ❙⟩"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
then show ?case by simp
next
case (Cons ξ Ξ)
let ?A = "𝔚⇩⊔ φ Ξ :→ φ"
let ?B = "𝔚⇩→ φ Ξ :→ φ"
let ?X = "Ξ :→ φ"
from Cons.hyps have "⊢ ((?X ⊔ ψ) → ?A) → ((?X → ψ) → ?B) → ?X" by simp
moreover
have "⊢ (((?X ⊔ ψ) → ?A) → ((?X → ψ) → ?B) → ?X)
→ ((ξ → ?X ⊔ ψ) → (?X ⊔ ξ) → ?A) → (((ξ → ?X) → ψ) → (?X → ξ) → ?B) → ξ → ?X"
proof -
let ?φ ="(((❙⟨?X❙⟩ ⊔ ❙⟨ψ❙⟩) → ❙⟨?A❙⟩) → ((❙⟨?X❙⟩ → ❙⟨ψ❙⟩) → ❙⟨?B❙⟩) → ❙⟨?X❙⟩) →
((❙⟨ξ❙⟩ → ❙⟨?X❙⟩ ⊔ ❙⟨ψ❙⟩) → (❙⟨?X❙⟩ ⊔ ❙⟨ξ❙⟩) → ❙⟨?A❙⟩) →
(((❙⟨ξ❙⟩ → ❙⟨?X❙⟩) → ❙⟨ψ❙⟩) → (❙⟨?X❙⟩ → ❙⟨ξ❙⟩) → ❙⟨?B❙⟩) →
❙⟨ξ❙⟩ →
❙⟨?X❙⟩"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
ultimately
have " ⊢ ((ξ → ?X ⊔ ψ) → (?X ⊔ ξ) → ?A) → (((ξ → ?X) → ψ) → (?X → ξ) → ?B) → ξ → ?X"
using modus_ponens
by blast
thus ?case by simp
qed
lemma (in classical_logic) disj_conj_impl_duality:
"⊢ (φ → χ ⊓ ψ → χ) ↔ ((φ ⊔ ψ) → χ)"
proof -
let ?φ = "(❙⟨φ❙⟩ → ❙⟨χ❙⟩ ⊓ ❙⟨ψ❙⟩ → ❙⟨χ❙⟩) ↔ ((❙⟨φ❙⟩ ⊔ ❙⟨ψ❙⟩) → ❙⟨χ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
lemma (in classical_logic) weak_disj_of_conj_equiv:
"(∀σ∈set Σ. σ :⊢ φ) = ⊢ ⨆ (map ⨅ Σ) → φ"
proof (induct Σ)
case Nil
then show ?case
by (simp add: ex_falso_quodlibet)
next
case (Cons σ Σ)
have "(∀σ'∈set (σ # Σ). σ' :⊢ φ) = (σ :⊢ φ ∧ (∀σ'∈set Σ. σ' :⊢ φ))" by simp
also have "... = (⊢ σ :→ φ ∧ ⊢ ⨆ (map ⨅ Σ) → φ)" using Cons.hyps list_deduction_def by simp
also have "... = (⊢ ⨅ σ → φ ∧ ⊢ ⨆ (map ⨅ Σ) → φ)"
using list_curry_uncurry weak_biconditional_weaken by blast
also have "... = (⊢ ⨅ σ → φ ⊓ ⨆ (map ⨅ Σ) → φ)" by simp
also have "... = (⊢ (⨅ σ ⊔ ⨆ (map ⨅ Σ)) → φ)"
using disj_conj_impl_duality weak_biconditional_weaken by blast
finally show ?case by simp
qed
lemma (in classical_logic) arbitrary_disj_concat_equiv:
"⊢ ⨆ (Φ @ Ψ) ↔ (⨆ Φ ⊔ ⨆ Ψ)"
proof (induct Φ)
case Nil
then show ?case
by (simp,
meson ex_falso_quodlibet
modus_ponens
biconditional_introduction
disjunction_elimination
disjunction_right_introduction
trivial_implication)
next
case (Cons φ Φ)
have "⊢ ⨆ (Φ @ Ψ) ↔ (⨆ Φ ⊔ ⨆ Ψ) → (φ ⊔ ⨆ (Φ @ Ψ)) ↔ ((φ ⊔ ⨆ Φ) ⊔ ⨆ Ψ)"
proof -
let ?φ =
"(❙⟨⨆ (Φ @ Ψ)❙⟩ ↔ (❙⟨⨆ Φ❙⟩ ⊔ ❙⟨⨆ Ψ❙⟩)) → (❙⟨φ❙⟩ ⊔ ❙⟨⨆ (Φ @ Ψ)❙⟩) ↔ ((❙⟨φ❙⟩ ⊔ ❙⟨⨆ Φ❙⟩) ⊔ ❙⟨⨆ Ψ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
then show ?case using Cons modus_ponens by simp
qed
lemma (in classical_logic) arbitrary_conj_concat_equiv:
"⊢ ⨅ (Φ @ Ψ) ↔ (⨅ Φ ⊓ ⨅ Ψ)"
proof (induct Φ)
case Nil
then show ?case
by (simp,
meson modus_ponens
biconditional_introduction
conjunction_introduction
conjunction_right_elimination
verum_tautology)
next
case (Cons φ Φ)
have "⊢ ⨅ (Φ @ Ψ) ↔ (⨅ Φ ⊓ ⨅ Ψ) → (φ ⊓ ⨅ (Φ @ Ψ)) ↔ ((φ ⊓ ⨅ Φ) ⊓ ⨅ Ψ)"
proof -
let ?φ =
"(❙⟨⨅ (Φ @ Ψ)❙⟩ ↔ (❙⟨⨅ Φ❙⟩ ⊓ ❙⟨⨅ Ψ❙⟩)) → (❙⟨φ❙⟩ ⊓ ❙⟨⨅ (Φ @ Ψ)❙⟩) ↔ ((❙⟨φ❙⟩ ⊓ ❙⟨⨅ Φ❙⟩) ⊓ ❙⟨⨅ Ψ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
then show ?case using Cons modus_ponens by simp
qed
lemma (in classical_logic) conj_absorption:
assumes "χ ∈ set Φ"
shows "⊢ ⨅ Φ ↔ (χ ⊓ ⨅ Φ)"
using assms
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
then show ?case
proof (cases "φ = χ")
case True
then show ?thesis
by (simp,
metis biconditional_def
implication_distribution
trivial_implication
weak_biconditional_weaken
weak_conjunction_deduction_equivalence)
next
case False
then show ?thesis
by (metis Cons.prems
arbitrary_conjunction.simps(2)
modus_ponens
arbitrary_conjunction_antitone
biconditional_introduction
remdups.simps(2)
set_remdups
set_subset_Cons)
qed
qed
lemma (in classical_logic) : "⊢ ⨆ (map ((⊓) φ) Ψ) ↔ (φ ⊓ ⨆ Ψ)"
proof (induct Ψ)
case Nil
then show ?case
by (simp add: ex_falso_quodlibet biconditional_def conjunction_right_elimination)
next
case (Cons ψ Ψ)
have "⊢ ⨆ (map ((⊓) φ) Ψ) ↔ (φ ⊓ ⨆ Ψ)
→ ((φ ⊓ ψ) ⊔ ⨆ (map ((⊓) φ) Ψ)) ↔ (φ ⊓ (ψ ⊔ ⨆ Ψ))"
proof -
let ?φ = "❙⟨⨆ (map ((⊓) φ) Ψ)❙⟩ ↔ (❙⟨φ❙⟩ ⊓ ❙⟨⨆ Ψ❙⟩)
→ ((❙⟨φ❙⟩ ⊓ ❙⟨ψ❙⟩) ⊔ ❙⟨⨆ (map ((⊓) φ) Ψ)❙⟩) ↔ (❙⟨φ❙⟩ ⊓ (❙⟨ψ❙⟩ ⊔ ❙⟨⨆ Ψ❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
then show ?case using Cons modus_ponens by simp
qed
lemma (in classical_logic) :
"⊢ ⨆ (map ⨅ (map ((@) Δ) Σ)) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ Σ))"
proof (induct Σ)
case Nil
then show ?case
by (simp, metis list.simps(8) arbitrary_disjunction.simps(1) conj_extract)
next
case (Cons σ Σ)
moreover have
"⊢ ⨆ (map ⨅ (map ((@) Δ) Σ)) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ Σ))
→ ⨅ (Δ @ σ) ↔ (⨅ Δ ⊓ ⨅ σ)
→ (⨅ (Δ @ σ) ⊔ ⨆ (map (⨅ ∘ (@) Δ) Σ)) ↔ (⨅ Δ ⊓ (⨅ σ ⊔ ⨆ (map ⨅ Σ)))"
proof -
let ?φ =
" ❙⟨⨆ (map ⨅ (map ((@) Δ) Σ))❙⟩ ↔ (❙⟨⨅ Δ❙⟩ ⊓ ❙⟨⨆ (map ⨅ Σ)❙⟩)
→ ❙⟨⨅ (Δ @ σ)❙⟩ ↔ (❙⟨⨅ Δ❙⟩ ⊓ ❙⟨⨅ σ❙⟩)
→ (❙⟨⨅ (Δ @ σ)❙⟩ ⊔ ❙⟨⨆ (map (⨅ ∘ (@) Δ) Σ)❙⟩) ↔ (❙⟨⨅ Δ❙⟩ ⊓ (❙⟨⨅ σ❙⟩ ⊔ ❙⟨⨆ (map ⨅ Σ)❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
hence
"⊢ (⨅ (Δ @ σ) ⊔ ⨆ (map (⨅ ∘ (@) Δ) Σ)) ↔ (⨅ Δ ⊓ (⨅ σ ⊔ ⨆ (map ⨅ Σ)))"
using Cons.hyps arbitrary_conj_concat_equiv modus_ponens by blast
then show ?case by simp
qed
lemma (in classical_logic) :
"⊢ ⨆ (map (⨅ ∘ (map snd ∘ (@) Δ)) Ψ) ↔ (⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ map snd) Ψ))"
proof (induct Δ)
case Nil
then show ?case
by (simp,
meson modus_ponens
biconditional_introduction
conjunction_introduction
conjunction_right_elimination
verum_tautology)
next
case (Cons χ Δ)
let ?Δ' = "map snd Δ"
let ?χ' = "snd χ"
let ?Π = "λφ. ⨅ (map snd φ)"
let ?ΠΔ = "λφ. ⨅ (?Δ' @ map snd φ)"
from Cons have
"⊢ ⨆ (map ?ΠΔ Ψ) ↔ (⨅ ?Δ' ⊓ ⨆ (map ?Π Ψ))"
by auto
moreover have ⋆: "map (λφ. ?χ' ⊓ ?ΠΔ φ) = map ((⊓) ?χ') ∘ map ?ΠΔ"
by fastforce
have "⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ) = ⨆ (map ((⊓) ?χ') (map ?ΠΔ Ψ))"
by (simp add: ⋆)
hence
"⊢ ⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ) ↔ (?χ' ⊓ ⨆ (map (λφ. ?ΠΔ φ) Ψ))"
using conj_extract by presburger
moreover have
"⊢ ⨆ (map ?ΠΔ Ψ) ↔ (⨅ ?Δ' ⊓ ⨆ (map ?Π Ψ))
→ ⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ) ↔ (?χ' ⊓ ⨆ (map ?ΠΔ Ψ))
→ ⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ) ↔ ((?χ' ⊓ ⨅ ?Δ') ⊓ ⨆ (map ?Π Ψ))"
proof -
let ?φ = "❙⟨⨆ (map ?ΠΔ Ψ)❙⟩ ↔ (❙⟨⨅ ?Δ'❙⟩ ⊓ ❙⟨⨆ (map ?Π Ψ)❙⟩)
→ ❙⟨⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ)❙⟩ ↔ (❙⟨?χ'❙⟩ ⊓ ❙⟨⨆ (map ?ΠΔ Ψ)❙⟩)
→ ❙⟨⨆ (map (λφ. ?χ' ⊓ ?ΠΔ φ) Ψ)❙⟩ ↔ ((❙⟨?χ'❙⟩ ⊓ ❙⟨⨅ ?Δ'❙⟩) ⊓ ❙⟨⨆ (map ?Π Ψ)❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
ultimately have "⊢ ⨆ (map (λφ. ?χ' ⊓ ⨅ (?Δ' @ map snd φ)) Ψ)
↔ ((?χ' ⊓ ⨅ ?Δ') ⊓ ⨆ (map (λφ. ⨅ (map snd φ)) Ψ))"
using modus_ponens by blast
thus ?case by simp
qed
lemma (in classical_logic) :
"⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ) ↔
(⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
proof -
have "∀ Ψ. ⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ) ↔
(⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
proof (induct Δ)
case Nil
then show ?case
by (simp,
meson modus_ponens
biconditional_introduction
conjunction_introduction
conjunction_right_elimination
verum_tautology)
next
case (Cons δ Δ)
{
fix Ψ
have " ⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)
↔ (⨅ (map snd (δ # Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
proof (cases "δ ∈ set Δ")
assume "δ ∈ set Δ"
have
"⊢ ⨅ (map snd Δ) ↔ (snd δ ⊓ ⨅ (map snd Δ))
→ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)
↔ (⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))
→ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)
↔ ((snd δ ⊓ ⨅ (map snd Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
proof -
let ?φ = " ❙⟨⨅ (map snd Δ)❙⟩ ↔ (❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩)
→ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)❙⟩
↔ (❙⟨⨅ (map snd Δ)❙⟩ ⊓ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩)
→ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)❙⟩
↔ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩) ⊓ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
moreover have "⊢ ⨅ (map snd Δ) ↔ (snd δ ⊓ ⨅ (map snd Δ))"
by (simp add: ‹δ ∈ set Δ› conj_absorption)
ultimately have
"⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)
↔ ((snd δ ⊓ ⨅ (map snd Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
using Cons.hyps modus_ponens by blast
moreover have "map snd ∘ remdups ∘ (@) (δ # Δ) = map snd ∘ remdups ∘ (@) Δ"
using ‹δ ∈ set Δ› by fastforce
ultimately show ?thesis using Cons by simp
next
assume "δ ∉ set Δ"
hence †:
"⨅ ∘ (map snd ∘ remdups) = (λψ. ⨅ (map snd (remdups ψ)))"
" (λψ. ⨅ (map snd (if δ ∈ set ψ then remdups (Δ @ ψ) else δ # remdups (Δ @ ψ))))
= ⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))"
by fastforce+
show ?thesis
proof (induct Ψ)
case Nil
then show ?case
by (simp, metis list.simps(8) arbitrary_disjunction.simps(1) conj_extract)
next
case (Cons ψ Ψ)
have "⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) [ψ])
↔ (⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) [ψ]))"
using ‹∀Ψ. ⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) Δ)) Ψ)
↔ (⨅ (map snd Δ) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))›
by blast
hence
"⊢ (⨅ (map snd (remdups (Δ @ ψ))) ⊔ ⊥)
↔ (⨅ (map snd Δ) ⊓ ⨅ (map snd (remdups ψ)) ⊔ ⊥)"
by simp
hence ⋆:
"⊢ ⨅ (map snd (remdups (Δ @ ψ))) ↔ (⨅ (map snd Δ) ⊓ ⨅ (map snd (remdups ψ)))"
by (metis
(no_types, opaque_lifting)
biconditional_conjunction_weaken_rule
biconditional_symmetry_rule
biconditional_transitivity_rule
disjunction_def
double_negation_biconditional
negation_def)
have "⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)
↔ (⨅ (map snd (δ # Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
using Cons by blast
hence ♢: "⊢ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)
↔ ((snd δ ⊓ ⨅ (map snd Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ))"
by simp
show ?case
proof (cases "δ ∈ set ψ")
assume "δ ∈ set ψ"
have "snd δ ∈ set (map snd (remdups ψ))"
using ‹δ ∈ set ψ› by auto
hence ♠: "⊢ ⨅ (map snd (remdups ψ)) ↔ (snd δ ⊓ ⨅ (map snd (remdups ψ)))"
using conj_absorption by blast
have
"⊢ (⨅ (map snd (remdups ψ)) ↔ (snd δ ⊓ ⨅ (map snd (remdups ψ))))
→ (⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)
↔ ((snd δ ⊓ ⨅ (map snd Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))
→ (⨅ (map snd (remdups (Δ @ ψ))) ↔ (⨅ (map snd Δ) ⊓ ⨅ (map snd (remdups ψ))))
→ (⨅ (map snd (remdups (Δ @ ψ)))
⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ))
↔ ((snd δ ⊓ ⨅ (map snd Δ))
⊓ (⨅ (map snd (remdups ψ)) ⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))"
proof -
let ?φ =
" (❙⟨⨅ (map snd (remdups ψ))❙⟩ ↔ (❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd (remdups ψ))❙⟩))
→ (❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)❙⟩
↔ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩) ⊓ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩))
→ (❙⟨⨅ (map snd (remdups (Δ @ ψ)))❙⟩
↔ (❙⟨⨅ (map snd Δ)❙⟩ ⊓ ❙⟨⨅ (map snd (remdups ψ))❙⟩))
→ (❙⟨⨅ (map snd (remdups (Δ @ ψ)))❙⟩
⊔ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)❙⟩)
↔ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩)
⊓ (❙⟨⨅ (map snd (remdups ψ))❙⟩ ⊔ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
hence
"⊢ (⨅ (map snd (remdups (Δ @ ψ)))
⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ))
↔ ((snd δ ⊓ ⨅ (map snd Δ))
⊓ (⨅ (map snd (remdups ψ)) ⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))"
using ⋆ ♢ ♠ modus_ponens by blast
thus ?thesis using ‹δ ∉ set Δ› ‹δ ∈ set ψ›
by (simp add: †)
next
assume "δ ∉ set ψ"
have
"⊢ (⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)
↔ ((snd δ ⊓ ⨅ (map snd Δ)) ⊓ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))
→ (⨅ (map snd (remdups (Δ @ ψ))) ↔ (⨅ (map snd Δ) ⊓ ⨅ (map snd (remdups ψ))))
→ ((snd δ ⊓ ⨅ (map snd (remdups (Δ @ ψ))))
⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ))
↔ ((snd δ ⊓ ⨅ (map snd Δ))
⊓ (⨅ (map snd (remdups ψ)) ⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))"
proof -
let ?φ =
" (❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)❙⟩
↔ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩) ⊓ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩))
→ (❙⟨⨅ (map snd (remdups (Δ @ ψ)))❙⟩
↔ (❙⟨⨅ (map snd Δ)❙⟩ ⊓ ❙⟨⨅ (map snd (remdups ψ))❙⟩))
→ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd (remdups (Δ @ ψ)))❙⟩)
⊔ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ)❙⟩)
↔ ((❙⟨snd δ❙⟩ ⊓ ❙⟨⨅ (map snd Δ)❙⟩)
⊓ (❙⟨⨅ (map snd (remdups ψ))❙⟩ ⊔ ❙⟨⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
hence
"⊢ ((snd δ ⊓ ⨅ (map snd (remdups (Δ @ ψ))))
⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups ∘ (@) (δ # Δ))) Ψ))
↔ ((snd δ ⊓ ⨅ (map snd Δ))
⊓ (⨅ (map snd (remdups ψ)) ⊔ ⨆ (map (⨅ ∘ (map snd ∘ remdups)) Ψ)))"
using ⋆ ♢ modus_ponens by blast
then show ?thesis using ‹δ ∉ set ψ› ‹δ ∉ set Δ› by (simp add: †)
qed
qed
qed
}
then show ?case by fastforce
qed
thus ?thesis by blast
qed
lemma (in classical_logic) optimal_witness_list_intersect_biconditional:
assumes "mset Ξ ⊆# mset Γ"
and "mset Φ ⊆# mset (Γ ⊖ Ξ)"
and "mset Ψ ⊆# mset (𝔚⇩→ φ Ξ)"
shows "∃ Σ. ⊢ ((Φ @ Ψ) :→ φ) ↔ (⨆ (map ⨅ Σ) → φ)
∧ (∀ σ ∈ set Σ. mset σ ⊆# mset Γ ∧ length σ + 1 ≥ length (Φ @ Ψ))"
proof -
have "∃ Σ. ⊢ (Ψ :→ φ) ↔ (⨆ (map ⨅ Σ) → φ)
∧ (∀ σ ∈ set Σ. mset σ ⊆# mset Ξ ∧ length σ + 1 ≥ length Ψ)"
proof -
from assms(3) obtain Ψ⇩0 :: "('a list × 'a) list" where Ψ⇩0:
"mset Ψ⇩0 ⊆# mset (𝔙 Ξ)"
"map (λ(Ψ,ψ). (Ψ :→ φ → ψ)) Ψ⇩0 = Ψ"
using mset_sub_map_list_exists by fastforce
let ?Π⇩C = "λ (Δ,δ) Σ. (map ((#) (Δ, δ)) Σ) @ (map ((@) (𝔙 Δ)) Σ)"
let ?T⇩Σ = "λ Ψ. foldr ?Π⇩C Ψ [[]]"
let ?Σ = "map (map snd ∘ remdups) (?T⇩Σ Ψ⇩0)"
have I: "⊢ (Ψ :→ φ) ↔ (⨆ (map ⨅ ?Σ) → φ)"
proof -
let ?Σ⇩α = "map (map snd) (?T⇩Σ Ψ⇩0)"
let ?Ψ' = "map (λ(Ψ,ψ). (Ψ :→ φ → ψ)) Ψ⇩0"
{
fix Ψ :: "('a list × 'a) list"
let ?Σ⇩α = "map (map snd) (?T⇩Σ Ψ)"
let ?Σ = "map (map snd ∘ remdups) (?T⇩Σ Ψ)"
have "⊢ (⨆ (map ⨅ ?Σ⇩α) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)"
proof (induct Ψ)
case Nil
then show ?case by (simp add: biconditional_reflection)
next
case (Cons Δδ Ψ)
let ?Δ = "fst Δδ"
let ?δ = "snd Δδ"
let ?Σ⇩α = "map (map snd) (?T⇩Σ Ψ)"
let ?Σ = "map (map snd ∘ remdups) (?T⇩Σ Ψ)"
let ?Σ⇩α' = "map (map snd) (?T⇩Σ ((?Δ,?δ) # Ψ))"
let ?Σ' = "map (map snd ∘ remdups) (?T⇩Σ ((?Δ,?δ) # Ψ))"
{
fix Δ :: "'a list"
fix δ :: 'a
let ?Σ⇩α' = "map (map snd) (?T⇩Σ ((Δ,δ) # Ψ))"
let ?Σ' = "map (map snd ∘ remdups) (?T⇩Σ ((Δ,δ) # Ψ))"
let ?Φ = "map (map snd ∘ (@) [(Δ, δ)]) (?T⇩Σ Ψ)"
let ?Ψ = "map (map snd ∘ (@) (𝔙 Δ)) (?T⇩Σ Ψ)"
let ?Δ = "map (map snd ∘ remdups ∘ (@) [(Δ, δ)]) (?T⇩Σ Ψ)"
let ?Ω = "map (map snd ∘ remdups ∘ (@) (𝔙 Δ)) (?T⇩Σ Ψ)"
have "⊢ (⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ) ↔ (⨆ (map ⨅ ?Φ) ⊔ ⨆ (map ⨅ ?Ψ))) →
(⨆ (map ⨅ ?Δ @ map ⨅ ?Ω) ↔ (⨆ (map ⨅ ?Δ) ⊔ ⨆ (map ⨅ ?Ω))) →
(⨆ (map ⨅ ?Φ) ↔ (⨅ [δ] ⊓ ⨆ (map ⨅ ?Σ⇩α))) →
(⨆ (map ⨅ ?Ψ) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ ?Σ⇩α))) →
(⨆ (map ⨅ ?Δ) ↔ (⨅ [δ] ⊓ ⨆ (map ⨅ ?Σ))) →
(⨆ (map ⨅ ?Ω) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ ?Σ))) →
((⨆ (map ⨅ ?Σ⇩α) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)) →
((⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ) → φ) ↔ (⨆ (map ⨅ ?Δ @ map ⨅ ?Ω) → φ))"
proof -
let ?φ =
"(❙⟨⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ)❙⟩ ↔ (❙⟨⨆ (map ⨅ ?Φ)❙⟩ ⊔ ❙⟨⨆ (map ⨅ ?Ψ)❙⟩)) →
(❙⟨⨆ (map ⨅ ?Δ @ map ⨅ ?Ω)❙⟩ ↔ (❙⟨⨆ (map ⨅ ?Δ)❙⟩ ⊔ ❙⟨⨆ (map ⨅ ?Ω)❙⟩)) →
(❙⟨⨆ (map ⨅ ?Φ)❙⟩ ↔ (❙⟨⨅ [δ]❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩)) →
(❙⟨⨆ (map ⨅ ?Ψ)❙⟩ ↔ (❙⟨⨅ Δ❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩)) →
(❙⟨⨆ (map ⨅ ?Δ)❙⟩ ↔ (❙⟨⨅ [δ]❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ)❙⟩)) →
(❙⟨⨆ (map ⨅ ?Ω)❙⟩ ↔ (❙⟨⨅ Δ❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ)❙⟩)) →
((❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩ → ❙⟨φ❙⟩) ↔ (❙⟨⨆ (map ⨅ ?Σ)❙⟩ → ❙⟨φ❙⟩)) →
((❙⟨⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ)❙⟩ → ❙⟨φ❙⟩) ↔ (❙⟨⨆ (map ⨅ ?Δ @ map ⨅ ?Ω)❙⟩ → ❙⟨φ❙⟩))"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
moreover
have "map snd (𝔙 Δ) = Δ" by (induct Δ, auto)
hence "⊢ ⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ) ↔ (⨆ (map ⨅ ?Φ) ⊔ ⨆ (map ⨅ ?Ψ))"
"⊢ ⨆ (map ⨅ ?Δ @ map ⨅ ?Ω) ↔ (⨆ (map ⨅ ?Δ) ⊔ ⨆ (map ⨅ ?Ω))"
"⊢ ⨆ (map ⨅ ?Φ) ↔ (⨅ [δ] ⊓ ⨆ (map ⨅ ?Σ⇩α))"
"⊢ ⨆ (map ⨅ ?Ψ) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ ?Σ⇩α))"
"⊢ ⨆ (map ⨅ ?Δ) ↔ (⨅ [δ] ⊓ ⨆ (map ⨅ ?Σ))"
"⊢ ⨆ (map ⨅ ?Ω) ↔ (⨅ Δ ⊓ ⨆ (map ⨅ ?Σ))"
using arbitrary_disj_concat_equiv
extract_inner_concat [where Δ = "[(Δ, δ)]" and Ψ = "?T⇩Σ Ψ"]
extract_inner_concat [where Δ = "𝔙 Δ" and Ψ = "?T⇩Σ Ψ"]
extract_inner_concat_remdups [where Δ = "[(Δ, δ)]" and Ψ = "?T⇩Σ Ψ"]
extract_inner_concat_remdups [where Δ = "𝔙 Δ" and Ψ = "?T⇩Σ Ψ"]
by auto
ultimately have
"⊢ ((⨆ (map ⨅ ?Σ⇩α) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)) →
(⨆ (map ⨅ ?Φ @ map ⨅ ?Ψ) → φ) ↔ (⨆ (map ⨅ ?Δ @ map ⨅ ?Ω) → φ)"
using modus_ponens by blast
moreover have "(#) (Δ, δ) = (@) [(Δ, δ)]" by fastforce
ultimately have
"⊢ ((⨆ (map ⨅ ?Σ⇩α) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)) →
((⨆ (map ⨅ ?Σ⇩α') → φ) ↔ (⨆ (map ⨅ ?Σ') → φ))"
by auto
}
hence
"⊢ ((⨆ (map ⨅ ?Σ⇩α') → φ) ↔ (⨆ (map ⨅ ?Σ') → φ))"
using Cons modus_ponens by blast
moreover have "Δδ = (?Δ,?δ)" by fastforce
ultimately show ?case by metis
qed
}
hence "⊢ (⨆ (map ⨅ ?Σ⇩α) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)" by blast
moreover have "⊢ (?Ψ' :→ φ) ↔ (⨆ (map ⨅ ?Σ⇩α) → φ)"
proof (induct Ψ⇩0)
case Nil
have "⊢ φ ↔ ((⊤ ⊔ ⊥) → φ)"
proof -
let ?φ = "❙⟨φ❙⟩ ↔ ((⊤ ⊔ ⊥) → ❙⟨φ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
thus ?case by simp
next
case (Cons ψ⇩0 Ψ⇩0)
let ?Ξ = "fst ψ⇩0"
let ?δ = "snd ψ⇩0"
let ?Ψ' = "map (λ(Ψ,ψ). (Ψ :→ φ → ψ)) Ψ⇩0"
let ?Σ⇩α = "map (map snd) (?T⇩Σ Ψ⇩0)"
{
fix Ξ :: "'a list"
have "map snd (𝔙 Ξ) = Ξ" by (induct Ξ, auto)
hence "map snd ∘ (@) (𝔙 Ξ) = (@) Ξ ∘ map snd" by fastforce
}
moreover have "(map snd ∘ (#) (?Ξ, ?δ)) = (@) [?δ] ∘ map snd" by fastforce
ultimately have †:
"map (map snd) (?T⇩Σ (ψ⇩0 # Ψ⇩0)) = map ((#) ?δ) ?Σ⇩α @ map ((@) ?Ξ) ?Σ⇩α"
"map (λ(Ψ,ψ). (Ψ :→ φ → ψ)) (ψ⇩0 # Ψ⇩0) = ?Ξ :→ φ → ?δ # ?Ψ'"
by (simp add: case_prod_beta')+
have A: "⊢ (?Ψ' :→ φ) ↔ (⨆ (map ⨅ ?Σ⇩α) → φ)" using Cons.hyps by auto
have B: "⊢ (?Ξ :→ φ) ↔ (⨅ ?Ξ → φ)"
by (simp add: list_curry_uncurry)
have C: "⊢ ⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α))
↔ (⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α)) ⊔ ⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α)))"
using arbitrary_disj_concat_equiv by blast
have "map ⨅ (map ((#) ?δ) ?Σ⇩α) = (map ((⊓) ?δ) (map ⨅ ?Σ⇩α))" by auto
hence D: "⊢ ⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α)) ↔ (?δ ⊓ ⨆ (map ⨅ ?Σ⇩α))"
using conj_extract by presburger
have E: "⊢ ⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α)) ↔ (⨅ ?Ξ ⊓ ⨆ (map ⨅ ?Σ⇩α))"
using conj_multi_extract by blast
have
"⊢ (?Ψ' :→ φ) ↔ (⨆ (map ⨅ ?Σ⇩α) → φ)
→ (?Ξ :→ φ) ↔ (⨅ ?Ξ → φ)
→ ⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α))
↔ (⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α)) ⊔ ⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α)))
→ ⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α)) ↔ (?δ ⊓ ⨆ (map ⨅ ?Σ⇩α))
→ ⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α)) ↔ (⨅ ?Ξ ⊓ ⨆ (map ⨅ ?Σ⇩α))
→ ((?Ξ :→ φ → ?δ) → ?Ψ' :→ φ)
↔ (⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α)) → φ)"
proof -
let ?φ =
" ❙⟨?Ψ' :→ φ❙⟩ ↔ (❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩ → ❙⟨φ❙⟩)
→ ❙⟨(?Ξ :→ φ)❙⟩ ↔ (❙⟨⨅ ?Ξ❙⟩ → ❙⟨φ❙⟩)
→ ❙⟨⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α))❙⟩
↔ (❙⟨⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α))❙⟩ ⊔ ❙⟨⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α))❙⟩)
→ ❙⟨⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α))❙⟩ ↔ (❙⟨?δ❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩)
→ ❙⟨⨆ (map ⨅ (map ((@) ?Ξ) ?Σ⇩α))❙⟩ ↔ (❙⟨⨅ ?Ξ❙⟩ ⊓ ❙⟨⨆ (map ⨅ ?Σ⇩α)❙⟩)
→ ((❙⟨?Ξ :→ φ❙⟩ → ❙⟨?δ❙⟩) → ❙⟨?Ψ' :→ φ❙⟩)
↔ (❙⟨⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α))❙⟩ → ❙⟨φ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
hence
"⊢ ((?Ξ :→ φ → ?δ) → ?Ψ' :→ φ)
↔ (⨆ (map ⨅ (map ((#) ?δ) ?Σ⇩α) @ map ⨅ (map ((@) ?Ξ) ?Σ⇩α)) → φ)"
using A B C D E modus_ponens by blast
thus ?case using † by simp
qed
ultimately show ?thesis using biconditional_transitivity_rule Ψ⇩0 by blast
qed
have II: "∀ σ ∈ set ?Σ. length σ + 1 ≥ length Ψ"
proof -
let ?ℱ = "length ∘ fst"
let ?𝒮 = "sort_key (- ?ℱ)"
let ?Σ' = "map (map snd ∘ remdups) (?T⇩Σ (?𝒮 Ψ⇩0))"
have "mset Ψ⇩0 = mset (?𝒮 Ψ⇩0)" by simp
have "∀ Φ. mset Ψ⇩0 = mset Φ ⟶ mset (map mset (?T⇩Σ Ψ⇩0)) = mset (map mset (?T⇩Σ Φ))"
proof (induct Ψ⇩0)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ⇩0)
obtain Δ δ where "ψ = (Δ,δ)" by fastforce
{
fix Φ
assume "mset (ψ # Ψ⇩0) = mset Φ"
hence "mset Ψ⇩0 = mset (remove1 ψ Φ)"
by (simp add: union_single_eq_diff)
have "ψ ∈ set Φ" using ‹mset (ψ # Ψ⇩0) = mset Φ›
by (metis list.set_intros(1) set_mset_mset)
hence "mset (map mset (?T⇩Σ Φ)) = mset (map mset (?T⇩Σ (ψ # (remove1 ψ Φ))))"
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
then show ?case proof (cases "φ = ψ")
case True
then show ?thesis by simp
next
case False
let ?Σ' = "?T⇩Σ (ψ # (remove1 ψ Φ))"
have †: "mset (map mset ?Σ') = mset (map mset (?T⇩Σ Φ))"
using Cons False by simp
obtain Δ' δ'
where "φ = (Δ',δ')"
by fastforce
let ?Σ = "?T⇩Σ (remove1 ψ Φ)"
let ?𝔪 = "image_mset mset"
have
"mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
mset (map mset (?Π⇩C ψ (?Π⇩C φ ?Σ)))"
using False by simp
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
(?𝔪 ∘ (image_mset ((#) ψ) ∘ image_mset ((#) φ))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((#) ψ) ∘ image_mset ((@) (𝔙 Δ')))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ)) ∘ image_mset ((#) φ))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ)) ∘ image_mset ((@) (𝔙 Δ')))) (mset ?Σ)"
using ‹ψ = (Δ,δ)› ‹φ = (Δ',δ')›
by (simp add: multiset.map_comp)
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
(?𝔪 ∘ (image_mset ((#) φ) ∘ image_mset ((#) ψ))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ')) ∘ image_mset ((#) ψ))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((#) φ) ∘ image_mset ((@) (𝔙 Δ)))) (mset ?Σ) +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ')) ∘ image_mset ((@) (𝔙 Δ)))) (mset ?Σ)"
by (simp add: image_mset_cons_homomorphism
image_mset_append_homomorphism
image_mset_add_collapse
add_mset_commute
add.commute)
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
(?𝔪 ∘ (image_mset ((#) φ))) (mset ?Σ') +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ')))) (mset ?Σ')"
using ‹ψ = (Δ,δ)›
by (simp add: multiset.map_comp)
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
image_mset ((+) {#φ#}) (mset (map mset ?Σ')) +
image_mset ((+) (mset (𝔙 Δ'))) (mset (map mset ?Σ'))"
by (simp add: image_mset_cons_homomorphism
image_mset_append_homomorphism)
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
image_mset ((+) {#φ#}) (mset (map mset (?T⇩Σ Φ))) +
image_mset ((+) (mset (𝔙 Δ'))) (mset (map mset (?T⇩Σ Φ)))"
using † by auto
hence "mset (map mset (?T⇩Σ (ψ # remove1 ψ (φ # Φ)))) =
(?𝔪 ∘ (image_mset ((#) φ))) (mset (?T⇩Σ Φ)) +
(?𝔪 ∘ (image_mset ((@) (𝔙 Δ')))) (mset (?T⇩Σ Φ))"
by (simp add: image_mset_cons_homomorphism
image_mset_append_homomorphism)
thus ?thesis using ‹φ = (Δ',δ')› by (simp add: multiset.map_comp)
qed
qed
hence " image_mset mset (image_mset ((#) ψ) (mset (?T⇩Σ (remove1 ψ Φ)))) +
image_mset mset (image_mset ((@) (𝔙 Δ)) (mset (?T⇩Σ (remove1 ψ Φ))))
= image_mset mset (mset (?T⇩Σ Φ))"
by (simp add: ‹ψ = (Δ,δ)› multiset.map_comp)
hence
" image_mset ((+) {# ψ #}) (image_mset mset (mset (?T⇩Σ (remove1 ψ Φ)))) +
image_mset ((+) (mset (𝔙 Δ))) (image_mset mset (mset (?T⇩Σ (remove1 ψ Φ))))
= image_mset mset (mset (?T⇩Σ Φ))"
by (simp add: image_mset_cons_homomorphism image_mset_append_homomorphism)
hence
"image_mset ((+) {# ψ #}) (image_mset mset (mset (?T⇩Σ Ψ⇩0))) +
image_mset ((+) (mset (𝔙 Δ))) (image_mset mset (mset (?T⇩Σ Ψ⇩0)))
= image_mset mset (mset (?T⇩Σ Φ))"
using Cons ‹mset Ψ⇩0 = mset (remove1 ψ Φ)›
by fastforce
hence
"image_mset mset (image_mset ((#) ψ) (mset (?T⇩Σ Ψ⇩0))) +
image_mset mset (image_mset ((@) (𝔙 Δ)) (mset (?T⇩Σ Ψ⇩0)))
= image_mset mset (mset (?T⇩Σ Φ))"
by (simp add: image_mset_cons_homomorphism image_mset_append_homomorphism)
hence "mset (map mset (?T⇩Σ (ψ # Ψ⇩0))) = mset (map mset (?T⇩Σ Φ))"
by (simp add: ‹ψ = (Δ,δ)› multiset.map_comp)
}
then show ?case by blast
qed
hence "mset (map mset (?T⇩Σ Ψ⇩0)) = mset (map mset (?T⇩Σ (?𝒮 Ψ⇩0)))"
using ‹mset Ψ⇩0 = mset (?𝒮 Ψ⇩0)› by blast
hence " mset (map (mset ∘ (map snd) ∘ remdups) (?T⇩Σ Ψ⇩0))
= mset (map (mset ∘ (map snd) ∘ remdups) (?T⇩Σ (?𝒮 Ψ⇩0)))"
using mset_mset_map_snd_remdups by blast
hence "mset (map mset ?Σ) = mset (map mset ?Σ')"
by (simp add: fun.map_comp)
hence "set (map mset ?Σ) = set (map mset ?Σ')"
using mset_eq_setD by blast
hence "∀ σ ∈ set ?Σ. ∃ σ' ∈ set ?Σ'. mset σ = mset σ'"
by fastforce
hence "∀ σ ∈ set ?Σ. ∃ σ' ∈ set ?Σ'. length σ = length σ'"
using mset_eq_length by blast
have "mset (?𝒮 Ψ⇩0) ⊆# mset (𝔙 Ξ)"
by (simp add: Ψ⇩0(1))
{
fix n
have "∀ Ψ. mset Ψ ⊆# mset (𝔙 Ξ) ⟶
sorted (map (- ?ℱ) Ψ) ⟶
length Ψ = n ⟶
(∀ σ' ∈ set (map (map snd ∘ remdups) (?T⇩Σ Ψ)). length σ' + 1 ≥ n)"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
{
fix Ψ :: "('a list × 'a) list"
assume A: "mset Ψ ⊆# mset (𝔙 Ξ)"
and B: "sorted (map (- ?ℱ) Ψ)"
and C: "length Ψ = n + 1"
obtain Δ δ where "(Δ, δ) = hd Ψ"
using prod.collapse by blast
let ?Ψ' = "tl Ψ"
have "mset ?Ψ' ⊆# mset (𝔙 Ξ)" using A
by (induct Ψ, simp, simp, meson mset_subset_eq_insertD subset_mset_def)
moreover
have "sorted (map (- ?ℱ) (tl Ψ))"
using B
by (simp add: map_tl sorted_tl)
moreover have "length ?Ψ' = n" using C
by simp
ultimately have ⋆: "∀ σ' ∈ set (map (map snd ∘ remdups) (?T⇩Σ ?Ψ')). length σ' + 1 ≥ n"
using Suc
by blast
from C have "Ψ = (Δ, δ) # ?Ψ'"
by (metis ‹(Δ, δ) = hd Ψ›
One_nat_def
add_is_0
list.exhaust_sel
list.size(3)
nat.simps(3))
have "distinct ((Δ, δ) # ?Ψ')"
using A ‹Ψ = (Δ, δ) # ?Ψ'›
MaxSAT_optimal_pre_witness_distinct
mset_distinct_msub_down
by fastforce
hence "set ((Δ, δ) # ?Ψ') ⊆ set (𝔙 Ξ)"
by (metis A ‹Ψ = (Δ, δ) # ?Ψ'›
Un_iff
mset_le_perm_append
perm_set_eq set_append
subsetI)
hence "∀ (Δ', δ') ∈ set ?Ψ'. (Δ, δ) ≠ (Δ', δ')"
"∀ (Δ', δ') ∈ set (𝔙 Ξ). ((Δ, δ) ≠ (Δ', δ')) ⟶ (length Δ ≠ length Δ')"
"set ?Ψ' ⊆ set (𝔙 Ξ)"
using MaxSAT_optimal_pre_witness_length_iff_eq [where Ψ="Ξ"]
‹distinct ((Δ, δ) # ?Ψ')›
by auto
hence "∀ (Δ', δ') ∈ set ?Ψ'. length Δ ≠ length Δ'"
"sorted (map (- ?ℱ) ((Δ, δ) # ?Ψ'))"
using B ‹Ψ = (Δ, δ) # ?Ψ'›
by (fastforce, auto)
hence "∀ (Δ', δ') ∈ set ?Ψ'. length Δ > length Δ'"
by fastforce
{
fix σ' :: "'a list"
assume "σ' ∈ set (map (map snd ∘ remdups) (?T⇩Σ Ψ))"
hence "σ' ∈ set (map (map snd ∘ remdups) (?T⇩Σ ((Δ, δ) # ?Ψ')))"
using ‹Ψ = (Δ, δ) # ?Ψ'›
by simp
from this obtain ψ where ψ:
"ψ ∈ set (?T⇩Σ ?Ψ')"
"σ' = (map snd ∘ remdups ∘ (#) (Δ, δ)) ψ ∨
σ' = (map snd ∘ remdups ∘ (@) (𝔙 Δ)) ψ"
by fastforce
hence "length σ' ≥ n"
proof (cases "σ' = (map snd ∘ remdups ∘ (#) (Δ, δ)) ψ")
case True
{
fix Ψ :: "('a list × 'a) list"
fix n :: "nat"
assume "∀ (Δ, δ) ∈ set Ψ. n > length Δ"
hence "∀ σ ∈ set (?T⇩Σ Ψ). ∀ (Δ, δ) ∈ set σ. n > length Δ"
proof (induct Ψ)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ)
obtain Δ δ where "ψ = (Δ, δ)"
by fastforce
hence "n > length Δ" using Cons.prems by fastforce
have 0: "∀ σ ∈ set (?T⇩Σ Ψ). ∀ (Δ', δ') ∈ set σ. n > length Δ'"
using Cons by simp
{
fix σ :: "('a list × 'a) list"
fix ψ' :: "'a list × 'a"
assume 1: "σ ∈ set (?T⇩Σ (ψ # Ψ))"
and 2: "ψ' ∈ set σ"
obtain Δ' δ' where "ψ' = (Δ', δ')"
by fastforce
have 3: "σ ∈ (#) (Δ, δ) ` set (?T⇩Σ Ψ) ∨ σ ∈ (@) (𝔙 Δ) ` set (?T⇩Σ Ψ)"
using 1 ‹ψ = (Δ, δ)› by simp
have "n > length Δ'"
proof (cases "σ ∈ (#) (Δ, δ) ` set (?T⇩Σ Ψ)")
case True
from this obtain σ' where
"set σ = insert (Δ, δ) (set σ')"
"σ' ∈ set (?T⇩Σ Ψ)"
by auto
then show ?thesis
using 0 ‹ψ' ∈ set σ› ‹ψ' = (Δ', δ')› ‹n > length Δ›
by auto
next
case False
from this and 3 obtain σ' where σ':
"set σ = set (𝔙 Δ) ∪ (set σ')"
"σ' ∈ set (?T⇩Σ Ψ)"
by auto
have "∀ (Δ', δ') ∈ set (𝔙 Δ). length Δ > length Δ'"
by (metis (mono_tags, lifting)
case_prodI2
MaxSAT_optimal_pre_witness_nonelement
not_le)
hence "∀ (Δ', δ') ∈ set (𝔙 Δ). n > length Δ'"
using ‹n > length Δ› by auto
then show ?thesis using 0 σ' ‹ψ' ∈ set σ› ‹ψ' = (Δ', δ')› by fastforce
qed
hence "n > length (fst ψ')" using ‹ψ' = (Δ', δ')› by fastforce
}
then show ?case by fastforce
qed
}
hence "∀ σ ∈ set (?T⇩Σ ?Ψ'). ∀ (Δ', δ') ∈ set σ. length Δ > length Δ'"
using ‹∀ (Δ', δ') ∈ set ?Ψ'. length Δ > length Δ'›
by blast
then show ?thesis using True ⋆ ψ(1) by fastforce
next
case False
have "∀ (Δ', δ') ∈ set ?Ψ'. length Δ ≥ length Δ'"
using ‹∀ (Δ', δ') ∈ set ?Ψ'. length Δ > length Δ'›
by auto
hence "∀ (Δ', δ') ∈ set Ψ. length Δ ≥ length Δ'"
using ‹Ψ = (Δ, δ) # ?Ψ'›
by (metis case_prodI2 eq_iff prod.sel(1) set_ConsD)
hence "length Δ + 1 ≥ length Ψ"
using A MaxSAT_optimal_pre_witness_pigeon_hole
by fastforce
hence "length Δ ≥ n"
using C
by simp
have "length Δ = length (𝔙 Δ)"
by (induct Δ, simp+)
hence "length (remdups (𝔙 Δ)) = length (𝔙 Δ)"
by (simp add: MaxSAT_optimal_pre_witness_distinct)
hence "length (remdups (𝔙 Δ)) ≥ n"
using ‹length Δ = length (𝔙 Δ)› ‹n ≤ length Δ›
by linarith
have "mset (remdups (𝔙 Δ @ ψ)) = mset (remdups (ψ @ 𝔙 Δ))"
by (simp add: mset_remdups)
hence "length (remdups (𝔙 Δ @ ψ)) ≥ length (remdups (𝔙 Δ))"
by (metis le_cases length_sub_mset mset_remdups_append_msub size_mset)
hence "length (remdups (𝔙 Δ @ ψ)) ≥ n"
using ‹n ≤ length (remdups (𝔙 Δ))› dual_order.trans by blast
thus ?thesis using False ψ(2)
by simp
qed
}
hence "∀ σ' ∈ set (map (map snd ∘ remdups) (?T⇩Σ Ψ)). length σ' ≥ n"
by blast
}
then show ?case by fastforce
qed
}
hence "∀ σ' ∈ set ?Σ'. length σ' + 1 ≥ length (?𝒮 Ψ⇩0)"
using ‹mset (?𝒮 Ψ⇩0) ⊆# mset (𝔙 Ξ)›
by fastforce
hence "∀ σ' ∈ set ?Σ'. length σ' + 1 ≥ length Ψ⇩0" by simp
hence "∀ σ ∈ set ?Σ. length σ + 1 ≥ length Ψ⇩0"
using ‹∀ σ ∈ set ?Σ. ∃ σ' ∈ set ?Σ'. length σ = length σ'›
by fastforce
thus ?thesis using Ψ⇩0 by fastforce
qed
have III: "∀ σ ∈ set ?Σ. mset σ ⊆# mset Ξ"
proof -
have "remdups (𝔙 Ξ) = 𝔙 Ξ"
by (simp add: MaxSAT_optimal_pre_witness_distinct distinct_remdups_id)
from Ψ⇩0(1) have "set Ψ⇩0 ⊆ set (𝔙 Ξ)"
by (metis (no_types, lifting) ‹remdups (𝔙 Ξ) = 𝔙 Ξ›
mset_remdups_set_sub_iff
mset_remdups_subset_eq
subset_mset.dual_order.trans)
hence "∀ σ ∈ set (?T⇩Σ Ψ⇩0). set σ ⊆ set (𝔙 Ξ)"
proof (induct Ψ⇩0)
case Nil
then show ?case by simp
next
case (Cons ψ Ψ⇩0)
hence "∀ σ ∈ set (?T⇩Σ Ψ⇩0). set σ ⊆ set (𝔙 Ξ)" by auto
obtain Δ δ where "ψ = (Δ,δ)" by fastforce
hence "(Δ, δ) ∈ set (𝔙 Ξ)" using Cons by simp
{
fix σ :: "('a list × 'a) list"
assume ⋆: "σ ∈ (#) (Δ, δ) ` set (?T⇩Σ Ψ⇩0) ∪ (@) (𝔙 Δ) ` set (?T⇩Σ Ψ⇩0)"
have "set σ ⊆ set (𝔙 Ξ)"
proof (cases "σ ∈ (#) (Δ, δ) ` set (?T⇩Σ Ψ⇩0)")
case True
then show ?thesis
using ‹∀ σ ∈ set (?T⇩Σ Ψ⇩0). set σ ⊆ set (𝔙 Ξ)› ‹(Δ, δ) ∈ set (𝔙 Ξ)›
by fastforce
next
case False
hence "σ ∈ (@) (𝔙 Δ) ` set (?T⇩Σ Ψ⇩0)" using ⋆ by simp
moreover have "set (𝔙 Δ) ⊆ set (𝔙 Ξ)"
using MaxSAT_optimal_pre_witness_element_inclusion ‹(Δ, δ) ∈ set (𝔙 Ξ)›
by fastforce
ultimately show ?thesis
using ‹∀ σ ∈ set (?T⇩Σ Ψ⇩0). set σ ⊆ set (𝔙 Ξ)›
by force
qed
}
hence "∀σ∈(#) (Δ, δ) ` set (?T⇩Σ Ψ⇩0) ∪ (@) (𝔙 Δ) ` set (?T⇩Σ Ψ⇩0). set σ ⊆ set (𝔙 Ξ)"
by auto
thus ?case using ‹ψ = (Δ, δ)› by simp
qed
hence "∀ σ ∈ set (?T⇩Σ Ψ⇩0). mset (remdups σ) ⊆# mset (remdups (𝔙 Ξ))"
using mset_remdups_set_sub_iff by blast
hence "∀ σ ∈ set ?Σ. mset σ ⊆# mset (map snd (𝔙 Ξ))"
using map_monotonic ‹remdups (𝔙 Ξ) = 𝔙 Ξ›
by auto
moreover have "map snd (𝔙 Ξ) = Ξ" by (induct Ξ, simp+)
ultimately show ?thesis by simp
qed
show ?thesis using I II III by fastforce
qed
from this obtain Σ⇩0 where Σ⇩0:
"⊢ (Ψ :→ φ) ↔ (⨆ (map ⨅ Σ⇩0) → φ)"
"∀ σ ∈ set Σ⇩0. mset σ ⊆# mset Ξ ∧ length σ + 1 ≥ length Ψ"
by blast
moreover
have "(Φ @ Ψ) :→ φ = Φ :→ (Ψ :→ φ)" by (induct Φ, simp+)
hence "⊢ ((Φ @ Ψ) :→ φ) ↔ (⨅ Φ → (Ψ :→ φ))"
by (simp add: list_curry_uncurry)
moreover have "⊢ (Ψ :→ φ) ↔ (⨆ (map ⨅ Σ⇩0) → φ)
→ (Φ @ Ψ) :→ φ ↔ (⨅ Φ → Ψ :→ φ)
→ (Φ @ Ψ) :→ φ ↔ ((⨅ Φ ⊓ ⨆ (map ⨅ Σ⇩0)) → φ)"
proof -
let ?φ = "❙⟨Ψ :→ φ❙⟩ ↔ (❙⟨⨆ (map ⨅ Σ⇩0)❙⟩ → ❙⟨φ❙⟩)
→ ❙⟨(Φ @ Ψ) :→ φ❙⟩ ↔ (❙⟨⨅ Φ❙⟩ → ❙⟨Ψ :→ φ❙⟩)
→ ❙⟨(Φ @ Ψ) :→ φ❙⟩ ↔ ((❙⟨⨅ Φ❙⟩ ⊓ ❙⟨⨆ (map ⨅ Σ⇩0)❙⟩) → ❙⟨φ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
moreover
let ?Σ = "map ((@) Φ) Σ⇩0"
have "∀φ ψ χ. ⊢ (φ → ψ) → χ → ψ ∨ ¬ ⊢ χ → φ"
by (meson modus_ponens flip_hypothetical_syllogism)
hence "⊢ ((⨅ Φ ⊓ ⨆ (map ⨅ Σ⇩0)) → φ) ↔ (⨆ (map ⨅ ?Σ) → φ)"
using append_dnf_distribute biconditional_def by fastforce
ultimately have "⊢ (Φ @ Ψ) :→ φ ↔ (⨆ (map ⨅ ?Σ) → φ)"
using modus_ponens biconditional_transitivity_rule
by blast
moreover
{
fix σ
assume "σ ∈ set ?Σ"
from this obtain σ⇩0 where σ⇩0: "σ = Φ @ σ⇩0" "σ⇩0 ∈ set Σ⇩0" by (simp, blast)
hence "mset σ⇩0 ⊆# mset Ξ" using Σ⇩0(2) by blast
hence "mset σ ⊆# mset (Φ @ Ξ)" using σ⇩0(1) by simp
hence "mset σ ⊆# mset Γ" using assms(1) assms(2)
by (simp, meson subset_mset.dual_order.trans subset_mset.le_diff_conv2)
moreover
have "length σ + 1 ≥ length (Φ @ Ψ)" using Σ⇩0(2) σ⇩0 by simp
ultimately have "mset σ ⊆# mset Γ" "length σ + 1 ≥ length (Φ @ Ψ)" by auto
}
ultimately
show ?thesis by blast
qed
lemma (in classical_logic) relative_maximals_optimal_witness:
assumes "¬ ⊢ φ"
shows "0 < (∥ Γ ∥⇩φ)
= (∃ Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ :⊢ φ ∧
1 + (∥ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ ∥⇩φ) = ∥ Γ ∥⇩φ)"
proof (rule iffI)
assume "0 < ∥ Γ ∥⇩φ"
from this obtain Ξ where Ξ: "Ξ ∈ ℳ Γ φ" "length Ξ < length Γ"
using ‹¬ ⊢ φ›
complement_relative_MaxSAT_def
relative_MaxSAT_intro
relative_maximals_existence
by fastforce
from this obtain ψ where ψ: "ψ ∈ set (Γ ⊖ Ξ)"
by (metis ‹0 < ∥ Γ ∥⇩φ›
less_not_refl
list.exhaust
list.set_intros(1)
list.size(3)
complement_relative_MaxSAT_intro)
let ?Σ = "𝔚 φ (ψ # Ξ)"
let ?Σ⇩A = "𝔚⇩⊔ φ (ψ # Ξ)"
let ?Σ⇩B = "𝔚⇩→ φ (ψ # Ξ)"
have ♢: "mset (ψ # Ξ) ⊆# mset Γ"
"ψ # Ξ :⊢ φ"
using Ξ(1) ψ
relative_maximals_def
list_deduction_theorem
relative_maximals_complement_deduction
msub_list_subtract_elem_cons_msub [where Ξ="Ξ"]
by blast+
moreover have "map snd ?Σ = ψ # Ξ" by (induct Ξ, simp+)
ultimately have "?Σ⇩A :⊢ φ"
"mset (map snd ?Σ) ⊆# mset Γ"
using MaxSAT_optimal_witness_deduction
list_deduction_def weak_biconditional_weaken
by (metis+)
moreover
{
let ?Γ' = "?Σ⇩B @ Γ ⊖ map snd ?Σ"
have A: "length ?Σ⇩B = 1 + length Ξ"
by (induct Ξ, simp+)
have B: "?Σ⇩B ∈ ℳ ?Γ' φ"
proof -
have "¬ ?Σ⇩B :⊢ φ"
by (metis (no_types, lifting)
Ξ(1) ‹?Σ⇩A :⊢ φ›
modus_ponens list_deduction_def
optimal_witness_split_identity
relative_maximals_def
mem_Collect_eq)
moreover have "mset ?Σ⇩B ⊆# mset ?Γ'"
by simp
hence "∀ Ψ. mset Ψ ⊆# mset ?Γ' ⟶ ¬ Ψ :⊢ φ ⟶ length Ψ ≤ length ?Σ⇩B"
proof -
have "∀ Ψ ∈ ℳ ?Γ' φ. length Ψ = length ?Σ⇩B"
proof (rule ccontr)
assume "¬ (∀ Ψ ∈ ℳ ?Γ' φ. length Ψ = length ?Σ⇩B)"
from this obtain Ψ where
Ψ: "Ψ ∈ ℳ ?Γ' φ"
"length Ψ ≠ length ?Σ⇩B"
by blast
have "length Ψ ≥ length ?Σ⇩B"
using Ψ(1)
‹¬ ?Σ⇩B :⊢ φ›
‹mset ?Σ⇩B ⊆# mset ?Γ'›
unfolding relative_maximals_def
by blast
hence "length Ψ > length ?Σ⇩B"
using Ψ(2)
by linarith
have "length Ψ = length (Ψ ⊖ ?Σ⇩B) + length (Ψ ❙∩ ?Σ⇩B)"
(is "length Ψ = length ?A + length ?B")
by (metis (no_types, lifting)
length_append
list_diff_intersect_comp
mset_append
mset_eq_length)
{
fix σ
assume "mset σ ⊆# mset Γ"
"length σ + 1 ≥ length (?A @ ?B)"
hence "length σ + 1 ≥ length Ψ"
using ‹length Ψ = length ?A + length ?B›
by simp
hence "length σ + 1 > length ?Σ⇩B"
using ‹length Ψ > length ?Σ⇩B› by linarith
hence "length σ + 1 > length Ξ + 1"
using A by simp
hence "length σ > length Ξ" by linarith
have "σ :⊢ φ"
proof (rule ccontr)
assume "¬ σ :⊢ φ"
hence "length σ ≤ length Ξ"
using ‹mset σ ⊆# mset Γ› Ξ(1)
unfolding relative_maximals_def
by blast
thus "False" using ‹length σ > length Ξ› by linarith
qed
}
moreover
have "mset Ψ ⊆# mset ?Γ'"
"¬ Ψ :⊢ φ"
"∀Φ. mset Φ ⊆# mset ?Γ' ∧ ¬ Φ :⊢ φ ⟶ length Φ ≤ length Ψ"
using Ψ(1) relative_maximals_def by blast+
hence "mset ?A ⊆# mset (Γ ⊖ map snd ?Σ)"
by (simp add: add.commute subset_eq_diff_conv)
hence "mset ?A ⊆# mset (Γ ⊖ (ψ # Ξ))"
using ‹map snd ?Σ = ψ # Ξ› by metis
moreover
have "mset ?B ⊆# mset (𝔚⇩→ φ (ψ # Ξ))"
using list_intersect_right_project by blast
ultimately obtain Σ where Σ: "⊢ ((?A @ ?B) :→ φ) ↔ (⨆ (map ⨅ Σ) → φ)"
"∀σ∈set Σ. σ :⊢ φ"
using ♢ optimal_witness_list_intersect_biconditional
by metis
hence "⊢ ⨆ (map ⨅ Σ) → φ"
using weak_disj_of_conj_equiv by blast
hence "?A @ ?B :⊢ φ"
using Σ(1) modus_ponens list_deduction_def weak_biconditional_weaken
by blast
moreover have "set (?A @ ?B) = set Ψ"
using list_diff_intersect_comp union_code set_mset_mset by metis
hence "?A @ ?B :⊢ φ = Ψ :⊢ φ"
using list_deduction_monotonic by blast
ultimately have "Ψ :⊢ φ" by metis
thus "False" using Ψ(1) unfolding relative_maximals_def by blast
qed
moreover have "∃ Ψ. Ψ ∈ ℳ ?Γ' φ"
using assms relative_maximals_existence by blast
ultimately show ?thesis
using relative_maximals_def
by fastforce
qed
ultimately show ?thesis
unfolding relative_maximals_def
by fastforce
qed
have C: "∀ Ξ Γ φ. Ξ ∈ ℳ Γ φ ⟶ length Ξ = ¦ Γ ¦⇩φ"
using relative_MaxSAT_intro by blast
then have D: "length Ξ = ¦ Γ ¦⇩φ"
using ‹Ξ ∈ ℳ Γ φ› by blast
have
"∀(Σ ::'a list) Γ n. (¬ mset Σ ⊆# mset Γ ∨ length (Γ ⊖ Σ) ≠ n) ∨ length Γ = n + length Σ"
using list_subtract_msub_eq by blast
then have E: "length Γ = length (Γ ⊖ map snd (𝔚 φ (ψ # Ξ))) + length (ψ # Ξ)"
using ‹map snd (𝔚 φ (ψ # Ξ)) = ψ # Ξ› ‹mset (ψ # Ξ) ⊆# mset Γ› by presburger
have "1 + length Ξ = ¦ 𝔚⇩→ φ (ψ # Ξ) @ Γ ⊖ map snd (𝔚 φ (ψ # Ξ)) ¦⇩φ"
using C B A by presburger
hence "1 + (∥ map (uncurry (→)) ?Σ @ Γ ⊖ map snd ?Σ ∥⇩φ) = ∥ Γ ∥⇩φ"
using D E ‹map snd (𝔚 φ (ψ # Ξ)) = ψ # Ξ› complement_relative_MaxSAT_def by force
}
ultimately
show "∃ Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ :⊢ φ ∧
1 + (∥ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ ∥⇩φ) = ∥ Γ ∥⇩φ"
by metis
next
assume "∃ Σ. mset (map snd Σ) ⊆# mset Γ ∧
map (uncurry (⊔)) Σ :⊢ φ ∧
1 + (∥ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ ∥⇩φ) = ∥ Γ ∥⇩φ"
thus "0 < ∥ Γ ∥⇩φ"
by auto
qed
primrec (in implication_logic)
MaxSAT_witness :: "('a × 'a) list ⇒ 'a list ⇒ ('a × 'a) list" ("𝔘")
where
"𝔘 _ [] = []"
| "𝔘 Σ (ξ # Ξ) = (case find (λ σ. ξ = snd σ) Σ of
None ⇒ 𝔘 Σ Ξ
| Some σ ⇒ σ # (𝔘 (remove1 σ Σ) Ξ))"
lemma (in implication_logic) MaxSAT_witness_right_msub:
"mset (map snd (𝔘 Σ Ξ)) ⊆# mset Ξ"
proof -
have "∀ Σ. mset (map snd (𝔘 Σ Ξ)) ⊆# mset Ξ"
proof (induct Ξ)
case Nil
then show ?case by simp
next
case (Cons ξ Ξ)
{
fix Σ
have "mset (map snd (𝔘 Σ (ξ # Ξ))) ⊆# mset (ξ # Ξ)"
proof (cases "find (λ σ. ξ = snd σ) Σ")
case None
then show ?thesis
by (simp, metis Cons.hyps
add_mset_add_single
mset_map mset_subset_eq_add_left subset_mset.order_trans)
next
case (Some σ)
note σ = this
hence "ξ = snd σ"
by (meson find_Some_predicate)
moreover
have "σ ∈ set Σ"
using σ
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ' Σ)
then show ?case
by (cases "ξ = snd σ'", simp+)
qed
ultimately show ?thesis using σ Cons.hyps by simp
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in implication_logic) MaxSAT_witness_left_msub:
"mset (𝔘 Σ Ξ) ⊆# mset Σ"
proof -
have "∀ Σ. mset (𝔘 Σ Ξ) ⊆# mset Σ"
proof (induct Ξ)
case Nil
then show ?case by simp
next
case (Cons ξ Ξ)
{
fix Σ
have "mset (𝔘 Σ (ξ # Ξ)) ⊆# mset Σ"
proof (cases "find (λ σ. ξ = snd σ) Σ")
case None
then show ?thesis using Cons.hyps by simp
next
case (Some σ)
note σ = this
hence "σ ∈ set Σ"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ' Σ)
then show ?case
by (cases "ξ = snd σ'", simp+)
qed
moreover from Cons.hyps have "mset (𝔘 (remove1 σ Σ) Ξ) ⊆# mset (remove1 σ Σ)"
by blast
hence "mset (𝔘 Σ (ξ # Ξ)) ⊆# mset (σ # remove1 σ Σ)" using σ by simp
ultimately show ?thesis by simp
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in implication_logic) MaxSAT_witness_right_projection:
"mset (map snd (𝔘 Σ Ξ)) = mset ((map snd Σ) ❙∩ Ξ)"
proof -
have "∀ Σ. mset (map snd (𝔘 Σ Ξ)) = mset ((map snd Σ) ❙∩ Ξ)"
proof (induct Ξ)
case Nil
then show ?case by simp
next
case (Cons ξ Ξ)
{
fix Σ
have "mset (map snd (𝔘 Σ (ξ # Ξ))) = mset (map snd Σ ❙∩ ξ # Ξ)"
proof (cases "find (λ σ. ξ = snd σ) Σ")
case None
hence "ξ ∉ set (map snd Σ)"
proof (induct Σ)
case Nil
then show ?case by simp
next
case (Cons σ Σ)
have "find (λσ. ξ = snd σ) Σ = None"
"ξ ≠ snd σ"
using Cons.prems
by (auto, metis Cons.prems find.simps(2) find_None_iff list.set_intros(1))
then show ?case using Cons.hyps by simp
qed
then show ?thesis using None Cons.hyps by simp
next
case (Some σ)
hence "σ ∈ set Σ" "ξ = snd σ"
by (meson find_Some_predicate find_Some_set_membership)+
moreover
from ‹σ ∈ set Σ› have "mset Σ = mset (σ # (remove1 σ Σ))"
by simp
hence "mset (map snd Σ) = mset ((snd σ) # (remove1 (snd σ) (map snd Σ)))"
"mset (map snd Σ) = mset (map snd (σ # (remove1 σ Σ)))"
by (simp add: ‹σ ∈ set Σ›, metis map_monotonic subset_mset.eq_iff)
hence "mset (map snd (remove1 σ Σ)) = mset (remove1 (snd σ) (map snd Σ))"
by simp
ultimately show ?thesis using Some Cons.hyps by simp
qed
}
then show ?case by simp
qed
thus ?thesis by simp
qed
lemma (in classical_logic) witness_list_implication_rule:
"⊢ (map (uncurry (⊔)) Σ :→ φ) → ⨅ (map (λ (χ, ξ). (χ → ξ) → φ) Σ) → φ"
proof (induct Σ)
case Nil
then show ?case using axiom_k by simp
next
case (Cons σ Σ)
let ?χ = "fst σ"
let ?ξ = "snd σ"
let ?Σ⇩A = "map (uncurry (⊔)) Σ"
let ?Σ⇩B = "map (λ (χ, ξ). (χ → ξ) → φ) Σ"
assume "⊢ ?Σ⇩A :→ φ → ⨅ ?Σ⇩B → φ"
moreover have
"⊢ (?Σ⇩A :→ φ → ⨅ ?Σ⇩B → φ)
→ ((?χ ⊔ ?ξ) → ?Σ⇩A :→ φ) → (((?χ → ?ξ) → φ) ⊓ ⨅ ?Σ⇩B) → φ"
proof -
let ?φ = "(❙⟨?Σ⇩A :→ φ❙⟩ → ❙⟨⨅ ?Σ⇩B❙⟩ → ❙⟨φ❙⟩)
→ (((❙⟨?χ❙⟩ ⊔ ❙⟨?ξ❙⟩) → ❙⟨?Σ⇩A :→ φ❙⟩) → (((❙⟨?χ❙⟩ → ❙⟨?ξ❙⟩) → ❙⟨φ❙⟩) ⊓ ❙⟨⨅ ?Σ⇩B❙⟩) → ❙⟨φ❙⟩)"
have "∀𝔐. 𝔐 ⊨⇩p⇩r⇩o⇩p ?φ" by fastforce
hence "⊢ ❙⦇ ?φ ❙⦈" using propositional_semantics by blast
thus ?thesis by simp
qed
ultimately have "⊢ ((?χ ⊔ ?ξ) → ?Σ⇩A :→ φ) → (((?χ → ?ξ) → φ) ⊓ ⨅ ?Σ⇩B) → φ"
using modus_ponens by blast
moreover
have "(λ σ. (fst σ → snd σ) → φ) = (λ (χ, ξ). (χ → ξ) → φ)"
"uncurry (⊔) = (λ σ. fst σ ⊔ snd σ)"
by fastforce+
hence "(λ (χ, ξ). (χ → ξ) → φ) σ = (?χ → ?ξ) → φ"
"uncurry (⊔) σ = ?χ ⊔ ?ξ"
by metis+
ultimately show ?case by simp
qed
lemma (in classical_logic) witness_relative_MaxSAT_increase:
assumes "¬ ⊢ φ"
and "mset (map snd Σ) ⊆# mset Γ"
and "map (uncurry (⊔)) Σ :⊢ φ"
shows "(¦ Γ ¦⇩φ) < (¦ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ ¦⇩φ)"
proof -
from ‹¬ ⊢ φ› obtain Ξ where Ξ: "Ξ ∈ ℳ Γ φ"
using relative_maximals_existence by blast
let ?Σ' = "Σ ⊖ 𝔘 Σ Ξ"
let ?ΣΞ' = "map (uncurry (⊔)) (𝔘 Σ Ξ) @ map (uncurry (→)) (𝔘 Σ Ξ)"
have "mset Σ = mset (𝔘 Σ Ξ @ ?Σ')" by (simp add: MaxSAT_witness_left_msub)
hence "set (map (uncurry (⊔)) Σ) = set (map (uncurry (⊔)) ((𝔘 Σ Ξ) @ ?Σ'))"
by (metis mset_map mset_eq_setD)
hence "map (uncurry (⊔)) ((𝔘 Σ Ξ) @ ?Σ') :⊢ φ"
using list_deduction_monotonic assms(3)
by blast
hence "map (uncurry (⊔)) (𝔘 Σ Ξ) @ map (uncurry (⊔)) ?Σ' :⊢ φ" by simp
moreover
{
fix Φ Ψ
have "((Φ @ Ψ) :→ φ) = (Φ :→ (Ψ :→ φ))"
by (induct Φ, simp+)
hence "(Φ @ Ψ) :⊢ φ = Φ :⊢ (Ψ :→ φ)"
unfolding list_deduction_def
by (induct Φ, simp+)
}
ultimately have "map (uncurry (⊔)) (𝔘 Σ Ξ) :⊢ map (uncurry (⊔)) ?Σ' :→ φ"
by simp
moreover have "set (map (uncurry (⊔)) (𝔘 Σ Ξ)) ⊆ set ?ΣΞ'"
by simp
ultimately have "?ΣΞ' :⊢ map (uncurry (⊔)) ?Σ' :→ φ"
using list_deduction_monotonic by blast
hence "?ΣΞ' :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ"
using list_deduction_modus_ponens
list_deduction_weaken
witness_list_implication_rule
by blast
hence "?ΣΞ' $⊢ [⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ]"
using measure_deduction_one_collapse by metis
hence
"?ΣΞ' @ (map snd (𝔘 Σ Ξ)) ⊖ (map snd (𝔘 Σ Ξ))
$⊢ [⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ]"
by simp
hence "map snd (𝔘 Σ Ξ) $⊢ [⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ]"
using measure_witness_left_split [where Γ="map snd (𝔘 Σ Ξ)"
and Σ="𝔘 Σ Ξ"]
by fastforce
hence "map snd (𝔘 Σ Ξ) $⊢ [⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ]"
using MaxSAT_witness_right_projection by auto
hence "map snd (𝔘 Σ Ξ) :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ"
using measure_deduction_one_collapse by blast
hence ⋆:
"map snd (𝔘 Σ Ξ) @ Ξ ⊖ (map snd Σ) :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ') → φ"
(is "?Ξ⇩0 :⊢ _")
using list_deduction_monotonic
by (metis (no_types, lifting) append_Nil2
measure_cancel
measure_deduction.simps(1)
measure_list_deduction_antitonic)
have "mset Ξ = mset (Ξ ⊖ (map snd Σ)) + mset (Ξ ❙∩ (map snd Σ))"
using list_diff_intersect_comp by blast
hence "mset Ξ = mset ((map snd Σ) ❙∩ Ξ) + mset (Ξ ⊖ (map snd Σ))"
by (metis subset_mset.inf_commute list_intersect_mset_homomorphism union_commute)
hence "mset Ξ = mset (map snd (𝔘 Σ Ξ)) + mset (Ξ ⊖ (map snd Σ))"
using MaxSAT_witness_right_projection by simp
hence "mset Ξ = mset ?Ξ⇩0"
by simp
hence "set Ξ = set ?Ξ⇩0"
by (metis mset_eq_setD)
have "¬ ?Ξ⇩0 :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ')"
proof (rule notI)
assume "?Ξ⇩0 :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ')"
hence "?Ξ⇩0 :⊢ φ"
using ⋆ list_deduction_modus_ponens by blast
hence "Ξ :⊢ φ"
using list_deduction_monotonic ‹set Ξ = set ?Ξ⇩0› by blast
thus "False"
using Ξ relative_maximals_def by blast
qed
moreover
have "mset (map snd (𝔘 Σ Ξ)) ⊆# mset ?Ξ⇩0"
"mset (map (uncurry (→)) (𝔘 Σ Ξ) @ ?Ξ⇩0 ⊖ map snd (𝔘 Σ Ξ))
= mset (map (uncurry (→)) (𝔘 Σ Ξ) @ Ξ ⊖ (map snd Σ))"
(is "_ = mset ?Ξ⇩1")
by auto
hence "?Ξ⇩1 ≼ ?Ξ⇩0"
by (metis add.commute
witness_stronger_theory
add_diff_cancel_right'
list_subtract.simps(1)
list_subtract_mset_homomorphism
list_diff_intersect_comp
list_intersect_right_project
msub_stronger_theory_intro
stronger_theory_combine
stronger_theory_empty_list_intro
self_append_conv)
ultimately have
"¬ ?Ξ⇩1 :⊢ ⨅ (map (λ (χ, γ). (χ → γ) → φ) ?Σ')"
using stronger_theory_deduction_monotonic by blast
from this obtain χ γ where
"(χ,γ) ∈ set ?Σ'"
"¬ (χ → γ) # ?Ξ⇩1 :⊢ φ"
using list_deduction_theorem
by fastforce
have "mset (χ → γ # ?Ξ⇩1) ⊆# mset (map (uncurry (→)) Σ @ Γ ⊖ map snd Σ)"
proof -
let ?A = "map (uncurry (→)) Σ"
let ?B = "map (uncurry (→)) (𝔘 Σ Ξ)"
have "(χ,γ) ∈ (set Σ - set (𝔘 Σ Ξ))"
proof -
from ‹(χ,γ) ∈ set ?Σ'› have "γ ∈# mset (map snd (Σ ⊖ 𝔘 Σ Ξ))"
by (metis set_mset_mset image_eqI set_map snd_conv)
hence "γ ∈# mset (map snd Σ ⊖ map snd (𝔘 Σ Ξ))"
by (metis MaxSAT_witness_left_msub map_list_subtract_mset_equivalence)
hence "γ ∈# mset (map snd Σ ⊖ (map snd Σ ❙∩ Ξ))"
by (metis MaxSAT_witness_right_projection list_subtract_mset_homomorphism)
hence "γ ∈# mset (map snd Σ ⊖ Ξ)"
by (metis add_diff_cancel_right'
list_subtract_mset_homomorphism
list_diff_intersect_comp)
moreover from assms(2) have "mset (map snd Σ ⊖ Ξ) ⊆# mset (Γ ⊖ Ξ)"
by (simp, metis list_subtract_monotonic list_subtract_mset_homomorphism mset_map)
ultimately have "γ ∈# mset (Γ ⊖ Ξ)"
by (simp add: mset_subset_eqD)
hence "γ ∈ set (Γ ⊖ Ξ)"
using set_mset_mset by fastforce
hence "γ ∈ set Γ - set Ξ"
using Ξ by simp
hence "γ ∉ set Ξ"
by blast
hence "∀ Σ. (χ,γ) ∉ set (𝔘 Σ Ξ)"
proof (induct Ξ)
case Nil
then show ?case by simp
next
case (Cons ξ Ξ)
{
fix Σ
have "(χ, γ) ∉ set (𝔘 Σ (ξ # Ξ))"
proof (cases "find (λσ. ξ = snd σ) Σ")
case None
then show ?thesis using Cons by simp
next
case (Some σ)
moreover from this have "snd σ = ξ"
using find_Some_predicate by fastforce
with Cons.prems have "σ ≠ (χ,γ)" by fastforce
ultimately show ?thesis using Cons by simp
qed
}
then show ?case by blast
qed
moreover from ‹(χ,γ) ∈ set ?Σ'› have "(χ,γ) ∈ set Σ"
by (meson list_subtract_set_trivial_upper_bound subsetCE)
ultimately show ?thesis by fastforce
qed
with ‹(χ, γ) ∈ set ?Σ'› have "mset ((χ,γ) # 𝔘 Σ Ξ) ⊆# mset Σ"
by (meson MaxSAT_witness_left_msub msub_list_subtract_elem_cons_msub)
hence "mset (χ → γ # ?B) ⊆# mset (map (uncurry (→)) Σ)"
by (metis (no_types, lifting)
‹(χ, γ) ∈ set ?Σ'›
MaxSAT_witness_left_msub
map_list_subtract_mset_equivalence
map_monotonic
mset_eq_setD msub_list_subtract_elem_cons_msub
pair_imageI
set_map
uncurry_def)
moreover
have "mset Ξ ⊆# mset Γ"
using Ξ relative_maximals_def
by blast
hence "mset (Ξ ⊖ (map snd Σ)) ⊆# mset (Γ ⊖ (map snd Σ))"
using list_subtract_monotonic by blast
ultimately show ?thesis
using subset_mset.add_mono by fastforce
qed
moreover have "length ?Ξ⇩1 = length ?Ξ⇩0"
by simp
hence "length ?Ξ⇩1 = length Ξ"
using ‹mset Ξ = mset ?Ξ⇩0› mset_eq_length
by metis
hence "length ((χ → γ) # ?Ξ⇩1) = length Ξ + 1"
by simp
hence "length ((χ → γ) # ?Ξ⇩1) = (¦ Γ ¦⇩φ) + 1"
using Ξ
by (simp add: relative_MaxSAT_intro)
moreover from ‹¬ ⊢ φ› obtain Ω where Ω: "Ω ∈ ℳ (map (uncurry (→)) Σ @ Γ ⊖ map snd Σ) φ"
using relative_maximals_existence by blast
ultimately have "length Ω ≥ (¦ Γ ¦⇩φ) + 1"
using relative_maximals_def
by (metis (no_types, lifting) ‹¬ χ → γ # ?Ξ⇩1 :⊢ φ› mem_Collect_eq)
thus ?thesis
using Ω relative_MaxSAT_intro by auto
qed
lemma (in classical_logic) relative_maximals_counting_deduction_lower_bound:
assumes "¬ ⊢ φ"
shows "(Γ #⊢ n φ) = (n ≤ ∥ Γ ∥⇩φ)"
proof -
have "∀ Γ. (Γ #⊢ n φ) = (n ≤ ∥ Γ ∥⇩φ)"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
{
fix Γ
assume "Γ #⊢ (Suc n) φ"
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ φ"
"map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ) #⊢ n φ"
by fastforce
let ?Γ' = "map (uncurry (→)) Σ @ Γ ⊖ (map snd Σ)"
have "length Γ = length ?Γ'"
using Σ(1) list_subtract_msub_eq by fastforce
hence "(∥ Γ ∥⇩φ) > (∥ ?Γ' ∥⇩φ)"
by (metis Σ(1) Σ(2) ‹¬ ⊢ φ›
witness_relative_MaxSAT_increase
length_MaxSAT_decomposition
add_less_cancel_right
nat_add_left_cancel_less)
with Σ(3) Suc.hyps have "Suc n ≤ ∥ Γ ∥⇩φ"
by auto
}
moreover
{
fix Γ
assume "Suc n ≤ ∥ Γ ∥⇩φ"
from this obtain Σ where Σ:
"mset (map snd Σ) ⊆# mset Γ"
"map (uncurry (⊔)) Σ :⊢ φ"
"1 + (∥ map (uncurry (→)) Σ @ Γ ⊖ map snd Σ ∥⇩φ) = ∥ Γ ∥⇩φ"
(is "1 + (∥ ?Γ' ∥⇩φ) = ∥ Γ ∥⇩φ")
by (metis Suc_le_D assms relative_maximals_optimal_witness zero_less_Suc)
have "n ≤ ∥ ?Γ' ∥⇩φ"
using Σ(3) ‹Suc n ≤ ∥ Γ ∥⇩φ› by linarith
hence "?Γ' #⊢ n φ" using Suc by blast
hence "Γ #⊢ (Suc n) φ" using Σ(1) Σ(2) by fastforce
}
ultimately show ?case by metis
qed
thus ?thesis by auto
qed
text ‹ As a brief aside, we may observe that ‹φ› is a tautology
if and only if counting deduction can prove it for any given number
of times. This follows immediately from
@{thm relative_maximals_counting_deduction_lower_bound [no_vars]}. ›
lemma (in classical_logic) counting_deduction_tautology_equiv:
"(∀ n. Γ #⊢ n φ) = ⊢ φ"
proof (cases "⊢ φ")
case True
then show ?thesis
by (simp add: counting_deduction_tautology_weaken)
next
case False
have "¬ Γ #⊢ (1 + length Γ) φ"
proof (rule notI)
assume "Γ #⊢ (1 + length Γ) φ"
hence "1 + length Γ ≤ ∥ Γ ∥⇩φ"
using ‹¬ ⊢ φ› relative_maximals_counting_deduction_lower_bound by blast
hence "1 + length Γ ≤ length Γ"
using complement_relative_MaxSAT_def by fastforce
thus "False" by linarith
qed
then show ?thesis
using ‹¬ ⊢ φ› by blast
qed
theorem (in classical_logic) relative_maximals_max_counting_deduction:
"Γ #⊢ n φ = (∀ Φ ∈ ℳ Γ φ. n ≤ length (Γ ⊖ Φ))"
proof (cases "⊢ φ")
case True
from ‹⊢ φ› have "Γ #⊢ n φ"
using counting_deduction_tautology_weaken
by blast
moreover from ‹⊢ φ› have "ℳ Γ φ = {}"
using relative_maximals_existence by auto
hence "∀ Φ ∈ ℳ Γ φ. n ≤ length (Γ ⊖ Φ)" by blast
ultimately show ?thesis by meson
next
case False
from ‹¬ ⊢ φ› have "(Γ #⊢ n φ) = (n ≤ ∥ Γ ∥⇩φ)"
by (simp add: relative_maximals_counting_deduction_lower_bound)
moreover have "(n ≤ ∥ Γ ∥⇩φ) = (∀ Φ ∈ ℳ Γ φ. n ≤ length (Γ ⊖ Φ))"
proof (rule iffI)
assume "n ≤ ∥ Γ ∥⇩φ"
{
fix Φ
assume "Φ ∈ ℳ Γ φ"
hence "n ≤ length (Γ ⊖ Φ)"
using ‹n ≤ ∥ Γ ∥⇩φ› complement_relative_MaxSAT_intro by auto
}
thus "∀Φ ∈ ℳ Γ φ. n ≤ length (Γ ⊖ Φ)" by blast
next
assume "∀Φ ∈ ℳ Γ φ. n ≤ length (Γ ⊖ Φ)"
with ‹¬ ⊢ φ› obtain Φ where
"Φ ∈ ℳ Γ φ"
"n ≤ length (Γ ⊖ Φ)"
using relative_maximals_existence
by blast
thus "n ≤ ∥ Γ ∥⇩φ"
by (simp add: complement_relative_MaxSAT_intro)
qed
ultimately show ?thesis by metis
qed
lemma (in consistent_classical_logic) counting_deduction_to_maxsat:
"(Γ #⊢ n ⊥) = (MaxSAT Γ + n ≤ length Γ)"
by (metis
add.commute
consistency
length_MaxSAT_decomposition
relative_maximals_counting_deduction_lower_bound
nat_add_left_cancel_le)
chapter ‹ Inequality Completeness For Probability Logic \label{subsec:probability-logic-completeness} ›
section ‹ Limited Counting Deduction Completeness ›
text ‹ The reduction of counting deduction to MaxSAT allows us to
first prove completeness for counting deduction, as maximal consistent
sublists allow us to recover maximally consistent sets, which give
rise to Dirac measures. ›
text ‹ The completeness result first presented here, where all of the
propositions on the left hand side are the same, will be extended
later. ›
lemma (in probability_logic) list_probability_upper_bound:
"(∑γ←Γ. 𝒫 γ) ≤ real (length Γ)"
proof (induct Γ)
case Nil
then show ?case by simp
next
case (Cons γ Γ)
moreover have "𝒫 γ ≤ 1" using unity_upper_bound by blast
ultimately have "𝒫 γ + (∑γ←Γ. 𝒫 γ) ≤ 1 + real (length Γ)" by linarith
then show ?case by simp
qed
theorem (in classical_logic) dirac_limited_counting_deduction_completeness:
"(∀ 𝒫 ∈ dirac_measures. real n * 𝒫 φ ≤ (∑γ←Γ. 𝒫 γ)) = ❙∼ Γ #⊢ n (∼ φ)"
proof -
{
fix 𝒫 :: "'a ⇒ real"
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
assume "❙∼ Γ #⊢ n (∼ φ)"
moreover have "replicate n (∼ φ) = ❙∼ (replicate n φ)"
by (induct n, auto)
ultimately have "❙∼ Γ $⊢ ❙∼ (replicate n φ)"
using counting_deduction_to_measure_deduction by metis
hence "(∑φ←(replicate n φ). 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using measure_deduction_soundness
by blast
moreover have "(∑φ←(replicate n φ). 𝒫 φ) = real n * 𝒫 φ"
by (induct n, simp, simp add: semiring_normalization_rules(3))
ultimately have "real n * 𝒫 φ ≤ (∑γ←Γ. 𝒫 γ)"
by simp
}
moreover
{
assume "¬ ❙∼ Γ #⊢ n (∼ φ)"
have "∃ 𝒫 ∈ dirac_measures. real n * 𝒫 φ > (∑γ←Γ. 𝒫 γ)"
proof -
have "∃Φ. Φ ∈ ℳ (❙∼ Γ) (∼ φ)"
using
‹¬ ❙∼ Γ #⊢ n (∼ φ)›
relative_maximals_existence
counting_deduction_tautology_weaken
by blast
from this obtain Φ where Φ:
"(❙∼ Φ) ∈ ℳ (❙∼ Γ) (∼ φ)"
"mset Φ ⊆# mset Γ"
unfolding map_negation_def
by (metis
(mono_tags, lifting)
relative_maximals_def
mem_Collect_eq
mset_sub_map_list_exists)
hence "¬ ⊢ φ → ⨆ Φ"
using
biconditional_weaken
list_deduction_def
map_negation_list_implication
set_deduction_base_theory
relative_maximals_def
by blast
from this obtain Ω where Ω: "MCS Ω" "φ ∈ Ω" "⨆ Φ ∉ Ω"
by (meson
insert_subset
formula_consistent_def
formula_maximal_consistency
formula_maximally_consistent_extension
formula_maximally_consistent_set_def_def
set_deduction_base_theory
set_deduction_reflection
set_deduction_theorem)
let ?𝒫 = "λ χ. if χ∈Ω then (1 :: real) else 0"
from Ω have "?𝒫 ∈ dirac_measures"
using MCS_dirac_measure by blast
moreover
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ ?𝒫
unfolding dirac_measures_def
by auto
have "∀ φ ∈ set Φ. ?𝒫 φ = 0"
using Φ(1) Ω(1) Ω(3) arbitrary_disjunction_exclusion_MCS by auto
with Φ(2) have "(∑γ←Γ. ?𝒫 γ) = (∑γ←(Γ ⊖ Φ). ?𝒫 γ)"
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
then show ?case
proof -
obtain ω :: 'a where
ω: "¬ mset Φ ⊆# mset Γ
∨ ω ∈ set Φ ∧ ω ∈ Ω
∨ (∑γ←Γ. ?𝒫 γ) = (∑γ←Γ ⊖ Φ. ?𝒫 γ)"
using Cons.hyps by fastforce
have A:
"∀(f :: 'a ⇒ real) (Γ ::'a list) Φ.
¬ mset Φ ⊆# mset Γ
∨ sum_list ((∑φ←Φ. f φ) # map f (Γ ⊖ Φ)) = (∑γ←Γ. f γ)"
using listSubstract_multisubset_list_summation by auto
have B: "∀rs. sum_list ((0::real) # rs) = sum_list rs"
by auto
have C: "∀r rs. (0::real) = r ∨ sum_list (r # rs) ≠ sum_list rs"
by simp
have D: "∀f. sum_list (sum_list (map f (φ # Φ)) # map f (Γ ⊖ (φ # Φ)))
= (sum_list (map f Γ)::real)"
using A Cons.prems(1) by blast
have E: "mset Φ ⊆# mset Γ"
using Cons.prems(1) subset_mset.dual_order.trans by force
then have F: "∀f. (0::real) = sum_list (map f Φ)
∨ sum_list (map f Γ) ≠ sum_list (map f (Γ ⊖ Φ))"
using C A by (metis (no_types))
then have G: "(∑φ'←(φ # Φ). ?𝒫 φ') = 0 ∨ ω ∈ Ω"
using E ω Cons.prems(2) by auto
have H: "∀Γ r::real. r = (∑γ←Γ. ?𝒫 γ)
∨ ω ∈ set Φ
∨ r ≠ (∑γ←(φ # Γ). ?𝒫 γ)"
using Cons.prems(2) by auto
have "(1::real) ≠ 0" by linarith
moreover
{ assume "ω ∉ set Φ"
then have "ω ∉ Ω ∨ (∑γ←Γ. ?𝒫 γ) = (∑γ←Γ ⊖ (φ # Φ). ?𝒫 γ)"
using H F E D B ω by (metis (no_types) sum_list.Cons) }
ultimately have ?thesis
using G D B by (metis Cons.prems(2) list.set_intros(2))
then show ?thesis
by linarith
qed
qed
hence "(∑γ←Γ. ?𝒫 γ) ≤ real (length (Γ ⊖ Φ))"
using list_probability_upper_bound
by auto
moreover
have "length (❙∼ Γ ⊖ ❙∼ Φ) < n"
by (metis not_le Φ(1) ‹¬ (❙∼ Γ) #⊢ n (∼ φ)›
relative_maximals_max_counting_deduction
maximals_list_subtract_length_equiv)
hence "real (length (❙∼ Γ ⊖ ❙∼ Φ)) < real n"
by simp
with Ω(2) have "real (length (❙∼ Γ ⊖ ❙∼ Φ)) < real n * ?𝒫 φ"
by simp
moreover
have "(❙∼ (Γ ⊖ Φ)) ⇌ (❙∼ Γ ⊖ ❙∼ Φ)"
unfolding map_negation_def
by (metis Φ(2) map_list_subtract_mset_equivalence)
with perm_length have "length (Γ ⊖ Φ) = length (❙∼ Γ ⊖ ❙∼ Φ)"
by (metis length_map local.map_negation_def)
hence "real (length (Γ ⊖ Φ)) = real (length (❙∼ Γ ⊖ ❙∼ Φ))"
by simp
ultimately show ?thesis
by force
qed
}
ultimately show ?thesis by fastforce
qed
section ‹ Measure Deduction Completeness ›
text ‹ Since measure deduction may be reduced to counting deduction,
we have measure deduction is complete. ›
lemma (in classical_logic) dirac_measure_deduction_completeness:
"(∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)) = ❙∼ Γ $⊢ ❙∼ Φ"
proof -
{
fix 𝒫 :: "'a ⇒ real"
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
assume "❙∼ Γ $⊢ ❙∼ Φ"
hence "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using measure_deduction_soundness
by blast
}
moreover
{
assume "¬ ❙∼ Γ $⊢ ❙∼ Φ"
have "∃ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) > (∑γ←Γ. 𝒫 γ)"
proof -
from ‹¬ ❙∼ Γ $⊢ ❙∼ Φ› have "¬ ❙∼ (❙∼ Φ) @ ❙∼ Γ #⊢ (length (❙∼ Φ)) ⊥"
using measure_deduction_to_counting_deduction by blast
moreover
have "❙∼ (❙∼ Φ) @ ❙∼ Γ #⊢ (length (❙∼ Φ)) ⊥ = ❙∼ (❙∼ Φ) @ ❙∼ Γ #⊢ (length Φ) ⊥"
by (induct Φ, auto)
moreover have "⊢ ∼ ⊤ → ⊥"
by (simp add: negation_def)
ultimately have "¬ ❙∼ (❙∼ Φ @ Γ) #⊢ (length Φ) (∼ ⊤)"
using counting_deduction_implication by fastforce
from this obtain 𝒫 where 𝒫:
"𝒫 ∈ dirac_measures"
"real (length Φ) * 𝒫 ⊤ > (∑γ← (❙∼ Φ @ Γ). 𝒫 γ)"
using dirac_limited_counting_deduction_completeness
by fastforce
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
from 𝒫(2) have "real (length Φ) > (∑γ← ❙∼ Φ. 𝒫 γ) + (∑γ← Γ. 𝒫 γ)"
by (simp add: probability_unity)
moreover have "(∑γ← ❙∼ Φ. 𝒫 γ) = real (length Φ) - (∑γ← Φ. 𝒫 γ)"
using complementation
by (induct Φ, auto)
ultimately show ?thesis
using 𝒫(1) by auto
qed
}
ultimately show ?thesis by fastforce
qed
theorem (in classical_logic) measure_deduction_completeness:
"(∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)) = ❙∼ Γ $⊢ ❙∼ Φ"
proof -
{
fix 𝒫 :: "'a ⇒ real"
assume "𝒫 ∈ probabilities"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding probabilities_def
by auto
assume "❙∼ Γ $⊢ ❙∼ Φ"
hence "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using measure_deduction_soundness
by blast
}
thus ?thesis
using dirac_measures_subset dirac_measure_deduction_completeness
by fastforce
qed
section ‹ Counting Deduction Completeness ›
text ‹ Leveraging our measure deduction completeness result, we may
extend our limited counting deduction completeness theorem to full
completness. ›
lemma (in classical_logic) measure_left_commute:
"(Φ @ Ψ) $⊢ Ξ = (Ψ @ Φ) $⊢ Ξ"
proof -
have "(Φ @ Ψ) ≼ (Ψ @ Φ)" "(Ψ @ Φ) ≼ (Φ @ Ψ)"
using stronger_theory_reflexive stronger_theory_right_permutation perm_append_swap by blast+
thus ?thesis
using measure_stronger_theory_left_monotonic
by blast
qed
lemma (in classical_logic) stronger_theory_double_negation_right:
"Φ ≼ ❙∼ (❙∼ Φ)"
by (induct Φ, simp, simp add: double_negation negation_def stronger_theory_left_right_cons)
lemma (in classical_logic) stronger_theory_double_negation_left:
"❙∼ (❙∼ Φ) ≼ Φ"
by (induct Φ,
simp,
simp add: double_negation_converse negation_def stronger_theory_left_right_cons)
lemma (in classical_logic) counting_deduction_completeness:
"(∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)) = (❙∼ Γ @ Φ) #⊢ (length Φ) ⊥"
proof -
have "(∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ))
= ❙∼ (❙∼ Φ) @ ❙∼ Γ #⊢ (length (❙∼ Φ)) ⊥"
using dirac_measure_deduction_completeness measure_deduction_to_counting_deduction by blast
also have "... = ❙∼ (❙∼ Φ) @ ❙∼ Γ #⊢ (length Φ) ⊥" by (induct Φ, auto)
also have "... = ❙∼ Γ @ ❙∼ (❙∼ Φ) #⊢ (length Φ) ⊥"
by (simp add: measure_left_commute counting_deduction_to_measure_deduction)
also have "... = ❙∼ Γ @ Φ #⊢ (length Φ) ⊥"
by (meson measure_cancel
stronger_theory_to_measure_deduction
measure_transitive
counting_deduction_to_measure_deduction
stronger_theory_double_negation_left
stronger_theory_double_negation_right)
finally show ?thesis by blast
qed
section ‹ Collapse Theorem For Probability Logic \label{subsubsec:collapse-theorem} ›
text ‹ We now turn to proving the collapse theorem for probability logic.
This states that any inequality holds for all finitely
additive probability measures if and only if it holds for all Dirac
measures. ›
theorem (in classical_logic) weakly_additive_completeness_collapse:
" (∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ))
= (∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ))"
by (simp add: dirac_measure_deduction_completeness
measure_deduction_completeness)
text ‹The collapse theorem may be strengthened to include an arbitrary
constant term ‹c›. This will be key to characterizing MaxSAT
completeness in \S\ref{subsubsec:maxsat-completeness}.›
lemma (in classical_logic) nat_dirac_probability:
"∀ 𝒫 ∈ dirac_measures. ∃n :: nat. real n = (∑φ←Φ. 𝒫 φ)"
proof (induct Φ)
case Nil
then show ?case by simp
next
case (Cons φ Φ)
{
fix 𝒫 :: "'a ⇒ real"
assume "𝒫 ∈ dirac_measures"
from Cons this obtain n where "real n = (∑φ'←Φ. 𝒫 φ')" by fastforce
hence ⋆: "(∑φ'←Φ. 𝒫 φ') = real n" by simp
have "∃ n. real n = (∑φ'←(φ # Φ). 𝒫 φ')"
proof (cases "𝒫 φ = 1")
case True
then show ?thesis
by (simp add: ⋆, metis of_nat_Suc)
next
case False
hence "𝒫 φ = 0" using ‹𝒫 ∈ dirac_measures› dirac_measures_def by auto
then show ?thesis using ⋆
by simp
qed
}
thus ?case by blast
qed
lemma (in classical_logic) dirac_ceiling:
"∀ 𝒫 ∈ dirac_measures.
((∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ))
= ((∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ))"
proof -
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
have "((∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ))
= ((∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ))"
proof (rule iffI)
assume assm: "(∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
show "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
proof (rule ccontr)
assume "¬ (∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
moreover
obtain x :: int
and y :: int
and z :: int
where xyz: "x = (∑φ←Φ. 𝒫 φ)"
"y = ⌈c⌉"
"z = (∑γ←Γ. 𝒫 γ)"
using nat_dirac_probability
by (metis ‹𝒫 ∈ dirac_measures› of_int_of_nat_eq)
ultimately have "x + y - 1 ≥ z" by linarith
hence "(∑φ←Φ. 𝒫 φ) + c > (∑γ←Γ. 𝒫 γ)" using xyz by linarith
thus "False" using assm by simp
qed
next
assume "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
thus "(∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
by linarith
qed
}
thus ?thesis by blast
qed
lemma (in probability_logic) probability_replicate_verum:
fixes n :: nat
shows "(∑φ←Φ. 𝒫 φ) + n = (∑φ←(replicate n ⊤) @ Φ. 𝒫 φ)"
using probability_unity
by (induct n, auto)
lemma (in classical_logic) dirac_collapse:
"(∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ))
= (∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ))"
proof
assume "∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
hence "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
using dirac_measures_subset by fastforce
thus "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
using dirac_ceiling by blast
next
assume assm: "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
show "∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
proof (cases "c ≥ 0")
case True
from this obtain n :: nat where "real n = ⌈c⌉"
by (metis (full_types)
antisym_conv
ceiling_le_zero
ceiling_zero
nat_0_iff
nat_eq_iff2
of_nat_nat)
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
using assm ‹𝒫 ∈ dirac_measures› by blast
hence "(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using ‹real n = ⌈c⌉›
probability_replicate_verum [where Φ=Φ and n=n]
by metis
}
hence "∀ 𝒫 ∈ dirac_measures.
(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
by blast
hence †: "∀ 𝒫 ∈ probabilities.
(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using weakly_additive_completeness_collapse by blast
{
fix 𝒫
assume "𝒫 ∈ probabilities"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding probabilities_def
by auto
have "(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using † ‹𝒫 ∈ probabilities› by blast
hence "(∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
using ‹real n = ⌈c⌉›
probability_replicate_verum [where Φ=Φ and n=n]
by linarith
}
then show ?thesis by blast
next
case False
hence "⌈c⌉ ≤ 0" by auto
from this obtain n :: nat where "real n = - ⌈c⌉"
by (metis neg_0_le_iff_le of_nat_nat)
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
using assm ‹𝒫 ∈ dirac_measures› by blast
hence "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using ‹real n = - ⌈c⌉›
probability_replicate_verum [where Φ=Γ and n=n]
by linarith
}
hence "∀ 𝒫 ∈ dirac_measures.
(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
by blast
hence ‡: "∀ 𝒫 ∈ probabilities.
(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using weakly_additive_completeness_collapse by blast
{
fix 𝒫
assume "𝒫 ∈ probabilities"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding probabilities_def
by auto
have "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using ‡ ‹𝒫 ∈ probabilities› by blast
hence "(∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
using ‹real n = - ⌈c⌉›
probability_replicate_verum [where Φ=Γ and n=n]
by linarith
}
then show ?thesis by blast
qed
qed
lemma (in classical_logic) dirac_strict_floor:
"∀ 𝒫 ∈ dirac_measures.
((∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ))
= ((∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
proof
fix 𝒫 :: "'a ⇒ real"
let ?𝒫' = "(λ φ. ⌊ 𝒫 φ ⌋) :: 'a ⇒ int"
assume "𝒫 ∈ dirac_measures"
hence "∀ φ. 𝒫 φ = ?𝒫' φ"
unfolding dirac_measures_def
by (metis (mono_tags, lifting)
mem_Collect_eq
of_int_0
of_int_1
of_int_floor_cancel)
hence A: "(∑φ←Φ. 𝒫 φ) = (∑φ←Φ. ?𝒫' φ)"
by (induct Φ, auto)
have B: "(∑γ←Γ. 𝒫 γ) = (∑γ←Γ. ?𝒫' γ)"
using ‹∀ φ. 𝒫 φ = ?𝒫' φ› by (induct Γ, auto)
have "((∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ))
= ((∑φ←Φ. ?𝒫' φ) + c < (∑γ←Γ. ?𝒫' γ))"
unfolding A B by auto
also have "… = ((∑φ←Φ. ?𝒫' φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. ?𝒫' γ))"
by linarith
finally show "((∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ)) =
((∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
using A B by linarith
qed
lemma (in classical_logic) strict_dirac_collapse:
" (∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ))
= (∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
proof
assume "∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ)"
hence "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ)"
using dirac_measures_subset by blast
thus "∀ 𝒫 ∈ dirac_measures. ((∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
using dirac_strict_floor by blast
next
assume "∀ 𝒫 ∈ dirac_measures. ((∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
moreover have "⌊c⌋ + 1 = ⌈ (⌊c⌋ + 1) :: real⌉"
by simp
ultimately have ⋆:
"∀ 𝒫 ∈ probabilities. ((∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ))"
using dirac_collapse [of Φ "⌊c⌋ + 1" Γ]
by auto
show "∀ 𝒫 ∈ probabilities. ((∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ))"
proof
fix 𝒫 :: "'a ⇒ real"
assume "𝒫 ∈ probabilities"
hence "(∑φ←Φ. 𝒫 φ) + ⌊c⌋ + 1 ≤ (∑γ←Γ. 𝒫 γ)"
using ⋆ by auto
thus "(∑φ←Φ. 𝒫 φ) + c < (∑γ←Γ. 𝒫 γ)"
by linarith
qed
qed
section ‹ MaxSAT Completeness For Probability Logic \label{subsubsec:maxsat-completeness} ›
text ‹ It follows from the collapse theorem that any probability inequality
tautology, include those with ∗‹constant terms›, may be reduced to a
bounded MaxSAT problem. This is not only a key computational
complexity result, but suggests a straightforward algorithm for
∗‹computing› probability identities. ›
lemma (in classical_logic) :
assumes "¬ ⊢ φ"
shows "(¦ replicate n ⊤ @ Φ ¦⇩φ) = n + (¦ Φ ¦⇩φ)"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
{
fix Φ
obtain Σ where "Σ ∈ ℳ (⊤ # Φ) φ"
using assms relative_maximals_existence by fastforce
hence "⊤ ∈ set Σ"
by (metis (no_types, lifting)
list.set_intros(1)
list_deduction_modus_ponens
list_deduction_weaken
relative_maximals_complement_equiv
relative_maximals_def
verum_tautology
mem_Collect_eq)
hence "¬ (remove1 ⊤ Σ :⊢ φ)"
by (meson ‹Σ ∈ ℳ (⊤ # Φ) φ›
list.set_intros(1)
axiom_k
list_deduction_modus_ponens
list_deduction_monotonic
list_deduction_weaken
relative_maximals_complement_equiv
set_remove1_subset)
moreover
have "mset Σ ⊆# mset (⊤ # Φ)"
using ‹Σ ∈ ℳ (⊤ # Φ) φ› relative_maximals_def by blast
hence "mset (remove1 ⊤ Σ) ⊆# mset Φ"
using subset_eq_diff_conv by fastforce
ultimately have "(¦ Φ ¦⇩φ) ≥ length (remove1 ⊤ Σ)"
by (metis (no_types, lifting)
relative_MaxSAT_intro
list_deduction_weaken
relative_maximals_def
relative_maximals_existence
mem_Collect_eq)
hence "(¦ Φ ¦⇩φ) + 1 ≥ length Σ"
by (simp add: ‹⊤ ∈ set Σ› length_remove1)
moreover have "(¦ Φ ¦⇩φ) < length Σ"
proof (rule ccontr)
assume "¬ (¦ Φ ¦⇩φ) < length Σ"
hence "(¦ Φ ¦⇩φ) ≥ length Σ" by linarith
from this obtain Δ where "Δ ∈ ℳ Φ φ" "length Δ ≥ length Σ"
using assms relative_MaxSAT_intro relative_maximals_existence by fastforce
hence "¬ (⊤ # Δ) :⊢ φ"
using list_deduction_modus_ponens
list_deduction_theorem
list_deduction_weaken
relative_maximals_def
verum_tautology
by blast
moreover have "mset (⊤ # Δ) ⊆# mset (⊤ # Φ)"
using ‹Δ ∈ ℳ Φ φ› relative_maximals_def by auto
ultimately have "length Σ ≥ length (⊤ # Δ)"
using ‹Σ ∈ ℳ (⊤ # Φ) φ› relative_maximals_def by blast
hence "length Δ ≥ length (⊤ # Δ)"
using ‹length Σ ≤ length Δ› dual_order.trans by blast
thus "False" by simp
qed
ultimately have "(¦ ⊤ # Φ ¦⇩φ) = (1 + ¦ Φ ¦⇩φ)"
by (metis Suc_eq_plus1 Suc_le_eq ‹Σ ∈ ℳ (⊤ # Φ) φ› add.commute le_antisym relative_MaxSAT_intro)
}
thus ?case using Suc by simp
qed
lemma (in classical_logic) complement_MaxSAT_completeness:
"(∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)) = (length Φ ≤ ∥ ❙∼ Γ @ Φ ∥⇩⊥)"
proof (cases "⊢ ⊥")
case True
hence "ℳ (❙∼ Γ @ Φ) ⊥ = {}"
using relative_maximals_existence by auto
hence "length (❙∼ Γ @ Φ) = ∥ ❙∼ Γ @ Φ ∥⇩⊥"
unfolding complement_relative_MaxSAT_def relative_MaxSAT_def by presburger
then show ?thesis
using True counting_deduction_completeness counting_deduction_tautology_weaken
by auto
next
case False
then show ?thesis
using counting_deduction_completeness relative_maximals_counting_deduction_lower_bound
by blast
qed
lemma (in classical_logic) relative_maximals_neg_verum_elim:
"(¦ replicate n (∼ ⊤) @ Φ ¦⇩φ) = (¦ Φ ¦⇩φ)"
proof (induct n)
case 0
then show ?case by simp
next
case (Suc n)
{
fix Φ
have "(¦ (∼ ⊤) # Φ ¦⇩φ) = (¦ Φ ¦⇩φ)"
proof (cases "⊢ φ")
case True
then show ?thesis
unfolding relative_MaxSAT_def relative_maximals_def
by (simp add: list_deduction_weaken)
next
case False
from this obtain Σ where "Σ ∈ ℳ ((∼ ⊤) # Φ) φ"
using relative_maximals_existence by fastforce
have "[(∼ ⊤)] :⊢ φ"
by (metis modus_ponens
Peirces_law
pseudo_scotus
list_deduction_theorem
list_deduction_weaken
negation_def
verum_def)
hence "∼ ⊤ ∉ set Σ"
by (meson ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ›
list.set_intros(1)
list_deduction_base_theory
list_deduction_theorem
list_deduction_weaken
relative_maximals_complement_equiv)
hence "remove1 (∼ ⊤) Σ = Σ"
by (simp add: remove1_idem)
moreover have "mset Σ ⊆# mset ((∼ ⊤) # Φ)"
using ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ› relative_maximals_def by blast
ultimately have "mset Σ ⊆# mset Φ"
by (metis add_mset_add_single mset.simps(2) mset_remove1 subset_eq_diff_conv)
moreover have "¬ (Σ :⊢ φ)"
using ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ› relative_maximals_def by blast
ultimately have "(¦ Φ ¦⇩φ) ≥ length Σ"
by (metis (no_types, lifting)
relative_MaxSAT_intro
list_deduction_weaken
relative_maximals_def
relative_maximals_existence
mem_Collect_eq)
hence "(¦ Φ ¦⇩φ) ≥ (¦ (∼ ⊤) # Φ ¦⇩φ)"
using ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ› relative_MaxSAT_intro by auto
moreover
have "(¦ Φ ¦⇩φ) ≤ (¦ (∼ ⊤) # Φ ¦⇩φ)"
proof -
obtain Δ where "Δ ∈ ℳ Φ φ"
using False relative_maximals_existence by blast
hence
"¬ Δ :⊢ φ"
"mset Δ ⊆# mset ((∼ ⊤) # Φ)"
unfolding relative_maximals_def
by (simp,
metis (mono_tags, lifting)
Diff_eq_empty_iff_mset
list_subtract.simps(2)
list_subtract_mset_homomorphism
relative_maximals_def
mem_Collect_eq
mset_zero_iff
remove1.simps(1))
hence "length Δ ≤ length Σ"
using ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ› relative_maximals_def by blast
thus ?thesis
using ‹Δ ∈ ℳ Φ φ› ‹Σ ∈ ℳ (∼ ⊤ # Φ) φ› relative_MaxSAT_intro by auto
qed
ultimately show ?thesis
using le_antisym by blast
qed
}
thus ?case using Suc by simp
qed
lemma (in classical_logic) dirac_MaxSAT_partial_completeness:
"(∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)) = (MaxSAT (❙∼ Γ @ Φ ) ≤ length Γ)"
proof -
{
fix 𝒫 :: "'a ⇒ real"
obtain ρ :: "'a list ⇒ 'a list ⇒ 'a ⇒ real" where
" (∀Φ Γ. ρ Φ Γ ∈ dirac_measures ∧ ¬ (∑φ←Φ. (ρ Φ Γ) φ) ≤ (∑γ←Γ. (ρ Φ Γ) γ)
∨ length Φ ≤ ∥ ❙∼ Γ @ Φ ∥⇩⊥)
∧ (∀Φ Γ. length Φ ≤ (∥ ❙∼ Γ @ Φ ∥⇩⊥)
⟶ (∀𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)))"
using complement_MaxSAT_completeness by moura
moreover have "∀Γ φ n. length Γ - n ≤ (∥ Γ ∥⇩φ) ∨ (¦ Γ ¦⇩φ) - n ≠ 0"
by (metis add_diff_cancel_right'
cancel_ab_semigroup_add_class.diff_right_commute
diff_is_0_eq length_MaxSAT_decomposition)
moreover have "∀ Γ Φ n. length (Γ @ Φ) - n ≤ length Γ ∨ length Φ - n ≠ 0"
by force
ultimately have
" (𝒫 ∈ dirac_measures ⟶ (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ))
∧ (¦ ❙∼ Γ @ Φ ¦⇩⊥) ≤ length (❙∼ Γ)
∨ ¬ (¦ ❙∼ Γ @ Φ ¦⇩⊥) ≤ length (❙∼ Γ)
∧ (∃𝒫. 𝒫 ∈ dirac_measures ∧ ¬ (∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ))"
by (metis (no_types) add_diff_cancel_left'
add_diff_cancel_right'
diff_is_0_eq length_append
length_MaxSAT_decomposition)
}
then show ?thesis by auto
qed
lemma (in consistent_classical_logic) dirac_inequality_elim:
fixes c :: real
assumes "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
shows "(MaxSAT (❙∼ Γ @ Φ) + c ≤ length Γ)"
proof (cases "c ≥ 0")
case True
from this obtain n :: nat where "real n = ⌈c⌉"
by (metis ceiling_mono ceiling_zero of_nat_nat)
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←Φ. 𝒫 φ) + n ≤ (∑γ←Γ. 𝒫 γ)"
by (metis assms ‹𝒫 ∈ dirac_measures› ‹real n = ⌈c⌉› dirac_ceiling)
hence "(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using probability_replicate_verum [where Φ=Φ and n=n]
by metis
}
hence "(¦ ❙∼ Γ @ replicate n ⊤ @ Φ ¦⇩⊥) ≤ length Γ"
using dirac_MaxSAT_partial_completeness by blast
moreover have "mset (❙∼ Γ @ replicate n ⊤ @ Φ) = mset (replicate n ⊤ @ ❙∼ Γ @ Φ)"
by simp
ultimately have "(¦ replicate n ⊤ @ ❙∼ Γ @ Φ ¦⇩⊥) ≤ length Γ"
unfolding relative_MaxSAT_def relative_maximals_def
by metis
hence "(¦ ❙∼ Γ @ Φ ¦⇩⊥) + ⌈c⌉ ≤ length Γ"
using ‹real n = ⌈c⌉› consistency relative_maximals_verum_extract
by auto
then show ?thesis by linarith
next
case False
hence "⌈c⌉ ≤ 0" by auto
from this obtain n :: nat where "real n = - ⌈c⌉"
by (metis neg_0_le_iff_le of_nat_nat)
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ←Γ. 𝒫 γ)"
using assms ‹𝒫 ∈ dirac_measures› dirac_ceiling
by blast
hence "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ) + n"
using ‹real n = - ⌈c⌉› by linarith
hence "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using probability_replicate_verum [where Φ=Γ and n=n]
by metis
}
hence "(¦ ❙∼ (replicate n ⊤ @ Γ) @ Φ ¦⇩⊥) ≤ length (replicate n ⊤ @ Γ)"
using dirac_MaxSAT_partial_completeness [where Φ=Φ and Γ="replicate n ⊤ @ Γ"]
by metis
hence "(¦ ❙∼ Γ @ Φ ¦⇩⊥) ≤ n + length Γ"
by (simp add: relative_maximals_neg_verum_elim)
then show ?thesis using ‹real n = - ⌈c⌉› by linarith
qed
lemma (in classical_logic) dirac_inequality_intro:
fixes c :: real
assumes "MaxSAT (❙∼ Γ @ Φ) + c ≤ length Γ"
shows "∀ 𝒫 ∈ dirac_measures. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
proof (cases "⊢ ⊥")
assume "⊢ ⊥"
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "False"
using ‹⊢ ⊥› consistency by blast
}
then show ?thesis by blast
next
assume "¬ ⊢ ⊥"
then show ?thesis
proof (cases "c ≥ 0")
assume "c ≥ 0"
from this obtain n :: nat where "real n = ⌈c⌉"
by (metis ceiling_mono ceiling_zero of_nat_nat)
hence "n + (¦ ❙∼ Γ @ Φ ¦⇩⊥) ≤ length Γ"
using assms by linarith
hence "(¦ replicate n ⊤ @ ❙∼ Γ @ Φ ¦⇩⊥) ≤ length Γ"
by (simp add: ‹¬ ⊢ ⊥› relative_maximals_verum_extract)
moreover have "mset (replicate n ⊤ @ ❙∼ Γ @ Φ) = mset (❙∼ Γ @ replicate n ⊤ @ Φ)"
by simp
ultimately have "(¦ ❙∼ Γ @ replicate n ⊤ @ Φ ¦⇩⊥) ≤ length Γ"
unfolding relative_MaxSAT_def relative_maximals_def
by metis
hence "∀ 𝒫 ∈ dirac_measures. (∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using dirac_MaxSAT_partial_completeness by blast
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)"
using ‹𝒫 ∈ dirac_measures›
‹∀ 𝒫 ∈ dirac_measures. (∑φ←(replicate n ⊤) @ Φ. 𝒫 φ) ≤ (∑γ←Γ. 𝒫 γ)›
by blast
hence "(∑φ← Φ. 𝒫 φ) + n ≤ (∑γ←Γ. 𝒫 γ)"
by (simp add: probability_replicate_verum)
hence "(∑φ← Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ)"
using ‹real n = real_of_int ⌈c⌉› by linarith
}
then show ?thesis by blast
next
assume "¬ (c ≥ 0)"
hence "⌈c⌉ ≤ 0" by auto
from this obtain n :: nat where "real n = - ⌈c⌉"
by (metis neg_0_le_iff_le of_nat_nat)
hence "(¦ ❙∼ Γ @ Φ ¦⇩⊥) ≤ n + length Γ"
using assms by linarith
hence "(¦ ❙∼ (replicate n ⊤ @ Γ) @ Φ ¦⇩⊥) ≤ length (replicate n ⊤ @ Γ)"
by (simp add: relative_maximals_neg_verum_elim)
hence "∀ 𝒫 ∈ dirac_measures.
(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using dirac_MaxSAT_partial_completeness by blast
{
fix 𝒫
assume "𝒫 ∈ dirac_measures"
from this interpret probability_logic "(λ φ. ⊢ φ)" "(→)" ⊥ 𝒫
unfolding dirac_measures_def
by auto
have "(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)"
using ‹𝒫 ∈ dirac_measures›
‹∀ 𝒫 ∈ dirac_measures.
(∑φ←Φ. 𝒫 φ) ≤ (∑γ←(replicate n ⊤) @ Γ. 𝒫 γ)›
by blast
hence "(∑φ←Φ. 𝒫 φ) + ⌈c⌉ ≤ (∑γ← Γ. 𝒫 γ)"
using ‹real n = - ⌈c⌉› probability_replicate_verum by auto
hence "(∑φ←Φ. 𝒫 φ) + c ≤ (∑γ← Γ. 𝒫 γ)"
by linarith
}
then show ?thesis by blast
qed
qed
lemma (in consistent_classical_logic) dirac_inequality_equiv:
"(∀ δ ∈ dirac_measures. (∑φ←Φ. δ φ) + c ≤ (∑γ←Γ. δ γ))
= (MaxSAT (❙∼ Γ @ Φ) + (c :: real) ≤ length Γ)"
using dirac_inequality_elim dirac_inequality_intro consistency by auto
theorem (in consistent_classical_logic) probability_inequality_equiv:
"(∀ 𝒫 ∈ probabilities. (∑φ←Φ. 𝒫 φ) + c ≤ (∑γ←Γ. 𝒫 γ))
= (MaxSAT (❙∼ Γ @ Φ) + (c :: real) ≤ length Γ)"
unfolding dirac_collapse
using dirac_inequality_equiv dirac_ceiling by blast
no_notation first_component ("𝔄")
no_notation second_component ("𝔅")
no_notation merge_witness ("𝔍")
no_notation X_witness ("𝔛")
no_notation X_component ("𝔛⇩∙")
no_notation Y_witness ("𝔜")
no_notation Y_component ("𝔜⇩∙")
no_notation submerge_witness ("𝔈")
no_notation recover_witness_A ("𝔓")
no_notation recover_complement_A ("𝔓⇧C")
no_notation recover_witness_B ("𝔔")
no_notation relative_maximals ("ℳ")
no_notation relative_MaxSAT ("¦ _ ¦⇩_" [45])
no_notation complement_relative_MaxSAT ("∥ _ ∥⇩_" [45])
no_notation MaxSAT_optimal_pre_witness ("𝔙")
no_notation MaxSAT_optimal_witness ("𝔚")
no_notation disjunction_MaxSAT_optimal_witness ("𝔚⇩⊔")
no_notation implication_MaxSAT_optimal_witness ("𝔚⇩→")
no_notation MaxSAT_witness ("𝔘")
notation FuncSet.funcset (infixr "→" 60)
end