theory Multigraph_Adaptor
  imports
    "../Directed_Graph/Directed_Multigraph"
    "../Undirected_Graph/Multigraph"
begin

fun undirect :: "('a, 'b) Directed_Multigraph.edge \<Rightarrow> ('a, 'b) Multigraph.edge" where
  "undirect (\<epsilon>, u, v) = (\<epsilon>, {u, v})"

lemma
  shows
    head_mem_endpoints_undirect: "head e \<in> Multigraph.endpoints (undirect e)" and
    tail_mem_endpoints_undirect: "tail e \<in> Multigraph.endpoints (undirect e)"
proof -
  obtain \<epsilon> u v where
    "e = (\<epsilon>, u, v)"
    by (elim undirect.cases)
  thus
    "head e \<in> Multigraph.endpoints (undirect e)"
    "tail e \<in> Multigraph.endpoints (undirect e)"
    by (simp_all add: head_def tail_def Directed_Multigraph.endpoints_def Multigraph.endpoints_def)
qed

lemma endpoints_undirect_eq:
  shows "Multigraph.endpoints (undirect e) = {head e, tail e}"
proof -
  obtain \<epsilon> u v where
    "e = (\<epsilon>, u, v)"
    by (elim undirect.cases)
  thus ?thesis
    by (auto simp add: Multigraph.endpoints_def head_def tail_def Directed_Multigraph.endpoints_def)
qed

lemma (in other) tail_eq_other_head:
  shows "tail e = other (undirect e) (head e)"
proof -
  have "{head e, tail e} = {head e, other (undirect e) (head e)}"
    using endpoints_undirect_eq head_mem_endpoints_undirect
    by (fast dest: other)
  thus ?thesis
    by (auto simp add: doubleton_eq_iff)
qed

lemma (in other) head_eq_other_tail:
  shows "head e = other (undirect e) (tail e)"
proof -
  have "{head e, tail e} = {tail e, other (undirect e) (tail e)}"
    using endpoints_undirect_eq tail_mem_endpoints_undirect
    by (metis other)
  thus ?thesis
    by (auto simp add: doubleton_eq_iff)
qed

lemma mem_image_undirect_iff:
  shows "(\<epsilon>, {u, v}) \<in> undirect ` G \<longleftrightarrow> (\<epsilon>, u, v) \<in> G \<or> (\<epsilon>, v, u) \<in> G"
  by (force simp add: doubleton_eq_iff)

lemma mem_endpoints_image_undirect_iff:
  shows
    "{u, v} \<in> Multigraph.endpoints ` undirect ` G \<longleftrightarrow>
     (u, v) \<in> Directed_Multigraph.endpoints ` G \<or> (v, u) \<in> Directed_Multigraph.endpoints ` G"
  unfolding Multigraph.mem_endpoints_iff Directed_Multigraph.mem_endpoints_iff mem_image_undirect_iff
  by blast

(* TODO: Rename. *)
locale huehuehue =
  Directed_Multigraph.finite_multigraph
  where G = G +
    other
  where other = other
  for G :: "('a, 'b) Directed_Multigraph.multigraph"
    and other :: "('a, 'b) Multigraph.edge \<Rightarrow> 'b \<Rightarrow> 'b"
begin
sublocale Multigraph.finite_multigraph other "undirect ` G"
proof (standard, goal_cases)
  case (1 e)
  thus ?case
    by (auto simp add: Multigraph.endpoints_def)
next
  case 2
  show ?case
    using finite_edges
    by simp
qed

end

lemma (in huehuehue) V_image_undirect_eq:
  shows "Multigraph.V (undirect ` G) = Directed_Multigraph.V G"
proof (standard, goal_cases)
  case 1
  show ?case
  proof (standard, goal_cases)
    case (1 u)
    then obtain v where
      "{u, v} \<in> Multigraph.endpoints ` undirect ` G"
      by (elim mem_VE)
    thus ?case
      by (auto simp add: mem_endpoints_image_undirect_iff intro: head_mem_V_3 tail_mem_V_3)
  qed
next
  case 2
  show ?case
  proof (standard, goal_cases)
    case (1 u)
    then obtain v where
      "(u, v) \<in> Directed_Multigraph.endpoints ` G \<or> (v, u) \<in> Directed_Multigraph.endpoints ` G"
      by (elim Directed_Multigraph.mem_VE)
    thus ?case
      by (auto simp add: mem_endpoints_image_undirect_iff[symmetric] intro: mem_VI_2)
  qed
qed

end


section "Definition of a Federated Byzantine Agreement System"

theory FBA
imports Main
begin

definition project where
  "project slices S n \<equiv> {Sl \<inter> S | Sl . Sl \<in> slices n}"
  \<comment> \<open>Projecting on @{term S} is the same as deleting the complement of @{term S}, where deleting is understood as in the Stellar Whitepaper.\<close>

locale FBAS =
  fixes slices :: "'node \<Rightarrow> 'node set set" \<comment> \<open>the quorum slices\<close>
    and W :: "'node set" \<comment> \<open>the well-behaved nodes\<close>
  assumes slices_ne:"\<And>p . p \<in> W \<Longrightarrow> slices p \<noteq> {}" \<comment> \<open>the set of slices of a well-behaved node is not empty\<close>
begin

definition quorum where
  "quorum Q \<equiv> \<forall> p \<in> Q \<inter> W . (\<exists> Sl \<in> slices p . Sl \<subseteq> Q)"
  \<comment> \<open>A quorum is a set whose well-behaved members have at least one slice included in the set.\<close>

end

section \<open>Intact and the Cascade Theorem\<close>

locale intact = \<comment> \<open>Here we fix an intact set @{term I} and prove the cascade theorem.\<close>
  orig:FBAS slices W
  + proj:FBAS "project slices I" W \<comment> \<open>We consider the projection of the system on @{term I}.\<close>
  for slices W I +  \<comment> \<open>An intact set is a set @{term I} satisfying the three assumptions below:\<close>
  assumes intact_wb:"I \<subseteq> W"
    and q_avail:"orig.quorum I" \<comment> \<open>@{term I} is a quorum in the original system.\<close>
    and q_inter:"\<And> Q Q' . \<lbrakk>proj.quorum Q; proj.quorum Q'; Q \<inter> I \<noteq> {}; Q' \<inter> I \<noteq> {}\<rbrakk>  \<Longrightarrow> Q \<inter> Q' \<inter> I \<noteq> {}"
    \<comment> \<open>Any two sets that intersect @{term I} and that are quorums in the projected system intersect in @{term I}.
Note that requiring that @{text \<open>Q \<inter> Q' \<noteq> {}\<close>} instead of @{text \<open>Q \<inter> Q' \<inter> I \<noteq> {}\<close>} would be equivalent.\<close>
begin

theorem blocking_safe: \<comment> \<open>A set that blocks an intact node contains an intact node.
If this were not the case, quorum availability would trivially be violated.\<close>
  fixes S n
  assumes "n\<in>I" and "\<forall> Sl\<in> slices n .Sl\<inter>S \<noteq> {}"
  shows "S \<inter> I \<noteq> {}"
  using assms q_avail intact_wb unfolding orig.quorum_def
  by auto (metis inf.absorb_iff2 inf_assoc inf_bot_right inf_sup_aci(1))

theorem cascade:
\<comment> \<open>If @{term U} is a quorum of an intact node and @{term S} is a super-set of @{term U}, then either @{term S} includes
all intact nodes or there is an intact node outside of @{term S} which is blocked by the intact members of @{term S}.
This shows that, in SCP, once the intact members of a quorum accept a statement,
a cascading effect occurs and all intact nodes eventually accept it regardless of what befouled and faulty nodes do.\<close>
  fixes U S
  assumes "orig.quorum U" and "U \<inter> I \<noteq> {}" and "U \<subseteq> S"
  obtains "I \<subseteq> S" | "\<exists> n \<in> I - S . \<forall> Sl \<in> slices n . Sl \<inter> S \<inter> I \<noteq> {}"
proof -
  have False if 1:"\<forall> n \<in> I - S . \<exists> Sl \<in> slices n . Sl \<inter> S \<inter> I = {}" and 2:"\<not>(I \<subseteq> S)"
  proof -
    text \<open>First we show that @{term \<open>I-S\<close>} is a quorum in the projected system. This is immediate from the definition of quorum and assumption 1.\<close>
    have "proj.quorum (I-S)" using 1
      unfolding proj.quorum_def project_def
      by (auto; smt DiffI Diff_Compl Diff_Int_distrib Diff_eq Diff_eq_empty_iff Int_commute)
    text \<open>Then we show that U is also a quorum in the projected system:\<close>
    moreover have "proj.quorum U" using \<open>orig.quorum U\<close>
      unfolding proj.quorum_def orig.quorum_def project_def
      by (simp; meson Int_commute inf.coboundedI2)
    text \<open>Since quorums of @{term I} must intersect, we get a contradiction:\<close>
    ultimately show False using \<open>U \<subseteq> S\<close> \<open>U \<inter> I \<noteq> {}\<close> \<open>\<not>(I\<subseteq>S)\<close> q_inter by auto
  qed
  thus ?thesis using that by blast
qed

end

section "The Union Theorem"

text \<open>Here we prove that the union of two intact sets that intersect is intact.
This implies that maximal intact sets are disjoint.\<close>

locale intersecting_intact =
  i1:intact slices W I\<^sub>1 + i2:intact slices W I\<^sub>2 \<comment> \<open>We fix two intersecting intact sets @{term I\<^sub>1} and @{term I\<^sub>2}.\<close>
  + proj:FBAS "project slices (I\<^sub>1\<union>I\<^sub>2)" W \<comment> \<open>We consider the projection of the system on @{term \<open>I\<^sub>1\<union>I\<^sub>2\<close>}.\<close>
  for slices W I\<^sub>1 I\<^sub>2 +
assumes inter:"I\<^sub>1 \<inter> I\<^sub>2 \<noteq> {}"
begin

theorem union_quorum: "i1.orig.quorum (I\<^sub>1\<union>I\<^sub>2)" \<comment> \<open>@{term \<open>I\<^sub>1\<union>I\<^sub>2\<close>} is a quorum in the original system.\<close>
  using i1.intact_axioms i2.intact_axioms
  unfolding  intact_def FBAS_def intact_axioms_def i1.orig.quorum_def
  by (metis Int_iff Un_iff le_supI1 le_supI2)

theorem union_quorum_intersection:
  assumes "proj.quorum Q\<^sub>1" and "proj.quorum Q\<^sub>2" and "Q\<^sub>1 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}" and "Q\<^sub>2 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}"
  shows "Q\<^sub>1 \<inter> Q\<^sub>2 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}"
    \<comment> \<open>Any two sets that intersect @{term \<open>I\<^sub>1\<union>I\<^sub>2\<close>} and that are quorums in the system projected on @{term \<open>I\<^sub>1\<union>I\<^sub>2\<close>} intersect in @{term \<open>I\<^sub>1\<union>I\<^sub>2\<close>}.\<close>
proof -
  text \<open>First we show that @{term Q\<^sub>1} and @{term Q\<^sub>2} are quorums in the projections on @{term I\<^sub>1} and @{term I\<^sub>2}.\<close>
  have "i1.proj.quorum Q\<^sub>1" using \<open>proj.quorum Q\<^sub>1\<close>
    unfolding i1.proj.quorum_def proj.quorum_def project_def
    by auto (metis Int_Un_distrib Int_iff Un_subset_iff)
  moreover have "i2.proj.quorum Q\<^sub>2" using \<open>proj.quorum Q\<^sub>2\<close>
    unfolding i2.proj.quorum_def proj.quorum_def project_def
    by auto (metis Int_Un_distrib Int_iff Un_subset_iff)
  moreover have "i2.proj.quorum Q\<^sub>1" using \<open>proj.quorum Q\<^sub>1\<close>
    unfolding proj.quorum_def i2.proj.quorum_def project_def
    by auto (metis Int_Un_distrib Int_iff Un_subset_iff)
  moreover have "i1.proj.quorum Q\<^sub>2" using \<open>proj.quorum Q\<^sub>2\<close>
    unfolding proj.quorum_def i1.proj.quorum_def project_def
    by auto (metis Int_Un_distrib Int_iff Un_subset_iff)
  text \<open>Next we show that @{term Q\<^sub>1} and @{term Q\<^sub>2} intersect if they are quorums of, respectively, @{term I\<^sub>1} and @{term I\<^sub>2}.
This is the only interesting part of the proof.\<close>
  moreover have "Q\<^sub>1 \<inter> Q\<^sub>2 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}"
    if "i1.proj.quorum Q\<^sub>1" and "i2.proj.quorum Q\<^sub>2" and "i2.proj.quorum Q\<^sub>1"
      and "Q\<^sub>1 \<inter> I\<^sub>1 \<noteq> {}" and "Q\<^sub>2 \<inter> I\<^sub>2 \<noteq> {}"
    for Q\<^sub>1 Q\<^sub>2
  proof -
    have "i1.proj.quorum I\<^sub>2"
    proof -
      have "i1.orig.quorum I\<^sub>2" by (simp add: i2.q_avail)
      thus ?thesis unfolding i1.orig.quorum_def i1.proj.quorum_def project_def
        by auto (meson Int_commute Int_iff inf_le2 subset_trans)
    qed
    moreover note \<open>i1.proj.quorum Q\<^sub>1\<close>
    ultimately have "Q\<^sub>1 \<inter> I\<^sub>2 \<noteq> {}" using i1.q_inter inter \<open>Q\<^sub>1 \<inter> I\<^sub>1 \<noteq> {}\<close> by blast

    moreover note \<open>i2.proj.quorum Q\<^sub>2\<close>
    moreover note \<open>i2.proj.quorum Q\<^sub>1\<close>
    ultimately have "Q\<^sub>1 \<inter> Q\<^sub>2 \<inter> I\<^sub>2 \<noteq> {}" using i2.q_inter \<open>Q\<^sub>2 \<inter> I\<^sub>2 \<noteq> {}\<close> by blast
    thus ?thesis by (simp add: inf_sup_distrib1)
  qed
  text \<open>Next  we show that @{term Q\<^sub>1} and @{term Q\<^sub>2} intersect if they are quorums of the same intact set. This is obvious.\<close>
  moreover
  have "Q\<^sub>1 \<inter> Q\<^sub>2 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}"
    if "i1.proj.quorum Q\<^sub>1" and "i1.proj.quorum Q\<^sub>2" and "Q\<^sub>1 \<inter> I\<^sub>1 \<noteq> {}" and "Q\<^sub>2 \<inter> I\<^sub>1 \<noteq> {}"
    for Q\<^sub>1 Q\<^sub>2
    by (simp add: Int_Un_distrib i1.q_inter that)
  moreover
  have "Q\<^sub>1 \<inter> Q\<^sub>2 \<inter> (I\<^sub>1\<union>I\<^sub>2) \<noteq> {}"
    if "i2.proj.quorum Q\<^sub>1" and "i2.proj.quorum Q\<^sub>2" and "Q\<^sub>1 \<inter> I\<^sub>2 \<noteq> {}" and "Q\<^sub>2 \<inter> I\<^sub>2 \<noteq> {}"
    for Q\<^sub>1 Q\<^sub>2
    by (simp add: Int_Un_distrib i2.q_inter that)
  text \<open>Finally we have covered all the cases and get the final result:\<close>
  ultimately
  show ?thesis
    by (smt Int_Un_distrib Int_commute assms(3,4) sup_bot.right_neutral)
qed

end

end


theory bin_times
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

datatype Bin = One | ZeroAnd "Bin" | OneAnd "Bin"

fun s :: "Bin => Bin" where
"s (One) = ZeroAnd One"
| "s (ZeroAnd xs) = OneAnd xs"
| "s (OneAnd ys) = ZeroAnd (s ys)"

fun plus2 :: "Bin => Bin => Bin" where
"plus2 (One) y = s y"
| "plus2 (ZeroAnd z) (One) = s (ZeroAnd z)"
| "plus2 (ZeroAnd z) (ZeroAnd ys) = ZeroAnd (plus2 z ys)"
| "plus2 (ZeroAnd z) (OneAnd xs) = OneAnd (plus2 z xs)"
| "plus2 (OneAnd x2) (One) = s (OneAnd x2)"
| "plus2 (OneAnd x2) (ZeroAnd zs) = OneAnd (plus2 x2 zs)"
| "plus2 (OneAnd x2) (OneAnd ys2) = ZeroAnd (s (plus2 x2 ys2))"

fun times :: "Bin => Bin => Bin" where
"times (One) y = y"
| "times (ZeroAnd xs) y = ZeroAnd (times xs y)"
| "times (OneAnd ys) y = plus2 (ZeroAnd (times ys y)) y"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S n) y = S (plus n y)"

fun toNat :: "Bin => Nat" where
"toNat (One) = S Z"
| "toNat (ZeroAnd xs) = plus (toNat xs) (toNat xs)"
| "toNat (OneAnd ys) = S (plus (toNat ys) (toNat ys))"

fun mult :: "Nat => Nat => Nat" where
"mult (Z) y = Z"
| "mult (S n) y = plus y (mult n y)"

(*hipster s plus2 times plus toNat mult *)

theorem x0 :
  "!! (x :: Bin) (y :: Bin) .
     (toNat (times x y)) = (mult (toNat x) (toNat y))"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


(*
 * Copyright Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory Strict_part_mono
  imports "HOL-Library.Word" More_Word
begin

definition
  strict_part_mono :: "'a set \<Rightarrow> ('a :: order \<Rightarrow> 'b :: order) \<Rightarrow> bool" where
 "strict_part_mono S f \<equiv> \<forall>A\<in>S. \<forall>B\<in>S. A < B \<longrightarrow> f A < f B"

lemma strict_part_mono_by_steps:
  "strict_part_mono {..n :: nat} f = (n \<noteq> 0 \<longrightarrow> f (n - 1) < f n \<and> strict_part_mono {.. n - 1} f)"
  apply (cases n; simp add: strict_part_mono_def)
  apply (safe; clarsimp)
  apply (case_tac "B = Suc nat"; simp)
  apply (case_tac "A = nat"; clarsimp)
  apply (erule order_less_trans [rotated])
  apply simp
  done

lemma strict_part_mono_singleton[simp]:
  "strict_part_mono {x} f"
  by (simp add: strict_part_mono_def)

lemma strict_part_mono_lt:
  "\<lbrakk> x < f 0; strict_part_mono {.. n :: nat} f \<rbrakk> \<Longrightarrow> \<forall>m \<le> n. x < f m"
  by (metis atMost_iff le_0_eq le_cases neq0_conv order.strict_trans strict_part_mono_def)

lemma strict_part_mono_reverseE:
  "\<lbrakk> f n \<le> f m; strict_part_mono {.. N :: nat} f; n \<le> N \<rbrakk> \<Longrightarrow> n \<le> m"
  by (rule ccontr) (fastforce simp: linorder_not_le strict_part_mono_def)

lemma two_power_strict_part_mono:
  "strict_part_mono {..LENGTH('a) - 1} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
proof -
  { fix n
    have "n < LENGTH('a) \<Longrightarrow> strict_part_mono {..n} (\<lambda>x. (2 :: 'a :: len word) ^ x)"
    proof (induct n)
      case 0 then show ?case by simp
    next
      case (Suc n)
      from Suc.prems
      have "2 ^ n < (2 :: 'a :: len word) ^ Suc n"
        using power_strict_increasing unat_power_lower word_less_nat_alt by fastforce
      with Suc
      show ?case by (subst strict_part_mono_by_steps) simp
    qed
  }
  then show ?thesis by simp
qed

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_regexp_RecPlus
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype A = X | Y

datatype R
         = Nil | Eps | Atom "A" | Plus "R" "R" | Seq "R" "R" | Star "R"

fun seq :: "R => R => R" where
"seq x y =
   (case x of
      Nil => Nil
      | other =>
          (case y of
             Nil => Nil
             | other =>
                 (case x of
                    Eps => y
                    | other =>
                        (case y of
                           Eps => x
                           | other => Seq x y))))"

fun plus :: "R => R => R" where
"plus x y =
   (case x of
      Nil => y
      | other =>
          (case y of
             Nil => x
             | other => Plus x y))"

fun eqA :: "A => A => bool" where
"eqA (X) (X) = True"
| "eqA (X) (Y) = False"
| "eqA (Y) (X) = False"
| "eqA (Y) (Y) = True"

fun eps :: "R => bool" where
"eps x =
   (case x of
      Eps => True
      | Plus p q => ((eps p) | (eps q))
      | Seq r q2 => ((eps r) & (eps q2))
      | Star y => True
      | other => False)"

fun epsR :: "R => R" where
"epsR x = (if eps x then Eps else Nil)"

fun step :: "R => A => R" where
"step x y =
   (case x of
      Atom a => (if eqA a y then Eps else Nil)
      | Plus p q => plus (step p y) (step q y)
      | Seq r q2 => plus (seq (step r y) q2) (seq (epsR r) (step q2 y))
      | Star p2 => seq (step p2 y) x
      | other => Nil)"

fun recognise :: "R => A list => bool" where
"recognise x (nil2) = eps x"
| "recognise x (cons2 z xs) = recognise (step x z) xs"

theorem property0 :
  "((recognise (Plus p q) s) = ((recognise p s) | (recognise q s)))"
  oops

end


(*  Title:      HOL/Word/Bits_Z2.thy
    Author:     Author: Brian Huffman, PSU and Gerwin Klein, NICTA
*)

section \<open>Bit operations in $\cal Z_2$\<close>

theory Bits_Z2
  imports Bits "HOL-Library.Z2"
begin

instantiation bit :: bit_operations
begin

primrec bitNOT_bit
  where
    "NOT 0 = (1::bit)"
  | "NOT 1 = (0::bit)"

primrec bitAND_bit
  where
    "0 AND y = (0::bit)"
  | "1 AND y = (y::bit)"

primrec bitOR_bit
  where
    "0 OR y = (y::bit)"
  | "1 OR y = (1::bit)"

primrec bitXOR_bit
  where
    "0 XOR y = (y::bit)"
  | "1 XOR y = (NOT y :: bit)"

instance  ..

end

lemmas bit_simps =
  bitNOT_bit.simps bitAND_bit.simps bitOR_bit.simps bitXOR_bit.simps

lemma bit_extra_simps [simp]:
  "x AND 0 = 0"
  "x AND 1 = x"
  "x OR 1 = 1"
  "x OR 0 = x"
  "x XOR 1 = NOT x"
  "x XOR 0 = x"
  for x :: bit
  by (cases x; auto)+

lemma bit_ops_comm:
  "x AND y = y AND x"
  "x OR y = y OR x"
  "x XOR y = y XOR x"
  for x :: bit
  by (cases y; auto)+

lemma bit_ops_same [simp]:
  "x AND x = x"
  "x OR x = x"
  "x XOR x = 0"
  for x :: bit
  by (cases x; auto)+

lemma bit_not_not [simp]: "NOT (NOT x) = x"
  for x :: bit
  by (cases x) auto

lemma bit_or_def: "b OR c = NOT (NOT b AND NOT c)"
  for b c :: bit
  by (induct b) simp_all

lemma bit_xor_def: "b XOR c = (b AND NOT c) OR (NOT b AND c)"
  for b c :: bit
  by (induct b) simp_all

lemma bit_NOT_eq_1_iff [simp]: "NOT b = 1 \<longleftrightarrow> b = 0"
  for b :: bit
  by (induct b) simp_all

lemma bit_AND_eq_1_iff [simp]: "a AND b = 1 \<longleftrightarrow> a = 1 \<and> b = 1"
  for a b :: bit
  by (induct a) simp_all

lemma bit_nand_same [simp]: "x AND NOT x = 0"
  for x :: bit
  by (cases x) simp_all

end


(* Author: Tobias Nipkow *)

section \<open>2-3 Tree Implementation of Sets\<close>

theory Tree23_Set
imports
  Tree23
  Cmp
  Set_Specs
begin

declare sorted_wrt.simps(2)[simp del]

definition empty :: "'a tree23" where
"empty = Leaf"

fun isin :: "'a::linorder tree23 \<Rightarrow> 'a \<Rightarrow> bool" where
"isin Leaf x = False" |
"isin (Node2 l a r) x =
  (case cmp x a of
     LT \<Rightarrow> isin l x |
     EQ \<Rightarrow> True |
     GT \<Rightarrow> isin r x)" |
"isin (Node3 l a m b r) x =
  (case cmp x a of
     LT \<Rightarrow> isin l x |
     EQ \<Rightarrow> True |
     GT \<Rightarrow>
       (case cmp x b of
          LT \<Rightarrow> isin m x |
          EQ \<Rightarrow> True |
          GT \<Rightarrow> isin r x))"

datatype 'a upI = TI "'a tree23" | OF "'a tree23" 'a "'a tree23"

fun treeI :: "'a upI \<Rightarrow> 'a tree23" where
"treeI (TI t) = t" |
"treeI (OF l a r) = Node2 l a r"

fun ins :: "'a::linorder \<Rightarrow> 'a tree23 \<Rightarrow> 'a upI" where
"ins x Leaf = OF Leaf x Leaf" |
"ins x (Node2 l a r) =
   (case cmp x a of
      LT \<Rightarrow>
        (case ins x l of
           TI l' => TI (Node2 l' a r) |
           OF l1 b l2 => TI (Node3 l1 b l2 a r)) |
      EQ \<Rightarrow> TI (Node2 l a r) |
      GT \<Rightarrow>
        (case ins x r of
           TI r' => TI (Node2 l a r') |
           OF r1 b r2 => TI (Node3 l a r1 b r2)))" |
"ins x (Node3 l a m b r) =
   (case cmp x a of
      LT \<Rightarrow>
        (case ins x l of
           TI l' => TI (Node3 l' a m b r) |
           OF l1 c l2 => OF (Node2 l1 c l2) a (Node2 m b r)) |
      EQ \<Rightarrow> TI (Node3 l a m b r) |
      GT \<Rightarrow>
        (case cmp x b of
           GT \<Rightarrow>
             (case ins x r of
                TI r' => TI (Node3 l a m b r') |
                OF r1 c r2 => OF (Node2 l a m) b (Node2 r1 c r2)) |
           EQ \<Rightarrow> TI (Node3 l a m b r) |
           LT \<Rightarrow>
             (case ins x m of
                TI m' => TI (Node3 l a m' b r) |
                OF m1 c m2 => OF (Node2 l a m1) c (Node2 m2 b r))))"

hide_const insert

definition insert :: "'a::linorder \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
"insert x t = treeI(ins x t)"

datatype 'a upD = TD "'a tree23" | UF "'a tree23"

fun treeD :: "'a upD \<Rightarrow> 'a tree23" where
"treeD (TD t) = t" |
"treeD (UF t) = t"

(* Variation: return None to signal no-change *)

fun node21 :: "'a upD \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a upD" where
"node21 (TD t1) a t2 = TD(Node2 t1 a t2)" |
"node21 (UF t1) a (Node2 t2 b t3) = UF(Node3 t1 a t2 b t3)" |
"node21 (UF t1) a (Node3 t2 b t3 c t4) = TD(Node2 (Node2 t1 a t2) b (Node2 t3 c t4))"

fun node22 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a upD \<Rightarrow> 'a upD" where
"node22 t1 a (TD t2) = TD(Node2 t1 a t2)" |
"node22 (Node2 t1 b t2) a (UF t3) = UF(Node3 t1 b t2 a t3)" |
"node22 (Node3 t1 b t2 c t3) a (UF t4) = TD(Node2 (Node2 t1 b t2) c (Node2 t3 a t4))"

fun node31 :: "'a upD \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a upD" where
"node31 (TD t1) a t2 b t3 = TD(Node3 t1 a t2 b t3)" |
"node31 (UF t1) a (Node2 t2 b t3) c t4 = TD(Node2 (Node3 t1 a t2 b t3) c t4)" |
"node31 (UF t1) a (Node3 t2 b t3 c t4) d t5 = TD(Node3 (Node2 t1 a t2) b (Node2 t3 c t4) d t5)"

fun node32 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a upD \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a upD" where
"node32 t1 a (TD t2) b t3 = TD(Node3 t1 a t2 b t3)" |
"node32 t1 a (UF t2) b (Node2 t3 c t4) = TD(Node2 t1 a (Node3 t2 b t3 c t4))" |
"node32 t1 a (UF t2) b (Node3 t3 c t4 d t5) = TD(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"

fun node33 :: "'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a tree23 \<Rightarrow> 'a \<Rightarrow> 'a upD \<Rightarrow> 'a upD" where
"node33 l a m b (TD r) = TD(Node3 l a m b r)" |
"node33 t1 a (Node2 t2 b t3) c (UF t4) = TD(Node2 t1 a (Node3 t2 b t3 c t4))" |
"node33 t1 a (Node3 t2 b t3 c t4) d (UF t5) = TD(Node3 t1 a (Node2 t2 b t3) c (Node2 t4 d t5))"

fun split_min :: "'a tree23 \<Rightarrow> 'a * 'a upD" where
"split_min (Node2 Leaf a Leaf) = (a, UF Leaf)" |
"split_min (Node3 Leaf a Leaf b Leaf) = (a, TD(Node2 Leaf b Leaf))" |
"split_min (Node2 l a r) = (let (x,l') = split_min l in (x, node21 l' a r))" |
"split_min (Node3 l a m b r) = (let (x,l') = split_min l in (x, node31 l' a m b r))"

text \<open>In the base cases of \<open>split_min\<close> and \<open>del\<close> it is enough to check if one subtree is a \<open>Leaf\<close>,
in which case completeness implies that so are the others. Exercise.\<close>

fun del :: "'a::linorder \<Rightarrow> 'a tree23 \<Rightarrow> 'a upD" where
"del x Leaf = TD Leaf" |
"del x (Node2 Leaf a Leaf) =
  (if x = a then UF Leaf else TD(Node2 Leaf a Leaf))" |
"del x (Node3 Leaf a Leaf b Leaf) =
  TD(if x = a then Node2 Leaf b Leaf else
     if x = b then Node2 Leaf a Leaf
     else Node3 Leaf a Leaf b Leaf)" |
"del x (Node2 l a r) =
  (case cmp x a of
     LT \<Rightarrow> node21 (del x l) a r |
     GT \<Rightarrow> node22 l a (del x r) |
     EQ \<Rightarrow> let (a',r') = split_min r in node22 l a' r')" |
"del x (Node3 l a m b r) =
  (case cmp x a of
     LT \<Rightarrow> node31 (del x l) a m b r |
     EQ \<Rightarrow> let (a',m') = split_min m in node32 l a' m' b r |
     GT \<Rightarrow>
       (case cmp x b of
          LT \<Rightarrow> node32 l a (del x m) b r |
          EQ \<Rightarrow> let (b',r') = split_min r in node33 l a m b' r' |
          GT \<Rightarrow> node33 l a m b (del x r)))"

definition delete :: "'a::linorder \<Rightarrow> 'a tree23 \<Rightarrow> 'a tree23" where
"delete x t = treeD(del x t)"

subsection "Functional Correctness"

subsubsection "Proofs for isin"

lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> set (inorder t))"
by (induction t) (auto simp: isin_simps)

subsubsection "Proofs for insert"

lemma inorder_ins:
  "sorted(inorder t) \<Longrightarrow> inorder(treeI(ins x t)) = ins_list x (inorder t)"
by(induction t) (auto simp: ins_list_simps split: upI.splits)

lemma inorder_insert:
  "sorted(inorder t) \<Longrightarrow> inorder(insert a t) = ins_list a (inorder t)"
by(simp add: insert_def inorder_ins)

subsubsection "Proofs for delete"

lemma inorder_node21: "height r > 0 \<Longrightarrow>
  inorder (treeD (node21 l' a r)) = inorder (treeD l') @ a # inorder r"
by(induct l' a r rule: node21.induct) auto

lemma inorder_node22: "height l > 0 \<Longrightarrow>
  inorder (treeD (node22 l a r')) = inorder l @ a # inorder (treeD r')"
by(induct l a r' rule: node22.induct) auto

lemma inorder_node31: "height m > 0 \<Longrightarrow>
  inorder (treeD (node31 l' a m b r)) = inorder (treeD l') @ a # inorder m @ b # inorder r"
by(induct l' a m b r rule: node31.induct) auto

lemma inorder_node32: "height r > 0 \<Longrightarrow>
  inorder (treeD (node32 l a m' b r)) = inorder l @ a # inorder (treeD m') @ b # inorder r"
by(induct l a m' b r rule: node32.induct) auto

lemma inorder_node33: "height m > 0 \<Longrightarrow>
  inorder (treeD (node33 l a m b r')) = inorder l @ a # inorder m @ b # inorder (treeD r')"
by(induct l a m b r' rule: node33.induct) auto

lemmas inorder_nodes = inorder_node21 inorder_node22
  inorder_node31 inorder_node32 inorder_node33

lemma split_minD:
  "split_min t = (x,t') \<Longrightarrow> complete t \<Longrightarrow> height t > 0 \<Longrightarrow>
  x # inorder(treeD t') = inorder t"
by(induction t arbitrary: t' rule: split_min.induct)
  (auto simp: inorder_nodes split: prod.splits)

lemma inorder_del: "\<lbrakk> complete t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  inorder(treeD (del x t)) = del_list x (inorder t)"
by(induction t rule: del.induct)
  (auto simp: del_list_simps inorder_nodes split_minD split!: if_split prod.splits)

lemma inorder_delete: "\<lbrakk> complete t ; sorted(inorder t) \<rbrakk> \<Longrightarrow>
  inorder(delete x t) = del_list x (inorder t)"
by(simp add: delete_def inorder_del)

subsection \<open>Completeness\<close>

subsubsection "Proofs for insert"

text\<open>First a standard proof that \<^const>\<open>ins\<close> preserves \<^const>\<open>complete\<close>.\<close>

fun hI :: "'a upI \<Rightarrow> nat" where
"hI (TI t) = height t" |
"hI (OF l a r) = height l"

lemma complete_ins: "complete t \<Longrightarrow> complete (treeI(ins a t)) \<and> hI(ins a t) = height t"
by (induct t) (auto split!: if_split upI.split) (* 15 secs in 2015 *)

text\<open>Now an alternative proof (by Brian Huffman) that runs faster because
two properties (completeness and height) are combined in one predicate.\<close>

inductive full :: "nat \<Rightarrow> 'a tree23 \<Rightarrow> bool" where
"full 0 Leaf" |
"\<lbrakk>full n l; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node2 l p r)" |
"\<lbrakk>full n l; full n m; full n r\<rbrakk> \<Longrightarrow> full (Suc n) (Node3 l p m q r)"

inductive_cases full_elims:
  "full n Leaf"
  "full n (Node2 l p r)"
  "full n (Node3 l p m q r)"

inductive_cases full_0_elim: "full 0 t"
inductive_cases full_Suc_elim: "full (Suc n) t"

lemma full_0_iff [simp]: "full 0 t \<longleftrightarrow> t = Leaf"
  by (auto elim: full_0_elim intro: full.intros)

lemma full_Leaf_iff [simp]: "full n Leaf \<longleftrightarrow> n = 0"
  by (auto elim: full_elims intro: full.intros)

lemma full_Suc_Node2_iff [simp]:
  "full (Suc n) (Node2 l p r) \<longleftrightarrow> full n l \<and> full n r"
  by (auto elim: full_elims intro: full.intros)

lemma full_Suc_Node3_iff [simp]:
  "full (Suc n) (Node3 l p m q r) \<longleftrightarrow> full n l \<and> full n m \<and> full n r"
  by (auto elim: full_elims intro: full.intros)

lemma full_imp_height: "full n t \<Longrightarrow> height t = n"
  by (induct set: full, simp_all)

lemma full_imp_complete: "full n t \<Longrightarrow> complete t"
  by (induct set: full, auto dest: full_imp_height)

lemma complete_imp_full: "complete t \<Longrightarrow> full (height t) t"
  by (induct t, simp_all)

lemma complete_iff_full: "complete t \<longleftrightarrow> (\<exists>n. full n t)"
  by (auto elim!: complete_imp_full full_imp_complete)

text \<open>The \<^const>\<open>insert\<close> function either preserves the height of the
tree, or increases it by one. The constructor returned by the \<^term>\<open>insert\<close> function determines which: A return value of the form \<^term>\<open>TI t\<close> indicates that the height will be the same. A value of the
form \<^term>\<open>OF l p r\<close> indicates an increase in height.\<close>

fun full\<^sub>i :: "nat \<Rightarrow> 'a upI \<Rightarrow> bool" where
"full\<^sub>i n (TI t) \<longleftrightarrow> full n t" |
"full\<^sub>i n (OF l p r) \<longleftrightarrow> full n l \<and> full n r"

lemma full\<^sub>i_ins: "full n t \<Longrightarrow> full\<^sub>i n (ins a t)"
by (induct rule: full.induct) (auto split: upI.split)

text \<open>The \<^const>\<open>insert\<close> operation preserves completeance.\<close>

lemma complete_insert: "complete t \<Longrightarrow> complete (insert a t)"
unfolding complete_iff_full insert_def
apply (erule exE)
apply (drule full\<^sub>i_ins [of _ _ a])
apply (cases "ins a t")
apply (auto intro: full.intros)
done

subsection "Proofs for delete"

fun hD :: "'a upD \<Rightarrow> nat" where
"hD (TD t) = height t" |
"hD (UF t) = height t + 1"

lemma complete_treeD_node21:
  "\<lbrakk>complete r; complete (treeD l'); height r = hD l' \<rbrakk> \<Longrightarrow> complete (treeD (node21 l' a r))"
by(induct l' a r rule: node21.induct) auto

lemma complete_treeD_node22:
  "\<lbrakk>complete(treeD r'); complete l; hD r' = height l \<rbrakk> \<Longrightarrow> complete (treeD (node22 l a r'))"
by(induct l a r' rule: node22.induct) auto

lemma complete_treeD_node31:
  "\<lbrakk> complete (treeD l'); complete m; complete r; hD l' = height r; height m = height r \<rbrakk>
  \<Longrightarrow> complete (treeD (node31 l' a m b r))"
by(induct l' a m b r rule: node31.induct) auto

lemma complete_treeD_node32:
  "\<lbrakk> complete l; complete (treeD m'); complete r; height l = height r; hD m' = height r \<rbrakk>
  \<Longrightarrow> complete (treeD (node32 l a m' b r))"
by(induct l a m' b r rule: node32.induct) auto

lemma complete_treeD_node33:
  "\<lbrakk> complete l; complete m; complete(treeD r'); height l = hD r'; height m = hD r' \<rbrakk>
  \<Longrightarrow> complete (treeD (node33 l a m b r'))"
by(induct l a m b r' rule: node33.induct) auto

lemmas completes = complete_treeD_node21 complete_treeD_node22
  complete_treeD_node31 complete_treeD_node32 complete_treeD_node33

lemma height'_node21:
   "height r > 0 \<Longrightarrow> hD(node21 l' a r) = max (hD l') (height r) + 1"
by(induct l' a r rule: node21.induct)(simp_all)

lemma height'_node22:
   "height l > 0 \<Longrightarrow> hD(node22 l a r') = max (height l) (hD r') + 1"
by(induct l a r' rule: node22.induct)(simp_all)

lemma height'_node31:
  "height m > 0 \<Longrightarrow> hD(node31 l a m b r) =
   max (hD l) (max (height m) (height r)) + 1"
by(induct l a m b r rule: node31.induct)(simp_all add: max_def)

lemma height'_node32:
  "height r > 0 \<Longrightarrow> hD(node32 l a m b r) =
   max (height l) (max (hD m) (height r)) + 1"
by(induct l a m b r rule: node32.induct)(simp_all add: max_def)

lemma height'_node33:
  "height m > 0 \<Longrightarrow> hD(node33 l a m b r) =
   max (height l) (max (height m) (hD r)) + 1"
by(induct l a m b r rule: node33.induct)(simp_all add: max_def)

lemmas heights = height'_node21 height'_node22
  height'_node31 height'_node32 height'_node33

lemma height_split_min:
  "split_min t = (x, t') \<Longrightarrow> height t > 0 \<Longrightarrow> complete t \<Longrightarrow> hD t' = height t"
by(induct t arbitrary: x t' rule: split_min.induct)
  (auto simp: heights split: prod.splits)

lemma height_del: "complete t \<Longrightarrow> hD(del x t) = height t"
by(induction x t rule: del.induct)
  (auto simp: heights max_def height_split_min split: prod.splits)

lemma complete_split_min:
  "\<lbrakk> split_min t = (x, t'); complete t; height t > 0 \<rbrakk> \<Longrightarrow> complete (treeD t')"
by(induct t arbitrary: x t' rule: split_min.induct)
  (auto simp: heights height_split_min completes split: prod.splits)

lemma complete_treeD_del: "complete t \<Longrightarrow> complete(treeD(del x t))"
by(induction x t rule: del.induct)
  (auto simp: completes complete_split_min height_del height_split_min split: prod.splits)

corollary complete_delete: "complete t \<Longrightarrow> complete(delete x t)"
by(simp add: delete_def complete_treeD_del)

subsection \<open>Overall Correctness\<close>

interpretation S: Set_by_Ordered
where empty = empty and isin = isin and insert = insert and delete = delete
and inorder = inorder and inv = complete
proof (standard, goal_cases)
  case 2 thus ?case by(simp add: isin_set)
next
  case 3 thus ?case by(simp add: inorder_insert)
next
  case 4 thus ?case by(simp add: inorder_delete)
next
  case 6 thus ?case by(simp add: complete_insert)
next
  case 7 thus ?case by(simp add: complete_delete)
qed (simp add: empty_def)+

end


theory tree_Flatten3
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a list = Nil2 | Cons2 "'a" "'a list"

datatype 'a Tree = Node "'a Tree" "'a" "'a Tree" | Nil2

fun flatten3 :: "'a Tree => 'a list" where
"flatten3 (Node (Node p x2 q) z r) =
   flatten3 (Node p x2 (Node q z r))"
| "flatten3 (Node (Nil2) z r) = Cons2 z (flatten3 r)"
| "flatten3 (Nil2) = Nil2"

fun append :: "'a list => 'a list => 'a list" where
"append (Nil2) y = y"
| "append (Cons2 z xs) y = Cons2 z (append xs y)"

fun flatten0 :: "'a Tree => 'a list" where
"flatten0 (Node p y q) =
   append (append (flatten0 p) (Cons2 y (Nil2))) (flatten0 q)"
| "flatten0 (Nil2) = Nil2"

(*hipster flatten3 append flatten0 *)

theorem x0 :
  "!! (p :: 'a Tree) . (flatten3 p) = (flatten0 p)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


(*    Title:              SatSolverVerification/NieuwenhuisOliverasTinelli.thy
      Author:             Filip Maric
      Maintainer:         Filip Maric <filip at matf.bg.ac.yu>
*)

header{* Transition system of Nieuwenhuis, Oliveras and Tinelli. *}
theory NieuwenhuisOliverasTinelli
imports SatSolverVerification
begin

text{* This theory formalizes the transition rule system given by
Nieuwenhuis et al. in \cite{NieuwenhuisOliverasTinelli} *}

(******************************************************************************)
subsection{* Specification *}
(******************************************************************************)

record State =
"getF" :: Formula
"getM" :: LiteralTrail

definition
appliedDecide:: "State \<Rightarrow> State \<Rightarrow> Variable set \<Rightarrow> bool"
where
"appliedDecide stateA stateB decisionVars ==
  \<exists> l.
        (var l) \<in> decisionVars \<and>
        \<not> l el (elements (getM stateA)) \<and>
        \<not> opposite l el (elements (getM stateA)) \<and>

        getF stateB = getF stateA \<and>
        getM stateB = getM stateA @ [(l, True)]
"
definition
applicableDecide :: "State \<Rightarrow> Variable set \<Rightarrow> bool"
where
"applicableDecide state decisionVars == \<exists> state'. appliedDecide state state' decisionVars"

definition
appliedUnitPropagate :: "State \<Rightarrow> State \<Rightarrow> bool"
where
"appliedUnitPropagate stateA stateB ==
  \<exists> (uc::Clause) (ul::Literal).
       uc el (getF stateA) \<and>
       isUnitClause uc ul (elements (getM stateA)) \<and>

       getF stateB = getF stateA \<and>
       getM stateB = getM stateA @ [(ul, False)]
"
definition
applicableUnitPropagate :: "State \<Rightarrow> bool"
where
"applicableUnitPropagate state == \<exists> state'. appliedUnitPropagate state state'"

definition
appliedBackjump :: "State \<Rightarrow> State \<Rightarrow> bool"
where
"appliedBackjump stateA stateB ==
  \<exists> bc bl level.
       isUnitClause bc bl (elements (prefixToLevel level (getM stateA))) \<and>
       formulaEntailsClause (getF stateA) bc \<and>
       var bl \<in> vars (getF stateA) \<union> vars (elements (getM stateA)) \<and>
       0 \<le> level \<and> level < (currentLevel (getM stateA)) \<and>

       getF stateB = getF stateA \<and>
       getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]
"
definition
applicableBackjump :: "State \<Rightarrow> bool"
where
"applicableBackjump state ==  \<exists> state'. appliedBackjump state state'"

definition
appliedLearn :: "State \<Rightarrow> State \<Rightarrow> bool"
where
"appliedLearn stateA stateB ==
  \<exists> c.
       (formulaEntailsClause (getF stateA) c) \<and>
       (vars c) \<subseteq> vars (getF stateA) \<union> vars (elements (getM stateA)) \<and>
       getF stateB = getF stateA @ [c] \<and>
       getM stateB = getM stateA
"
definition
applicableLearn :: "State \<Rightarrow> bool"
where
"applicableLearn state == (\<exists> state'. appliedLearn state state')"

text{* Solving starts with the initial formula and the empty trail. *}
definition
isInitialState :: "State \<Rightarrow> Formula \<Rightarrow> bool"
where
"isInitialState state F0 ==
      getF state = F0 \<and>
      getM state = []
"

text{* Transitions are preformed only by using given rules. *}
definition
"transition stateA stateB decisionVars ==
     appliedDecide        stateA stateB decisionVars \<or>
     appliedUnitPropagate stateA stateB \<or>
     appliedLearn         stateA stateB \<or>
     appliedBackjump      stateA stateB
"

text{* Transition relation is obtained by applying transition rules
iteratively. It is defined using a reflexive-transitive closure. *}
definition
"transitionRelation decisionVars == ({(stateA, stateB). transition stateA stateB decisionVars})^*"

text{* Final state is one in which no rules apply *}
definition
isFinalState :: "State \<Rightarrow> Variable set \<Rightarrow> bool"
where
"isFinalState state decisionVars == \<not> (\<exists> state'. transition state state' decisionVars)"

text{* The following several lemmas establish conditions for applicability of different rules. *}
lemma applicableDecideCharacterization:
  fixes stateA::State
  shows "applicableDecide stateA decisionVars =
  (\<exists> l.
        (var l) \<in> decisionVars \<and>
        \<not> l el (elements (getM stateA)) \<and>
        \<not> opposite l el (elements (getM stateA)))
  " (is "?lhs = ?rhs")
proof
  assume ?rhs
  then obtain l where
    *: "(var l) \<in> decisionVars" "\<not> l el (elements (getM stateA))" "\<not> opposite l el (elements (getM stateA))"
    unfolding applicableDecide_def
    by auto
  let ?stateB = "stateA\<lparr> getM := (getM stateA) @ [(l, True)] \<rparr>"
  from * have "appliedDecide stateA ?stateB decisionVars"
    unfolding appliedDecide_def
    by auto
  thus ?lhs
    unfolding applicableDecide_def
    by auto
next
  assume ?lhs
  then obtain stateB l
    where "(var l) \<in> decisionVars" "\<not> l el (elements (getM stateA))"
    "\<not> opposite l el (elements (getM stateA))"
    unfolding applicableDecide_def
    unfolding appliedDecide_def
    by auto
  thus ?rhs
    by auto
qed

lemma applicableUnitPropagateCharacterization:
  fixes stateA::State and F0::Formula
  shows "applicableUnitPropagate stateA =
  (\<exists> (uc::Clause) (ul::Literal).
       uc el (getF stateA) \<and>
       isUnitClause uc ul (elements (getM stateA)))
  " (is "?lhs = ?rhs")
proof
  assume "?rhs"
  then obtain ul uc
    where *: "uc el (getF stateA)" "isUnitClause uc ul (elements (getM stateA))"
    unfolding applicableUnitPropagate_def
    by auto
  let ?stateB = "stateA\<lparr> getM := getM stateA @ [(ul, False)] \<rparr>"
  from * have "appliedUnitPropagate stateA ?stateB"
    unfolding appliedUnitPropagate_def
    by auto
  thus ?lhs
    unfolding applicableUnitPropagate_def
    by auto
next
  assume ?lhs
  then obtain stateB uc ul
    where "uc el (getF stateA)" "isUnitClause uc ul (elements (getM stateA))"
    unfolding applicableUnitPropagate_def
    unfolding appliedUnitPropagate_def
    by auto
  thus ?rhs
    by auto
qed

lemma applicableLearnCharacterization:
  fixes stateA::State
  shows "applicableLearn stateA =
    (\<exists> c. formulaEntailsClause (getF stateA) c \<and>
          vars c \<subseteq> vars (getF stateA) \<union>  vars (elements (getM stateA)))" (is "?lhs = ?rhs")
proof
  assume "?rhs"
  then obtain c where
  *: "formulaEntailsClause (getF stateA) c"
     "vars c \<subseteq> vars (getF stateA) \<union>  vars (elements (getM stateA))"
    unfolding applicableLearn_def
    by auto
  let ?stateB = "stateA\<lparr> getF := getF stateA @ [c]\<rparr>"
  from * have "appliedLearn stateA ?stateB"
    unfolding appliedLearn_def
    by auto
  thus "?lhs"
    unfolding applicableLearn_def
    by auto
next
  assume "?lhs"
  then obtain c stateB
    where
    "formulaEntailsClause (getF stateA) c"
    "vars c \<subseteq> vars (getF stateA) \<union> vars (elements (getM stateA))"
    unfolding applicableLearn_def
    unfolding appliedLearn_def
    by auto
  thus "?rhs"
    by auto
qed

text{* Final states are the ones where no rule is applicable. *}
lemma finalStateNonApplicable:
  fixes state::State
  shows "isFinalState state decisionVars =
          (\<not> applicableDecide state decisionVars \<and>
           \<not> applicableUnitPropagate state \<and>
           \<not> applicableBackjump state \<and>
           \<not> applicableLearn state)"
unfolding isFinalState_def
unfolding transition_def
unfolding applicableDecide_def
unfolding applicableUnitPropagate_def
unfolding applicableBackjump_def
unfolding applicableLearn_def
by auto

(******************************************************************************)
subsection{* Invariants *}
(******************************************************************************)
text{* Invariants that are relevant for the rest of correctness proof. *}
definition
invariantsHoldInState :: "State \<Rightarrow> Formula \<Rightarrow> Variable set \<Rightarrow> bool"
where
"invariantsHoldInState state F0 decisionVars ==
    InvariantImpliedLiterals (getF state) (getM state) \<and>
    InvariantVarsM (getM state) F0 decisionVars \<and>
    InvariantVarsF (getF state) F0 decisionVars \<and>
    InvariantConsistent (getM state) \<and>
    InvariantUniq (getM state) \<and>
    InvariantEquivalent F0 (getF state)
"

text{* Invariants hold in initial states. *}
lemma invariantsHoldInInitialState:
  fixes state :: State and F0 :: Formula
  assumes "isInitialState state F0"
  shows "invariantsHoldInState state F0 decisionVars"
using assms
by (auto simp add:
  isInitialState_def
  invariantsHoldInState_def
  InvariantImpliedLiterals_def
  InvariantVarsM_def
  InvariantVarsF_def
  InvariantConsistent_def
  InvariantUniq_def
  InvariantEquivalent_def equivalentFormulae_def
)

text{* Valid transitions preserve invariants. *}
lemma transitionsPreserveInvariants:
  fixes stateA::State and stateB::State
  assumes "transition stateA stateB decisionVars" and
  "invariantsHoldInState stateA F0 decisionVars"
  shows "invariantsHoldInState stateB F0 decisionVars"
proof-
    from `invariantsHoldInState stateA F0 decisionVars`
    have
      "InvariantImpliedLiterals (getF stateA) (getM stateA)" and
      "InvariantVarsM (getM stateA) F0 decisionVars" and
      "InvariantVarsF (getF stateA) F0 decisionVars" and
      "InvariantConsistent (getM stateA)" and
      "InvariantUniq (getM stateA)" and
      "InvariantEquivalent F0 (getF stateA)"
      unfolding invariantsHoldInState_def
      by auto
  {
    assume "appliedDecide stateA stateB decisionVars"
    then obtain l::Literal where
      "(var l) \<in> decisionVars"
      "\<not> literalTrue l (elements (getM stateA))"
      "\<not> literalFalse l (elements (getM stateA))"
      "getM stateB = getM stateA @ [(l, True)]"
      "getF stateB = getF stateA"
      unfolding appliedDecide_def
      by auto

    from `\<not> literalTrue l (elements (getM stateA))` `\<not> literalFalse l (elements (getM stateA))`
    have *: "var l \<notin> vars (elements (getM stateA))"
      using variableDefinedImpliesLiteralDefined[of "l" "elements (getM stateA)"]
      by simp

    have "InvariantImpliedLiterals (getF stateB) (getM stateB)"
      using `getF stateB = getF stateA`
        `getM stateB = getM stateA @ [(l, True)]`
        `InvariantImpliedLiterals (getF stateA) (getM stateA)`
        `InvariantUniq (getM stateA)`
        `var l \<notin> vars (elements (getM stateA))`
        InvariantImpliedLiteralsAfterDecide[of "getF stateA" "getM stateA" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using `getM stateB = getM stateA @ [(l, True)]`
        `InvariantVarsM (getM stateA) F0 decisionVars`
        `var l \<in> decisionVars`
        InvariantVarsMAfterDecide[of "getM stateA" "F0" "decisionVars" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsF (getF stateB) F0 decisionVars"
      using `getF stateB = getF stateA`
      `InvariantVarsF (getF stateA) F0 decisionVars`
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using `getM stateB = getM stateA @ [(l, True)]`
        `InvariantConsistent (getM stateA)`
        `var l \<notin> vars (elements (getM stateA))`
        InvariantConsistentAfterDecide[of "getM stateA" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using `getM stateB = getM stateA @ [(l, True)]`
        `InvariantUniq (getM stateA)`
        `var l \<notin> vars (elements (getM stateA))`
        InvariantUniqAfterDecide[of "getM stateA" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantEquivalent F0 (getF stateB)"
      using `getF stateB = getF stateA`
      `InvariantEquivalent F0 (getF stateA)`
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  moreover
  {
    assume "appliedUnitPropagate stateA stateB"
    then obtain uc::Clause and ul::Literal where
      "uc el (getF stateA)"
      "isUnitClause uc ul (elements (getM stateA))"
      "getF stateB = getF stateA"
      "getM stateB = getM stateA @ [(ul, False)]"
      unfolding appliedUnitPropagate_def
      by auto

    from `isUnitClause uc ul (elements (getM stateA))`
    have "ul el uc"
      unfolding isUnitClause_def
      by simp

    from `uc el (getF stateA)`
    have "formulaEntailsClause (getF stateA) uc"
      by (simp add: formulaEntailsItsClauses)

    have "InvariantImpliedLiterals (getF stateB) (getM stateB)"
      using `getF stateB = getF stateA`
        `InvariantImpliedLiterals (getF stateA) (getM stateA)`
        `formulaEntailsClause (getF stateA) uc`
        `isUnitClause uc ul (elements (getM stateA))`
        `getM stateB = getM stateA @ [(ul, False)]`
        InvariantImpliedLiteralsAfterUnitPropagate[of "getF stateA" "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    moreover
    from `ul el uc` `uc el (getF stateA)`
    have "ul el (getF stateA)"
      by (auto simp add: literalElFormulaCharacterization)
    with `InvariantVarsF (getF stateA) F0 decisionVars`
    have "var ul \<in> vars F0 \<union> decisionVars"
      using "formulaContainsItsLiteralsVariable" [of "ul" "getF stateA"]
      unfolding InvariantVarsF_def
      by auto

    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using `InvariantVarsM (getM stateA) F0 decisionVars`
        `var ul \<in> vars F0 \<union> decisionVars`
        `getM stateB = getM stateA @ [(ul, False)]`
        InvariantVarsMAfterUnitPropagate[of "getM stateA" "F0" "decisionVars" "ul" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsF (getF stateB) F0 decisionVars"
      using `getF stateB = getF stateA`
      `InvariantVarsF (getF stateA) F0 decisionVars`
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using `InvariantConsistent (getM stateA)`
        `isUnitClause uc ul (elements (getM stateA))`
        `getM stateB = getM stateA @ [(ul, False)]`
        InvariantConsistentAfterUnitPropagate [of "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using `InvariantUniq (getM stateA)`
        `isUnitClause uc ul (elements (getM stateA))`
        `getM stateB = getM stateA @ [(ul, False)]`
        InvariantUniqAfterUnitPropagate [of "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    moreover
    have "InvariantEquivalent F0 (getF stateB)"
      using `getF stateB = getF stateA`
      `InvariantEquivalent F0 (getF stateA)`
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  moreover
  {
    assume "appliedLearn stateA stateB"
    then obtain c::Clause where
      "formulaEntailsClause (getF stateA) c"
      "vars c \<subseteq> vars (getF stateA) \<union> vars (elements (getM stateA))"
      "getF stateB = getF stateA @ [c]"
      "getM stateB = getM stateA"
      unfolding appliedLearn_def
      by auto

    have "InvariantImpliedLiterals (getF stateB) (getM stateB)"
      using
        `InvariantImpliedLiterals (getF stateA) (getM stateA)`
        `getF stateB = getF stateA @ [c]`
        `getM stateB = getM stateA`
        InvariantImpliedLiteralsAfterLearn[of "getF stateA" "getM stateA" "getF stateB"]
      by simp
    moreover
    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using
        `InvariantVarsM (getM stateA) F0 decisionVars`
        `getM stateB = getM stateA`
      by simp
    moreover
    from `vars c \<subseteq> vars (getF stateA) \<union> vars (elements (getM stateA))`
      `InvariantVarsM (getM stateA) F0 decisionVars`
        `InvariantVarsF (getF stateA) F0 decisionVars`
    have "vars c \<subseteq> vars F0 \<union> decisionVars"
      unfolding InvariantVarsM_def
      unfolding InvariantVarsF_def
      by auto
    hence "InvariantVarsF (getF stateB) F0 decisionVars"
      using `InvariantVarsF (getF stateA) F0 decisionVars`
        `getF stateB = getF stateA @ [c]`
      using varsAppendFormulae [of "getF stateA" "[c]"]
      unfolding InvariantVarsF_def
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using `InvariantConsistent (getM stateA)`
        `getM stateB = getM stateA`
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using `InvariantUniq (getM stateA)`
        `getM stateB = getM stateA`
      by simp
    moreover
    have "InvariantEquivalent F0 (getF stateB)"
      using
        `InvariantEquivalent F0 (getF stateA)`
        `formulaEntailsClause (getF stateA) c`
        `getF stateB = getF stateA @ [c]`
        InvariantEquivalentAfterLearn[of "F0" "getF stateA" "c" "getF stateB"]
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by simp
  }
  moreover
  {
    assume "appliedBackjump stateA stateB"
    then obtain bc::Clause and bl::Literal and level::nat
      where
      "isUnitClause bc bl (elements (prefixToLevel level (getM stateA)))"
      "formulaEntailsClause (getF stateA) bc"
      "var bl \<in> vars (getF stateA) \<union> vars (elements (getM stateA))"
      "getF stateB = getF stateA"
      "getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]"
      unfolding appliedBackjump_def
      by auto

    have "isPrefix (prefixToLevel level (getM stateA)) (getM stateA)"
      by (simp add:isPrefixPrefixToLevel)

    have "InvariantImpliedLiterals (getF stateB) (getM stateB)"
      using `InvariantImpliedLiterals (getF stateA) (getM stateA)`
        `isPrefix (prefixToLevel level (getM stateA)) (getM stateA)`
        `isUnitClause bc bl (elements (prefixToLevel level (getM stateA)))`
        `formulaEntailsClause (getF stateA) bc`
        `getF stateB = getF stateA`
        `getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]`
        InvariantImpliedLiteralsAfterBackjump[of "getF stateA" "getM stateA" "prefixToLevel level (getM stateA)" "bc" "bl" "getM stateB"]
      by simp
    moreover

    from `InvariantVarsF (getF stateA) F0 decisionVars`
      `InvariantVarsM (getM stateA) F0 decisionVars`
      `var bl \<in> vars (getF stateA) \<union> vars (elements (getM stateA))`
    have "var bl \<in> vars F0 \<union> decisionVars"
      unfolding InvariantVarsM_def
      unfolding InvariantVarsF_def
      by auto

    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using `InvariantVarsM (getM stateA) F0 decisionVars`
        `isPrefix (prefixToLevel level (getM stateA)) (getM stateA)`
        `getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]`
        `var bl \<in> vars F0 \<union> decisionVars`
        InvariantVarsMAfterBackjump[of "getM stateA" "F0" "decisionVars" "prefixToLevel level (getM stateA)" "bl" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsF (getF stateB) F0 decisionVars"
      using `getF stateB = getF stateA`
      `InvariantVarsF (getF stateA) F0 decisionVars`
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using `InvariantConsistent (getM stateA)`
        `isPrefix (prefixToLevel level (getM stateA)) (getM stateA)`
        `isUnitClause bc bl (elements (prefixToLevel level (getM stateA)))`
        `getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]`
        InvariantConsistentAfterBackjump[of "getM stateA" "prefixToLevel level (getM stateA)" "bc" "bl" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using `InvariantUniq (getM stateA)`
        `isPrefix (prefixToLevel level (getM stateA)) (getM stateA)`
        `isUnitClause bc bl (elements (prefixToLevel level (getM stateA)))`
        `getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]`
        InvariantUniqAfterBackjump[of "getM stateA" "prefixToLevel level (getM stateA)" "bc" "bl" "getM stateB"]
      by simp
    moreover
    have "InvariantEquivalent F0 (getF stateB)"
      using
      `InvariantEquivalent F0 (getF stateA)`
      `getF stateB = getF stateA`
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  ultimately
  show ?thesis
    using `transition stateA stateB decisionVars`
    unfolding transition_def
    by auto
qed

text{* The consequence is that invariants hold in all valid runs. *}
lemma invariantsHoldInValidRuns:
  fixes F0 :: Formula and decisionVars :: "Variable set"
  assumes "invariantsHoldInState stateA F0 decisionVars" and
  "(stateA, stateB) \<in> transitionRelation decisionVars"
  shows "invariantsHoldInState stateB F0 decisionVars"
using assms
using transitionsPreserveInvariants
using rtrancl_induct[of "stateA" "stateB"
  "{(stateA, stateB). transition stateA stateB decisionVars}" "\<lambda> x. invariantsHoldInState x F0 decisionVars"]
unfolding transitionRelation_def
by auto

lemma invariantsHoldInValidRunsFromInitialState:
  fixes F0 :: Formula and decisionVars :: "Variable set"
  assumes "isInitialState state0 F0"
  and "(state0, state) \<in> transitionRelation decisionVars"
  shows "invariantsHoldInState state F0 decisionVars"
proof-
  from `isInitialState state0 F0`
  have "invariantsHoldInState state0 F0 decisionVars"
    by (simp add:invariantsHoldInInitialState)
  with assms
  show ?thesis
    using invariantsHoldInValidRuns [of "state0"  "F0" "decisionVars" "state"]
    by simp
qed

text{*
 In the following text we will show that there are two kinds of states:
 \begin{enumerate}
  \item \textit{UNSAT} states where @{term "formulaFalse F0 (elements (getM state))"}
  and @{term "decisions (getM state) = []"}.
  \item \textit{SAT} states where @{term "\<not> formulaFalse F0 (elements (getM state))"}
  and @{term "vars (elements (getM state)) \<supseteq> decisionVars"}
 \end{enumerate}

 The soundness theorems claim that if \textit{UNSAT} state is reached
 the formula is unsatisfiable and if \textit{SAT} state is reached,
 the formula is satisfiable.

 Completeness theorems claim that every final state is either
 \textit{UNSAT} or \textit{SAT}. A consequence of this and soundness
 theorems, is that if formula is unsatisfiable the solver will finish
 in an \textit{UNSAT} state, and if the formula is satisfiable the
 solver will finish in a \textit{SAT} state.  *}

(******************************************************************************)
subsection{* Soundness *}
(******************************************************************************)
(*----------------------------------------------------------------------------*)
theorem soundnessForUNSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars"

  "formulaFalse (getF state) (elements (getM state))"
  "decisions (getM state) = []"

  shows "\<not> satisfiable F0"
(*----------------------------------------------------------------------------*)
proof-
  from `isInitialState state0 F0` `(state0, state) \<in> transitionRelation decisionVars`
  have "invariantsHoldInState state F0 decisionVars"
    using invariantsHoldInValidRunsFromInitialState
    by simp
  hence "InvariantImpliedLiterals (getF state) (getM state)" "InvariantEquivalent F0 (getF state)"
    unfolding invariantsHoldInState_def
    by auto
  with `formulaFalse (getF state) (elements (getM state))`
    `decisions (getM state) = []`
  show ?thesis
    using unsatReport[of "getF state" "getM state" "F0"]
    by simp
qed

(*----------------------------------------------------------------------------*)
theorem soundnessForSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars"

  "\<not> formulaFalse (getF state) (elements (getM state))"
  "vars (elements (getM state)) \<supseteq> decisionVars"
  shows
  "model (elements (getM state)) F0"
(*----------------------------------------------------------------------------*)
proof-
  from `isInitialState state0 F0` `(state0, state) \<in> transitionRelation decisionVars`
  have "invariantsHoldInState state F0 decisionVars"
    using invariantsHoldInValidRunsFromInitialState
    by simp
  hence
    "InvariantConsistent (getM state)"
    "InvariantEquivalent F0 (getF state)"
    "InvariantVarsF (getF state) F0 decisionVars"
    unfolding invariantsHoldInState_def
    by auto
  with assms
  show ?thesis
  using satReport[of "F0" "decisionVars" "getF state" "getM state"]
  by simp
qed

(******************************************************************************)
subsection{* Termination *}
(******************************************************************************)
text{* This system is terminating, but only under assumption that
there is no infinite derivation consisting only of applications of
rule $Learn$. We will formalize this condition by requiring that there
there exists an ordering @{term learnL} on the formulae that is
well-founded such that the state is decreased with each application
of the $Learn$ rule. If such ordering exists, the termination
ordering is built as a lexicographic combination of @{term lexLessRestricted}
trail ordering and the @{term learnL} ordering.
*}

definition "lexLessState F0 decisionVars == {((stateA::State), (stateB::State)).
                       (getM stateA, getM stateB) \<in> lexLessRestricted (vars F0 \<union> decisionVars)}"
definition "learnLessState learnL == {((stateA::State), (stateB::State)).
                        getM stateA = getM stateB \<and> (getF stateA, getF stateB) \<in> learnL}"
definition "terminationLess F0 decisionVars learnL ==
  {((stateA::State), (stateB::State)).
      (stateA,stateB) \<in> lexLessState F0 decisionVars \<or>
      (stateA,stateB) \<in> learnLessState learnL}"

text{* We want to show that every valid transition decreases a state
  with respect to the constructed termination ordering. Therefore, we
  show that $Decide$, $UnitPropagate$ and $Backjump$ rule decrease the
  trail with respect to the restricted trail ordering @{term
  lexLessRestricted}.  Invariants ensure that trails are indeed uniq,
  consistent and with finite variable sets. By assumption, $Learn$
  rule will decrease the formula component of the state with respect
  to the @{term learnL} ordering. *}

lemma trailIsDecreasedByDeciedUnitPropagateAndBackjump:
  fixes stateA::State and stateB::State
  assumes "invariantsHoldInState stateA F0 decisionVars" and
  "appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB \<or> appliedBackjump stateA stateB"
  shows "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
proof-
  from `appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB \<or> appliedBackjump stateA stateB`
    `invariantsHoldInState stateA F0 decisionVars`
  have "invariantsHoldInState stateB F0 decisionVars"
      using transitionsPreserveInvariants
      unfolding transition_def
      by auto
    from `invariantsHoldInState stateA F0 decisionVars`
    have *: "uniq (elements (getM stateA))" "consistent (elements (getM stateA))" "vars (elements (getM stateA)) \<subseteq> vars F0 \<union> decisionVars"
      unfolding invariantsHoldInState_def
      unfolding InvariantVarsM_def
      unfolding InvariantConsistent_def
      unfolding InvariantUniq_def
      by auto
    from `invariantsHoldInState stateB F0 decisionVars`
    have **: "uniq (elements (getM stateB))" "consistent (elements (getM stateB))" "vars (elements (getM stateB)) \<subseteq> vars F0 \<union> decisionVars"
      unfolding invariantsHoldInState_def
      unfolding InvariantVarsM_def
      unfolding InvariantConsistent_def
      unfolding InvariantUniq_def
      by auto
  {
    assume "appliedDecide stateA stateB decisionVars"
    hence "(getM stateB, getM stateA) \<in> lexLess"
      unfolding appliedDecide_def
      by (auto simp add:lexLessAppend)
    with * **
    have "((getM stateB), (getM stateA)) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  moreover
  {
    assume "appliedUnitPropagate stateA stateB"
    hence "(getM stateB, getM stateA) \<in> lexLess"
      unfolding appliedUnitPropagate_def
      by (auto simp add:lexLessAppend)
    with * **
    have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  moreover
  {
    assume "appliedBackjump stateA stateB"
    then obtain bc::Clause and bl::Literal and level::nat
      where
      "isUnitClause bc bl (elements (prefixToLevel level (getM stateA)))"
      "formulaEntailsClause (getF stateA) bc"
      "var bl \<in> vars (getF stateA) \<union> vars (elements (getM stateA))"
      "0 \<le> level" "level < currentLevel (getM stateA)"
      "getF stateB = getF stateA"
      "getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]"
      unfolding appliedBackjump_def
      by auto

    with `getM stateB = prefixToLevel level (getM stateA) @ [(bl, False)]`
    have "(getM stateB, getM stateA) \<in> lexLess"
      by (simp add:lexLessBackjump)
    with * **
    have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  ultimately
  show ?thesis
    using assms
    by auto
qed

text{* Now we can show that, under the assumption for $Learn$ rule,
  every rule application decreases a state with respect to the
  constructed termination ordering. *}
theorem stateIsDecreasedByValidTransitions:
  fixes stateA::State and stateB::State
  assumes "invariantsHoldInState stateA F0 decisionVars" and "transition stateA stateB decisionVars"
  "appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL"
  shows "(stateB, stateA) \<in> terminationLess F0 decisionVars learnL"
proof-
  {
    assume "appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB \<or> appliedBackjump stateA stateB"
    with `invariantsHoldInState stateA F0 decisionVars`
    have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      using trailIsDecreasedByDeciedUnitPropagateAndBackjump
      by simp
    hence "(stateB, stateA) \<in> lexLessState F0 decisionVars"
      unfolding lexLessState_def
      by simp
    hence "(stateB, stateA) \<in> terminationLess F0 decisionVars learnL"
      unfolding terminationLess_def
      by simp
  }
  moreover
  {
    assume "appliedLearn stateA stateB"
    with `appliedLearn stateA stateB \<longrightarrow> (getF stateB, getF stateA) \<in> learnL`
    have "(getF stateB, getF stateA) \<in> learnL"
      by simp
    moreover
    from `appliedLearn stateA stateB`
    have "(getM stateB) = (getM stateA)"
      unfolding appliedLearn_def
      by auto
   ultimately
   have "(stateB, stateA) \<in> learnLessState learnL"
      unfolding learnLessState_def
      by simp
    hence "(stateB, stateA) \<in> terminationLess F0 decisionVars learnL"
      unfolding terminationLess_def
      by simp
  }
  ultimately
  show ?thesis
    using `transition stateA stateB decisionVars`
    unfolding transition_def
    by auto
qed

text{* The minimal states with respect to the termination ordering are
  final i.e., no further transition rules are applicable. *}
definition
"isMinimalState stateMin F0 decisionVars learnL == (\<forall> state::State. (state, stateMin) \<notin> terminationLess F0 decisionVars learnL)"

lemma minimalStatesAreFinal:
  fixes stateA::State
  assumes *: "\<forall> (stateA::State) (stateB::State). appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL" and
  "invariantsHoldInState state F0 decisionVars" and "isMinimalState state F0 decisionVars learnL"
  shows "isFinalState state decisionVars"
proof-
  {
    assume "\<not> ?thesis"
    then obtain state'::State
      where "transition state state' decisionVars"
      unfolding isFinalState_def
      by auto
    with `invariantsHoldInState state F0 decisionVars` *
    have "(state', state) \<in> terminationLess F0 decisionVars learnL"
      using stateIsDecreasedByValidTransitions[of "state" "F0" "decisionVars" "state'" "learnL"]
      unfolding transition_def
      by auto
    with `isMinimalState state F0 decisionVars learnL`
    have False
      unfolding isMinimalState_def
      by auto
  }
  thus ?thesis
    by auto
qed

text{* We now prove that termination ordering is well founded. We
start with two auxiliary lemmas. *}
lemma wfLexLessState:
  fixes decisionVars :: "Variable set" and F0 :: "Formula"
  assumes "finite decisionVars"
  shows "wf (lexLessState F0 decisionVars)"
unfolding wf_eq_minimal
proof-
  show "\<forall>Q state. state \<in> Q \<longrightarrow> (\<exists>stateMin\<in>Q. \<forall>state'. (state', stateMin) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q)"
  proof-
    {
      fix Q :: "State set" and state :: State
      assume "state \<in> Q"
      let ?Q1 = "{M::LiteralTrail. \<exists> state. state \<in> Q \<and> (getM state) = M}"
      from `state \<in> Q`
      have "getM state \<in> ?Q1"
        by auto
      from `finite decisionVars`
      have "finite (vars F0 \<union> decisionVars)"
        using finiteVarsFormula[of "F0"]
        by simp
      hence "wf (lexLessRestricted (vars F0 \<union> decisionVars))"
      using  wfLexLessRestricted[of "vars F0 \<union> decisionVars"]
      by simp
    with `getM state \<in> ?Q1`
      obtain Mmin where "Mmin \<in> ?Q1" "\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> decisionVars) \<longrightarrow> M' \<notin> ?Q1"
        unfolding wf_eq_minimal
        apply (erule_tac x="?Q1" in allE)
        apply (erule_tac x="getM state" in allE)
        by auto
      from `Mmin \<in> ?Q1` obtain stateMin
        where "stateMin \<in> Q" "(getM stateMin) = Mmin"
        by auto
      have "\<forall>state'. (state', stateMin) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q"
      proof
        fix state'
        show "(state', stateMin) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q"
        proof
          assume "(state', stateMin) \<in> lexLessState F0 decisionVars"
          hence "(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
            unfolding lexLessState_def
            by auto
          from `\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> decisionVars) \<longrightarrow> M' \<notin> ?Q1`
            `(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> decisionVars)` `getM stateMin = Mmin`
          have "getM state' \<notin> ?Q1"
            by simp
          with `getM stateMin = Mmin`
          show "state' \<notin> Q"
            by auto
        qed
      qed
      with `stateMin \<in> Q`
      have "\<exists> stateMin \<in> Q. (\<forall>state'. (state', stateMin) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q)"
        by auto
    }
    thus ?thesis
      by auto
  qed
qed

lemma wfLearnLessState:
  assumes "wf learnL"
  shows "wf (learnLessState learnL)"
unfolding wf_eq_minimal
proof-
  show "\<forall>Q state. state \<in> Q \<longrightarrow> (\<exists>stateMin\<in>Q. \<forall>state'. (state', stateMin) \<in> learnLessState learnL \<longrightarrow> state' \<notin> Q)"
  proof-
    {
      fix Q :: "State set" and state :: State
      assume "state \<in> Q"
      let ?M = "(getM state)"
      let ?Q1 = "{f::Formula. \<exists> state. state \<in> Q \<and> (getM state) = ?M \<and> (getF state) = f}"
      from `state \<in> Q`
      have "getF state \<in> ?Q1"
        by auto
      with `wf learnL`
      obtain FMin where "FMin \<in> ?Q1" "\<forall>F'. (F', FMin) \<in> learnL \<longrightarrow> F' \<notin> ?Q1"
        unfolding wf_eq_minimal
        apply (erule_tac x="?Q1" in allE)
        apply (erule_tac x="getF state" in allE)
        by auto
      from `FMin \<in> ?Q1` obtain stateMin
        where "stateMin \<in> Q" "(getM stateMin) = ?M" "getF stateMin = FMin"
        by auto
      have "\<forall>state'. (state', stateMin) \<in> learnLessState learnL \<longrightarrow> state' \<notin> Q"
      proof
        fix state'
        show "(state', stateMin) \<in> learnLessState learnL \<longrightarrow> state' \<notin> Q"
        proof
          assume "(state', stateMin) \<in> learnLessState learnL"
          with `getM stateMin = ?M`
          have "getM state' = getM stateMin" "(getF state', getF stateMin) \<in> learnL"
            unfolding learnLessState_def
            by auto
          from `\<forall>F'. (F', FMin) \<in> learnL \<longrightarrow> F' \<notin> ?Q1`
            `(getF state', getF stateMin) \<in> learnL` `getF stateMin = FMin`
          have "getF state' \<notin> ?Q1"
            by simp
          with `getM state' = getM stateMin` `getM stateMin = ?M`
          show "state' \<notin> Q"
            by auto
        qed
      qed
      with `stateMin \<in> Q`
      have "\<exists> stateMin \<in> Q. (\<forall>state'. (state', stateMin) \<in> learnLessState learnL \<longrightarrow> state' \<notin> Q)"
        by auto
    }
    thus ?thesis
      by auto
  qed
qed

text{* Now we can prove the following key lemma which shows that the
termination ordering is well founded. *}
lemma wfTerminationLess:
  fixes F0 :: Formula and decisionVars :: "Variable set"
  assumes "finite decisionVars" "wf learnL"
  shows "wf (terminationLess F0 decisionVars learnL)"
  unfolding wf_eq_minimal
proof-
  show "\<forall>Q state. state \<in> Q \<longrightarrow> (\<exists> stateMin \<in> Q. \<forall>state'. (state', stateMin) \<in> terminationLess F0 decisionVars learnL \<longrightarrow> state' \<notin> Q)"
  proof-
    {
      fix Q::"State set"
      fix state::State
      assume "state \<in> Q"
      have "wf (lexLessState F0 decisionVars)"
        using wfLexLessState[of "decisionVars" "F0"]
        using `finite decisionVars`
        by simp
      with `state \<in> Q` obtain state0
        where "state0 \<in> Q" "\<forall>state'. (state', state0) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q"
        unfolding wf_eq_minimal
        by auto
      let ?Q0 = "{state. state \<in> Q \<and> (getM state) = (getM state0)}"
      from `state0 \<in> Q`
      have "state0 \<in> ?Q0"
        by simp
      from `wf learnL`
      have "wf (learnLessState learnL)"
        using wfLearnLessState
        by simp
      with `state0 \<in> ?Q0` obtain state1
        where "state1 \<in> ?Q0" "\<forall>state'. (state', state1) \<in> learnLessState learnL \<longrightarrow> state' \<notin> ?Q0"
        unfolding wf_eq_minimal
        apply (erule_tac x="?Q0" in allE)
        apply (erule_tac x="state0" in allE)
        by auto
      from `state1 \<in> ?Q0`
      have "state1 \<in> Q" "getM state1 = getM state0"
        by auto
      let ?stateMin = state1
      have "\<forall>state'. (state', ?stateMin) \<in> terminationLess F0 decisionVars learnL \<longrightarrow> state' \<notin> Q"
      proof
        fix state'
        show "(state', ?stateMin) \<in> terminationLess F0 decisionVars learnL \<longrightarrow> state' \<notin> Q"
        proof
          assume "(state', ?stateMin) \<in> terminationLess F0 decisionVars learnL"
          hence
            "(state', ?stateMin) \<in> lexLessState F0 decisionVars \<or>
            (state', ?stateMin) \<in> learnLessState learnL"
            unfolding terminationLess_def
            by auto
          moreover
          {
            assume "(state', ?stateMin) \<in> lexLessState F0 decisionVars"
            with `getM state1 = getM state0`
            have "(state', state0) \<in> lexLessState F0 decisionVars"
              unfolding lexLessState_def
              by simp
            with `\<forall>state'. (state', state0) \<in> lexLessState F0 decisionVars \<longrightarrow> state' \<notin> Q`
            have "state' \<notin> Q"
              by simp
          }
          moreover
          {
            assume "(state', ?stateMin) \<in> learnLessState learnL"
            with `\<forall>state'. (state', state1) \<in> learnLessState learnL \<longrightarrow> state' \<notin> ?Q0`
            have "state' \<notin> ?Q0"
              by simp
            from `(state', state1) \<in> learnLessState learnL` `getM state1 = getM state0`
            have "getM state' = getM state0"
              unfolding learnLessState_def
              by auto
            with `state' \<notin> ?Q0`
            have "state' \<notin> Q"
              by simp
          }
          ultimately
          show "state' \<notin> Q"
            by auto
        qed
      qed
      with `?stateMin \<in> Q` have "(\<exists> stateMin \<in> Q. \<forall>state'. (state', stateMin) \<in> terminationLess F0 decisionVars learnL \<longrightarrow> state' \<notin> Q)"
        by auto
    }
    thus ?thesis
      by simp
  qed
qed

text{* Using the termination ordering we show that the transition
 relation is well founded on states reachable from initial state.  The
 assumption for the $Learn$ rule is neccessary. *}
(*----------------------------------------------------------------------------*)
theorem wfTransitionRelation:
  fixes decisionVars :: "Variable set" and F0 :: "Formula"
  assumes "finite decisionVars" and "isInitialState state0 F0" and
  *: "\<exists> learnL::(Formula \<times> Formula) set.
        wf learnL \<and>
        (\<forall> stateA stateB. appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL)"
  shows "wf {(stateB, stateA).
             (state0, stateA) \<in> transitionRelation decisionVars \<and> (transition stateA stateB decisionVars)}"
(*----------------------------------------------------------------------------*)
proof-
  from * obtain learnL::"(Formula \<times> Formula) set"
    where
    "wf learnL" and
    **: "\<forall> stateA stateB. appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL"
    by auto
  let ?rel = "{(stateB, stateA).
                  (state0, stateA) \<in> transitionRelation decisionVars \<and> (transition stateA stateB decisionVars)}"
  let ?rel'= "terminationLess F0 decisionVars learnL"

  have "\<forall>x y. (x, y) \<in> ?rel \<longrightarrow> (x, y) \<in> ?rel'"
  proof-
    {
      fix stateA::State and stateB::State
      assume "(stateB, stateA) \<in> ?rel"
      hence "(stateB, stateA) \<in> ?rel'"
        using `isInitialState state0 F0`
        using invariantsHoldInValidRunsFromInitialState[of "state0" "F0" "stateA" "decisionVars"]
        using stateIsDecreasedByValidTransitions[of "stateA" "F0" "decisionVars" "stateB"] **
        by simp
    }
    thus ?thesis
      by simp
  qed
  moreover
  have "wf ?rel'"
    using `finite decisionVars` `wf learnL`
    by (rule wfTerminationLess)
  ultimately
  show ?thesis
    using wellFoundedEmbed[of "?rel" "?rel'"]
    by simp
qed

text{* We will now give two corollaries of the previous theorem. First
  is a weak termination result that shows that there is a terminating
  run from every intial state to the final one. *}
corollary
  fixes decisionVars :: "Variable set" and F0 :: "Formula" and state0 :: "State"
  assumes "finite decisionVars" and "isInitialState state0 F0" and
  *: "\<exists> learnL::(Formula \<times> Formula) set.
        wf learnL \<and>
        (\<forall> stateA stateB. appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL)"
  shows "\<exists> state. (state0, state) \<in> transitionRelation decisionVars \<and> isFinalState state decisionVars"
proof-
  {
    assume "\<not> ?thesis"
    let ?Q = "{state. (state0, state) \<in> transitionRelation decisionVars}"
    let ?rel = "{(stateB, stateA). (state0, stateA) \<in> transitionRelation decisionVars \<and>
                         transition stateA stateB decisionVars}"
    have "state0 \<in> ?Q"
      unfolding transitionRelation_def
      by simp
    hence "\<exists> state. state \<in> ?Q"
      by auto

    from assms
    have "wf ?rel"
      using wfTransitionRelation[of "decisionVars" "state0" "F0"]
      by auto
    hence "\<forall> Q. (\<exists> x. x \<in> Q) \<longrightarrow> (\<exists> stateMin \<in> Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> Q)"
      unfolding wf_eq_minimal
      by simp
    hence " (\<exists> x. x \<in> ?Q) \<longrightarrow> (\<exists> stateMin \<in> ?Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q)"
      by rule
    with `\<exists> state. state \<in> ?Q`
    have "\<exists> stateMin \<in> ?Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q"
      by simp
    then obtain stateMin
      where "stateMin \<in> ?Q" and "\<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q"
      by auto

    from `stateMin \<in> ?Q`
    have "(state0, stateMin) \<in> transitionRelation decisionVars"
      by simp
    with `\<not> ?thesis`
    have "\<not> isFinalState stateMin decisionVars"
      by simp
    then obtain state'::State
      where "transition stateMin state' decisionVars"
      unfolding isFinalState_def
      by auto
    have "(state', stateMin) \<in> ?rel"
      using `(state0, stateMin) \<in> transitionRelation decisionVars`
            `transition stateMin state' decisionVars`
      by simp
    with `\<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q`
    have "state' \<notin> ?Q"
      by force
    moreover
    from `(state0, stateMin) \<in> transitionRelation decisionVars` `transition stateMin state' decisionVars`
    have "state' \<in> ?Q"
      unfolding transitionRelation_def
      using rtrancl_into_rtrancl[of "state0" "stateMin" "{(stateA, stateB). transition stateA stateB decisionVars}" "state'"]
      by simp
    ultimately
    have False
      by simp
  }
  thus ?thesis
    by auto
qed

text{* Now we prove the final strong termination result which states
that there cannot be infinite chains of transitions. If there is an
infinite transition chain that starts from an initial state, its
elements would for a set that would contain initial state and for
every element of that set there would be another element of that set
that is directly reachable from it. We show that no such set exists. *}
corollary noInfiniteTransitionChains:
  fixes F0::Formula and decisionVars::"Variable set"
  assumes "finite decisionVars" and
  *: "\<exists> learnL::(Formula \<times> Formula) set.
        wf learnL \<and>
        (\<forall> stateA stateB. appliedLearn stateA stateB  \<longrightarrow> (getF stateB, getF stateA) \<in> learnL)"
  shows "\<not> (\<exists> Q::(State set). \<exists> state0 \<in> Q. isInitialState state0 F0 \<and>
                              (\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' decisionVars))
            )"
proof-
  {
  assume "\<not> ?thesis"
  then obtain Q::"State set" and state0::"State"
    where "isInitialState state0 F0" "state0 \<in> Q"
          "\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' decisionVars)"
    by auto
  let ?rel = "{(stateB, stateA). (state0, stateA) \<in> transitionRelation decisionVars \<and>
                         transition stateA stateB decisionVars}"
  from `finite decisionVars` `isInitialState state0 F0` *
  have "wf ?rel"
    using wfTransitionRelation
    by simp
  hence wfmin: "\<forall>Q x. x \<in> Q \<longrightarrow>
         (\<exists>z\<in>Q. \<forall>y. (y, z) \<in> ?rel \<longrightarrow> y \<notin> Q)"
    unfolding wf_eq_minimal
    by simp
  let ?Q = "{state \<in> Q. (state0, state) \<in> transitionRelation decisionVars}"
  from `state0 \<in> Q`
  have "state0 \<in> ?Q"
    unfolding transitionRelation_def
    by simp
  with wfmin
  obtain stateMin::State
    where "stateMin \<in> ?Q" and "\<forall>y. (y, stateMin) \<in> ?rel \<longrightarrow> y \<notin> ?Q"
    apply (erule_tac x="?Q" in allE)
    by auto

  from `stateMin \<in> ?Q`
  have "stateMin \<in> Q" "(state0, stateMin) \<in> transitionRelation decisionVars"
    by auto
  with `\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' decisionVars)`
  obtain state'::State
    where "state' \<in> Q" "transition stateMin state' decisionVars"
    by auto

  with `(state0, stateMin) \<in> transitionRelation decisionVars`
  have "(state', stateMin) \<in> ?rel"
    by simp
  with `\<forall>y. (y, stateMin) \<in> ?rel \<longrightarrow> y \<notin> ?Q`
  have "state' \<notin> ?Q"
    by force

  from `state' \<in> Q` `(state0, stateMin) \<in> transitionRelation decisionVars`
    `transition stateMin state' decisionVars`
  have "state' \<in> ?Q"
    unfolding transitionRelation_def
    using rtrancl_into_rtrancl[of "state0" "stateMin" "{(stateA, stateB). transition stateA stateB decisionVars}" "state'"]
    by simp
  with `state' \<notin> ?Q`
  have False
    by simp
  }
  thus ?thesis
    by force
qed

(******************************************************************************)
subsection{* Completeness *}
(******************************************************************************)

text{* In this section we will first show that each final state is
either \textit{SAT} or \textit{UNSAT} state. *}

lemma finalNonConflictState:
  fixes state::State and FO :: Formula
  assumes
  "\<not> applicableDecide state decisionVars"
  shows "vars (elements (getM state)) \<supseteq> decisionVars"
proof
  fix x :: Variable
  let ?l = "Pos x"
  assume "x \<in> decisionVars"
  hence "var ?l = x" and "var ?l \<in> decisionVars" and "var (opposite ?l) \<in> decisionVars"
    by auto
  with `\<not> applicableDecide state decisionVars`
  have "literalTrue ?l (elements (getM state)) \<or> literalFalse ?l (elements (getM state))"
    unfolding applicableDecideCharacterization
    by force
  with `var ?l = x`
  show "x \<in> vars (elements (getM state))"
    using valuationContainsItsLiteralsVariable[of "?l" "elements (getM state)"]
    using valuationContainsItsLiteralsVariable[of "opposite ?l" "elements (getM state)"]
    by auto
qed

lemma finalConflictingState:
  fixes state :: State
  assumes
  "InvariantUniq (getM state)" and
  "InvariantConsistent (getM state)" and
  "InvariantImpliedLiterals (getF state) (getM state)"
  "\<not> applicableBackjump state" and
  "formulaFalse (getF state) (elements (getM state))"
  shows
  "decisions (getM state) = []"
proof-
  from `InvariantUniq (getM state)`
  have "uniq (elements (getM state))"
    unfolding InvariantUniq_def
    .
  from `InvariantConsistent (getM state)`
  have "consistent (elements (getM state))"
    unfolding InvariantConsistent_def
    .

  let ?c = "oppositeLiteralList (decisions (getM state))"
  {
    assume "\<not> ?thesis"
    hence "?c \<noteq> []"
      using oppositeLiteralListNonempty[of "decisions (getM state)"]
      by simp
    moreover
    have "clauseFalse ?c (elements (getM state))"
    proof-
      {
        fix l::Literal
        assume "l el ?c"
        hence "opposite l el decisions (getM state)"
          using literalElListIffOppositeLiteralElOppositeLiteralList [of "l" "?c"]
          by simp
        hence "literalFalse l (elements (getM state))"
          using markedElementsAreElements[of "opposite l" "getM state"]
          by simp
      }
      thus ?thesis
        using clauseFalseIffAllLiteralsAreFalse[of "?c" "elements (getM state)"]
        by simp
    qed
    moreover
    let ?l = "getLastAssertedLiteral (oppositeLiteralList ?c) (elements (getM state))"
    have "isLastAssertedLiteral ?l (oppositeLiteralList ?c) (elements (getM state))"
      using `InvariantUniq (getM state)`
      using getLastAssertedLiteralCharacterization[of "?c" "elements (getM state)"]
        `?c \<noteq> []` `clauseFalse ?c (elements (getM state))`
      unfolding InvariantUniq_def
      by simp
    moreover
    have "\<forall> l. l el ?c \<longrightarrow> (opposite l) el (decisions (getM state))"
    proof-
      {
        fix l::Literal
        assume "l el ?c"
        hence "(opposite l) el (oppositeLiteralList ?c)"
          using literalElListIffOppositeLiteralElOppositeLiteralList[of "l" "?c"]
          by simp
      }
      thus ?thesis
        by simp
    qed
    ultimately
    have "\<exists> level. (isBackjumpLevel level (opposite ?l) ?c (getM state))"
      using `uniq (elements (getM state))`
      using allDecisionsThenExistsBackjumpLevel[of "getM state" "?c" "opposite ?l"]
      by simp
    then obtain level::nat
      where "isBackjumpLevel level (opposite ?l) ?c (getM state)"
      by auto
    with `consistent (elements (getM state))` `uniq (elements (getM state))` `clauseFalse ?c (elements (getM state))`
    have "isUnitClause ?c (opposite ?l) (elements (prefixToLevel level (getM state)))"
      using isBackjumpLevelEnsuresIsUnitInPrefix[of "getM state" "?c" "level" "opposite ?l"]
      by simp
    moreover
    have "formulaEntailsClause (getF state) ?c"
    proof-
      from `clauseFalse ?c (elements (getM state))` `consistent (elements (getM state))`
      have "\<not> clauseTautology ?c"
        using tautologyNotFalse[of "?c" "elements (getM state)"]
        by auto

      from `formulaFalse (getF state) (elements (getM state))` `InvariantImpliedLiterals (getF state) (getM state)`
      have "\<not> satisfiable ((getF state) @ val2form (decisions (getM state)))"
        using InvariantImpliedLiteralsAndFormulaFalseThenFormulaAndDecisionsAreNotSatisfiable
        by simp
      hence "\<not> satisfiable ((getF state) @ val2form (oppositeLiteralList ?c))"
        by simp
      with `\<not> clauseTautology ?c`
      show ?thesis
        using unsatisfiableFormulaWithSingleLiteralClauses
        by simp
    qed
    moreover
    have "var ?l \<in> vars (getF state) \<union> vars (elements (getM state))"
    proof-
      from `isLastAssertedLiteral ?l (oppositeLiteralList ?c) (elements (getM state))`
      have "?l el (oppositeLiteralList ?c)"
        unfolding isLastAssertedLiteral_def
        by simp
      hence "literalTrue ?l (elements (getM state))"
        by (simp add: markedElementsAreElements)
      hence "var ?l \<in> vars (elements (getM state))"
        using valuationContainsItsLiteralsVariable[of "?l" "elements (getM state)"]
        by simp
      thus ?thesis
        by simp
    qed
    moreover
    have "0 \<le> level" "level < (currentLevel (getM state))"
    proof-
      from `isBackjumpLevel level (opposite ?l) ?c (getM state)`
      have "0 \<le> level" "level < (elementLevel ?l (getM state))"
        unfolding isBackjumpLevel_def
        by auto
      thus "0 \<le> level" "level < (currentLevel (getM state))"
        using elementLevelLeqCurrentLevel[of "?l" "getM state"]
        by auto
    qed
    ultimately
    have "applicableBackjump state"
      unfolding applicableBackjumpCharacterization
      by force
    with `\<not> applicableBackjump state`
    have "False"
      by simp
  }
  thus ?thesis
    by auto
qed

lemma finalStateCharacterizationLemma:
  fixes state :: State
  assumes
  "InvariantUniq (getM state)" and
  "InvariantConsistent (getM state)" and
  "InvariantImpliedLiterals (getF state) (getM state)"
  "\<not> applicableDecide state decisionVars"  and
  "\<not> applicableBackjump state"
  shows
  "(\<not> formulaFalse (getF state) (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse (getF state) (elements (getM state)) \<and> decisions (getM state) = [])"
proof (cases "formulaFalse (getF state) (elements (getM state))")
  case True
  hence "decisions (getM state) = []"
    using assms
    using finalConflictingState
    by auto
  with True
  show ?thesis
    by simp
next
  case False
  hence  "vars (elements (getM state)) \<supseteq> decisionVars"
    using assms
    using finalNonConflictState
    by auto
  with False
  show ?thesis
    by simp
qed

(*----------------------------------------------------------------------------*)
theorem finalStateCharacterization:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars" and
  "isFinalState state decisionVars"
  shows
  "(\<not> formulaFalse (getF state) (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse (getF state) (elements (getM state)) \<and> decisions (getM state) = [])"
(*----------------------------------------------------------------------------*)
proof-
  from `isInitialState state0 F0` `(state0, state) \<in> transitionRelation decisionVars`
  have "invariantsHoldInState state F0 decisionVars"
    using invariantsHoldInValidRunsFromInitialState
    by simp
  hence
    *: "InvariantUniq (getM state)"
    "InvariantConsistent (getM state)"
    "InvariantImpliedLiterals (getF state) (getM state)"
    unfolding invariantsHoldInState_def
    by auto

  from `isFinalState state decisionVars`
  have **:
    "\<not> applicableBackjump state"
    "\<not> applicableDecide state decisionVars"
    unfolding finalStateNonApplicable
    by auto

  from * **
  show ?thesis
    using finalStateCharacterizationLemma[of "state" "decisionVars"]
    by simp
qed

text{* Completeness theorems are easy consequences of this characterization and
 soundness. *}

(*----------------------------------------------------------------------------*)
theorem completenessForSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "satisfiable F0" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars" and
  "isFinalState state decisionVars"
  shows "\<not> formulaFalse (getF state) (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars"
(*----------------------------------------------------------------------------*)
proof-
  from assms
  have *: "(\<not> formulaFalse (getF state) (elements (getM state))  \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
    (formulaFalse (getF state) (elements (getM state)) \<and> decisions (getM state) = [])"
    using finalStateCharacterization[of "state0" "F0" "state" "decisionVars"]
    by auto
  {
    assume "formulaFalse (getF state) (elements (getM state))"
    with *
    have "formulaFalse (getF state) (elements (getM state))" "decisions (getM state) = []"
      by auto
    with assms
      have "\<not> satisfiable F0"
      using soundnessForUNSAT
      by simp
    with `satisfiable F0`
    have False
      by simp
  }
  with * show ?thesis
    by auto
qed

(*----------------------------------------------------------------------------*)
theorem completenessForUNSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and

  "\<not> satisfiable F0" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars" and
  "isFinalState state decisionVars"
  shows
  "formulaFalse (getF state) (elements (getM state)) \<and> decisions (getM state) = []"
(*----------------------------------------------------------------------------*)
proof-
  from assms
  have *:
  "(\<not> formulaFalse (getF state) (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse (getF state) (elements (getM state))  \<and> decisions (getM state) = [])"
    using finalStateCharacterization[of "state0" "F0" "state" "decisionVars"]
    by auto
  {
    assume "\<not> formulaFalse (getF state) (elements (getM state))"
    with *
    have "\<not> formulaFalse (getF state) (elements (getM state))" "vars (elements (getM state)) \<supseteq> decisionVars"
      by auto
    with assms
    have "satisfiable F0"
      using soundnessForSAT[of "F0" "decisionVars" "state0" "state"]
      unfolding satisfiable_def
      by auto
    with `\<not> satisfiable F0`
    have False
      by simp
  }
  with * show ?thesis
    by auto
qed

(*----------------------------------------------------------------------------*)
theorem partialCorrectness:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation decisionVars" and
  "isFinalState state decisionVars"
  shows
  "satisfiable F0 = (\<not> formulaFalse (getF state) (elements (getM state)))"
(*----------------------------------------------------------------------------*)
using assms
using completenessForUNSAT[of "F0" "decisionVars" "state0" "state"]
using completenessForSAT[of "F0" "state0" "state" "decisionVars"]
by auto

end