Theory TAO_9_PLM

theory TAO_9_PLM
imports TAO_8_Definitions Eisbach_Tools
(*<*)
theory TAO_9_PLM
imports 
  TAO_8_Definitions 
  "HOL-Eisbach.Eisbach_Tools"
begin
(*>*)

section‹The Deductive System PLM›
text‹\label{TAO_PLM}›

declare meta_defs[no_atp] meta_aux[no_atp]

locale PLM = Axioms
begin

subsection‹Automatic Solver›
text‹\label{TAO_PLM_Solver}›

  named_theorems PLM
  named_theorems PLM_intro
  named_theorems PLM_elim
  named_theorems PLM_dest
  named_theorems PLM_subst

  method PLM_solver declares PLM_intro PLM_elim PLM_subst PLM_dest PLM
    = ((assumption | (match axiom in A: "[[φ]]" for φ  ‹fact A[axiom_instance]›)
        | fact PLM | rule PLM_intro | subst PLM_subst | subst (asm) PLM_subst
        | fastforce | safe | drule PLM_dest | erule PLM_elim); (PLM_solver)?)

subsection‹Modus Ponens›
text‹\label{TAO_PLM_ModusPonens}›

  lemma modus_ponens[PLM]:
    "⟦[φ in v]; [φ  ψ in v]⟧ ⟹ [ψ in v]"
    by (simp add: Semantics.T5)

subsection‹Axioms›
text‹\label{TAO_PLM_Axioms}›

  interpretation Axioms .
  declare axiom[PLM]
  declare conn_defs[PLM]

subsection‹(Modally Strict) Proofs and Derivations›
text‹\label{TAO_PLM_ProofsAndDerivations}›

  lemma vdash_properties_6[no_atp]:
    "⟦[φ in v]; [φ  ψ in v]⟧ ⟹ [ψ in v]"
    using modus_ponens .
  lemma vdash_properties_9[PLM]:
    "[φ in v] ⟹ [ψ  φ in v]"
    using modus_ponens pl_1[axiom_instance] by blast
  lemma vdash_properties_10[PLM]:
    "[φ  ψ in v] ⟹ ([φ in v] ⟹ [ψ in v])"
    using vdash_properties_6 .

  attribute_setup deduction = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm vdash_properties_10}))
›

subsection‹GEN and RN›
text‹\label{TAO_PLM_GEN_RN}›

  lemma rule_gen[PLM]:
    "⟦⋀α . [φ α in v]⟧ ⟹ [α . φ α in v]"
    by (simp add: Semantics.T8)

  lemma RN_2[PLM]:
    "(⋀ v . [ψ in v] ⟹ [φ in v]) ⟹ ([ψ in v] ⟹ [φ in v])"
    by (simp add: Semantics.T6)

  lemma RN[PLM]:
    "(⋀ v . [φ in v]) ⟹ [φ in v]"
    using qml_3[axiom_necessitation, axiom_instance] RN_2 by blast

subsection‹Negations and Conditionals›
text‹\label{TAO_PLM_NegationsAndConditionals}›

  lemma if_p_then_p[PLM]:
    "[φ  φ in v]"
    using pl_1 pl_2 vdash_properties_10 axiom_instance by blast

  lemma deduction_theorem[PLM,PLM_intro]:
    "⟦[φ in v] ⟹ [ψ in v]⟧ ⟹ [φ  ψ in v]"
    by (simp add: Semantics.T5)
  lemmas CP = deduction_theorem

  lemma ded_thm_cor_3[PLM]:
    "⟦[φ  ψ in v]; [ψ  χ in v]⟧ ⟹ [φ  χ in v]"
    by (meson pl_2 vdash_properties_10 vdash_properties_9 axiom_instance)
  lemma ded_thm_cor_4[PLM]:
    "⟦[φ  χ) in v]; [ψ in v]⟧ ⟹ [φ  χ in v]"
    by (meson pl_2 vdash_properties_10 vdash_properties_9 axiom_instance)

  lemma useful_tautologies_1[PLM]:
    "[¬¬φ  φ in v]"
    by (meson pl_1 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_2[PLM]:
    "[φ  ¬¬φ in v]"
    by (meson pl_1 pl_3 ded_thm_cor_3 useful_tautologies_1
              vdash_properties_10 axiom_instance)
  lemma useful_tautologies_3[PLM]:
    "[¬φ  ψ) in v]"
    by (meson pl_1 pl_2 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_4[PLM]:
    "[(¬ψ  ¬φ)  ψ) in v]"
    by (meson pl_1 pl_2 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_5[PLM]:
    "[(φ  ψ)  (¬ψ  ¬φ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_6[PLM]:
    "[(φ  ¬ψ)  ¬φ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_7[PLM]:
    "[(¬φ  ψ)  (¬ψ  φ) in v]"
    using ded_thm_cor_3 useful_tautologies_4 useful_tautologies_5
          useful_tautologies_6 by blast
  lemma useful_tautologies_8[PLM]:
    "[φ  (¬ψ  ¬ ψ)) in v]"
    by (meson ded_thm_cor_3 CP useful_tautologies_5)
  lemma useful_tautologies_9[PLM]:
    "[(φ  ψ)  ((¬φ  ψ)  ψ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_10[PLM]:
    "[(φ  ¬ψ)  ((φ  ψ)  ¬φ) in v]"
    by (metis ded_thm_cor_3 CP useful_tautologies_6)

  lemma modus_tollens_1[PLM]:
    "⟦[φ  ψ in v]; [¬ψ in v]⟧ ⟹ [¬φ in v]"
    by (metis ded_thm_cor_3 ded_thm_cor_4 useful_tautologies_3
              useful_tautologies_7 vdash_properties_10)
  lemma modus_tollens_2[PLM]:
    "⟦[φ  ¬ψ in v]; [ψ in v]⟧ ⟹ [¬φ in v]"
    using modus_tollens_1 useful_tautologies_2
          vdash_properties_10 by blast

  lemma contraposition_1[PLM]:
    "[φ  ψ in v] = [¬ψ  ¬φ in v]"
    using useful_tautologies_4 useful_tautologies_5
          vdash_properties_10 by blast
  lemma contraposition_2[PLM]:
    "[φ  ¬ψ in v] = [ψ  ¬φ in v]"
    using contraposition_1 ded_thm_cor_3
          useful_tautologies_1 by blast

  lemma reductio_aa_1[PLM]:
    "⟦[¬φ in v] ⟹ [¬ψ in v]; [¬φ in v] ⟹ [ψ in v]⟧ ⟹ [φ in v]"
    using CP modus_tollens_2 useful_tautologies_1
          vdash_properties_10 by blast
  lemma reductio_aa_2[PLM]:
    "⟦[φ in v] ⟹ [¬ψ in v]; [φ in v] ⟹ [ψ in v]⟧ ⟹ [¬φ in v]"
    by (meson contraposition_1 reductio_aa_1)
  lemma reductio_aa_3[PLM]:
    "⟦[¬φ  ¬ψ in v]; [¬φ  ψ in v]⟧ ⟹ [φ in v]"
    using reductio_aa_1 vdash_properties_10 by blast
  lemma reductio_aa_4[PLM]:
    "⟦[φ  ¬ψ in v]; [φ  ψ in v]⟧ ⟹ [¬φ in v]"
    using reductio_aa_2 vdash_properties_10 by blast

  lemma raa_cor_1[PLM]:
    "⟦[φ in v]; [¬ψ in v] ⟹ [¬φ in v]⟧ ⟹ ([φ in v] ⟹ [ψ in v])"
    using reductio_aa_1 vdash_properties_9 by blast
  lemma raa_cor_2[PLM]:
    "⟦[¬φ in v]; [¬ψ in v] ⟹ [φ in v]⟧ ⟹ ([¬φ in v] ⟹ [ψ in v])"
    using reductio_aa_1 vdash_properties_9 by blast
  lemma raa_cor_3[PLM]:
    "⟦[φ in v]; [¬ψ  ¬φ in v]⟧ ⟹ ([φ in v] ⟹ [ψ in v])"
    using raa_cor_1 vdash_properties_10 by blast
  lemma raa_cor_4[PLM]:
    "⟦[¬φ in v]; [¬ψ  φ in v]⟧ ⟹ ([¬φ in v] ⟹ [ψ in v])"
    using raa_cor_2 vdash_properties_10 by blast

text‹
\begin{remark}
  In contrast to PLM the classical introduction and elimination rules are proven
  before the tautologies. The statements proven so far are sufficient
  for the proofs and using the derived rules the tautologies can be derived
  automatically.
\end{remark}
›

  lemma intro_elim_1[PLM]:
    "⟦[φ in v]; [ψ in v]⟧ ⟹ [φ & ψ in v]"
    unfolding conj_def using ded_thm_cor_4 if_p_then_p modus_tollens_2 by blast
  lemmas "&I" = intro_elim_1
  lemma intro_elim_2_a[PLM]:
    "[φ & ψ in v] ⟹ [φ in v]"
    unfolding conj_def using CP reductio_aa_1 by blast
  lemma intro_elim_2_b[PLM]:
    "[φ & ψ in v] ⟹ [ψ in v]"
    unfolding conj_def using pl_1 CP reductio_aa_1 axiom_instance by blast
  lemmas "&E" = intro_elim_2_a intro_elim_2_b
  lemma intro_elim_3_a[PLM]:
    "[φ in v] ⟹ [φ  ψ in v]"
    unfolding disj_def using ded_thm_cor_4 useful_tautologies_3 by blast
  lemma intro_elim_3_b[PLM]:
    "[ψ in v] ⟹ [φ  ψ in v]"
    by (simp only: disj_def vdash_properties_9)
  lemmas "I" = intro_elim_3_a intro_elim_3_b
  lemma intro_elim_4_a[PLM]:
    "⟦[φ  ψ in v]; [φ  χ in v]; [ψ  χ in v]⟧ ⟹ [χ in v]"
    unfolding disj_def by (meson reductio_aa_2 vdash_properties_10)
  lemma intro_elim_4_b[PLM]:
    "⟦[φ  ψ in v]; [¬φ in v]⟧ ⟹ [ψ in v]"
    unfolding disj_def using vdash_properties_10 by blast
  lemma intro_elim_4_c[PLM]:
    "⟦[φ  ψ in v]; [¬ψ in v]⟧ ⟹ [φ in v]"
    unfolding disj_def using raa_cor_2 vdash_properties_10 by blast
  lemma intro_elim_4_d[PLM]:
    "⟦[φ  ψ in v]; [φ  χ in v]; [ψ  Θ in v]⟧ ⟹ [χ  Θ in v]"
    unfolding disj_def using contraposition_1 ded_thm_cor_3 by blast
  lemma intro_elim_4_e[PLM]:
    "⟦[φ  ψ in v]; [φ  χ in v]; [ψ  Θ in v]⟧ ⟹ [χ  Θ in v]"
    unfolding equiv_def using "&E"(1) intro_elim_4_d by blast
  lemmas "E" = intro_elim_4_a intro_elim_4_b intro_elim_4_c intro_elim_4_d
  lemma intro_elim_5[PLM]:
    "⟦[φ  ψ in v]; [ψ  φ in v]⟧ ⟹ [φ  ψ in v]"
    by (simp only: equiv_def "&I")
  lemmas "I" = intro_elim_5
  lemma intro_elim_6_a[PLM]:
    "⟦[φ  ψ in v]; [φ in v]⟧ ⟹ [ψ in v]"
    unfolding equiv_def using "&E"(1) vdash_properties_10 by blast
  lemma intro_elim_6_b[PLM]:
    "⟦[φ  ψ in v]; [ψ in v]⟧ ⟹ [φ in v]"
    unfolding equiv_def using "&E"(2) vdash_properties_10 by blast
  lemma intro_elim_6_c[PLM]:
    "⟦[φ  ψ in v]; [¬φ in v]⟧ ⟹ [¬ψ in v]"
    unfolding equiv_def using "&E"(2) modus_tollens_1 by blast
  lemma intro_elim_6_d[PLM]:
    "⟦[φ  ψ in v]; [¬ψ in v]⟧ ⟹ [¬φ in v]"
    unfolding equiv_def using "&E"(1) modus_tollens_1 by blast
  lemma intro_elim_6_e[PLM]:
    "⟦[φ  ψ in v]; [ψ  χ in v]⟧ ⟹ [φ  χ in v]"
    by (metis equiv_def ded_thm_cor_3 "&E" "I")
  lemma intro_elim_6_f[PLM]:
    "⟦[φ  ψ in v]; [φ  χ in v]⟧ ⟹ [χ  ψ in v]"
    by (metis equiv_def ded_thm_cor_3 "&E" "I")
  lemmas "E" = intro_elim_6_a intro_elim_6_b intro_elim_6_c
                intro_elim_6_d intro_elim_6_e intro_elim_6_f
  lemma intro_elim_7[PLM]:
    "[φ in v] ⟹ [¬¬φ in v]"
    using if_p_then_p modus_tollens_2 by blast
  lemmas "¬¬I" = intro_elim_7
  lemma intro_elim_8[PLM]:
    "[¬¬φ in v] ⟹ [φ in v]"
    using if_p_then_p raa_cor_2 by blast
  lemmas "¬¬E" = intro_elim_8

  context
  begin
    private lemma NotNotI[PLM_intro]:
      "[φ in v] ⟹ [¬(¬φ) in v]"
      by (simp add: "¬¬I")
    private lemma NotNotD[PLM_dest]:
      "[¬(¬φ) in v] ⟹ [φ in v]"
      using "¬¬E" by blast

    private lemma ImplI[PLM_intro]:
      "([φ in v] ⟹ [ψ in v]) ⟹ [φ  ψ in v]"
      using CP .
    private lemma ImplE[PLM_elim, PLM_dest]:
      "[φ  ψ in v] ⟹ ([φ in v] ⟹ [ψ in v])"
      using modus_ponens .
    private lemma ImplS[PLM_subst]:
      "[φ  ψ in v] = ([φ in v] ⟶ [ψ in v])"
      using ImplI ImplE by blast

    private lemma NotI[PLM_intro]:
      "([φ in v] ⟹ (⋀ψ .[ψ in v])) ⟹ [¬φ in v]"
      using CP modus_tollens_2 by blast
    private lemma NotE[PLM_elim,PLM_dest]:
      "[¬φ in v] ⟹ ([φ in v] ⟶ (∀ψ .[ψ in v]))"
      using "I"(2) "E"(3) by blast
    private lemma NotS[PLM_subst]:
      "[¬φ in v] = ([φ in v] ⟶ (∀ψ .[ψ in v]))"
      using NotI NotE by blast

    private lemma ConjI[PLM_intro]:
      "⟦[φ in v]; [ψ in v]⟧ ⟹ [φ & ψ in v]"
      using "&I" by blast
    private lemma ConjE[PLM_elim,PLM_dest]:
      "[φ & ψ in v] ⟹ (([φ in v] ∧ [ψ in v]))"
      using CP "&E" by blast
    private lemma ConjS[PLM_subst]:
      "[φ & ψ in v] = (([φ in v] ∧ [ψ in v]))"
      using ConjI ConjE by blast

    private lemma DisjI[PLM_intro]:
      "[φ in v] ∨ [ψ in v] ⟹ [φ  ψ in v]"
      using "I" by blast
    private lemma DisjE[PLM_elim,PLM_dest]:
      "[φ  ψ in v] ⟹ [φ in v] ∨ [ψ in v]"
      using CP "E"(1) by blast
    private lemma DisjS[PLM_subst]:
      "[φ  ψ in v] = ([φ in v] ∨ [ψ in v])"
      using DisjI DisjE by blast

    private lemma EquivI[PLM_intro]:
      "⟦[φ in v] ⟹ [ψ in v];[ψ in v] ⟹ [φ in v]⟧ ⟹ [φ  ψ in v]"
      using CP "I" by blast
    private lemma EquivE[PLM_elim,PLM_dest]:
      "[φ  ψ in v] ⟹ (([φ in v] ⟶ [ψ in v]) ∧ ([ψ in v] ⟶ [φ in v]))"
      using "E"(1) "E"(2) by blast
    private lemma EquivS[PLM_subst]:
      "[φ  ψ in v] = ([φ in v] ⟷ [ψ in v])"
      using EquivI EquivE by blast

    private lemma NotOrD[PLM_dest]:
      "¬[φ  ψ in v] ⟹ ¬[φ in v] ∧ ¬[ψ in v]"
      using "I" by blast
    private lemma NotAndD[PLM_dest]:
      "¬[φ & ψ in v] ⟹ ¬[φ in v] ∨ ¬[ψ in v]"
      using "&I" by blast
    private lemma NotEquivD[PLM_dest]:
      "¬[φ  ψ in v] ⟹ [φ in v] ≠ [ψ in v]"
      by (meson NotI contraposition_1 "I" vdash_properties_9)

    private lemma BoxI[PLM_intro]:
      "(⋀ v . [φ in v]) ⟹ [φ in v]"
      using RN by blast
    private lemma NotBoxD[PLM_dest]:
      "¬[φ in v] ⟹ (∃ v . ¬[φ in v])"
      using BoxI by blast

    private lemma AllI[PLM_intro]:
      "(⋀ x . [φ x in v]) ⟹ [ x . φ x in v]"
      using rule_gen by blast
    lemma NotAllD[PLM_dest]:
      "¬[ x . φ x in v] ⟹ (∃ x . ¬[φ x in v])"
      using AllI by fastforce
  end

  lemma oth_class_taut_1_a[PLM]:
    "[¬& ¬φ) in v]"
    by PLM_solver
  lemma oth_class_taut_1_b[PLM]:
    "[¬ ¬φ) in v]"
    by PLM_solver
  lemma oth_class_taut_2[PLM]:
    "[φ  ¬φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_a[PLM]:
    "[(φ & φ)  φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_b[PLM]:
    "[(φ & ψ) & φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_c[PLM]:
    "[(φ && χ))  ((φ & ψ) & χ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_d[PLM]:
    "[(φ  φ)  φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_e[PLM]:
    "[(φ  ψ)  φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_f[PLM]:
    "[(φ  χ))  ((φ  ψ)  χ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_g[PLM]:
    "[(φ  ψ)  φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_i[PLM]:
    "[(φ  χ))  ((φ  ψ)  χ) in v]"
    by PLM_solver
  lemma oth_class_taut_4_a[PLM]:
    "[φ  φ in v]"
    by PLM_solver
  lemma oth_class_taut_4_b[PLM]:
    "[φ  ¬¬φ in v]"
    by PLM_solver
  lemma oth_class_taut_5_a[PLM]:
    "[(φ  ψ)  ¬& ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_b[PLM]:
    "[¬ ψ) & ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_c[PLM]:
    "[(φ  ψ)  ((ψ  χ)  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_d[PLM]:
    "[(φ  ψ)  (¬φ  ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_e[PLM]:
    "[(φ  ψ)  ((φ  χ)  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_f[PLM]:
    "[(φ  ψ)  ((χ  φ)  ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_g[PLM]:
    "[(φ  ψ)  ((φ  χ)  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_h[PLM]:
    "[(φ  ψ)  ((χ  φ)  ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_i[PLM]:
    "[(φ  ψ)  ((φ & ψ)  (¬φ & ¬ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_j[PLM]:
    "[(¬ ψ))  ((φ & ¬ψ)  (¬φ & ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_k[PLM]:
    "[(φ  ψ)  (¬φ  ψ) in v]"
    by PLM_solver

  lemma oth_class_taut_6_a[PLM]:
    "[(φ & ψ)  ¬(¬φ  ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_b[PLM]:
    "[(φ  ψ)  ¬(¬φ & ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_c[PLM]:
    "[¬& ψ)  (¬φ  ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_d[PLM]:
    "[¬ ψ)  (¬φ & ¬ψ) in v]"
    by PLM_solver

  lemma oth_class_taut_7_a[PLM]:
    "[(φ & χ))  ((φ & ψ) & χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_7_b[PLM]:
    "[(φ & χ))  ((φ  ψ) & χ)) in v]"
    by PLM_solver

  lemma oth_class_taut_8_a[PLM]:
    "[((φ & ψ)  χ)  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_8_b[PLM]:
    "[(φ  χ))  ((φ & ψ)  χ) in v]"
    by PLM_solver

  lemma oth_class_taut_9_a[PLM]:
    "[(φ & ψ)  φ in v]"
    by PLM_solver
  lemma oth_class_taut_9_b[PLM]:
    "[(φ & ψ)  ψ in v]"
    by PLM_solver

  lemma oth_class_taut_10_a[PLM]:
    "[φ & ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_b[PLM]:
    "[(φ  χ))  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_c[PLM]:
    "[(φ  ψ)  ((φ  χ) & χ))) in v]"
    by PLM_solver
  lemma oth_class_taut_10_d[PLM]:
    "[(φ  χ)  ((ψ  χ)  ((φ  ψ)  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_e[PLM]:
    "[(φ  ψ)  ((χ  Θ)  ((φ & χ) & Θ))) in v]"
    by PLM_solver
  lemma oth_class_taut_10_f[PLM]:
    "[((φ & ψ) & χ))  χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_g[PLM]:
    "[((φ & ψ) & ψ))  χ)) in v]"
    by PLM_solver

  attribute_setup equiv_lr = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "E"(1)}))
›

  attribute_setup equiv_rl = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "E"(2)}))
›

  attribute_setup equiv_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm oth_class_taut_3_g[equiv_lr]}))
›

  attribute_setup conj1 = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "&E"(1)}))
›

  attribute_setup conj2 = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "&E"(2)}))
›

  attribute_setup conj_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm oth_class_taut_3_b[equiv_lr]}))
›

  
subsection‹Identity›
text‹\label{TAO_PLM_Identity}›

  lemma id_eq_prop_prop_1[PLM]:
    "[(F::Π1) = F in v]"
    unfolding identity_defs by PLM_solver 
  lemma id_eq_prop_prop_2[PLM]:
    "[((F::Π1) = G)  (G = F) in v]"
    by (meson id_eq_prop_prop_1 CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_3[PLM]:
    "[(((F::Π1) = G) & (G = H))  (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_4_a[PLM]:
    "[(F::Π2) = F in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_4_b[PLM]:
    "[(F::Π3) = F in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_5_a[PLM]:
    "[((F::Π2) = G)  (G = F) in v]"
    by (meson id_eq_prop_prop_4_a CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_5_b[PLM]:
    "[((F::Π3) = G)  (G = F) in v]"
    by (meson id_eq_prop_prop_4_b CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_6_a[PLM]:
    "[(((F::Π2) = G) & (G = H))  (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_6_b[PLM]:
    "[(((F::Π3) = G) & (G = H))  (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_7[PLM]:
    "[(p::Π0) = p in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_7_b[PLM]:
    "[(p::𝗈) = p in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_8[PLM]:
    "[((p::Π0) = q)  (q = p) in v]"
    by (meson id_eq_prop_prop_7 CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_8_b[PLM]:
    "[((p::𝗈) = q)  (q = p) in v]"
    by (meson id_eq_prop_prop_7_b CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_9[PLM]:
    "[(((p::Π0) = q) & (q = r))  (p = r) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_9_b[PLM]:
    "[(((p::𝗈) = q) & (q = r))  (p = r) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")

  lemma eq_E_simple_1[PLM]:
    "[(x =E y)  (⦇O!,x⦈ & ⦇O!,y⦈ & (F . ⦇F,x⦈  ⦇F,y⦈)) in v]"
    proof (rule "I"; rule CP)
      assume 1: "[x =E y in v]"
      have "[ x y . ((xP) =E (yP))  (⦇O!,xP& ⦇O!,yP& (F . ⦇F,xP ⦇F,yP⦈)) in v]"
        unfolding identityE_infix_def identityE_def
        apply (rule lambda_predicates_2_2[axiom_universal, axiom_universal, axiom_instance])
        by show_proper
      moreover have "[ α . (αP) = x in v]"
        apply (rule cqt_5_mod[where ψ="λ x . x =E y", axiom_instance,deduction])
        unfolding identityE_infix_def
        apply (rule SimpleExOrEnc.intros)
        using 1 unfolding identityE_infix_def by auto
      moreover have "[ β . (βP) = y in v]"
        apply (rule cqt_5_mod[where ψ="λ y . x =E y",axiom_instance,deduction])
        unfolding identityE_infix_def
        apply (rule SimpleExOrEnc.intros) using 1
        unfolding identityE_infix_def by auto
      ultimately have "[(x =E y)  (⦇O!,x⦈ & ⦇O!,y⦈
                        & (F . ⦇F,x⦈  ⦇F,y⦈)) in v]"
        using cqt_1_κ[axiom_instance,deduction, deduction] by meson
      thus "[(⦇O!,x⦈ & ⦇O!,y⦈ & (F . ⦇F,x⦈  ⦇F,y⦈)) in v]"
        using 1 "E"(1) by blast
    next
      assume 1: "[⦇O!,x⦈ & ⦇O!,y⦈ & (F. ⦇F,x⦈  ⦇F,y⦈) in v]"
      have "[ x y . ((xP) =E (yP))  (⦇O!,xP& ⦇O!,yP& (F . ⦇F,xP ⦇F,yP⦈)) in v]"
        unfolding identityE_def identityE_infix_def
        apply (rule lambda_predicates_2_2[axiom_universal, axiom_universal, axiom_instance])
        by show_proper
      moreover have "[ α . (αP) = x in v]"
        apply (rule cqt_5_mod[where ψ="λ x . ⦇O!,x⦈",axiom_instance,deduction])
        apply (rule SimpleExOrEnc.intros)
        using 1[conj1,conj1] by auto
      moreover have "[ β . (βP) = y in v]"
        apply (rule cqt_5_mod[where ψ="λ y . ⦇O!,y⦈",axiom_instance,deduction])
         apply (rule SimpleExOrEnc.intros)
        using 1[conj1,conj2] by auto
      ultimately have "[(x =E y)  (⦇O!,x⦈ & ⦇O!,y⦈
                        & (F . ⦇F,x⦈  ⦇F,y⦈)) in v]"
      using cqt_1_κ[axiom_instance,deduction, deduction] by meson
      thus "[(x =E y) in v]" using 1 "E"(2) by blast
    qed
  lemma eq_E_simple_2[PLM]:
    "[(x =E y)  (x = y) in v]"
    unfolding identity_defs by PLM_solver
  lemma eq_E_simple_3[PLM]:
    "[(x = y)  ((⦇O!,x⦈ & ⦇O!,y⦈ & (F . ⦇F,x⦈  ⦇F,y⦈))
                (⦇A!,x⦈ & ⦇A!,y⦈ & (F. ⦃x,F⦄  ⦃y,F⦄))) in v]"
    using eq_E_simple_1
    apply - unfolding identity_defs
    by PLM_solver

  lemma id_eq_obj_1[PLM]: "[(xP) = (xP) in v]"
    proof -
      have "[(⦇E!, xP⦈)  (¬⦇E!, xP⦈) in v]"
        using PLM.oth_class_taut_2 by simp
      hence "[(⦇E!, xP⦈) in v] ∨ [(¬⦇E!, xP⦈) in v]"
        using CP "E"(1) by blast
      moreover {
        assume "[(⦇E!, xP⦈) in v]"
        hence "[⦇λx. ⦇E!,xP⦈,xP⦈ in v]"
          apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl, rotated])
          by show_proper
        hence "[⦇λx. ⦇E!,xP⦈,xP&λx. ⦇E!,xP⦈,xP& (F. ⦇F,xP ⦇F,xP⦈) in v]"
          apply - by PLM_solver
        hence "[(xP) =E (xP) in v]"
          using eq_E_simple_1[equiv_rl] unfolding Ordinary_def by fast
      }
      moreover {
        assume "[(¬⦇E!, xP⦈) in v]"
        hence "[⦇λx. ¬⦇E!,xP⦈,xP⦈ in v]"
          apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl, rotated])
          by show_proper
        hence "[⦇λx. ¬⦇E!,xP⦈,xP&λx. ¬⦇E!,xP⦈,xP& (F. ⦃xP,F⦄  ⦃xP,F⦄) in v]"
          apply - by PLM_solver
      }
      ultimately show ?thesis unfolding identity_defs Ordinary_def Abstract_def
        using "I" by blast
    qed
  lemma id_eq_obj_2[PLM]:
    "[((xP) = (yP))  ((yP) = (xP)) in v]"
    by (meson l_identity[axiom_instance] id_eq_obj_1 CP ded_thm_cor_3)
  lemma id_eq_obj_3[PLM]:
    "[((xP) = (yP)) & ((yP) = (zP))  ((xP) = (zP)) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
end

text‹
\begin{remark}
  To unify the statements of the properties of equality a type class is introduced.
\end{remark}
›

class id_eq = quantifiable_and_identifiable +
  assumes id_eq_1: "[(x :: 'a) = x in v]"
  assumes id_eq_2: "[((x :: 'a) = y)  (y = x) in v]"
  assumes id_eq_3: "[((x :: 'a) = y) & (y = z)  (x = z) in v]"

instantiation ν :: id_eq
begin
  instance proof
    fix x :: ν and v
    show "[x = x in v]"
      using PLM.id_eq_obj_1
      by (simp add: identity_ν_def)
  next
    fix x y::ν and v
    show "[x = y  y = x in v]"
      using PLM.id_eq_obj_2
      by (simp add: identity_ν_def)
  next
    fix x y z::ν and v
    show "[((x = y) & (y = z))  x = z in v]"
      using PLM.id_eq_obj_3
      by (simp add: identity_ν_def)
  qed
end

instantiation 𝗈 :: id_eq
begin
  instance proof
    fix x :: 𝗈 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_7 .
  next
    fix x y :: 𝗈 and v
    show "[x = y  y = x in v]"
      using PLM.id_eq_prop_prop_8 .
  next
    fix x y z :: 𝗈 and v
    show "[((x = y) & (y = z))  x = z in v]"
      using PLM.id_eq_prop_prop_9 .
  qed
end

instantiation Π1 :: id_eq
begin
  instance proof
    fix x :: Π1 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_1 .
  next
    fix x y :: Π1 and v
    show "[x = y  y = x in v]"
      using PLM.id_eq_prop_prop_2 .
  next
    fix x y z :: Π1 and v
    show "[((x = y) & (y = z))  x = z in v]"
      using PLM.id_eq_prop_prop_3 .
  qed
end

instantiation Π2 :: id_eq
begin
  instance proof
    fix x :: Π2 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_4_a .
  next
    fix x y :: Π2 and v
    show "[x = y  y = x in v]"
      using PLM.id_eq_prop_prop_5_a .
  next
    fix x y z :: Π2 and v
    show "[((x = y) & (y = z))  x = z in v]"
      using PLM.id_eq_prop_prop_6_a .
  qed
end

instantiation Π3 :: id_eq
begin
  instance proof
    fix x :: Π3 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_4_b .
  next
    fix x y :: Π3 and v
    show "[x = y  y = x in v]"
      using PLM.id_eq_prop_prop_5_b .
  next
    fix x y z :: Π3 and v
    show "[((x = y) & (y = z))  x = z in v]"
      using PLM.id_eq_prop_prop_6_b .
  qed
end

context PLM
begin
  lemma id_eq_1[PLM]:
    "[(x::'a::id_eq) = x in v]"
    using id_eq_1 .
  lemma id_eq_2[PLM]:
    "[((x::'a::id_eq) = y)  (y = x) in v]"
    using id_eq_2 .
  lemma id_eq_3[PLM]:
    "[((x::'a::id_eq) = y) & (y = z)  (x = z) in v]"
    using id_eq_3 .

  attribute_setup eq_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm id_eq_2[deduction]}))
›


  lemma all_self_eq_1[PLM]:
    "[( α :: 'a::id_eq . α = α) in v]"
    by PLM_solver
  lemma all_self_eq_2[PLM]:
    "[α :: 'a::id_eq . = α) in v]"
    by PLM_solver

  lemma t_id_t_proper_1[PLM]:
    "[τ = τ'  ( β . (βP) = τ) in v]"
    proof (rule CP)
      assume "[τ = τ' in v]"
      moreover {
        assume "[τ =E τ' in v]"
        hence "[ β . (βP) = τ in v]"
          apply -
          apply (rule cqt_5_mod[where ψ="λ τ . τ =E τ'", axiom_instance, deduction])
           subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
          by simp
      }
      moreover {
        assume "[⦇A!,τ⦈ & ⦇A!,τ'⦈ & (F. ⦃τ,F⦄  ⦃τ',F⦄) in v]"
        hence "[ β . (βP) = τ in v]"
          apply -
          apply (rule cqt_5_mod[where ψ="λ τ . ⦇A!,τ⦈", axiom_instance, deduction])
           subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
          by PLM_solver
      }
      ultimately show "[ β . (βP) = τ in v]" unfolding identityκ_def
        using intro_elim_4_b reductio_aa_1 by blast
    qed

  lemma t_id_t_proper_2[PLM]: "[τ = τ'  ( β . (βP) = τ') in v]"
  proof (rule CP)
    assume "[τ = τ' in v]"
    moreover {
      assume "[τ =E τ' in v]"
      hence "[ β . (βP) = τ' in v]"
        apply -
        apply (rule cqt_5_mod[where ψ="λ τ' . τ =E τ'", axiom_instance, deduction])
         subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
        by simp
    }
    moreover {
      assume "[⦇A!,τ⦈ & ⦇A!,τ'⦈ & (F. ⦃τ,F⦄  ⦃τ',F⦄) in v]"
      hence "[ β . (βP) = τ' in v]"
        apply -
        apply (rule cqt_5_mod[where ψ="λ τ . ⦇A!,τ⦈", axiom_instance, deduction])
         subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
        by PLM_solver
    }
    ultimately show "[ β . (βP) = τ' in v]" unfolding identityκ_def
      using intro_elim_4_b reductio_aa_1 by blast
  qed

  lemma id_nec[PLM]: "[((α::'a::id_eq) = (β))  ((α) = (β)) in v]"
    apply (rule "I")
     using l_identity[where φ = "(λ β .  ((α) = (β)))", axiom_instance]
           id_eq_1 RN ded_thm_cor_4 unfolding identity_ν_def
     apply blast
    using qml_2[axiom_instance] by blast

  lemma id_nec_desc[PLM]:
    "[((ιx. φ x) = (ιx. ψ x))  ((ιx. φ x) = (ιx. ψ x)) in v]"
    proof (cases "[( α. (αP) = (ιx . φ x)) in v] ∧ [( β. (βP) = (ιx . ψ x)) in v]")
      assume "[( α. (αP) = (ιx . φ x)) in v] ∧ [( β. (βP) = (ιx . ψ x)) in v]"
      then obtain α and β where
        "[(αP) = (ιx . φ x) in v] ∧ [(βP) = (ιx . ψ x) in v]"
        apply - unfolding conn_defs by PLM_solver
      moreover {
        moreover have "[(α) = (β)  ((α) = (β)) in v]" by PLM_solver
        ultimately have "[((ιx. φ x) =P)  ((ιx. φ x) =P))) in v]"
          using l_identity[where φ="λ α . (α) =P)  ((α) =P))", axiom_instance]
          modus_ponens unfolding identity_ν_def by metis
      }
      ultimately show ?thesis
        using l_identity[where φ="λ α . (ιx . φ x) = (α)
                                    ((ιx . φ x) = (α))", axiom_instance]
        modus_ponens by metis
    next
      assume "¬([( α. (αP) = (ιx . φ x)) in v] ∧ [( β. (βP) = (ιx . ψ x)) in v])"
      hence "¬[⦇A!,(ιx . φ x)⦈ in v] ∧ ¬[(ιx . φ x) =E (ιx . ψ x) in v]
           ∨ ¬[⦇A!,(ιx . ψ x)⦈ in v] ∧ ¬[(ιx . φ x) =E (ιx . ψ x) in v]"
      unfolding identityE_infix_def
      using cqt_5[axiom_instance] PLM.contraposition_1 SimpleExOrEnc.intros
            vdash_properties_10 by meson
      hence "¬[(ιx . φ x) = (ιx . ψ x) in v]"
        apply - unfolding identity_defs by PLM_solver
      thus ?thesis apply - apply PLM_solver
        using qml_2[axiom_instance, deduction] by auto
    qed

subsection‹Quantification›
text‹\label{TAO_PLM_Quantification}›

  lemma rule_ui[PLM,PLM_elim,PLM_dest]:
    "[α . φ α in v] ⟹ [φ β in v]"
    by (meson cqt_1[axiom_instance, deduction])
  lemmas "E" = rule_ui

  lemma rule_ui_2[PLM,PLM_elim,PLM_dest]:
    "⟦[α . φ (αP) in v]; [ α . (α)P = β in v]⟧ ⟹ [φ β in v]"
    using cqt_1_κ[axiom_instance, deduction, deduction] by blast

  lemma cqt_orig_1[PLM]:
    "[(α. φ α)  φ β in v]"
    by PLM_solver
  lemma cqt_orig_2[PLM]:
    "[(α. φ  ψ α)  (α. ψ α)) in v]"
    by PLM_solver

  lemma universal[PLM]:
    "(⋀α . [φ α in v]) ⟹ [ α . φ α in v]"
    using rule_gen .
  lemmas "I" = universal

  lemma cqt_basic_1[PLM]:
    "[(α. (β . φ α β))  (β. (α. φ α β)) in v]"
    by PLM_solver
  lemma cqt_basic_2[PLM]:
    "[(α. φ α  ψ α)  ((α. φ α  ψ α) & (α. ψ α  φ α)) in v]"
    by PLM_solver
  lemma cqt_basic_3[PLM]:
    "[(α. φ α  ψ α)  ((α. φ α)  (α. ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_4[PLM]:
    "[(α. φ α & ψ α)  ((α. φ α) & (α. ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_6[PLM]:
    "[(α. (α. φ α))  (α. φ α) in v]"
    by PLM_solver
  lemma cqt_basic_7[PLM]:
    "[(φ  (α . ψ α))  (α.(φ  ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_8[PLM]:
    "[((α. φ α)  (α. ψ α))  (α. (φ α  ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_9[PLM]:
    "[((α. φ α  ψ α) & (α. ψ α  χ α))  (α. φ α  χ α) in v]"
    by PLM_solver
  lemma cqt_basic_10[PLM]:
    "[((α. φ α  ψ α) & (α. ψ α  χ α))  (α. φ α  χ α) in v]"
    by PLM_solver
  lemma cqt_basic_11[PLM]:
    "[(α. φ α  ψ α)  (α. ψ α  φ α) in v]"
    by PLM_solver
  lemma cqt_basic_12[PLM]:
    "[(α. φ α)  (β. φ β) in v]"
    by PLM_solver

  lemma existential[PLM,PLM_intro]:
    "[φ α in v] ⟹ [ α. φ α in v]"
    unfolding exists_def by PLM_solver
  lemmas "I" = existential
  lemma instantiation_[PLM,PLM_elim,PLM_dest]:
    "⟦[α . φ α in v]; (⋀α.[φ α in v] ⟹ [ψ in v])⟧ ⟹ [ψ in v]"
    unfolding exists_def by PLM_solver

  lemma Instantiate:
    assumes "[ x . φ x  in v]"
    obtains x where "[φ x in v]"
    apply (insert assms) unfolding exists_def by PLM_solver
  lemmas "E" = Instantiate

  lemma cqt_further_1[PLM]:
    "[(α. φ α)  (α. φ α) in v]"
    by PLM_solver
  lemma cqt_further_2[PLM]:
    "[(¬(α. φ α))  (α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_3[PLM]:
    "[(α. φ α)  ¬(α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_4[PLM]:
    "[(¬(α. φ α))  (α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_5[PLM]:
    "[(α. φ α & ψ α)  ((α. φ α) & (α. ψ α)) in v]"
      unfolding exists_def by PLM_solver
  lemma cqt_further_6[PLM]:
    "[(α. φ α  ψ α)  ((α. φ α)  (α. ψ α)) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_10[PLM]:
    "[(φ (α::'a::id_eq) & ( β . φ β  β = α))  ( β . φ β  β = α) in v]"
    apply PLM_solver
     using l_identity[axiom_instance, deduction, deduction] id_eq_2[deduction]
     apply blast
    using id_eq_1 by auto
  lemma cqt_further_11[PLM]:
    "[((α. φ α) & (α. ψ α))  (α. φ α  ψ α) in v]"
    by PLM_solver
  lemma cqt_further_12[PLM]:
    "[((¬(α. φ α)) & (¬(α. ψ α)))  (α. φ α  ψ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_13[PLM]:
    "[((α. φ α) & (¬(α. ψ α)))  (¬(α. φ α  ψ α)) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_14[PLM]:
    "[(α. β. φ α β)  (β. α. φ α β) in v]"
    unfolding exists_def by PLM_solver

  lemma nec_exist_unique[PLM]:
    "[( x. φ x  (φ x))  ((!x. φ x)  (!x. (φ x))) in v]"
    proof (rule CP)
      assume a: "[x. φ x  φ x in v]"
      show "[(!x. φ x)  (!x. φ x) in v]"
      proof (rule CP)
        assume "[(!x. φ x) in v]"
        hence "[α. φ α & (β. φ β  β = α) in v]"
          by (simp only: exists_unique_def)
        then obtain α where 1:
          "[φ α & (β. φ β  β = α) in v]"
          by (rule "E")
        {
          fix β
          have "[φ β  β = α in v]"
            using 1 "&E"(2) qml_2[axiom_instance]
              ded_thm_cor_3 "E" by fastforce
        }
        hence "[β. φ β  β = α in v]" by (rule "I")
        moreover have "[(φ α) in v]"
          using 1 "&E"(1) a vdash_properties_10 cqt_orig_1[deduction]
          by fast
        ultimately have "[α. (φ α) & (β. φ β  β = α) in v]"
          using "&I" "I" by fast
        thus "[(!x. φ x) in v]"
          unfolding exists_unique_def by assumption
      qed
    qed


subsection‹Actuality and Descriptions›
text‹\label{TAO_PLM_ActualityAndDescriptions}›

  lemma nec_imp_act[PLM]: "[φ  𝒜φ in v]"
    apply (rule CP)
    using qml_act_2[axiom_instance, equiv_lr]
          qml_2[axiom_actualization, axiom_instance]
          logic_actual_nec_2[axiom_instance, equiv_lr, deduction]
    by blast
  lemma act_conj_act_1[PLM]:
    "[𝒜(𝒜φ  φ) in v]"
    using equiv_def logic_actual_nec_2[axiom_instance]
          logic_actual_nec_4[axiom_instance] "&E"(2) "E"(2)
    by metis
  lemma act_conj_act_2[PLM]:
    "[𝒜 𝒜φ) in v]"
    using logic_actual_nec_2[axiom_instance] qml_act_1[axiom_instance]
          ded_thm_cor_3 "E"(2) nec_imp_act
    by blast
  lemma act_conj_act_3[PLM]:
    "[(𝒜φ & 𝒜ψ)  𝒜& ψ) in v]"
    unfolding conn_defs
    by (metis logic_actual_nec_2[axiom_instance]
              logic_actual_nec_1[axiom_instance]
              "E"(2) CP "E"(4) reductio_aa_2
              vdash_properties_10)
  lemma act_conj_act_4[PLM]:
    "[𝒜(𝒜φ  φ) in v]"
    unfolding equiv_def
    by (PLM_solver PLM_intro: act_conj_act_3[where φ="𝒜φ  φ"
                                and ψ= 𝒜φ", deduction])
  lemma closure_act_1a[PLM]:
    "[𝒜𝒜(𝒜φ  φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "E"(1)
    by blast
  lemma closure_act_1b[PLM]:
    "[𝒜𝒜𝒜(𝒜φ  φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "E"(1)
    by blast
  lemma closure_act_1c[PLM]:
    "[𝒜𝒜𝒜𝒜(𝒜φ  φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "E"(1)
    by blast
  lemma closure_act_2[PLM]:
    "[α. 𝒜(𝒜(φ α)  φ α) in v]"
    by PLM_solver

  lemma closure_act_3[PLM]:
    "[𝒜(α. 𝒜(φ α)  φ α) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4[PLM]:
    "[𝒜(α1 α2. 𝒜(φ α1 α2)  φ α1 α2) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4_b[PLM]:
    "[𝒜(α1 α2 α3. 𝒜(φ α1 α2 α3)  φ α1 α2 α3) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4_c[PLM]:
    "[𝒜(α1 α2 α3 α4. 𝒜(φ α1 α2 α3 α4)  φ α1 α2 α3 α4) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])

  lemma RA[PLM,PLM_intro]:
    "([φ in dw]) ⟹ [𝒜φ in dw]"
    using logic_actual[necessitation_averse_axiom_instance, equiv_rl] .

  lemma RA_2[PLM,PLM_intro]:
    "([ψ in dw] ⟹ [φ in dw]) ⟹ ([𝒜ψ in dw] ⟹ [𝒜φ in dw])"
    using RA logic_actual[necessitation_averse_axiom_instance] intro_elim_6_a by blast

  context
  begin
    private lemma ActualE[PLM,PLM_elim,PLM_dest]:
      "[𝒜φ in dw] ⟹ [φ in dw]"
      using logic_actual[necessitation_averse_axiom_instance, equiv_lr] .
    
    private lemma NotActualD[PLM_dest]:
      "¬[𝒜φ in dw] ⟹ ¬[φ in dw]"
      using RA by metis
    
    private lemma ActualImplI[PLM_intro]:
      "[𝒜φ  𝒜ψ in v] ⟹ [𝒜 ψ) in v]"
      using logic_actual_nec_2[axiom_instance, equiv_rl] .
    private lemma ActualImplE[PLM_dest, PLM_elim]:
      "[𝒜 ψ) in v] ⟹ [𝒜φ  𝒜ψ in v]"
      using logic_actual_nec_2[axiom_instance, equiv_lr] .
    private lemma NotActualImplD[PLM_dest]:
      "¬[𝒜 ψ) in v] ⟹ ¬[𝒜φ  𝒜ψ in v]"
      using ActualImplI by blast
    
    private lemma ActualNotI[PLM_intro]:
      "[¬𝒜φ in v] ⟹ [𝒜¬φ in v]"
      using logic_actual_nec_1[axiom_instance, equiv_rl] .
    lemma ActualNotE[PLM_elim,PLM_dest]:
      "[𝒜¬φ in v] ⟹ [¬𝒜φ in v]"
      using logic_actual_nec_1[axiom_instance, equiv_lr] .
    lemma NotActualNotD[PLM_dest]:
      "¬[𝒜¬φ in v] ⟹ ¬[¬𝒜φ in v]"
      using ActualNotI by blast
    
    private  lemma ActualConjI[PLM_intro]:
      "[𝒜φ & 𝒜ψ in v] ⟹ [𝒜& ψ) in v]"
      unfolding equiv_def
      by (PLM_solver PLM_intro: act_conj_act_3[deduction])
    private lemma ActualConjE[PLM_elim,PLM_dest]:
      "[𝒜& ψ) in v] ⟹ [𝒜φ & 𝒜ψ in v]"
      unfolding conj_def by PLM_solver
    
    private lemma ActualEquivI[PLM_intro]:
      "[𝒜φ  𝒜ψ in v] ⟹ [𝒜 ψ) in v]"
      unfolding equiv_def
      by (PLM_solver PLM_intro: act_conj_act_3[deduction])
    private lemma ActualEquivE[PLM_elim, PLM_dest]:
      "[𝒜 ψ) in v] ⟹ [𝒜φ  𝒜ψ in v]"
      unfolding equiv_def by PLM_solver

    private lemma ActualBoxI[PLM_intro]:
      "[φ in v] ⟹ [𝒜(φ) in v]"
      using qml_act_2[axiom_instance, equiv_lr] .
    private lemma ActualBoxE[PLM_elim, PLM_dest]:
      "[𝒜(φ) in v] ⟹ [φ in v]"
      using qml_act_2[axiom_instance, equiv_rl] .
    private lemma NotActualBoxD[PLM_dest]:
      "¬[𝒜(φ) in v] ⟹ ¬[φ in v]"
      using ActualBoxI by blast

    private lemma ActualDisjI[PLM_intro]:
      "[𝒜φ  𝒜ψ in v] ⟹ [𝒜 ψ) in v]"
      unfolding disj_def by PLM_solver
    private lemma ActualDisjE[PLM_elim,PLM_dest]:
      "[𝒜 ψ) in v] ⟹ [𝒜φ  𝒜ψ in v]"
      unfolding disj_def by PLM_solver
    private lemma NotActualDisjD[PLM_dest]:
      "¬[𝒜 ψ) in v] ⟹ ¬[𝒜φ  𝒜ψ in v]"
      using ActualDisjI by blast

    private lemma ActualForallI[PLM_intro]:
      "[ x . 𝒜(φ x) in v] ⟹ [𝒜( x . φ x) in v]"
      using logic_actual_nec_3[axiom_instance, equiv_rl] .
    lemma ActualForallE[PLM_elim,PLM_dest]:
      "[𝒜( x . φ x) in v] ⟹ [ x . 𝒜(φ x) in v]"
      using logic_actual_nec_3[axiom_instance, equiv_lr] .
    lemma NotActualForallD[PLM_dest]:
      "¬[𝒜( x . φ x) in v] ⟹ ¬[ x . 𝒜(φ x) in v]"
      using ActualForallI by blast

    lemma ActualActualI[PLM_intro]:
      "[𝒜φ in v] ⟹ [𝒜𝒜φ in v]"
      using logic_actual_nec_4[axiom_instance, equiv_lr] .
    lemma ActualActualE[PLM_elim,PLM_dest]:
      "[𝒜𝒜φ in v] ⟹ [𝒜φ in v]"
      using logic_actual_nec_4[axiom_instance, equiv_rl] .
    lemma NotActualActualD[PLM_dest]:
      "¬[𝒜𝒜φ in v] ⟹ ¬[𝒜φ in v]"
      using ActualActualI by blast
  end

  lemma ANeg_1[PLM]:
    "[¬𝒜φ  ¬φ in dw]"
    by PLM_solver
  lemma ANeg_2[PLM]:
    "[¬𝒜¬φ  φ in dw]"
    by PLM_solver
  lemma Act_Basic_1[PLM]:
    "[𝒜φ  𝒜¬φ in v]"
    by PLM_solver
  lemma Act_Basic_2[PLM]:
    "[𝒜& ψ)  (𝒜φ & 𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_3[PLM]:
    "[𝒜 ψ)  ((𝒜 ψ)) & (𝒜 φ))) in v]"
    by PLM_solver
  lemma Act_Basic_4[PLM]:
    "[(𝒜 ψ) & 𝒜 φ))  (𝒜φ  𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_5[PLM]:
    "[𝒜 ψ)  (𝒜φ  𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_6[PLM]:
    "[φ  𝒜(φ) in v]"
    unfolding diamond_def by PLM_solver
  lemma Act_Basic_7[PLM]:
    "[𝒜φ  𝒜φ in v]"
    by (simp add: qml_2[axiom_instance] qml_act_1[axiom_instance] "I")
  lemma Act_Basic_8[PLM]:
    "[𝒜(φ)  𝒜φ in v]"
    by (metis qml_act_2[axiom_instance] CP Act_Basic_7 "E"(1)
              "E"(2) nec_imp_act vdash_properties_10)
  lemma Act_Basic_9[PLM]:
    "[φ  𝒜φ in v]"
    using qml_act_1[axiom_instance] ded_thm_cor_3 nec_imp_act by blast
  lemma Act_Basic_10[PLM]:
    "[𝒜 ψ)  𝒜φ  𝒜ψ in v]"
    by PLM_solver

  lemma Act_Basic_11[PLM]:
    "[𝒜(α. φ α)  (α.𝒜(φ α)) in v]"
    proof -
      have "[𝒜( α . ¬φ α)  ( α . 𝒜¬φ α) in v]"
        using logic_actual_nec_3[axiom_instance] by blast
      hence "[¬𝒜( α . ¬φ α)  ¬( α . 𝒜¬φ α) in v]"
        using oth_class_taut_5_d[equiv_lr] by blast
      moreover have "[𝒜¬( α . ¬φ α)  ¬𝒜( α . ¬φ α) in v]"
        using logic_actual_nec_1[axiom_instance] by blast
      ultimately have "[𝒜¬( α . ¬φ α)  ¬( α . 𝒜¬φ α) in v]"
        using "E"(5) by auto
      moreover {
        have "[ α . 𝒜¬φ α  ¬𝒜φ α in v]"
          using logic_actual_nec_1[axiom_universal, axiom_instance] by blast 
        hence "[( α . 𝒜¬φ α)  ( α . ¬𝒜φ α) in v]"
          using cqt_basic_3[deduction] by fast
        hence "[(¬( α . 𝒜¬φ α))  ¬( α . ¬𝒜φ α) in v]"
          using oth_class_taut_5_d[equiv_lr] by blast
      }
      ultimately show ?thesis unfolding exists_def using "E"(5) by auto
    qed

  lemma act_quant_uniq[PLM]:
    "[( z . 𝒜φ z  z = x)  ( z . φ z  z = x) in dw]"
    by PLM_solver

  lemma fund_cont_desc[PLM]:
    "[(xP = (ιx. φ x))  ( z . φ z  (z = x)) in dw]"
    using descriptions[axiom_instance] act_quant_uniq "E"(5) by fast

  lemma hintikka[PLM]:
    "[(xP = (ιx. φ x))  (φ x & ( z . φ z  z = x)) in dw]"
    proof -
      have "[( z . φ z  z = x)  (φ x & ( z . φ z  z = x)) in dw]"
        unfolding identity_ν_def apply PLM_solver using id_eq_obj_1 apply simp
        using l_identity[where φ="λ x . φ x", axiom_instance,
                          deduction, deduction]
        using id_eq_obj_2[deduction] unfolding identity_ν_def by fastforce
      thus ?thesis using "E"(5) fund_cont_desc by blast
    qed

  lemma russell_axiom_a[PLM]:
    "[(⦇F, ιx. φ x⦈)  ( x . φ x & ( z . φ z  z = x) & ⦇F, xP⦈) in dw]"
    (is "[?lhs  ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction]
              SimpleExOrEnc.intros
        by blast
        then obtain α where 2:
          "[αP = (ιx. φ x) in dw]"
          using "E" by auto          
        hence 3: "[φ α & ( z . φ z  z = α) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) =P)  in dw]"
          using l_identity[where α=P" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[⦇F, αP⦈ in dw]"
        using 1 l_identity[where β=P" and α="ιx. φ x" and φ="λ x . ⦇F,x⦈",
                           axiom_instance, deduction, deduction] by auto
        with 3 have "[φ α & ( z . φ z  z = α) & ⦇F, αP⦈ in dw]" by (rule "&I")
        hence "[?rhs in dw]" using "I"[where α=α] by simp
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & ( z . φ z  z = α) & ⦇F, αP⦈ in dw]"
          using "E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [⦇F, αP⦈ in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by blast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma russell_axiom_g[PLM]:
    "[⦃ιx. φ x,F⦄  ( x . φ x & ( z . φ z  z = x) & ⦃xP, F⦄) in dw]"
    (is "[?lhs  ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction] SimpleExOrEnc.intros by blast
        then obtain α where 2: "[αP = (ιx. φ x) in dw]" by (rule "E")
        hence 3: "[(φ α & ( z . φ z  z = α)) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) = αP  in dw]"
          using l_identity[where α=P" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[⦃αP, F⦄ in dw]"
        using 1 l_identity[where β=P" and α="ιx. φ x" and φ="λ x . ⦃x,F⦄",
                           axiom_instance, deduction, deduction] by auto
        with 3 have "[(φ α & ( z . φ z  z = α)) & ⦃αP, F⦄ in dw]"
          using "&I" by auto
        hence "[?rhs in dw]" using "I"[where α=α] by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & ( z . φ z  z = α) & ⦃αP, F⦄ in dw]"
          using "E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [⦃αP, F⦄ in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma russell_axiom[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x)  ( x . φ x & ( z . φ z  z = x) & ψ (xP)) in dw]"
    (is "[?lhs  ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction] assms by blast
        then obtain α where 2: "[αP = (ιx. φ x) in dw]" by (rule "E")
        hence 3: "[(φ α & ( z . φ z  z = α)) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) =P)  in dw]"
          using l_identity[where α=P" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[ψ (αP) in dw]"
          using 1 l_identity[where β=P" and α="ιx. φ x" and φ="λ x . ψ x",
                             axiom_instance, deduction, deduction] by auto
        with 3 have "[φ α & ( z . φ z  z = α) & ψ (αP) in dw]"
          using "&I" by auto
        hence "[?rhs in dw]" using "I"[where α=α] by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & ( z . φ z  z = α) & ψ (αP) in dw]"
          using "E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [ψ (αP) in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma unique_exists[PLM]:
    "[( y . yP = (ιx. φ x))  (!x . φ x) in dw]"     
    proof((rule "I", rule CP, rule_tac[2] CP))
      assume "[y. yP = (ιx. φ x) in dw]"
      then obtain α where
        "[αP = (ιx. φ x) in dw]"
        by (rule "E")
      hence "[φ α & (β. φ β  β = α) in dw]"
        using hintikka[equiv_lr] by auto
      thus "[!x . φ x in dw]"
        unfolding exists_unique_def using "I" by fast
    next
      assume "[!x . φ x in dw]"
      then obtain α where
        "[φ α & (β. φ β  β = α) in dw]"
        unfolding exists_unique_def by (rule "E")
      hence "[αP = (ιx. φ x) in dw]"
        using hintikka[equiv_rl] by auto
      thus "[y. yP = (ιx. φ x) in dw]"
        using "I" by fast
    qed

  lemma y_in_1[PLM]:
    "[xP = (ιx . φ)  φ in dw]"
    using hintikka[equiv_lr, conj1] by (rule CP)

  lemma y_in_2[PLM]:
    "[zP = (ιx . φ x)  φ z in dw]"
    using hintikka[equiv_lr, conj1] by (rule CP)

  lemma y_in_3[PLM]:
    "[( y . yP = (ιx . φ (xP)))  φ (ιx . φ (xP)) in dw]"
    proof (rule CP)
      assume "[( y . yP = (ιx . φ (xP))) in dw]"
      then obtain y where 1:
        "[yP = (ιx. φ (xP)) in dw]"
        by (rule "E")
      hence "[φ (yP) in dw]"
        using y_in_2[deduction] unfolding identity_ν_def by blast
      thus "[φ (ιx. φ (xP)) in dw]"
        using l_identity[axiom_instance, deduction,
                         deduction] 1 by fast
    qed

  lemma act_quant_nec[PLM]:
    "[(z . (𝒜φ z  z = x))  (z. 𝒜𝒜φ z  z = x) in v]"
    by PLM_solver

  lemma equi_desc_descA_1[PLM]:
    "[(xP = (ιx . φ x))  (xP = (ιx . 𝒜φ x)) in v]"
    using descriptions[axiom_instance] apply (rule "E"(5))
    using act_quant_nec apply (rule "E"(5))
    using descriptions[axiom_instance]
    by (meson "E"(6) oth_class_taut_4_a)

  lemma equi_desc_descA_2[PLM]:
    "[( y . yP = (ιx. φ x))  ((ιx . φ x) = (ιx . 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[y. yP = (ιx. φ x) in v]"
      then obtain y where
        "[yP = (ιx. φ x) in v]"
        by (rule "E")
      moreover hence "[yP = (ιx. 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      ultimately show "[(ιx. φ x) = (ιx. 𝒜φ x) in v]"
        using l_identity[axiom_instance, deduction, deduction]
        by fast
    qed

  lemma equi_desc_descA_3[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x)  ( y . yP = (ιx. 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[ψ (ιx. φ x) in v]"
      hence "[α. αP = (ιx. φ x) in v]"
        using cqt_5[OF assms, axiom_instance, deduction] by auto
      then obtain α where "[αP = (ιx. φ x) in v]" by (rule "E")
      hence "[αP = (ιx . 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      thus "[y. yP = (ιx. 𝒜φ x) in v]"
        using "I" by fast
    qed

  lemma equi_desc_descA_4[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x)  ((ιx. φ x) = (ιx. 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[ψ (ιx. φ x) in v]"
      hence "[α. αP = (ιx. φ x) in v]"
        using cqt_5[OF assms, axiom_instance, deduction] by auto
      then obtain α where "[αP = (ιx. φ x) in v]" by (rule "E")
      moreover hence "[αP  = (ιx . 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      ultimately show "[(ιx. φ x)  = (ιx . 𝒜φ x) in v]"
        using l_identity[axiom_instance, deduction, deduction] by fast
    qed

  lemma nec_hintikka_scheme[PLM]:
    "[(xP = (ιx. φ x))  (𝒜φ x & ( z . 𝒜φ z  z = x)) in v]"
    using descriptions[axiom_instance]
    apply (rule "E"(5))
    apply PLM_solver
     using id_eq_obj_1 apply simp
     using id_eq_obj_2[deduction]
           l_identity[where α="x", axiom_instance, deduction, deduction]
     unfolding identity_ν_def
     apply blast
    using l_identity[where α="x", axiom_instance, deduction, deduction]
    id_eq_2[where 'a=ν, deduction] unfolding identity_ν_def by meson

  lemma equiv_desc_eq[PLM]:
    assumes "⋀x.[𝒜(φ x  ψ x) in v]"
    shows "[( x . ((xP = (ιx . φ x))  (xP = (ιx . ψ x)))) in v]"
    proof(rule "I")
      fix x
      {
        assume "[xP = (ιx . φ x) in v]"
        hence 1: "[𝒜φ x & (z. 𝒜φ z  z = x) in v]"
          using nec_hintikka_scheme[equiv_lr] by auto
        hence 2: "[𝒜φ x in v] ∧ [(z. 𝒜φ z  z = x) in v]"
          using "&E" by blast
        {
           fix z
           {
             assume "[𝒜ψ z in v]"
             hence "[𝒜φ z in v]"
              using assms[where x=z] apply - by PLM_solver
             moreover have "[𝒜φ z  z = x in v]"
               using 2 cqt_1[axiom_instance,deduction] by auto
             ultimately have "[z = x in v]"
              using vdash_properties_10 by auto
           }
           hence "[𝒜ψ z  z = x in v]" by (rule CP)
        }
        hence "[( z . 𝒜ψ z  z = x) in v]" by (rule "I")
        moreover have "[𝒜ψ x in v]"
          using 1[conj1] assms[where x=x]
          apply - by PLM_solver
        ultimately have "[𝒜ψ x & (z. 𝒜ψ z  z = x) in v]"
          by PLM_solver
        hence "[xP = (ιx. ψ x) in v]"
         using nec_hintikka_scheme[where φ="ψ", equiv_rl] by auto
      }
      moreover {
        assume "[xP = (ιx . ψ x) in v]"
        hence 1: "[𝒜ψ x & (z. 𝒜ψ z  z = x) in v]"
          using nec_hintikka_scheme[equiv_lr] by auto
        hence 2: "[𝒜ψ x in v] ∧ [(z. 𝒜ψ z  z = x) in v]"
          using "&E" by blast
        {
          fix z
          {
            assume "[𝒜φ z in v]"
            hence "[𝒜ψ z in v]"
              using assms[where x=z]
              apply - by PLM_solver
            moreover have "[𝒜ψ z  z = x in v]"
              using 2 cqt_1[axiom_instance,deduction] by auto
            ultimately have "[z = x in v]"
              using vdash_properties_10 by auto
          }
          hence "[𝒜φ z  z = x in v]" by (rule CP)
        }
        hence "[(z. 𝒜φ z  z = x) in v]" by (rule "I")
        moreover have "[𝒜φ x in v]"
          using 1[conj1] assms[where x=x]
          apply - by PLM_solver
        ultimately have "[𝒜φ x & (z. 𝒜φ z  z = x) in v]"
          by PLM_solver
        hence "[xP = (ιx. φ x) in v]"
          using nec_hintikka_scheme[where φ="φ",equiv_rl]
          by auto
      }
      ultimately show "[xP = (ιx. φ x)  (xP) = (ιx. ψ x) in v]"
        using "I" CP by auto
    qed

  lemma UniqueAux:
    assumes "[(𝒜φ (α::ν) & ( z . 𝒜(φ z)  z = α)) in v]"
    shows "[( z . (𝒜(φ z)  (z = α))) in v]"
    proof -
      {
        fix z
        {
          assume "[𝒜(φ z) in v]"
          hence "[z = α in v]"
            using assms[conj2, THEN cqt_1[where α=z,
                          axiom_instance, deduction],
                        deduction] by auto
        }
        moreover {
          assume "[z = α in v]"
          hence "[α = z in v]"
            unfolding identity_ν_def
            using id_eq_obj_2[deduction] by fast
          hence "[𝒜(φ z) in v]" using assms[conj1]
            using l_identity[axiom_instance, deduction,
                             deduction] by fast
        }
        ultimately have "[(𝒜(φ z)  (z = α)) in v]"
          using "I" CP by auto
      }
      thus "[( z . (𝒜(φ z)  (z = α))) in v]"
      by (rule "I")
    qed

  lemma nec_russell_axiom[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[(ψ (ιx. φ x))  ( x . (𝒜φ x & ( z . 𝒜(φ z)  z = x))
                              & ψ (xP)) in v]"
    (is "[?lhs  ?rhs in v]")
    proof -
      {
        assume 1: "[?lhs in v]"
        hence "[α. (αP) = (ιx. φ x) in v]"
          using cqt_5[axiom_instance, deduction] assms by blast
        then obtain α where 2: "[(αP) = (ιx. φ x) in v]" by (rule "E")
        hence "[( z . (𝒜(φ z)  (z = α))) in v]"
          using descriptions[axiom_instance, equiv_lr] by auto
        hence 3: "[(𝒜φ α) & ( z . (𝒜(φ z)  (z = α))) in v]"
          using cqt_1[where α=α and φ="λ z . (𝒜(φ z)  (z = α))",
                      axiom_instance, deduction, equiv_rl]
          using id_eq_obj_1[where x=α] unfolding identity_ν_def
          using hintikka[equiv_lr] cqt_basic_2[equiv_lr,conj1]
          "&I" by fast
        from 2 have "[(ιx. φ x) =P)  in v]"
          using l_identity[where β="(ιx. φ x)" and φ="λ x . x =P)",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[ψ (αP) in v]"
          using 1 l_identity[where α="(ιx. φ x)" and φ="λ x . ψ x",
                             axiom_instance, deduction,
                             deduction] by auto
        with 3 have "[(𝒜φ α & ( z . 𝒜(φ z)  (z = α))) & ψ (αP) in v]"
          using "&I" by simp
        hence "[?rhs in v]"
          using "I"[where α=α]
          by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in v]"
        then obtain α where 4:
          "[(𝒜φ α & ( z . 𝒜(φ z)  z = α)) & ψ (αP) in v]"
          using "E" by auto
        hence "[( z . (𝒜(φ z)  (z = α))) in v]"
          using UniqueAux "&E"(1) by auto
        hence "[(αP) = (ιx . φ x) in v] ∧ [ψ (αP) in v]"
          using descriptions[axiom_instance, equiv_rl]
                4[conj2] by blast
        hence "[?lhs in v]"
          using l_identity[axiom_instance, deduction,
                           deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma actual_desc_1[PLM]:
    "[( y . (yP) = (ιx. φ x))  (! x . 𝒜(φ x)) in v]" (is "[?lhs  ?rhs in v]")
    proof -
      {
        assume "[?lhs in v]"
        then obtain α where
          "[((αP) = (ιx. φ x)) in v]"
          by (rule "E")
        hence "[⦇A!,(ιx. φ x)⦈ in v] ∨ [(αP) =E (ιx. φ x) in v]"
          apply - unfolding identity_defs by PLM_solver
        then obtain x where
          "[((𝒜φ x & ( z . 𝒜(φ z)  z = x))) in v]"
          using nec_russell_axiom[where ψ="λx . ⦇A!,x⦈", equiv_lr, THEN "E"]
          using nec_russell_axiom[where ψ="λx . (αP) =E x", equiv_lr, THEN "E"]
          using SimpleExOrEnc.intros unfolding identityE_infix_def
          by (meson "&E")
        hence "[?rhs in v]" unfolding exists_unique_def by (rule "I")
      }
      moreover {
        assume "[?rhs in v]"
        then obtain x where
          "[((𝒜φ x & ( z . 𝒜(φ z)  z = x))) in v]"
          unfolding exists_unique_def by (rule "E")
        hence "[z. 𝒜φ z  z = x in v]"
          using UniqueAux by auto
        hence "[(xP) = (ιx. φ x) in v]"
          using descriptions[axiom_instance, equiv_rl] by auto
        hence "[?lhs in v]" by (rule "I")
      }
      ultimately show ?thesis
        using "I" CP by auto
    qed

  lemma actual_desc_2[PLM]:
    "[(xP) = (ιx. φ)  𝒜φ in v]"
    using nec_hintikka_scheme[equiv_lr, conj1]
    by (rule CP)

  lemma actual_desc_3[PLM]:
    "[(zP) = (ιx. φ x)  𝒜(φ z) in v]"
    using nec_hintikka_scheme[equiv_lr, conj1]
    by (rule CP)

  lemma actual_desc_4[PLM]:
    "[( y . ((yP) = (ιx. φ (xP))))  𝒜(φ (ιx. φ (xP))) in v]"
    proof (rule CP)
      assume "[( y . (yP) = (ιx . φ (xP))) in v]"
      then obtain y where 1:
        "[yP = (ιx. φ (xP)) in v]"
        by (rule "E")
      hence "[𝒜(φ (yP)) in v]" using actual_desc_3[deduction] by fast
      thus "[𝒜(φ (ιx. φ (xP))) in v]"
        using l_identity[axiom_instance, deduction,
                         deduction] 1 by fast
    qed

  lemma unique_box_desc_1[PLM]:
    "[(!x . (φ x))  ( y . (yP) = (ιx. φ x)  φ y) in v]"
    proof (rule CP)
      assume "[(!x . (φ x)) in v]"
      then obtain α where 1:
        "[φ α & (β. (φ β)  β = α) in v]"
        unfolding exists_unique_def by (rule "E")
      {
        fix y
        {
          assume "[(yP) = (ιx. φ x) in v]"
          hence "[𝒜φ α  α = y in v]"
            using nec_hintikka_scheme[where x="y" and φ="φ", equiv_lr, conj2,
                          THEN cqt_1[where α=α,axiom_instance, deduction]] by simp
          hence "[α = y in v]"
            using 1[conj1] nec_imp_act vdash_properties_10 by blast
          hence "[φ y in v]"
            using 1[conj1] qml_2[axiom_instance, deduction]
                  l_identity[axiom_instance, deduction, deduction]
            by fast
        }
        hence "[(yP) = (ιx. φ x)  φ y in v]"
          by (rule CP)
      }
      thus "[ y . (yP) = (ιx. φ x)  φ y in v]"
        by (rule "I")
    qed

  lemma unique_box_desc[PLM]:
    "[( x . (φ x  (φ x)))  ((!x . φ x)
       ( y . (yP = (ιx . φ x))  φ y)) in v]"
    apply (rule CP, rule CP)
    using nec_exist_unique[deduction, deduction]
          unique_box_desc_1[deduction] by blast

subsection‹Necessity›
text‹\label{TAO_PLM_Necessity}›

  lemma RM_1[PLM]:
    "(⋀v.[φ  ψ in v]) ⟹ [φ  ψ in v]"
    using RN qml_1[axiom_instance] vdash_properties_10 by blast

  lemma RM_1_b[PLM]:
    "(⋀v.[χ in v] ⟹ [φ  ψ in v]) ⟹ ([χ in v] ⟹ [φ  ψ in v])"
    using RN_2 qml_1[axiom_instance] vdash_properties_10 by blast

  lemma RM_2[PLM]:
    "(⋀v.[φ  ψ in v]) ⟹ [φ  ψ in v]"
    unfolding diamond_def
    using RM_1 contraposition_1 by auto

  lemma RM_2_b[PLM]:
    "(⋀v.[χ in v] ⟹ [φ  ψ in v]) ⟹ ([χ in v] ⟹ [φ  ψ in v])"
    unfolding diamond_def
    using RM_1_b contraposition_1 by blast

  lemma KBasic_1[PLM]:
    "[φ   φ) in v]"
    by (simp only: pl_1[axiom_instance] RM_1)
  lemma KBasic_2[PLM]:
    "[(¬φ)   ψ) in v]"
    by (simp only: RM_1 useful_tautologies_3)
  lemma KBasic_3[PLM]:
    "[& ψ)  φ & ψ in v]"
    apply (rule "I")
     apply (rule CP)
     apply (rule "&I")
      using RM_1 oth_class_taut_9_a vdash_properties_6 apply blast
     using RM_1 oth_class_taut_9_b vdash_properties_6 apply blast
    using qml_1[axiom_instance] RM_1 ded_thm_cor_3 oth_class_taut_10_a
          oth_class_taut_8_b vdash_properties_10
    by blast
  lemma KBasic_4[PLM]:
    "[ ψ)  ( ψ) &  φ)) in v]"
    apply (rule "I")
     unfolding equiv_def using KBasic_3 PLM.CP "E"(1)
     apply blast
    using KBasic_3 PLM.CP "E"(2)
    by blast
  lemma KBasic_5[PLM]:
    "[( ψ) &  φ))  (φ  ψ) in v]"
    by (metis qml_1[axiom_instance] CP "&E" "I" vdash_properties_10)
  lemma KBasic_6[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    using KBasic_4 KBasic_5 by (metis equiv_def ded_thm_cor_3 "&E"(1))
  lemma "[(φ  ψ)   ψ) in v]"
    nitpick[expect=genuine, user_axioms, card = 1, card i = 2]
    oops ― ‹countermodel as desired›
  lemma KBasic_7[PLM]:
    "[(φ & ψ)   ψ) in v]"
    proof (rule CP)
      assume "[φ & ψ in v]"
      hence "[ φ) in v] ∧ [ ψ) in v]"
        using "&E" KBasic_1 vdash_properties_10 by blast
      thus "[ ψ) in v]"
        using KBasic_4 "E"(2) intro_elim_1 by blast
    qed

  lemma KBasic_8[PLM]:
    "[& ψ)   ψ) in v]"
    using KBasic_7 KBasic_3
    by (metis equiv_def PLM.ded_thm_cor_3 "&E"(1))
  lemma KBasic_9[PLM]:
    "[((¬φ) & (¬ψ))   ψ) in v]"
    proof (rule CP)
      assume "[((¬φ) & (¬ψ)) in v]"
      hence "[((¬φ)  (¬ψ)) in v]"
        using KBasic_8 vdash_properties_10 by blast
      moreover have "⋀v.[((¬φ)  (¬ψ))  ψ) in v]"
        using CP "E"(2) oth_class_taut_5_d by blast
      ultimately show "[ ψ) in v]"
        using RM_1 PLM.vdash_properties_10 by blast
    qed

  lemma rule_sub_lem_1_a[PLM]:
    "[ χ) in v] ⟹ [(¬ψ)  (¬χ) in v]"
    using qml_2[axiom_instance] "E"(1) oth_class_taut_5_d
          vdash_properties_10
    by blast
  lemma rule_sub_lem_1_b[PLM]:
    "[ χ) in v] ⟹ [(ψ  Θ)  Θ) in v]"
    by (metis equiv_def contraposition_1 CP "&E"(2) "I"
              "E"(1) rule_sub_lem_1_a)
  lemma rule_sub_lem_1_c[PLM]:
    "[ χ) in v] ⟹ [(Θ  ψ)  χ) in v]"
    by (metis CP "I" "E"(3) "E"(4) "¬¬I"
              "¬¬E" rule_sub_lem_1_a)
  lemma rule_sub_lem_1_d[PLM]:
    "(⋀x.[(ψ x  χ x) in v]) ⟹ [(α. ψ α)  (α. χ α) in v]" 
    by (metis equiv_def "I" CP "&E" "I" raa_cor_1
              vdash_properties_10 rule_sub_lem_1_a "E")
  lemma rule_sub_lem_1_e[PLM]:
    "[ χ) in v] ⟹ [𝒜ψ  𝒜χ in v]"
    using Act_Basic_5 "E"(1) nec_imp_act
          vdash_properties_10
    by blast
  lemma rule_sub_lem_1_f[PLM]:
    "[ χ) in v] ⟹ [ψ  χ in v]" 
    using KBasic_6 "I" "E"(1) vdash_properties_9
    by blast


  named_theorems Substable_intros
  
  definition Substable :: "('a⇒'a⇒bool)⇒('a⇒𝗈) ⇒ bool"
    where "Substable ≡ (λ cond φ . ∀ ψ χ v . (cond ψ χ) ⟶ [φ ψ  φ χ in v])"
  
  lemma Substable_intro_const[Substable_intros]:
    "Substable cond (λ φ . Θ)"
    unfolding Substable_def using oth_class_taut_4_a by blast

  lemma Substable_intro_not[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . ¬(ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_a RN_2 "E" oth_class_taut_5_d by metis
  lemma Substable_intro_impl[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ  χ φ)"
    using assms unfolding Substable_def
    by (metis "I" CP intro_elim_6_a intro_elim_6_b)
  lemma Substable_intro_box[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . (ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_f RN by meson
  lemma Substable_intro_actual[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . 𝒜(ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_e RN by meson
  lemma Substable_intro_all[Substable_intros]:
    assumes "∀ x . Substable cond (ψ x)"
    shows "Substable cond (λ φ .  x . ψ x φ)"
    using assms unfolding Substable_def
    by (simp add: RN rule_sub_lem_1_d)

  named_theorems Substable_Cond_defs
end

class Substable =
  fixes Substable_Cond :: "'a⇒'a⇒bool"
  assumes rule_sub_nec:
    "⋀ φ ψ χ Θ v . ⟦PLM.Substable Substable_Cond φ; Substable_Cond ψ χ⟧
      ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"

instantiation 𝗈 :: Substable
begin
  definition Substable_Cond_𝗈 where [PLM.Substable_Cond_defs]:
    "Substable_Cond_𝗈 ≡ λ φ ψ . ∀ v . [φ  ψ in v]"
  instance proof
    interpret PLM .
    fix φ :: "𝗈 ⇒ 𝗈" and  ψ χ :: 𝗈 and Θ :: "bool ⇒ bool" and v::i
    assume "Substable Substable_Cond φ"
    moreover assume "Substable_Cond ψ χ"
    ultimately have "[φ ψ  φ χ in v]"
    unfolding Substable_def by blast
    hence "[φ ψ in v] = [φ χ in v]" using "E" by blast
    moreover assume "Θ [φ ψ in v]"
    ultimately show "Θ [φ χ in v]" by simp
  qed
end

instantiation "fun" :: (type, Substable) Substable
begin
  definition Substable_Cond_fun where [PLM.Substable_Cond_defs]:
    "Substable_Cond_fun ≡ λ φ ψ . ∀ x . Substable_Cond (φ x) (ψ x)"
  instance proof
    interpret PLM .
    fix φ:: "('a ⇒ 'b) ⇒ 𝗈" and  ψ χ :: "'a ⇒ 'b" and Θ v
    assume "Substable Substable_Cond φ"
    moreover assume "Substable_Cond ψ χ"
    ultimately have "[φ ψ  φ χ in v]"
      unfolding Substable_def by blast
    hence "[φ ψ in v] = [φ χ in v]" using "E" by blast
    moreover assume "Θ [φ ψ in v]"
    ultimately show "Θ [φ χ in v]" by simp
  qed
end

context PLM
begin

  lemma Substable_intro_equiv[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ  χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_conj[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ & χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_disj[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ  χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_diamond[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . (ψ φ))"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_exist[Substable_intros]:
    assumes "∀ x . Substable cond (ψ x)"
    shows "Substable cond (λ φ .  x . ψ x φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)

  lemma Substable_intro_id_𝗈[Substable_intros]:
    "Substable Substable_Cond (λ φ . φ)"
    unfolding Substable_def Substable_Cond_𝗈_def by blast
  lemma Substable_intro_id_fun[Substable_intros]:
    assumes "Substable Substable_Cond ψ"
    shows "Substable Substable_Cond (λ φ . ψ (φ x))"
    using assms unfolding Substable_def Substable_Cond_fun_def
    by blast

  method PLM_subst_method for ψ::"'a::Substable" and χ::"'a::Substable" =
    (match conclusion in "Θ [φ χ in v]" for Θ and φ and v 
      ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
        ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
        unfold Substable_Cond_defs)›)

  method PLM_autosubst =
    (match premises in "⋀v . [ψ  χ in v]" for ψ and χ 
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_autosubst1 =
    (match premises in "⋀v x . [ψ x  χ x in v]"
      for ψ::"'a::type⇒𝗈" and χ::"'a⇒𝗈" 
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_autosubst2 =
    (match premises in "⋀v x y . [ψ x y  χ x y in v]"
      for ψ::"'a::type⇒'a⇒𝗈" and χ::"'a::type⇒'a⇒𝗈" 
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_subst_goal_method for φ::"'a::Substable⇒𝗈" and ψ::"'a" =
    (match conclusion in "Θ [φ χ in v]" for Θ and χ and v 
      ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
        ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
        unfold Substable_Cond_defs)›)

(*
  text{* \begin{TODO}
            This can only be proven using the Semantics of the Box operator.
            As it is not needed for the further reasoning it remains commented for now.
         \end{TODO} *}
  lemma rule_sub_lem_2:
    assumes "Substable Substable_Cond φ"
    shows "[ χ) in v] ⟹ [φ ψ  φ χ in v]"
    using assms unfolding Substable_def Substable_Cond_defs
    using Semantics.T6 by fast
*)

  lemma rule_sub_nec[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v.[(ψ  χ) in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v.[(ψ  χ) in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "I" CP "E"(1) "E"(2) by meson
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_nec1[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v x .[(ψ x  χ x) in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v x.[(ψ x  χ x) in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "I" CP "E"(1) "E"(2) by metis
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_nec2[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v x y .[ψ x y  χ x y in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v x y .[ψ x y  χ x y in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "I" CP "E"(1) "E"(2) by metis
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_remark_1_autosubst:
    assumes "(⋀v.[⦇A!,x⦈  (¬(⦇E!,x⦈)) in v])"
        and "[¬⦇A!,x⦈ in v]"
    shows"[¬¬⦇E!,x⦈ in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_1:
    assumes "(⋀v.[⦇A!,x⦈  (¬(⦇E!,x⦈)) in v])"
        and "[¬⦇A!,x⦈ in v]"
      shows"[¬¬⦇E!,x⦈ in v]"
    apply (PLM_subst_method "⦇A!,x⦈" "(¬(⦇E!,x⦈))")
     apply (simp add: assms(1))
    by (simp add: assms(2))

  lemma rule_sub_remark_2:
    assumes "(⋀v.[⦇R,x,y⦈  (⦇R,x,y⦈ & (⦇Q,a⦈  (¬⦇Q,a⦈))) in v])"
        and "[p  ⦇R,x,y⦈ in v]"
    shows"[p  (⦇R,x,y⦈ & (⦇Q,a⦈  (¬⦇Q,a⦈)))  in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_3_autosubst:
    assumes "(⋀v x.[⦇A!,xP (¬(⦇E!,xP⦈)) in v])"
        and "[ x . ⦇A!,xP⦈ in v]"
    shows"[ x . (¬(⦇E!,xP⦈))  in v]"
    apply (insert assms) apply PLM_autosubst1 by auto

  lemma rule_sub_remark_3:
    assumes "(⋀v x.[⦇A!,xP (¬(⦇E!,xP⦈)) in v])"
        and "[ x . ⦇A!,xP⦈ in v]"
    shows "[ x . (¬(⦇E!,xP⦈))  in v]"
    apply (PLM_subst_method "λx . ⦇A!,xP⦈" "λx . (¬(⦇E!,xP⦈))")
     apply (simp add: assms(1))
    by (simp add: assms(2))

  lemma rule_sub_remark_4:
    assumes "⋀v x.[(¬(¬⦇P,xP⦈))  ⦇P,xP⦈ in v]"
        and "[𝒜(¬(¬⦇P,xP⦈)) in v]"
    shows "[𝒜⦇P,xP⦈ in v]"
    apply (insert assms) apply PLM_autosubst1 by auto

  lemma rule_sub_remark_5:
    assumes "⋀v.[(φ  ψ)  ((¬ψ)  (¬φ)) in v]"
        and "[ ψ) in v]"
    shows "[((¬ψ)  (¬φ)) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_6:
    assumes "⋀v.[ψ  χ in v]"
        and "[ ψ) in v]"
    shows "[ χ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_7:
    assumes "⋀v.[φ  (¬(¬φ)) in v]"
        and "[ φ) in v]"
    shows "[((¬(¬φ))  φ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_8:
    assumes "⋀v.[𝒜φ  φ in v]"
        and "[(𝒜φ) in v]"
    shows "[(φ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_9:
    assumes "⋀v.[⦇P,a⦈  (⦇P,a⦈ & (⦇Q,b⦈  (¬⦇Q,b⦈))) in v]"
        and "[⦇P,a⦈ = ⦇P,a⦈ in v]"
    shows "[⦇P,a⦈ = (⦇P,a⦈ & (⦇Q,b⦈  (¬⦇Q,b⦈))) in v]"
      unfolding identity_defs apply (insert assms)
      apply PLM_autosubst oops ― ‹no match as desired›

  ― ‹@{text "dr_alphabetic_rules"} implicitly holds›
  ― ‹@{text "dr_alphabetic_thm"} implicitly holds›

  lemma KBasic2_1[PLM]:
    "[φ  (¬(¬φ)) in v]"
    apply (PLM_subst_method "φ" "(¬(¬φ))")
     by PLM_solver+

  lemma KBasic2_2[PLM]:
    "[(¬(φ))  (¬φ) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "φ" "¬(¬φ)")
     by PLM_solver+

  lemma KBasic2_3[PLM]:
    "[φ  (¬((¬φ))) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "φ" "¬(¬φ)")
     apply PLM_solver
    by (simp add: oth_class_taut_4_b)
  lemmas "Df" = KBasic2_3

  lemma KBasic2_4[PLM]:
    "[(¬(φ))  (¬(φ)) in v]"
    unfolding diamond_def
    by (simp add: oth_class_taut_4_b)

  lemma KBasic2_5[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    by (simp only: CP RM_2_b)
  lemmas "K" = KBasic2_5

  lemma KBasic2_6[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    proof -
      have "[((¬φ) & (¬ψ))  ((¬φ) & (¬ψ)) in v]"
        using KBasic_3 by blast
      hence "[(¬((¬((¬φ) & (¬ψ)))))  ((¬φ) & (¬ψ)) in v]"
        using "Df" by (rule "E"(6))
      hence "[(¬((¬((¬φ) & (¬ψ)))))  ((¬(φ)) & (¬(ψ))) in v]"
        apply - apply (PLM_subst_method "(¬φ)" "¬(φ)")
         apply (simp add: KBasic2_4)
        apply (PLM_subst_method "(¬ψ)" "¬(ψ)")
         apply (simp add: KBasic2_4)
        unfolding diamond_def by assumption
      hence "[(¬( ψ)))  ((¬(φ)) & (¬(ψ))) in v]"
        apply - apply (PLM_subst_method "¬((¬φ) & (¬ψ))"  ψ")
        using oth_class_taut_6_b[equiv_sym] by auto
      hence "[(¬(¬( ψ))))  (¬((¬(φ))&(¬(ψ)))) in v]"
        by (rule oth_class_taut_5_d[equiv_lr])
      hence "[ ψ)  (¬((¬(φ)) & (¬(ψ)))) in v]"
        apply - apply (PLM_subst_method "¬(¬( ψ)))" " ψ)")
        using oth_class_taut_4_b[equiv_sym] by auto
      thus ?thesis
        apply - apply (PLM_subst_method "¬((¬(φ)) & (¬(ψ)))" "(φ)  (ψ)")
        using oth_class_taut_6_b[equiv_sym] by auto
    qed

  lemma KBasic2_7[PLM]:
    "[(φ  ψ)   ψ) in v]"
    proof -
      have "⋀ v . [φ  ψ) in v]"
        by (metis contraposition_1 contraposition_2 useful_tautologies_3 disj_def)
      hence "[φ   ψ) in v]" using RM_1 by auto
      moreover {
          have "⋀ v . [ψ  ψ) in v]"
            by (simp only: pl_1[axiom_instance] disj_def)
          hence "[ψ   ψ) in v]"
            using RM_1 by auto
      }
      ultimately show ?thesis
        using oth_class_taut_10_d vdash_properties_10 by blast
    qed

  lemma KBasic2_8[PLM]:
    "[& ψ)  (φ & ψ) in v]"
    by (metis CP RM_2 "&I" oth_class_taut_9_a
              oth_class_taut_9_b vdash_properties_10)

  lemma KBasic2_9[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    apply (PLM_subst_method "(¬(φ))  (ψ)" "φ  ψ")
     using oth_class_taut_5_k[equiv_sym] apply simp
    apply (PLM_subst_method "(¬φ)  ψ"  ψ")
     using oth_class_taut_5_k[equiv_sym] apply simp
    apply (PLM_subst_method "(¬φ)" "¬(φ)")
     using KBasic2_2[equiv_sym] apply simp
    using KBasic2_6 .

  lemma KBasic2_10[PLM]:
    "[(φ)  (¬((¬φ))) in v]"
    unfolding diamond_def apply (PLM_subst_method "φ" "¬¬φ")
    using oth_class_taut_4_b oth_class_taut_4_a by auto

  lemma KBasic2_11[PLM]:
    "[φ  (¬((¬φ))) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "(¬φ)" "¬(¬((¬φ)))")
    using oth_class_taut_4_b oth_class_taut_4_a by auto

  lemma KBasic2_12[PLM]: "[ ψ)  (φ  ψ) in v]"
    proof -
      have "[ φ)  ((¬ψ)  φ) in v]"
        using CP RM_1_b "E"(2) by blast
      hence "[ φ)  (ψ  φ) in v]"
        unfolding diamond_def disj_def
        by (meson CP "¬¬E" vdash_properties_6)
      thus ?thesis apply -
        apply (PLM_subst_method "(ψ  φ)" "(φ  ψ)")
         apply (simp add: PLM.oth_class_taut_3_e)
        apply (PLM_subst_method "(ψ  φ)" "(φ  ψ)")
         apply (simp add: PLM.oth_class_taut_3_e)
        by assumption
    qed

  lemma TBasic[PLM]:
    "[φ  φ in v]"
    unfolding diamond_def
    apply (subst contraposition_1)
    apply (PLM_subst_method "¬φ" "¬¬¬φ")
     apply (simp add: PLM.oth_class_taut_4_b)
    using qml_2[where φ="¬φ", axiom_instance]
    by simp
  lemmas "T" = TBasic

  lemma S5Basic_1[PLM]:
    "[φ  φ in v]"
    proof (rule CP)
      assume "[φ in v]"
      hence "[¬¬φ in v]"
        using KBasic2_10[equiv_lr] by simp
      moreover have "[(¬φ)  (¬φ) in v]"
        by (simp add: qml_3[axiom_instance])
      ultimately have "[¬¬φ in v]"
        by (simp add: PLM.modus_tollens_1)
      thus "[φ in v]"
        unfolding diamond_def apply -
        apply (PLM_subst_method "¬¬φ" "φ")
         using oth_class_taut_4_b[equiv_sym] apply simp
        unfolding diamond_def using oth_class_taut_4_b[equiv_rl]
        by simp
    qed
  lemmas "5" = S5Basic_1

  lemma S5Basic_2[PLM]:
    "[φ  φ in v]"
    using "5" "T" "I" by blast

  lemma S5Basic_3[PLM]:
    "[φ  φ in v]"
    using qml_3[axiom_instance] qml_2[axiom_instance] "I" by blast

  lemma S5Basic_4[PLM]:
    "[φ  φ in v]"
    using "T"[deduction, THEN S5Basic_3[equiv_lr]]
    by (rule CP)

  lemma S5Basic_5[PLM]:
    "[φ  φ in v]"
    using S5Basic_2[equiv_rl, THEN qml_2[axiom_instance, deduction]]
    by (rule CP)
  lemmas "B" = S5Basic_5

  lemma S5Basic_6[PLM]:
    "[φ  φ in v]"
    using S5Basic_4[deduction] RM_1[OF S5Basic_1, deduction] CP by auto
  lemmas "4" = S5Basic_6

  lemma S5Basic_7[PLM]:
    "[φ  φ in v]"
    using "4" qml_2[axiom_instance] by (rule "I")

  lemma S5Basic_8[PLM]:
    "[φ  φ in v]"
    using S5Basic_6[where φ="¬φ", THEN contraposition_1[THEN iffD1], deduction]
          KBasic2_11[equiv_lr] CP unfolding diamond_def by auto
  lemmas "4" = S5Basic_8

  lemma S5Basic_9[PLM]:
    "[φ  φ in v]"
    using "4" "T" by (rule "I")

  lemma S5Basic_10[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    apply (rule "I")
     apply (PLM_subst_goal_method "λ χ .  ψ)  (φ  χ)" "ψ")
      using S5Basic_2[equiv_sym] apply simp
     using KBasic2_12 apply assumption
    apply (PLM_subst_goal_method "λ χ .(φ  χ)   ψ)" "ψ")
     using S5Basic_7[equiv_sym] apply simp
    using KBasic2_7 by auto

  lemma S5Basic_11[PLM]:
    "[ ψ)  (φ  ψ) in v]"
    apply (rule "I")
     apply (PLM_subst_goal_method "λ χ .  ψ)  (φ  χ)" "ψ")
      using S5Basic_9 apply simp
     using KBasic2_12 apply assumption
    apply (PLM_subst_goal_method "λ χ .(φ  χ)   ψ)" "ψ")
     using S5Basic_3[equiv_sym] apply simp
    using KBasic2_7 by assumption

  lemma S5Basic_12[PLM]:
    "[& ψ)  (φ & ψ) in v]"
    proof -
      have "[((¬φ)  (¬ψ))  ((¬φ)  (¬ψ)) in v]"
        using S5Basic_10 by auto
      hence 1: "[(¬((¬φ)  (¬ψ)))  ¬((¬φ)  (¬ψ)) in v]"
        using oth_class_taut_5_d[equiv_lr] by auto
      have 2: "[((¬((¬φ)  (¬(ψ)))))  (¬((¬(φ))  (¬(ψ)))) in v]"
        apply (PLM_subst_method "¬ψ" "¬ψ")
         using KBasic2_4 apply simp
        apply (PLM_subst_method "¬φ" "¬φ")
         using KBasic2_4 apply simp
        apply (PLM_subst_method "(¬((¬φ)  (¬ψ)))" "((¬((¬φ)  ((¬ψ)))))")
         unfolding diamond_def
         apply (simp add: RN oth_class_taut_4_b rule_sub_lem_1_a rule_sub_lem_1_f)
        using 1 by assumption
      show ?thesis
        apply (PLM_subst_method "¬((¬φ)  (¬ψ))" & ψ")
         using oth_class_taut_6_a[equiv_sym] apply simp
        apply (PLM_subst_method "¬((¬(φ))  (¬ψ))" "φ & ψ")
         using oth_class_taut_6_a[equiv_sym] apply simp
        using 2 by assumption
    qed

  lemma S5Basic_13[PLM]:
    "[& (ψ))  (φ & (ψ)) in v]"
    apply (PLM_subst_method "ψ" "ψ")
     using S5Basic_2[equiv_sym] apply simp
    using S5Basic_12 by simp

  lemma S5Basic_14[PLM]:
    "[ (ψ))  (φ  ψ) in v]"
    proof (rule "I"; rule CP)
      assume "[ ψ) in v]"
      moreover {
        have "⋀v.[ ψ)  (φ  ψ) in v]"
          proof (rule CP)
            fix v
            assume "[ ψ) in v]"
            hence "[φ  ψ in v]"
              using "K"[deduction] by auto
            thus "[φ  ψ in v]"
              using "B" ded_thm_cor_3 by blast
          qed
        hence "[( ψ)  (φ  ψ)) in v]"
          by (rule RN)
        hence "[( ψ))  ((φ  ψ)) in v]"
          using qml_1[axiom_instance, deduction] by auto
      }
      ultimately show "[(φ  ψ) in v]"
        using S5Basic_6 CP vdash_properties_10 by meson
    next
      assume "[(φ  ψ) in v]"
      moreover {
        fix v
        {
          assume "[(φ  ψ) in v]"
          hence 1: "[φ  ψ in v]"
            using qml_1[axiom_instance, deduction] by auto
          assume "[φ in v]"
          hence "[φ in v]"
            using S5Basic_4[deduction] by auto
          hence "[ψ in v]"
            using 1[deduction] by auto
        }
        hence "[(φ  ψ) in v] ⟹ [φ  ψ in v]"
          using CP by auto
      }
      ultimately show "[ ψ) in v]"
        using S5Basic_6 RN_2 vdash_properties_10 by blast
    qed

  lemma sc_eq_box_box_1[PLM]:
    "[ φ)  (φ  φ) in v]"
    proof(rule CP)
      assume 1: "[ φ) in v]"
      hence "[(φ  φ) in v]"
        using S5Basic_14[equiv_lr] by auto
      hence "[φ  φ in v]"
        using qml_2[axiom_instance, deduction] by auto
      moreover from 1 have "[φ  φ in v]"
        using qml_2[axiom_instance, deduction] by auto
      ultimately have "[φ  φ in v]"
        using ded_thm_cor_3 by auto
      moreover have "[φ  φ in v]"
        using qml_2[axiom_instance] "T"
        by (rule ded_thm_cor_3)
      ultimately show "[φ  φ in v]"
        by (rule "I")
    qed

  lemma sc_eq_box_box_2[PLM]:
    "[ φ)  ((¬φ)  ((¬φ))) in v]"
    proof (rule CP)
      assume "[ φ) in v]"
      hence "[(¬(¬φ))  φ in v]"
        using sc_eq_box_box_1[deduction] unfolding diamond_def by auto
      thus "[((¬φ)  ((¬φ))) in v]"
        by (meson CP "I" "E"(3)
                  "E"(4) "¬¬I" "¬¬E")
    qed

  lemma sc_eq_box_box_3[PLM]:
    "[( φ) &  ψ))  ((φ  ψ)   ψ)) in v]"
    proof (rule CP)
      assume 1: "[( φ) &  ψ)) in v]"
      {
        assume "[φ  ψ in v]"
        hence "[(φ & ψ)  ((¬(φ)) & (¬(ψ))) in v]"
          using oth_class_taut_5_i[equiv_lr] by auto
        moreover {
          assume "[φ & ψ in v]"
          hence "[ ψ) in v]"
            using KBasic_7[deduction] by auto
        }
        moreover {
          assume "[(¬(φ)) & (¬(ψ)) in v]"
          hence "[(¬φ) & (¬ψ) in v]"
             using 1 "&E" "&I" sc_eq_box_box_2[deduction, equiv_lr]
             by metis
          hence "[((¬φ) & (¬ψ)) in v]"
            using KBasic_3[equiv_rl] by auto
          hence "[ ψ) in v]"
            using KBasic_9[deduction] by auto
        }
        ultimately have "[ ψ) in v]"
          using CP "E"(1) by blast
      }
      thus "[φ  ψ   ψ) in v]"
        using CP by auto
    qed

  lemma derived_S5_rules_1_a[PLM]:
    assumes "⋀v. [χ in v] ⟹ [φ  ψ in v]"
    shows "[χ in v] ⟹ [φ  ψ in v]"
    proof -
      have "[χ in v] ⟹ [φ  ψ in v]"
        using assms RM_1_b by metis
      thus "[χ in v] ⟹ [φ  ψ in v]"
        using S5Basic_4 vdash_properties_10 CP by metis
    qed

  lemma derived_S5_rules_1_b[PLM]:
    assumes "⋀v. [φ  ψ in v]"
    shows "[φ  ψ in v]"
    using derived_S5_rules_1_a all_self_eq_1 assms by blast

  lemma derived_S5_rules_2_a[PLM]:
    assumes "⋀v. [χ in v] ⟹ [φ  ψ in v]"
    shows "[χ in v] ⟹ [φ  ψ in v]"
    proof -
      have "[χ in v] ⟹ [φ  ψ in v]"
        using RM_2_b assms by metis
      thus "[χ in v] ⟹ [φ  ψ in v]"
        using "B" vdash_properties_10 CP by metis
    qed

  lemma derived_S5_rules_2_b[PLM]:
    assumes "⋀v. [φ  ψ in v]"
    shows "[φ  ψ in v]"
    using assms derived_S5_rules_2_a all_self_eq_1 by blast

  lemma BFs_1[PLM]: "[(α. (φ α))  (α. φ α) in v]"
    proof (rule derived_S5_rules_1_b)
      fix v
      {
        fix α
        have "⋀v.[(α . (φ α))  (φ α) in v]"
          using cqt_orig_1 by metis
        hence "[(α. (φ α))  (φ α) in v]"
          using RM_2 by metis
        moreover have "[(φ α)  (φ α) in v]"
          using "B" by auto
        ultimately have "[(α. (φ α))  (φ α) in v]"
          using ded_thm_cor_3 by auto
      }
      hence "[ α . (α. (φ α))  (φ α) in v]"
        using "I" by metis
      thus "[(α. (φ α))  (α. φ α) in v]"
        using cqt_orig_2[deduction] by auto
    qed
  lemmas BF = BFs_1

  lemma BFs_2[PLM]:
    "[(α. φ α)  (α. (φ α)) in v]"
    proof -
      {
        fix α
        {
           fix v
           have "[(α. φ α)  φ α in v]" using cqt_orig_1 by metis
        }
        hence "[(α . φ α)  (φ α) in v]" using RM_1 by auto
      }
      hence "[α . (α . φ α)  (φ α) in v]" using "I" by metis
      thus ?thesis using cqt_orig_2[deduction] by metis
    qed
  lemmas CBF = BFs_2

  lemma BFs_3[PLM]:
    "[( α. φ α)  ( α . (φ α)) in v]"
    proof -
      have "[(α. (¬(φ α)))  (α. ¬(φ α)) in v]"
        using BF by metis
      hence 1: "[(¬((α. ¬(φ α))))  (¬(α. (¬(φ α)))) in v]"
        using contraposition_1 by simp
      have 2: "[(¬(α. ¬(φ α)))  (¬(α. (¬(φ α)))) in v]"
        apply (PLM_subst_method "¬(α . ¬(φ α))" "(¬(α. ¬(φ α)))")
        using KBasic2_2 1 by simp+
      have "[(¬(α. ¬(φ α)))  ( α . ¬((¬(φ α)))) in v]"
        apply (PLM_subst_method "¬(α. (¬(φ α)))" " α. ¬((¬(φ α)))")
         using cqt_further_2 apply metis
        using 2 by metis
      thus ?thesis
        unfolding exists_def diamond_def by auto
    qed
  lemmas "BF" = BFs_3

  lemma BFs_4[PLM]:
    "[( α . (φ α))  ( α. φ α) in v]"
    proof -
      have 1: "[(α . ¬(φ α))  (α. (¬(φ α))) in v]"
        using CBF by auto
      have 2: "[( α . (¬((¬(φ α)))))  (¬((α. ¬(φ α)))) in v]"
        apply (PLM_subst_method "¬(α. (¬(φ α)))" "( α . (¬((¬(φ α)))))")
         using cqt_further_2 apply blast
        using 1 using contraposition_1 by metis
      have "[( α . (¬((¬(φ α)))))  (¬( α . ¬(φ α))) in v]"
        apply (PLM_subst_method "¬((α. ¬(φ α)))" "(¬(α. ¬(φ α)))")
         using KBasic2_2 apply blast
        using 2 by assumption
      thus ?thesis
        unfolding diamond_def exists_def by auto
    qed
  lemmas "CBF" = BFs_4

  lemma sign_S5_thm_1[PLM]:
    "[( α. (φ α))  ( α. φ α) in v]"
    proof (rule CP)
      assume "[  α . (φ α) in v]"
      then obtain τ where "[(φ τ) in v]"
        by (rule "E")
      moreover {
        fix v
        assume "[φ τ in v]"
        hence "[ α . φ α in v]"
          by (rule "I")
      }
      ultimately show "[(  α . φ α) in v]"
        using RN_2 by blast
    qed
  lemmas Buridan = sign_S5_thm_1

  lemma sign_S5_thm_2[PLM]:
    "[( α . φ α)  ( α . (φ α)) in v]"
    proof -
      {
        fix α
        {
          fix v
          have "[( α . φ α)  φ α in v]"
            using cqt_orig_1 by metis
        }
        hence "[( α . φ α)  (φ α) in v]"
          using RM_2 by metis
      }
      hence "[ α . ( α . φ α)  (φ α) in v]"
        using "I" by metis
      thus ?thesis
        using cqt_orig_2[deduction] by metis
    qed
  lemmas "Buridan" = sign_S5_thm_2

  lemma sign_S5_thm_3[PLM]:
    "[( α . φ α & ψ α)  (( α . φ α) & ( α . ψ α)) in v]"
    by (simp only: RM_2 cqt_further_5)

  lemma sign_S5_thm_4[PLM]:
    "[((( α. φ α  ψ α)) & (( α . ψ α  χ α)))  (α. φ α  χ α) in v]"
    proof (rule CP)
      assume "[(α. φ α  ψ α) & (α. ψ α  χ α) in v]"
      hence "[((α. φ α  ψ α) & (α. ψ α  χ α)) in v]"
        using KBasic_3[equiv_rl] by blast
      moreover {
        fix v
        assume "[((α. φ α  ψ α) & (α. ψ α  χ α)) in v]"
        hence "[( α . φ α  χ α) in v]"
          using cqt_basic_9[deduction] by blast
      }
      ultimately show "[(α. φ α  χ α) in v]"
        using RN_2 by blast
    qed

  lemma sign_S5_thm_5[PLM]:
    "[(((α. φ α  ψ α)) & ((α. ψ α  χ α)))  ((α. φ α  χ α)) in v]"
    proof (rule CP)
      assume "[(α. φ α  ψ α) & (α. ψ α  χ α) in v]"
      hence "[((α. φ α  ψ α) & (α. ψ α  χ α)) in v]"
        using KBasic_3[equiv_rl] by blast
      moreover {
        fix v
        assume "[((α. φ α  ψ α) & (α. ψ α  χ α)) in v]"
        hence "[( α . φ α  χ α) in v]"
          using cqt_basic_10[deduction] by blast
      }
      ultimately show "[(α. φ α  χ α) in v]"
        using RN_2 by blast
    qed
  
  lemma id_nec2_1[PLM]:
    "[((α::'a::id_eq) = β) = β) in v]"
    apply (rule "I"; rule CP)
     using id_nec[equiv_lr] derived_S5_rules_2_b CP modus_ponens apply blast
    using "T"[deduction] by auto

  lemma id_nec2_2_Aux:
    "[(φ)  ψ in v] ⟹ [(¬ψ)  (¬φ) in v]"
    proof -
      assume "[(φ)  ψ in v]"
      moreover have "⋀φ ψ. [(¬φ)  ψ in v] ⟹ [(¬ψ)  φ in v]"
        by PLM_solver
      ultimately show ?thesis
        unfolding diamond_def by blast
    qed

  lemma id_nec2_2[PLM]:
    "[((α::'a::id_eq)  β)   β) in v]"
    using id_nec2_1[THEN id_nec2_2_Aux] by auto

  lemma id_nec2_3[PLM]:
    "[(((α::'a::id_eq)  β))  β) in v]"
    using "T" "I" id_nec2_2[equiv_lr]
          CP derived_S5_rules_2_b by metis

  lemma exists_desc_box_1[PLM]:
    "[( y . (yP) = (ιx. φ x))  ( y . ((yP) = (ιx. φ x))) in v]"
    proof (rule CP)
      assume "[y. (yP) = (ιx. φ x) in v]"
      then obtain y where "[(yP) = (ιx. φ x) in v]"
        by (rule "E")
      hence "[(yP = (ιx. φ x)) in v]"
        using l_identity[axiom_instance, deduction, deduction]
              cqt_1[axiom_instance] all_self_eq_2[where 'a=ν]
              modus_ponens unfolding identity_ν_def by fast
      thus "[y. ((yP) = (ιx. φ x)) in v]"
        by (rule "I")
    qed

  lemma exists_desc_box_2[PLM]:
    "[( y . (yP) = (ιx. φ x))   ( y .((yP) = (ιx. φ x))) in v]"
    using exists_desc_box_1 Buridan ded_thm_cor_3 by fast

  lemma en_eq_1[PLM]:
    "[⦃x,F⦄  ⦃x,F⦄ in v]"
    using encoding[axiom_instance] RN
          sc_eq_box_box_1 modus_ponens by blast
  lemma en_eq_2[PLM]:
    "[⦃x,F⦄  ⦃x,F⦄ in v]"
    using encoding[axiom_instance] qml_2[axiom_instance] by (rule "I")
  lemma en_eq_3[PLM]:
    "[⦃x,F⦄  ⦃x,F⦄ in v]"
    using encoding[axiom_instance] derived_S5_rules_2_b "I" "T" by auto
  lemma en_eq_4[PLM]:
    "[(⦃x,F⦄  ⦃y,G⦄)  (⦃x,F⦄  ⦃y,G⦄) in v]"
    by (metis CP en_eq_2 "I" "E"(1) "E"(2))
  lemma en_eq_5[PLM]:
    "[(⦃x,F⦄  ⦃y,G⦄)  (⦃x,F⦄  ⦃y,G⦄) in v]"
    using "I" KBasic_6 encoding[axiom_necessitation, axiom_instance]
    sc_eq_box_box_3[deduction] "&I" by simp
  lemma en_eq_6[PLM]:
    "[(⦃x,F⦄  ⦃y,G⦄)  (⦃x,F⦄  ⦃y,G⦄) in v]"
    using en_eq_4 en_eq_5 oth_class_taut_4_a "E"(6) by meson
  lemma en_eq_7[PLM]:
    "[(¬⦃x,F⦄)  (¬⦃x,F⦄) in v]"
    using en_eq_3[THEN id_nec2_2_Aux] by blast
  lemma en_eq_8[PLM]:
    "[(¬⦃x,F⦄)  (¬⦃x,F⦄) in v]"
     unfolding diamond_def apply (PLM_subst_method "⦃x,F⦄" "¬¬⦃x,F⦄")
      using oth_class_taut_4_b apply simp
     apply (PLM_subst_method "⦃x,F⦄" "⦃x,F⦄")
      using en_eq_2 apply simp
     using oth_class_taut_4_a by assumption
  lemma en_eq_9[PLM]:
    "[(¬⦃x,F⦄)  (¬⦃x,F⦄) in v]"
    using en_eq_8 en_eq_7 "E"(5) by blast
  lemma en_eq_10[PLM]:
    "[𝒜⦃x,F⦄  ⦃x,F⦄ in v]"
    apply (rule "I")
     using encoding[axiom_actualization, axiom_instance,
                    THEN logic_actual_nec_2[axiom_instance, equiv_lr],
                    deduction, THEN qml_act_2[axiom_instance, equiv_rl],
                    THEN en_eq_2[equiv_rl]] CP
     apply simp
    using encoding[axiom_instance] nec_imp_act ded_thm_cor_3 by blast

subsection‹The Theory of Relations› 
text‹\label{TAO_PLM_Relations}›

  lemma beta_equiv_eq_1_1[PLM]:
    assumes "IsProperInX φ"
        and "IsProperInX ψ"
        and "⋀x.[φ (xP)  ψ (xP) in v]"
    shows "[⦇λ y. φ (yP), xPλ y. ψ (yP), xP⦈ in v]"
    using lambda_predicates_2_1[OF assms(1), axiom_instance]
    using lambda_predicates_2_1[OF assms(2), axiom_instance]
    using assms(3) by (meson "E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_1_2[PLM]:
    assumes "IsProperInXY φ"
        and "IsProperInXY ψ"
        and "⋀x y.[φ (xP) (yP)  ψ (xP) (yP) in v]"
    shows "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yPλ2 (λ x y. ψ (xP) (yP)), xP, yP⦈ in v]"
    using lambda_predicates_2_2[OF assms(1), axiom_instance]
    using lambda_predicates_2_2[OF assms(2), axiom_instance]
    using assms(3) by (meson "E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_1_3[PLM]:
    assumes "IsProperInXYZ φ"
        and "IsProperInXYZ ψ"
        and "⋀x y z.[φ (xP) (yP) (zP)  ψ (xP) (yP) (zP) in v]"
    shows "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zPλ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈ in v]"
    using lambda_predicates_2_3[OF assms(1), axiom_instance]
    using lambda_predicates_2_3[OF assms(2), axiom_instance]
    using assms(3) by (meson "E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_2_1[PLM]:
    assumes "IsProperInX φ"
        and "IsProperInX ψ"
    shows "[(( x . φ (xP)  ψ (xP))) 
            (( x . ⦇λ y. φ (yP), xPλ y. ψ (yP), xP⦈)) in v]"
     apply (rule qml_1[axiom_instance, deduction])
     apply (rule RN)
     proof (rule CP, rule "I")
      fix v x
      assume "[x. φ (xP)  ψ (xP) in v]"
      hence "⋀x.[φ (xP)  ψ (xP) in v]"
        by PLM_solver
      thus "[⦇λ y. φ (yP), xPλ y. ψ (yP), xP⦈ in v]"
        using assms beta_equiv_eq_1_1 by auto
     qed

  lemma beta_equiv_eq_2_2[PLM]:
    assumes "IsProperInXY φ"
        and "IsProperInXY ψ"
    shows "[(( x y . φ (xP) (yP)  ψ (xP) (yP))) 
            (( x y . ⦇λ2 (λ x y. φ (xP) (yP)), xP, yPλ2 (λ x y. ψ (xP) (yP)), xP, yP⦈)) in v]"
    apply (rule qml_1[axiom_instance, deduction])
    apply (rule RN)
    proof (rule CP, rule "I", rule "I")
      fix v x y
      assume "[x y. φ (xP) (yP)  ψ (xP) (yP) in v]"
      hence "(⋀x y.[φ (xP) (yP)  ψ (xP) (yP) in v])"
        by (meson "E")
      thus "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yPλ2 (λ x y. ψ (xP) (yP)), xP, yP⦈ in v]"
        using assms beta_equiv_eq_1_2 by auto
    qed

  lemma beta_equiv_eq_2_3[PLM]:
    assumes "IsProperInXYZ φ"
        and "IsProperInXYZ ψ"
    shows "[(( x y z . φ (xP) (yP) (zP)  ψ (xP) (yP) (zP))) 
            (( x y z . ⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zPλ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈)) in v]"
    apply (rule qml_1[axiom_instance, deduction])
    apply (rule RN)
    proof (rule CP, rule "I", rule "I", rule "I")
      fix v x y z
      assume "[x y z. φ (xP) (yP) (zP)  ψ (xP) (yP) (zP) in v]"
      hence "(⋀x y z.[φ (xP) (yP) (zP)  ψ (xP) (yP) (zP) in v])"
        by (meson "E")
      thus "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zPλ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈ in v]"
        using assms beta_equiv_eq_1_3 by auto
    qed

  lemma beta_C_meta_1[PLM]:
    assumes "IsProperInX φ"
    shows "[⦇λ y. φ (yP), xP φ (xP) in v]"
    using lambda_predicates_2_1[OF assms, axiom_instance] by auto

  lemma beta_C_meta_2[PLM]:
    assumes "IsProperInXY φ"
    shows "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yP φ (xP) (yP) in v]"
    using lambda_predicates_2_2[OF assms, axiom_instance] by auto

  lemma beta_C_meta_3[PLM]:
    assumes "IsProperInXYZ φ"
    shows "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zP φ (xP) (yP) (zP) in v]"
    using lambda_predicates_2_3[OF assms, axiom_instance] by auto

  lemma relations_1[PLM]:
    assumes "IsProperInX φ"
    shows "[ F. ( x. ⦇F,xP φ (xP)) in v]"
    using assms apply - by PLM_solver

  lemma relations_2[PLM]:
    assumes "IsProperInXY φ"
    shows "[ F. ( x y. ⦇F,xP,yP φ (xP) (yP)) in v]"
    using assms apply - by PLM_solver

  lemma relations_3[PLM]:
    assumes "IsProperInXYZ φ"
    shows "[ F. ( x y z. ⦇F,xP,yP,zP φ (xP) (yP) (zP)) in v]"
    using assms apply - by PLM_solver

  lemma prop_equiv[PLM]:
    shows "[( x . (⦃xP,F⦄  ⦃xP,G⦄))  F = G in v]"
    proof (rule CP)
      assume 1: "[x. ⦃xP,F⦄  ⦃xP,G⦄ in v]"
      {
        fix x
        have "[⦃xP,F⦄  ⦃xP,G⦄ in v]"
          using 1 by (rule "E")
        hence "[(⦃xP,F⦄  ⦃xP,G⦄) in v]"
          using PLM.en_eq_6 "E"(1) by blast
      }
      hence "[x. (⦃xP,F⦄  ⦃xP,G⦄) in v]"
        by (rule "I")
      thus "[F = G in v]"
        unfolding identity_defs
        by (rule BF[deduction])
    qed

  lemma propositions_lemma_1[PLM]:
    "[λ0 φ = φ in v]"
    using lambda_predicates_3_0[axiom_instance] .

  lemma propositions_lemma_2[PLM]:
    "[λ0 φ  φ in v]"
    using lambda_predicates_3_0[axiom_instance, THEN id_eq_prop_prop_8_b[deduction]]
    apply (rule l_identity[axiom_instance, deduction, deduction])
    by PLM_solver

  lemma propositions_lemma_4[PLM]:
    assumes "⋀x.[𝒜(φ x  ψ x) in v]"
    shows "[(χ::κ⇒𝗈) (ιx. φ x) = χ (ιx. ψ x) in v]"
    proof -
      have "[λ0 (χ (ιx. φ x)) = λ0 (χ (ιx. ψ x)) in v]"
        using assms lambda_predicates_4_0[axiom_instance]
        by blast
      hence "[(χ (ιx. φ x)) = λ0 (χ (ιx. ψ x)) in v]"
        using propositions_lemma_1[THEN id_eq_prop_prop_8_b[deduction]]
              id_eq_prop_prop_9_b[deduction] "&I"
        by blast
      thus ?thesis
        using propositions_lemma_1 id_eq_prop_prop_9_b[deduction] "&I"
        by blast
    qed

  lemma propositions[PLM]:
    "[ p . (p  p') in v]"
    by PLM_solver

  lemma pos_not_equiv_then_not_eq[PLM]:
    "[(¬(x. ⦇F,xP ⦇G,xP⦈))  F  G in v]"
    unfolding diamond_def
    proof (subst contraposition_1[symmetric], rule CP)
      assume "[F = G in v]"
      thus "[(¬(¬(x. ⦇F,xP ⦇G,xP⦈))) in v]"
        apply (rule l_identity[axiom_instance, deduction, deduction])
        by PLM_solver
    qed

  lemma thm_relation_negation_1_1[PLM]:
    "[⦇F-, xP ¬⦇F, xP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_1[axiom_instance])
    by show_proper

  lemma thm_relation_negation_1_2[PLM]:
    "[⦇F-, xP, yP ¬⦇F, xP, yP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_2[axiom_instance])
    by show_proper

  lemma thm_relation_negation_1_3[PLM]:
    "[⦇F-, xP, yP, zP ¬⦇F, xP, yP, zP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_3[axiom_instance])
    by show_proper

  lemma thm_relation_negation_2_1[PLM]:
    "[(¬⦇F-, xP⦈)  ⦇F, xP⦈ in v]"
    using thm_relation_negation_1_1[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_2_2[PLM]:
    "[(¬⦇F-, xP, yP⦈)  ⦇F, xP, yP⦈ in v]"
    using thm_relation_negation_1_2[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_2_3[PLM]:
    "[(¬⦇F-, xP, yP, zP⦈)  ⦇F, xP, yP, zP⦈ in v]"
    using thm_relation_negation_1_3[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_3[PLM]:
    "[(p)-  ¬p in v]"
    unfolding propnot_defs
    using propositions_lemma_2 by simp

  lemma thm_relation_negation_4[PLM]:
    "[(¬((p::𝗈)-))  p in v]"
    using thm_relation_negation_3[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_5_1[PLM]:
    "[(F::Π1)  (F-) in v]"
    using id_eq_prop_prop_2[deduction]
          l_identity[where φ="λ G . ⦇G,xP ⦇F-,xP⦈", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_1 "E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_5_2[PLM]:
    "[(F::Π2)  (F-) in v]"
    using id_eq_prop_prop_5_a[deduction]
          l_identity[where φ="λ G . ⦇G,xP,yP ⦇F-,xP,yP⦈", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_2 "E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_5_3[PLM]:
    "[(F::Π3)  (F-) in v]"
    using id_eq_prop_prop_5_b[deduction]
          l_identity[where φ="λ G . ⦇G,xP,yP,zP ⦇F-,xP,yP,zP⦈",
                     axiom_instance, deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_3 "E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_6[PLM]:
    "[(p::𝗈)  (p-) in v]"
    using id_eq_prop_prop_8_b[deduction]
          l_identity[where φ="λ G . G  (p-)", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_3 "E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_7[PLM]:
    "[((p::𝗈)-) = ¬p in v]"
    unfolding propnot_defs using propositions_lemma_1 by simp

  lemma thm_relation_negation_8[PLM]:
    "[(p::𝗈)  ¬p in v]"
    unfolding propnot_defs 
    using id_eq_prop_prop_8_b[deduction]
          l_identity[where φ="λ G . G  ¬(p)", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a oth_class_taut_1_b
          modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_9[PLM]:
    "[((p::𝗈) = q)  ((¬p) = (¬q)) in v]"
    using l_identity[where α="p" and β="q" and φ="λ x . (¬p) = (¬x)",
                      axiom_instance, deduction]
          id_eq_prop_prop_7_b using CP modus_ponens by blast

  lemma thm_relation_negation_10[PLM]:
    "[((p::𝗈) = q)  ((p-) = (q-)) in v]"
    using l_identity[where α="p" and β="q" and φ="λ x . (p-) = (x-)",
                      axiom_instance, deduction]
          id_eq_prop_prop_7_b using CP modus_ponens by blast

  lemma thm_cont_prop_1[PLM]:
    "[NonContingent (F::Π1)  NonContingent (F-) in v]"
    proof (rule "I"; rule CP)
      assume "[NonContingent F in v]"
      hence "[(x.⦇F,xP⦈)  (x.¬⦇F,xP⦈) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
      hence "[(x. ¬⦇F-,xP⦈)  (x. ¬⦇F,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬⦇F-,xP⦈")
        using thm_relation_negation_2_1[equiv_sym] by auto
      hence "[(x. ¬⦇F-,xP⦈)  (x. ⦇F-,xP⦈) in v]"
        apply -
        apply (PLM_subst_goal_method
               "λ φ . (x. ¬⦇F-,xP⦈)  (x. φ x)" "λ x . ¬⦇F,xP⦈")
        using thm_relation_negation_1_1[equiv_sym] by auto
      hence "[(x. ⦇F-,xP⦈)  (x. ¬⦇F-,xP⦈) in v]"
        by (rule oth_class_taut_3_e[equiv_lr])
      thus "[NonContingent (F-) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    next
      assume "[NonContingent (F-) in v]"
      hence "[(x. ¬⦇F-,xP⦈)  (x. ⦇F-,xP⦈) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs
        by (rule oth_class_taut_3_e[equiv_lr])
      hence "[(x.⦇F,xP⦈)  (x.⦇F-,xP⦈) in v]"
        apply -
        apply (PLM_subst_method  "λ x . ¬⦇F-,xP⦈" "λ x . ⦇F,xP⦈")
        using thm_relation_negation_2_1 by auto
      hence "[(x. ⦇F,xP⦈)  (x. ¬⦇F,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "λ x . ⦇F-,xP⦈" "λ x . ¬⦇F,xP⦈")
        using thm_relation_negation_1_1 by auto
      thus "[NonContingent F in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_prop_2[PLM]:
    "[Contingent F  ( x . ⦇F,xP⦈) & ( x . ¬⦇F,xP⦈) in v]"
    proof (rule "I"; rule CP)
      assume "[Contingent F in v]"
      hence "[¬((x.⦇F,xP⦈)  (x.¬⦇F,xP⦈)) in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
      hence "[(¬(x.⦇F,xP⦈)) & (¬(x.¬⦇F,xP⦈)) in v]"
        by (rule oth_class_taut_6_d[equiv_lr])
      hence "[(¬(x.¬⦇F,xP⦈)) & (¬(x.⦇F,xP⦈)) in v]"
        using KBasic2_2[equiv_lr] "&I" "&E" by meson
      thus "[(( x.⦇F,xP⦈)) & ((x. ¬⦇F,xP⦈)) in v]"
        unfolding exists_def apply -
        apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬¬⦇F,xP⦈")
        using oth_class_taut_4_b by auto
    next
      assume "[(( x.⦇F,xP⦈)) & ((x. ¬⦇F,xP⦈)) in v]"
      hence "[(¬(x.¬⦇F,xP⦈)) & (¬(x.⦇F,xP⦈)) in v]"
        unfolding exists_def apply -
        apply (PLM_subst_goal_method
               "λ φ . (¬(x.¬⦇F,xP⦈)) & (¬(x. φ x))" "λ x . ¬¬⦇F,xP⦈")
        using oth_class_taut_4_b[equiv_sym] by auto
      hence "[(¬(x.⦇F,xP⦈)) & (¬(x.¬⦇F,xP⦈)) in v]"
        using KBasic2_2[equiv_rl] "&I" "&E" by meson
      hence "[¬((x.⦇F,xP⦈)  (x.¬⦇F,xP⦈)) in v]"
        by (rule oth_class_taut_6_d[equiv_rl])
      thus "[Contingent F in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_prop_3[PLM]:
    "[Contingent (F::Π1)  Contingent (F-) in v]"
    using thm_cont_prop_1
    unfolding NonContingent_def Contingent_def
    by (rule oth_class_taut_5_d[equiv_lr])

  lemma lem_cont_e[PLM]:
    "[( x . ⦇F,xP& ((¬⦇F,xP⦈)))  ( x . ((¬⦇F,xP⦈) & ⦇F,xP⦈))in v]"
    proof -
      have "[( x . ⦇F,xP& ((¬⦇F,xP⦈))) in v]
             = [( x . (⦇F,xP& (¬⦇F,xP⦈))) in v]"
        using "BF"[deduction] "CBF"[deduction] by fast
      also have "... = [ x . (⦇F,xP& (¬⦇F,xP⦈)) in v]"
        apply (PLM_subst_method
               "λ x . (⦇F,xP& (¬⦇F,xP⦈))"
               "λ x . ⦇F,xP& (¬⦇F,xP⦈)")
        using S5Basic_12 by auto
      also have "... = [ x . (¬⦇F,xP⦈) & ⦇F,xP⦈ in v]" 
        apply (PLM_subst_method
               "λ x . ⦇F,xP& (¬⦇F,xP⦈)"
               "λ x . (¬⦇F,xP⦈) & ⦇F,xP⦈")
        using oth_class_taut_3_b by auto
      also have "... = [ x . ((¬⦇F,xP⦈) & ⦇F,xP⦈) in v]"
        apply (PLM_subst_method
               "λ x . (¬⦇F,xP⦈) & ⦇F,xP⦈"
               "λ x . ((¬⦇F,xP⦈) & ⦇F,xP⦈)")
        using S5Basic_12[equiv_sym] by auto
      also have "... = [ ( x . ((¬⦇F,xP⦈) & ⦇F,xP⦈)) in v]"
        using "CBF"[deduction] "BF"[deduction] by fast
      finally show ?thesis using "I" CP by blast
    qed

  lemma lem_cont_e_2[PLM]:
    "[( x . ⦇F,xP& (¬⦇F,xP⦈))  ( x . ⦇F-,xP& (¬⦇F-,xP⦈)) in v]"
    apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬⦇F-,xP⦈")
     using thm_relation_negation_2_1[equiv_sym] apply simp
    apply (PLM_subst_method "λ x . ¬⦇F,xP⦈" "λ x . ⦇F-,xP⦈")
     using thm_relation_negation_1_1[equiv_sym] apply simp
    using lem_cont_e by simp

  lemma thm_cont_e_1[PLM]:
    "[( x . ((¬⦇E!,xP⦈) & (⦇E!,xP⦈))) in v]"
    using lem_cont_e[where F="E!", equiv_lr] qml_4[axiom_instance,conj1]
    by blast

  lemma thm_cont_e_2[PLM]:
    "[Contingent (E!) in v]"
    using thm_cont_prop_2[equiv_rl] "&I" qml_4[axiom_instance, conj1]
          KBasic2_8[deduction, OF sign_S5_thm_3[deduction], conj1]
          KBasic2_8[deduction, OF sign_S5_thm_3[deduction, OF thm_cont_e_1], conj1]
    by fast

  lemma thm_cont_e_3[PLM]:
    "[Contingent (E!-) in v]"
    using thm_cont_e_2 thm_cont_prop_3[equiv_lr] by blast

  lemma thm_cont_e_4[PLM]:
    "[ (F::Π1) G . (F  G & Contingent F & Contingent G) in v]"
    apply (rule_tac α="E!" in "I", rule_tac α="E!-" in "I")
    using thm_cont_e_2 thm_cont_e_3 thm_relation_negation_5_1 "&I" by auto

  context
  begin
    qualified definition L where "L ≡ (λ x . ⦇E!, xP ⦇E!, xP⦈)"
    
    lemma thm_noncont_e_e_1[PLM]:
      "[Necessary L in v]"
      unfolding Necessary_defs L_def apply (rule RN, rule "I")
      apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl])
        apply show_proper
      using if_p_then_p .

    lemma thm_noncont_e_e_2[PLM]:
      "[Impossible (L-) in v]"
      unfolding Impossible_defs L_def apply (rule RN, rule "I")
      apply (rule thm_relation_negation_2_1[equiv_rl])
      apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl])
       apply show_proper
      using if_p_then_p .

    lemma thm_noncont_e_e_3[PLM]:
      "[NonContingent (L) in v]"
      unfolding NonContingent_def using thm_noncont_e_e_1
      by (rule "I"(1))

    lemma thm_noncont_e_e_4[PLM]:
      "[NonContingent (L-) in v]"
      unfolding NonContingent_def using thm_noncont_e_e_2
      by (rule "I"(2))

    lemma thm_noncont_e_e_5[PLM]:
      "[ (F::Π1) G . F  G & NonContingent F & NonContingent G in v]"
      apply (rule_tac α="L" in "I", rule_tac α="L-" in "I")
      using "I" thm_relation_negation_5_1 thm_noncont_e_e_3
            thm_noncont_e_e_4 "&I"
      by simp


  lemma four_distinct_1[PLM]:
    "[NonContingent (F::Π1)  ¬( G . (Contingent G & G = F)) in v]"
    proof (rule CP)
      assume "[NonContingent F in v]"
      hence "[¬(Contingent F) in v]"
        unfolding NonContingent_def Contingent_def
        apply - by PLM_solver
      moreover {
         assume "[ G . Contingent G & G = F in v]"
         then obtain P where "[Contingent P & P = F in v]"
          by (rule "E")
         hence "[Contingent F in v]"
           using "&E" l_identity[axiom_instance, deduction, deduction]
           by blast
      }
      ultimately show "[¬(G. Contingent G & G = F) in v]"
        using modus_tollens_1 CP by blast
    qed

  lemma four_distinct_2[PLM]:
    "[Contingent (F::Π1)  ¬( G . (NonContingent G & G = F)) in v]"
    proof (rule CP)
      assume "[Contingent F in v]"
      hence "[¬(NonContingent F) in v]"
        unfolding NonContingent_def Contingent_def
        apply - by PLM_solver
      moreover {
         assume "[ G . NonContingent G & G = F in v]"
         then obtain P where "[NonContingent P & P = F in v]"
          by (rule "E")
         hence "[NonContingent F in v]"
           using "&E" l_identity[axiom_instance, deduction, deduction]
           by blast
      }
      ultimately show "[¬(G. NonContingent G & G = F) in v]"
        using modus_tollens_1 CP by blast
    qed

    lemma four_distinct_3[PLM]:
      "[L  (L-) & L  E! & L  (E!-) & (L-)  E!
        & (L-)  (E!-) & E!  (E!-) in v]"
      proof (rule "&I")+
        show "[L  (L-) in v]"
        by (rule thm_relation_negation_5_1)
      next
        {
          assume "[L = E! in v]"
          hence "[NonContingent L & L = E! in v]"
            using thm_noncont_e_e_3 "&I" by auto
          hence "[ G . NonContingent G & G = E! in v]"
            using thm_noncont_e_e_3 "&I" "I" by fast
        }
        thus "[L  E! in v]"
          using four_distinct_2[deduction, OF thm_cont_e_2]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[L = (E!-) in v]"
          hence "[NonContingent L & L = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" by auto
          hence "[ G . NonContingent G & G = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" "I" by fast
        }
        thus "[L  (E!-) in v]"
          using four_distinct_2[deduction, OF thm_cont_e_3]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[(L-) = E! in v]"
          hence "[NonContingent (L-) & (L-) = E! in v]"
            using thm_noncont_e_e_4 "&I" by auto
          hence "[ G . NonContingent G & G = E! in v]"
            using thm_noncont_e_e_3 "&I" "I" by fast
        }
        thus "[(L-)  E! in v]"
          using four_distinct_2[deduction, OF thm_cont_e_2]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[(L-) = (E!-) in v]"
          hence "[NonContingent (L-) & (L-) = (E!-) in v]"
            using thm_noncont_e_e_4 "&I" by auto
          hence "[ G . NonContingent G & G = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" "I" by fast
        }
        thus "[(L-)  (E!-) in v]"
          using four_distinct_2[deduction, OF thm_cont_e_3]
                modus_tollens_1 CP
          by blast
      next
        show "[E!  (E!-) in v]"
          by (rule thm_relation_negation_5_1)
      qed
  end

  lemma thm_cont_propos_1[PLM]:
    "[NonContingent (p::𝗈)  NonContingent (p-) in v]"
    proof (rule "I"; rule CP)
      assume "[NonContingent p in v]"
      hence "[p  ¬p in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
      hence "[(¬(p-))  (¬p) in v]"
        apply -
        apply (PLM_subst_method "p" "¬(p-)")
        using thm_relation_negation_4[equiv_sym] by auto
      hence "[(¬(p-))  (p-) in v]"
        apply -
        apply (PLM_subst_goal_method "λφ . (¬(p-))