theory Chapter11
imports "HOL-IMP.Denotational" "HOL-IMP.Vars" "Short_Theory"
begin

text{*
\section*{Chapter 11}

\begin{exercise}
Building on Exercise~\ref{exe:IMP:REPEAT}, extend the denotational
semantics and the equivalence proof with the big-step semantics
with a @{text REPEAT} loop.
\end{exercise}

\exercise
Consider Example~11.14 and prove the following equation by induction on @{text n}:
*}
lemma "((W (\<lambda>s. s ''x'' \<noteq> 0) ({(s,t). t = s(''x'' := s ''x'' - 1)}))^^n) {} =
  {(s,t). 0 \<le> s ''x'' & s ''x'' < int n & t = s(''x'' := 0)}"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Consider Example~11.14 but with the loop condition
@{prop"b = Less (N 0) (V ''x'')"}. Find a closed expression @{text M}
(containing @{text n})
for @{prop"(f ^^ n) {}"} and prove @{prop"(f ^^ n) {} = M"}.
*}

text {*
\endexercise

\exercise
Define an operator @{text B} such that you
can express the equation for @{term "D (IF b THEN c1 ELSE c2)"}
in a point free way.
*}
definition B :: "bexp \<Rightarrow> (state \<times> state) set"  where
(* your definition/proof here *)

lemma
  "D (IF b THEN c1 ELSE c2) = (B b O D c1) \<union> (B (Not b) O D c2)"
(* your definition/proof here *)

text {*
  Similarly, find a point free equation for @{term "W (bval b) dc"}
  and use it to write down a point free version of
  @{term "D (WHILE b DO c)"} (still using @{text lfp}).
  Prove that your equations are equivalent to the old ones.
*}

(* your definition/proof here *)

text{*
\endexercise

\exercise
Let the `thin' part of a relation be its single-valued subset:
*}

definition thin :: "'a rel \<Rightarrow> 'a rel" where
"thin R = {(a,b) . (a,b) \<in> R \<and> (\<forall> c. (a,c) \<in> R \<longrightarrow> c = b)}"

text{* Prove *}

lemma fixes f :: "'a rel \<Rightarrow> 'a rel"
assumes "mono f" and thin_f: "\<And> R. f (thin R) \<subseteq> thin (f R)"
shows "single_valued (lfp f)"
(* your definition/proof here *)

text{*
\endexercise

\exercise
Generalise our set-theoretic treatment of continuity and least fixpoints to
\concept{chain-complete partial order}s (\concept{cpo}s),
i.e.\ partial orders @{text"\<le>"} that have a least element @{text "\<bottom>"} and
where every chain @{text"c 0 \<le> c 1 \<le> \<dots>"} has a least upper bound
@{term"lub c"} where \noquotes{@{term[source]"c :: nat \<Rightarrow> 'a"}}.
This setting is described by the following type class @{text cpo}
which is an extension of the type class @{class order} of partial orders.
For details see the decription of type classes in Chapter~13.
*}

context order
begin
definition chain :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool" where
"chain c = (\<forall>n. c n \<le> c (Suc n))"
end

class cpo = order +
fixes bot :: 'a and lub :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a"
assumes bot_least: "bot \<le> x"
and lub_ub: "chain c \<Longrightarrow> c n \<le> lub c"
and lub_least: "chain c \<Longrightarrow> (\<And>n. c n \<le> u) \<Longrightarrow> lub c \<le> u"

text{*
A function \noquotes{@{term[source] "f :: 'a \<Rightarrow> 'b"}}
between two cpos @{typ 'a} and @{typ 'b}
is called \concept{continuous} if @{prop"f(lub c) = lub (f o c)"}.
Prove that if @{text f} is monotone and continuous then
\ \mbox{@{text"lub (\<lambda>n. (f ^^ n) \<bottom>)"}} \ is the least (pre)fixpoint of @{text f}:
*}

definition cont :: "('a::cpo \<Rightarrow> 'b::cpo) \<Rightarrow> bool" where
"cont f = (\<forall>c. chain c \<longrightarrow> f (lub c) = lub (f o c))"

abbreviation "fix f \<equiv> lub (\<lambda>n. (f^^n) bot)"

lemma fix_lpfp: assumes "mono f" and "f p \<le> p" shows "fix f \<le> p"
(* your definition/proof here *)

theorem fix_fp: assumes "mono f" and "cont f" shows "f(fix f) = fix f"
(* your definition/proof here *)

text{*
\endexercise

\exercise
We define a dependency analysis @{text Dep} that maps commands to relations
between variables such that @{term "(x,y) : Dep c"} means that in
the execution of @{text c}
the initial value of @{text x} can influence the final value of @{text y}:
*}

fun Dep :: "com \<Rightarrow> (vname * vname) set" where
"Dep SKIP = Id" |
"Dep (x::=a) = {(u,v). if v = x then u \<in> vars a else u = v}" |
"Dep (c1;;c2) = Dep c1 O Dep c2" |
"Dep (IF b THEN c1 ELSE c2) = Dep c1 \<union> Dep c2 \<union> vars b \<times> UNIV" |
"Dep (WHILE b DO c) = lfp(\<lambda>R. Id \<union> vars b \<times> UNIV \<union> Dep c O R)"

text{*
where @{text"\<times>"} is the cross product of two sets.
Prove monotonicity of the function @{const lfp} is applied to.
*}

text{* For the correctness statement define *}

abbreviation Deps :: "com \<Rightarrow> vname set \<Rightarrow> vname set" where
"Deps c X \<equiv> (\<Union> x\<in>X. {y. (y,x) : Dep c})"

text{* and prove *}

lemma "\<lbrakk> (c,s) \<Rightarrow> s';  (c,t) \<Rightarrow> t';  s = t on Deps c X \<rbrakk> \<Longrightarrow> s' = t' on X"
(* your definition/proof here *)

text{*

Give an example that the following stronger termination-sensitive property
@{prop[display] "\<lbrakk> (c,s) \<Rightarrow> s'; s = t on Deps c X \<rbrakk>
  \<Longrightarrow> \<exists>t'. (c,t) \<Rightarrow> t' \<and> s' = t' on X"}
does not hold. Hint: @{prop"X = {}"}.

In the definition of @{term"Dep(IF b THEN c1 ELSE c2)"} the variables
in @{text b} can influence all variables (@{text UNIV}). However,
if a variable is not assigned to in @{text c1} and @{text c2}
it is not influenced by @{text b} (ignoring termination).
Theory @{short_theory "Vars"} defines a function @{const lvars} such
that @{term"lvars c"} is the set of variables on the left-hand side
of an assignment in @{text c}.
Modify the definition of @{const Dep} as follows:
replace @{const UNIV} by @{term"lvars c1 \<union> lvars c2"}
(in the case @{term"IF b THEN c1 ELSE c2"}) and by \mbox{@{term"lvars c"}}
(in the case @{term"WHILE b DO c"}).
Adjust the proof of the above correctness statement.
*}

text{*
\endexercise
*}

end


theory prop_02
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin
  datatype 'a list = Nil2 | Cons2 "'a" "'a list"
  datatype Nat = Z | S "Nat"
  fun plus :: "Nat => Nat => Nat" where
  "plus (Z) y = y"
  | "plus (S z) y = S (plus z y)"
  fun equal2 :: "Nat => Nat => bool" where
  "equal2 (Z) (Z) = True"
  | "equal2 (Z) (S z) = False"
  | "equal2 (S x2) (Z) = False"
  | "equal2 (S x2) (S y2) = equal2 x2 y2"
  fun count :: "Nat => Nat list => Nat" where
  "count x (Nil2) = Z"
  | "count x (Cons2 z ys) =
       (if equal2 x z then S (count x ys) else count x ys)"
  fun append :: "'a list => 'a list => 'a list" where
  "append (Nil2) y = y"
  | "append (Cons2 z xs) y = Cons2 z (append xs y)"
thm append.induct
  (*hipster plus equal2 count append *)
  theorem x0 :
    "(plus (count n xs) (count n ys)) = (count n (append xs ys))"
    by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)
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_int_add_comm
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

datatype Integer = P "Nat" | N "Nat"

fun pred :: "Nat => Nat" where
"pred (S y) = y"

fun plus2 :: "Nat => Nat => Nat" where
"plus2 (Z) y = y"
| "plus2 (S z) y = S (plus2 z y)"

fun t2 :: "Nat => Nat => Integer" where
"t2 x y =
   (let fail :: Integer =
     (case y of
        Z => P x
        | S z =>
            (case x of
               Z => N y
               | S x2 => t2 x2 z))
   in (case x of
         Z =>
           (case y of
              Z => P Z
              | S x4 => fail)
         | S x3 => fail))"

fun plus :: "Integer => Integer => Integer" where
"plus (P m) (P n) = P (plus2 m n)"
| "plus (P m) (N o2) = t2 m (plus2 (S Z) o2)"
| "plus (N m2) (P n2) = t2 n2 (plus2 (S Z) m2)"
| "plus (N m2) (N n3) = N (plus2 (plus2 (S Z) m2) n3)"

theorem property0 :
  "((plus x y) = (plus y x))"
  oops

end


(*by Ammer*)
theory VEBT_Insert imports VEBT_Member
begin

section \<open>Insert Function\<close>

context begin
  interpretation VEBT_internal .

fun vebt_insert :: "VEBT \<Rightarrow> nat \<Rightarrow>VEBT" where
  "vebt_insert (Leaf a b) x = (if x=0 then Leaf True b else if x = 1 then Leaf a True else Leaf a b)"|
  "vebt_insert (Node info 0 ts s) x = (Node info 0 ts s)"|
  "vebt_insert (Node info (Suc 0) ts s) x = (Node info (Suc 0) ts s)"|
  "vebt_insert (Node None (Suc deg) treeList summary) x =
              (Node (Some (x,x)) (Suc deg) treeList summary)"|
  "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x = (
     let xn = (if x < mi then mi else x);
         minn = (if x < mi then x else mi);
         l  = low xn (deg div 2);
         h = high xn (deg div 2) in (
         if h < length treeList \<and> \<not> (x = mi \<or> x = ma) then
                 Node (Some (minn, max xn ma)) deg (treeList[h:= vebt_insert (treeList ! h) l])
                        (if minNull (treeList ! h) then  vebt_insert summary h else summary)
         else  (Node (Some (mi, ma)) deg treeList summary)))"

end

context VEBT_internal begin

lemma insert_simp_norm:
  assumes "high x (deg div 2) < length treeList " and  "(mi::nat)< x" and "deg\<ge> 2" and "x \<noteq> ma"
  shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
                 Node (Some (mi, max x ma)) deg (treeList [(high x (deg div 2)):= vebt_insert (treeList ! (high x (deg div 2))) (low x (deg div 2))])
                       (if minNull (treeList ! (high x  (deg div 2))) then  vebt_insert summary (high x  (deg div 2)) else summary) "
proof-
  have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
    (let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
                  l= low xn (deg div 2); h = high xn (deg div 2)
                   in
              ( if h < length treeList \<and> \<not> (x = mi \<or> x = ma)then
                 Node (Some (minn, max xn ma)) deg (treeList [h:= vebt_insert (treeList ! h) l])
              (if minNull (treeList ! h) then  vebt_insert summary h else summary)
           else  (Node (Some (mi, ma)) deg treeList summary)))"
    using assms(3) vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
    by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
   have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (mi, max x ma)) deg (treeList[(high x (deg div 2)) := vebt_insert (treeList ! (high x (deg div 2))) (low x (deg div 2))])
                               (if minNull (treeList ! (high x (deg div 2))) then  vebt_insert summary (high x (deg div 2)) else summary)"
    using 11 apply (simp add: Let_def)
    apply (auto simp add: If_def)
    using assms not_less_iff_gr_or_eq apply blast+
    done
  then show ?thesis by blast
qed

lemma insert_simp_excp:
  assumes "high mi (deg div 2) < length treeList " and " (x::nat) < mi" and "deg\<ge> 2" and "x \<noteq> ma"
  shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
                 Node (Some (x, max mi ma)) deg (treeList[(high mi  (deg div 2)) := vebt_insert (treeList ! (high mi  (deg div 2))) (low mi  (deg div 2))])
                 (if minNull (treeList ! (high mi  (deg div 2))) then  vebt_insert summary (high mi  (deg div 2)) else summary) "
proof-
  have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
           ( let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
                  l= low xn (deg div 2); h = high xn (deg div 2)
                   in
              ( if h < length treeList \<and> \<not> (x = mi \<or> x = ma)then
                 Node (Some (minn, max xn ma)) deg (treeList[h:=vebt_insert (treeList ! h) l])
                               (if minNull (treeList ! h) then  vebt_insert summary h else summary)
           else  (Node (Some (mi, ma)) deg treeList summary)))"
    using assms(3) vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
    by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
  have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (x, max mi ma)) deg ( treeList[ (high mi (deg div 2)) := vebt_insert (treeList ! (high mi (deg div 2))) (low mi (deg div 2))])
                               (if minNull (treeList ! (high mi (deg div 2))) then  vebt_insert summary (high mi (deg div 2)) else summary)"
   using 11 apply (simp add: Let_def)
    apply (auto simp add: If_def)
    using assms not_less_iff_gr_or_eq apply blast+
    done
  then show ?thesis by blast
qed

lemma insert_simp_mima: assumes "x = mi \<or> x = ma" and "deg \<ge> 2"
  shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =  (Node (Some (mi,ma)) deg treeList summary)"
proof -
  have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
    ( let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
                  l= low xn (deg div 2); h = high xn (deg div 2)
                   in
              ( if h < length treeList \<and> \<not> (x = mi \<or> x = ma)then
                 Node (Some (minn, max xn ma)) deg (treeList[h:= vebt_insert (treeList ! h) l])
                               (if minNull (treeList ! h) then  vebt_insert summary h else summary)
    else  (Node (Some (mi, ma)) deg treeList summary)))" using assms vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
    by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
  then show ?thesis
    using assms(1) by auto
qed

lemma valid_insert_both_member_options_add: "invar_vebt t n \<Longrightarrow> x< 2^n \<Longrightarrow> both_member_options (vebt_insert t x) x"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
  case (1 a b)
  then show ?case apply(cases x)
    by (auto simp add: both_member_options_def)
next
  case (2 treeList n summary m deg)
  hence "deg>1"
    using valid_tree_deg_neq_0
    by (metis One_nat_def Suc_lessI add_gr_0 add_self_div_2 neq0_conv one_div_two_eq_zero)
  then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x ]
    by (smt Suc_1 Suc_leI add_numeral_left both_member_options_def le_add_diff_inverse membermima.simps(4)
        numerals(1) plus_1_eq_Suc semiring_norm(2))
next
  case (3 treeList n summary m deg)
  hence "\<forall>t\<in>set treeList. invar_vebt t n" by blast
  hence "n > 0" using set_n_deg_not_0[of treeList n m] "3"(4)
    by linarith
  hence "deg \<ge> 2"
    by (simp add: "3.hyps"(3) "3.hyps"(4) Suc_leI)
  then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x ]
    by (smt Suc_1 Suc_leI add_numeral_left both_member_options_def le_add_diff_inverse membermima.simps(4)
        numerals(1) plus_1_eq_Suc semiring_norm(2))
next
  case (4 treeList n summary m deg mi ma)
  hence "length treeList =2^n" by blast
  hence "high x n < length treeList"
    using "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) "4.prems" deg_not_0 exp_split_high_low(1) by auto
  hence "mi < 2^deg"
    using "4.hyps"(7) "4.hyps"(8) le_less_trans by blast
  then show ?case
  proof(cases "x = mi \<or> x = ma")
    case True
    then show ?thesis using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
      by (smt "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) add_diff_inverse_nat add_numeral_left add_self_div_2 both_member_options_def div_if membermima.simps(4) numerals(1) plus_1_eq_Suc semiring_norm(2) valid_tree_deg_neq_0)
  next
    case False
    hence "\<not> (x = mi \<or> x = ma)" by simp
    then show ?thesis
    proof(cases "x < mi")
      case True
      hence "high mi n < length treeList"
        using "4.hyps"(1) "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) \<open>mi < 2 ^ deg\<close> deg_not_0 exp_split_high_low(1) by auto
      hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
                      Node (Some (x, max mi ma)) deg ( treeList[(high mi n):= vebt_insert (treeList ! (high mi n)) (low mi n)] )
                      (if minNull (treeList ! high mi n) then  vebt_insert summary (high mi n) else summary)"
        by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) False True add_self_div_2 div_if insert_simp_excp not_less valid_tree_deg_neq_0)
      then show ?thesis
        by (smt "4.hyps"(1) "4.hyps"(4) Suc_pred add_diff_inverse_nat both_member_options_def membermima.simps(4) valid_tree_deg_neq_0 zero_eq_add_iff_both_eq_0)
    next
      case False
      hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
                      Node (Some (mi, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
                      (if minNull (treeList ! high x n) then  vebt_insert summary (high x n) else summary)"
        by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) \<open>\<not> (x = mi \<or> x = ma)\<close> \<open>high x n < length treeList\<close> add_self_div_2 div_if insert_simp_norm linorder_neqE_nat not_less valid_tree_deg_neq_0)
      have "low x n < 2^n \<and> high x n < 2^n"
        using "4.hyps"(2) "4.hyps"(3) \<open>high x n < length treeList\<close> low_def by auto
      have "invar_vebt (treeList ! (high x n)) n"
        by (metis "4.IH"(1) \<open>high x n < length treeList\<close> inthall member_def)
      hence "both_member_options (vebt_insert (treeList ! (high x n)) (low x n)) (low x n)"
        by (simp add: "4.IH"(1) \<open>high x n < length treeList\<close> low_def)
      have " (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high x n) = vebt_insert (treeList ! (high x n)) (low x n)"
        by (simp add: \<open>high x n < length treeList\<close>)
      then show ?thesis
        using both_member_options_ding[of "Some (mi, max x ma)" deg
        "(take (high x n) treeList @ [vebt_insert (treeList ! (high x n)) (low x n)] @ drop (high x n +1) treeList)"
        "if minNull (treeList ! high x n) then  vebt_insert summary (high x n) else summary" n x]
        by (metis "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) Suc_1 Suc_leD
          \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)\<close> \<open>both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)\<close> \<open>low x n < 2 ^ n \<and> high x n < 2 ^ n\<close> \<open>invar_vebt (treeList ! high x n) n\<close> add_self_div_2 both_member_options_from_chilf_to_complete_tree deg_not_0 div_greater_zero_iff length_list_update)
    qed
  qed
next
  case (5 treeList n summary m deg mi ma)
  hence "length treeList =2^m" by blast
  hence "high x n < length treeList"
    by (metis "5.hyps"(4) "5.prems" div_eq_0_iff div_exp_eq high_def length_0_conv length_greater_0_conv zero_less_numeral zero_less_power)
  hence "mi<2^deg"
    using "5.hyps"(7) "5.hyps"(8) le_less_trans by blast
  then show ?case
  proof(cases "x = mi \<or> x = ma")
    case True
    then show ?thesis using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
      by (smt "5.hyps"(3) "5.hyps"(4) Suc_leI add_Suc_right add_diff_inverse_nat add_numeral_left both_member_options_def diff_is_0_eq' vebt_insert.simps(3) membermima.simps(4) not_add_less1 numerals(1) plus_1_eq_Suc semiring_norm(2))
  next
    case False
    hence "\<not> (x = mi \<or> x = ma)" by simp
    then show ?thesis
    proof(cases "x < mi")
      case True
      hence "high mi n < length treeList"
        by (metis "5.hyps"(2) "5.hyps"(4) div_eq_0_iff \<open>mi < 2 ^ deg\<close> div_exp_eq high_def length_0_conv length_greater_0_conv zero_less_numeral zero_less_power)
      hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
                      Node (Some (x, max mi ma)) deg ( treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)] )
                               (if minNull (treeList ! high mi n) then  vebt_insert summary (high mi n) else summary)"
        using  insert_simp_excp[of mi deg treeList x ma summary]
           "5"(1) "5.hyps"(3) "5.hyps"(4) False True add_Suc_right add_self_div_2
           append_Cons div_less even_Suc_div_two in_set_conv_decomp not_less odd_add valid_tree_deg_neq_0
        by (smt (z3) nth_mem)
      then show ?thesis
        by (simp add: "5.hyps"(3) "5.hyps"(4) both_member_options_def)
    next
      case False
      hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
      Node (Some (mi, max x ma)) deg (treeList[(high x n):= vebt_insert (treeList ! (high x n)) (low x n)])
                               (if minNull (treeList ! high x n) then  vebt_insert summary (high x n) else summary)"
        by (smt (z3) "5.IH"(1) "5.hyps"(3) "5.hyps"(4) \<open>\<not> (x = mi \<or> x = ma)\<close> \<open>high x n < length treeList\<close> add_Suc_right add_self_div_2 deg_not_0 div_greater_zero_iff even_Suc_div_two insert_simp_norm linorder_neqE_nat nth_mem odd_add)
      have "low x n < 2^n \<and> high x n < 2^m"
        using "5.hyps"(2) "5.hyps"(3) \<open>high x n < length treeList\<close> low_def by auto
      have "invar_vebt (treeList ! (high x n)) n"
        by (metis "5.IH"(1) \<open>high x n < length treeList\<close> inthall member_def)
      hence "both_member_options (vebt_insert (treeList ! (high x n)) (low x n)) (low x n)"
        by (metis "5.IH"(1) \<open>high x n < length treeList\<close> \<open>low x n < 2 ^ n \<and> high x n < 2 ^ m\<close> inthall member_def)
      have " (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high x n) = vebt_insert (treeList ! (high x n)) (low x n)"
        by (meson \<open>high x n < length treeList\<close> nth_list_update_eq)
      then show ?thesis
        using both_member_options_ding[of "Some (mi, max x ma)" deg
            "(treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])"
            "if minNull (treeList ! high x n) then  vebt_insert summary (high x n) else summary" n x]
        using "5.hyps"(2) "5.hyps"(3) "5.hyps"(4) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)\<close> \<open>both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)\<close> \<open>low x n < 2 ^ n \<and> high x n < 2 ^ m\<close> both_member_options_from_chilf_to_complete_tree by auto
    qed
  qed
qed

lemma valid_insert_both_member_options_pres: "invar_vebt t n \<Longrightarrow> x<2^n \<Longrightarrow> y < 2^n \<Longrightarrow> both_member_options t x
                \<Longrightarrow> both_member_options (vebt_insert t y) x"
proof(induction t n arbitrary: x y rule: invar_vebt.induct)
  case (1 a b)
  then show ?case by (simp add: both_member_options_def)
next
  case (2 treeList n summary m deg)
  then show ?case
    using vebt_member.simps(2) invar_vebt.intros(2) valid_member_both_member_options by blast
next
  case (3 treeList n summary m deg)
  then show ?case
    using vebt_member.simps(2) invar_vebt.intros(3) valid_member_both_member_options by blast
next
  case (4 treeList n summary m deg mi ma)
  hence 00:"deg = n + m \<and> length treeList = 2^n \<and> n = m \<and> n \<ge> 1 \<and> deg \<ge> 2"
    by (metis One_nat_def Suc_leI add_mono_thms_linordered_semiring(1) deg_not_0 one_add_one)
  hence xyprop: "high x n < 2^m \<and> high y n < 2^m"
    by (metis "4.prems"(1) "4.prems"(2) high_def less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
  have "low x n <2^n \<and> low y n< 2^n"
    by (simp add: low_def)
  hence "x = mi \<or> x = ma \<or> both_member_options (treeList ! (high x n)) (low x n)"
    by (smt "00" "4.prems"(3) add_Suc_right add_self_div_2 both_member_options_def le_add_diff_inverse membermima.simps(4) naive_member.simps(3) plus_1_eq_Suc)
  have 001:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg" using invar_vebt.intros(4)[of treeList n summary m deg mi ma] "4" by simp
  then show ?case
  proof(cases "x = y")
    case True
    hence "both_member_options (vebt_insert (Node (Some (mi, ma)) deg treeList summary) y) y"
      using 001 valid_insert_both_member_options_add[of "(Node (Some (mi, ma)) deg treeList summary)" deg y ]
      using "4.prems"(2) by blast
    then show ?thesis
      by (simp add: True)
  next
    case False
    then show ?thesis
    proof(cases "y = mi \<or> y = ma")
      case True
      have "Suc (Suc (deg -2)) = deg"
        using "00" by linarith
      hence "vebt_insert (Node (Some (mi, ma)) deg treeList summary) y = Node (Some (mi, ma)) deg treeList summary"
        using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x] 00  True insert_simp_mima by blast
      then show ?thesis
        by (simp add: "4.prems"(3))
    next
      case False
      hence 0:"y \<noteq> mi \<and> y \<noteq> ma" by simp
      then show ?thesis
      proof(cases "x = mi")
        case True
        hence 1:"x = mi" by simp
        then show ?thesis
        proof(cases "x < y")
          case True
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (x, max y ma)) deg (treeList [ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] )
                               (if minNull (treeList ! (high y n)) then  vebt_insert summary (high y n) else summary)"
            using "00" "1" False True insert_simp_norm xyprop by auto
          then show ?thesis
            by (metis "001" Suc_pred both_member_options_def deg_not_0 membermima.simps(4))
        next
          case False
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (y, max x ma)) deg (treeList [ (high x n) :=vebt_insert (treeList ! (high x n)) (low x n)])
                               (if minNull (treeList ! (high x n)) then  vebt_insert summary (high x n) else summary)"
            by (metis "0" "00" False True add_self_div_2 insert_simp_excp linorder_neqE_nat xyprop)
          have 15: " invar_vebt (treeList ! (high x n)) n"
            by (metis "4"(1) "4.hyps"(2) in_set_member inthall xyprop)
          hence 16: "both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)"
            using \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> valid_insert_both_member_options_add by blast
          then show ?thesis
            by (metis "00" "14" Suc_1 add_leD1 add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)

        qed
      next
        case False
        hence "mi \<noteq> ma"
          using "001" "4.prems"(3) less_irrefl member_inv valid_member_both_member_options by fastforce
        hence "both_member_options (treeList !(high x n) ) (low x n) \<or> x = ma"
          using False \<open>x = mi \<or> x = ma \<or> both_member_options (treeList ! high x n) (low x n)\<close> by blast
        have "high ma n < 2^n"
          by (metis "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) high_def less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
        hence "both_member_options (treeList !(high ma n) ) (low ma n)"
          using "4.hyps"(3) "4.hyps"(9) \<open>mi \<noteq> ma\<close> by blast
        hence "both_member_options (treeList !(high x n) ) (low x n)"
          using \<open>both_member_options (treeList ! high x n) (low x n) \<or> x = ma\<close> by blast
        then show ?thesis
        proof(cases "mi < y")
          case True
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (mi, max y ma)) deg (treeList[(high y n):=vebt_insert (treeList ! (high y n)) (low y n)])
                               (if minNull (treeList ! (high y n)) then  vebt_insert summary (high y n) else summary)"
            using "0" "00" True insert_simp_norm xyprop by auto
          have "invar_vebt (treeList ! (high x n)) n"
            by (metis "4.IH"(1) "4.hyps"(2) in_set_member inthall xyprop)
          then show ?thesis
          proof(cases "high x n = high y n")
            case True
            have "both_member_options (vebt_insert (treeList ! (high y n)) (low y n)) (low x n)"
              using "4.IH"(1) "4.hyps"(2) True \<open>both_member_options (treeList ! high x n) (low x n)\<close> \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> xyprop by auto
            then show ?thesis
              by (metis "00" "14" Suc_1 True add_leD1 add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
          next
            case False
            have "(treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)]) ! (high x n) = treeList ! (high x n)"
              using False by auto
            then show ?thesis
              by (metis "00" "14" One_nat_def Suc_leD \<open>both_member_options (treeList ! high x n) (low x n)\<close> add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
          qed
        next
          case False
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (y, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
                               (if minNull (treeList ! (high mi n)) then  vebt_insert summary (high mi n) else summary)"
            using insert_simp_excp[of mi deg treeList y ma summary]
            by (smt "0" "00" "4.hyps"(7) "4.hyps"(8) False add_self_div_2 antisym_conv3 high_def le_less_trans less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
          have mimaprop: "high mi n < 2^n \<and> low mi n < 2^n"
            by (metis "00" "4.hyps"(7) "4.hyps"(8) div_eq_0_iff div_exp_eq high_def le_less_trans low_def mod_less_divisor zero_less_numeral zero_less_power)
          have "invar_vebt (treeList ! (high x n)) n"
            by (metis "4.IH"(1) "4.hyps"(2) in_set_member inthall xyprop)
          then show ?thesis
          proof(cases "high x n = high mi n")
            case True
            have "both_member_options (vebt_insert (treeList ! (high mi n)) (low mi n)) (low x n)"
              by (metis "4.IH"(1) "4.hyps"(2) True \<open>both_member_options (treeList ! high x n) (low x n)\<close> \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> mimaprop nth_mem xyprop)
            then show ?thesis
              by (metis "00" "14" Suc_1 Suc_leD True add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq xyprop)
          next
            case False
            have "(treeList[(high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high x n) = treeList ! (high x n)"
              using False by force
            then show ?thesis
              by (metis "00" "14" One_nat_def Suc_leD \<open>both_member_options (treeList ! high x n) (low x n)\<close> add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
          qed
        qed
      qed
    qed
  qed
next
  case (5 treeList n summary m deg mi ma)
  hence 00:"deg = n + m \<and> length treeList = 2^m \<and> Suc n = m \<and> n \<ge> 1 \<and> deg \<ge> 2 \<and> n = deg div 2"
    by (metis Suc_1 add_Suc_right add_mono_thms_linordered_semiring(1) add_self_div_2 even_Suc_div_two le_add1 odd_add plus_1_eq_Suc set_n_deg_not_0)
  hence xyprop: "high x n < 2^m \<and> high y n < 2^m"
    by (metis "5.prems"(1) "5.prems"(2) Suc_1 div_exp_eq div_if high_def nat.discI power_not_zero)
  have "low x n <2^n \<and> low y n< 2^n"
    by (simp add: low_def)
  hence "x = mi \<or> x = ma \<or> both_member_options (treeList ! (high x n)) (low x n)"
    by (smt "00" "5.prems"(3) add_Suc_right add_self_div_2 both_member_options_def le_add_diff_inverse membermima.simps(4) naive_member.simps(3) plus_1_eq_Suc)
  have 001:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
    using invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by simp
  then show ?case
  proof(cases "x = y")
    case True
    hence "both_member_options (vebt_insert (Node (Some (mi, ma)) deg treeList summary) y) y"
      using 001 valid_insert_both_member_options_add[of "(Node (Some (mi, ma)) deg treeList summary)" deg y ]
      using "5.prems"(2) by blast
    then show ?thesis
      by (simp add: True)
  next
    case False
    then show ?thesis
    proof(cases "y = mi \<or> y = ma")
      case True
      have "Suc (Suc (deg -2)) = deg"
        using "00" by linarith
      hence "vebt_insert (Node (Some (mi, ma)) deg treeList summary) y = Node (Some (mi, ma)) deg treeList summary"
        using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x] 00  True insert_simp_mima by blast
      then show ?thesis
        by (simp add: "5.prems"(3))
    next
      case False
      hence 0:"y \<noteq> mi \<and> y \<noteq> ma" by simp
      then show ?thesis
      proof(cases "x = mi")
        case True
        hence 1:"x = mi" by simp
        then show ?thesis
        proof(cases "x < y")
          case True
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (x, max y ma)) deg (treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] )
                               (if minNull (treeList ! (high y n)) then  vebt_insert summary (high y n) else summary)"
            using "00" "1" False True insert_simp_norm xyprop by metis
          then show ?thesis
            by (metis "001" Suc_pred both_member_options_def deg_not_0 membermima.simps(4))
        next
          case False
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (y, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
                               (if minNull (treeList ! (high x n)) then  vebt_insert summary (high x n) else summary)"
            by (metis "0" "00" False True add_self_div_2 insert_simp_excp linorder_neqE_nat xyprop)
          have 15: " invar_vebt (treeList ! (high x n)) n"
            by (metis "5"(1) "5.hyps"(2) in_set_member inthall xyprop)
          hence 16: "both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)"
            using \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> valid_insert_both_member_options_add by blast
          then show ?thesis
            by (metis "00" "14" Suc_1 add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
        qed
      next
        case False
        hence "mi \<noteq> ma"
          using "001" "5.prems"(3) less_irrefl member_inv valid_member_both_member_options by fastforce
        hence "both_member_options (treeList !(high x n) ) (low x n) \<or> x = ma"
          using False \<open>x = mi \<or> x = ma \<or> both_member_options (treeList ! high x n) (low x n)\<close> by blast
        have "high ma n < 2^m"
          by (metis "00" "5.hyps"(8) div_eq_0_iff div_exp_eq high_def nat_zero_less_power_iff power_not_zero zero_power2)
        hence "both_member_options (treeList !(high ma n) ) (low ma n)"
          using "5.hyps"(3) "5.hyps"(9) \<open>mi \<noteq> ma\<close> by blast
        hence "both_member_options (treeList !(high x n) ) (low x n)"
          using \<open>both_member_options (treeList ! high x n) (low x n) \<or> x = ma\<close> by blast
        then show ?thesis
        proof(cases "mi < y")
          case True
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (mi, max y ma)) deg (treeList[(high y n):= vebt_insert (treeList ! (high y n)) (low y n)])
                               (if minNull (treeList ! (high y n)) then  vebt_insert summary (high y n) else summary)"
            by (metis "0" "00" True insert_simp_norm xyprop)
          have "invar_vebt (treeList ! (high x n)) n"
            by (metis "5.IH"(1) "5.hyps"(2) in_set_member inthall xyprop)
          then show ?thesis
          proof(cases "high x n = high y n")
            case True
            have "both_member_options (vebt_insert (treeList ! (high y n)) (low y n)) (low x n)"
              by (metis "5.IH"(1) "5.hyps"(2) True \<open>both_member_options (treeList ! high x n) (low x n)\<close> \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> nth_mem xyprop)
            then show ?thesis
              by (metis "00" "14" Suc_1 True add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
          next
            case False
            have "(treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] ) ! (high x n) = treeList ! (high x n)"
              using False by force
            then show ?thesis
              by (metis "00" "14" One_nat_def Suc_leD \<open>both_member_options (treeList ! high x n) (low x n)\<close> both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
          qed
        next
          case False
          have 14:"vebt_insert (Node (Some (mi,ma)) deg  treeList summary) y =
                 Node (Some (y, max mi ma)) deg (treeList[(high mi n):= vebt_insert (treeList ! (high mi n)) (low mi n)] )
                               (if minNull (treeList ! (high mi n)) then  vebt_insert summary (high mi n) else summary)"
            using insert_simp_excp[of mi deg treeList y ma summary]
            by (metis "0" "00" "5.hyps"(7) "5.hyps"(8) div_eq_0_iff False antisym_conv3 div_exp_eq high_def le_less_trans power_not_zero zero_neq_numeral)
          have mimaprop: "high mi n < 2^m \<and> low mi n < 2^n" using exp_split_high_low[of mi n m] 00 "5"(9,10) by force
          have "invar_vebt (treeList ! (high x n)) n"
            by (metis "5.IH"(1) "5.hyps"(2) in_set_member inthall xyprop)
          then show ?thesis
          proof(cases "high x n = high mi n")
            case True
            have "both_member_options (vebt_insert (treeList ! (high mi n)) (low mi n)) (low x n)"
              by (metis "5.IH"(1) "5.hyps"(2) True \<open>both_member_options (treeList ! high x n) (low x n)\<close> \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> mimaprop nth_mem)
            then show ?thesis
              by (metis "00" "14" Suc_1 True add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
          next
            case False
            have "(treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high x n) = treeList ! (high x n)"
              by (metis False nth_list_update_neq)
            then show ?thesis
              by (metis "00" "14" One_nat_def Suc_leD \<open>both_member_options (treeList ! high x n) (low x n)\<close> both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
          qed
        qed
      qed
    qed
  qed
qed

lemma post_member_pre_member:"invar_vebt t n \<Longrightarrow> x< 2^n \<Longrightarrow> y <2^n \<Longrightarrow> vebt_member (vebt_insert t x) y \<Longrightarrow> vebt_member t y \<or> x = y"
proof(induction t n arbitrary: x y rule: invar_vebt.induct)
  case (1 a b)  then show ?case by auto
next
  case (2 treeList n summary m deg)
  hence "deg \<ge> 2"
    using deg_not_0 by fastforce
  then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x]
    by (metis (no_types, lifting) "2.prems"(3) vebt_member.simps(5) add_numeral_left le_add_diff_inverse member_inv numerals(1) plus_1_eq_Suc semiring_norm(2))
next
  case (3 treeList n summary m deg)
  hence "deg \<ge> 2"
    by (metis vebt_member.simps(2) One_nat_def Suc_1 Suc_eq_plus1 add_mono_thms_linordered_semiring(1) vebt_insert.simps(3) le_Suc_eq le_add1 plus_1_eq_Suc)
  then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x]
    by (metis (no_types, lifting) "3.prems"(3) vebt_member.simps(5) add_numeral_left le_add_diff_inverse member_inv numerals(1) plus_1_eq_Suc semiring_norm(2))
next
  case (4 treeList n summary m deg mi ma)
  hence 00:"deg = n+m \<and> n \<ge> 0 \<and> n = m \<and> deg \<ge> 2 \<and> length treeList =2^n"
    by (metis div_eq_0_iff add_self_div_2 deg_not_0 not_less zero_le)
  hence xyprop: "high x n < 2^n \<and> high y n < 2^n"
    using "4.hyps"(1) "4.prems"(1) "4.prems"(2) deg_not_0 exp_split_high_low(1) by blast
  have "low x n <2^n \<and> low y n< 2^n"
    by (simp add: low_def)
  then show ?case
  proof(cases "x = mi \<or> x = ma")
    case True
    then show ?thesis
      using "00" "4.prems"(3) insert_simp_mima by auto
  next
    case False
    hence mimaxyprop: "\<not> (x = mi \<or> x = ma) \<and> high x n < 2^n \<and> high mi n < 2^n \<and> low x n <2^n \<and> low mi n < 2^n \<and> length treeList = 2^n"
      using "00" "4.hyps"(1) "4.hyps"(7) "4.hyps"(8) \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans xyprop by blast
    then show ?thesis
    proof(cases "mi < x")
      case True
      hence "vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (mi, max x ma)) deg (treeList[(high x n) :=vebt_insert (treeList ! (high x n)) (low x n)])
                               (if minNull (treeList ! (high x n)) then  vebt_insert summary (high x n) else summary)"
        using insert_simp_norm[of x n treeList mi ma summary] mimaxyprop "00" add_self_div_2 insert_simp_norm by metis
      then show ?thesis
      proof(cases "y = mi \<or> y = max x ma")
        case True
        then show ?thesis
        proof(cases "y = mi")
          case True
          then show ?thesis
            by (metis "00" vebt_member.simps(5) le0 not_less_eq_eq numeral_2_eq_2 old.nat.exhaust)
        next
          case False
          hence "y = max x ma"
            using True by blast
          then show ?thesis
          proof(cases "x < ma")
            case True
            then show ?thesis
              by (metis (no_types, lifting) "00" vebt_member.simps(5) \<open>y = max x ma\<close> add_numeral_left le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
          next
            case False
            then show ?thesis
              using \<open>y = max x ma\<close> by linarith
          qed
        qed
      next
        case False
        hence "vebt_member ((treeList[(high x n):= vebt_insert (treeList ! (high x n)) (low x n)]) ! (high y n)) (low y n)"
          by (metis "4.hyps"(3) "4.hyps"(4) "4.prems"(3) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)\<close> add_self_div_2 member_inv)
        then show ?thesis
        proof(cases "high x n  = high y n")
          case True
          hence 000:"vebt_member (vebt_insert (treeList ! (high x n)) (low x n)) (low y n)"
            using \<open>vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)\<close> mimaxyprop by auto
          have 001:"invar_vebt (treeList ! (high x n)) n \<and> treeList ! (high x n) \<in> set treeList "
            by (simp add: "4.IH"(1) mimaxyprop)
          hence 002:"vebt_member (treeList ! (high x n)) (low y n) \<or> low y n = low x n"
            using "000" "4.IH"(1) \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> by fastforce
          hence 003:"both_member_options (treeList ! (high x n)) (low y n) \<or> low y n = low x n"
            using \<open>invar_vebt (treeList ! high x n) n \<and> treeList ! high x n \<in> set treeList\<close> both_member_options_equiv_member by blast
          have 004:"naive_member (treeList ! (high x n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            by (metis "00" Suc_le_D True add_self_div_2 mimaxyprop naive_member.simps(3) one_add_one plus_1_eq_Suc)
          hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y \<or> x = y"
            by (metis "00" "001" "002" Suc_le_D True add_self_div_2 bit_split_inv both_member_options_def member_valid_both_member_options membermima.simps(4) mimaxyprop one_add_one plus_1_eq_Suc)
          then show ?thesis
            by (smt "00" "001" "002" "003" "4"(11) "4"(8) vebt_member.simps(5) True add_numeral_left add_self_div_2 bit_split_inv le_add_diff_inverse mimaxyprop not_less not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
        next
          case False
          hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
            using \<open>vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)\<close> by auto
          moreover have 004:"naive_member (treeList ! (high y n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            by (metis "00" Suc_le_D add_self_div_2 naive_member.simps(3) one_add_one plus_1_eq_Suc xyprop)
          moreover have 001:"invar_vebt (treeList ! (high y n)) n \<and> treeList ! (high y n) \<in> set treeList "
            by (metis (full_types) "4.IH"(1) "4.hyps"(2) "4.hyps"(3) inthall member_def xyprop)
          moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
            by (metis "00" "000" "001" "004" Suc_le_D add_self_div_2 both_member_options_def member_valid_both_member_options membermima.simps(4) one_add_one plus_1_eq_Suc xyprop)
          moreover have "vebt_member (Node (Some (mi, ma)) deg treeList summary) y"
            using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
              invar_vebt.intros(4)[of treeList n summary m deg mi ma]
            using "4" calculation(4) by blast
          then show ?thesis  by simp
        qed
      qed
    next
      case False
      hence "x < mi"
        using mimaxyprop nat_neq_iff by blast
      hence "vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (x, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
                      (if minNull (treeList ! (high mi n)) then  vebt_insert summary (high mi n) else summary)"
        using insert_simp_excp[of mi n treeList x ma summary] mimaxyprop "00" add_self_div_2 insert_simp_excp by metis
      then show ?thesis
      proof(cases "y = x \<or> y = max mi ma")
        case True
        then show ?thesis
        proof(cases "y = x")
          case True
          then show ?thesis
            by (simp add: "00")
        next
          case False
          hence "y = max mi ma"
            using True by blast
          then show ?thesis
          proof(cases "mi < ma")
            case True
            then show ?thesis  using "00" vebt_member.simps(5) \<open>y = max mi ma\<close> add_numeral_left
                le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2)
              by (metis (no_types, lifting))
          next
            case False
            then show ?thesis
              by (metis "00" "4.hyps"(7) vebt_member.simps(5) \<open>y = max mi ma\<close> add_numeral_left le_add_diff_inverse max.absorb2 numerals(1) plus_1_eq_Suc semiring_norm(2))
          qed
        qed
      next
        case False
        hence "vebt_member ((treeList[(high mi n) :=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high y n)) (low y n)"
          by (metis "4.hyps"(3) "4.hyps"(4) "4.prems"(3) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)\<close> add_self_div_2 member_inv)
        then show ?thesis
        proof(cases "high mi n  = high y n")
          case True
          hence 000:"vebt_member (vebt_insert (treeList ! (high mi n)) (low mi n)) (low y n)"
            by (metis \<open>vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)\<close> mimaxyprop nth_list_update_eq)
          have 001:"invar_vebt (treeList ! (high mi n)) n \<and> treeList ! (high mi n) \<in> set treeList"
            by (simp add: "4.IH"(1) mimaxyprop)
          hence 002:"vebt_member (treeList ! (high mi n)) (low y n) \<or> low y n = low mi n"
            using "000" "4.IH"(1) \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> mimaxyprop by fastforce
          hence 003:"both_member_options (treeList ! (high mi n)) (low y n) \<or> low y n = low mi n"
            using \<open>invar_vebt (treeList ! high mi n) n \<and> treeList ! high mi n \<in> set treeList\<close> both_member_options_equiv_member by blast
          have 004:"naive_member (treeList ! (high mi n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y" using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary y]
            using "00" True mimaxyprop by fastforce
          hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y \<or> x = y"
            by (metis "00" "001" "002" Suc_le_D True add_self_div_2 bit_split_inv both_member_options_def member_valid_both_member_options membermima.simps(4) mimaxyprop one_add_one plus_1_eq_Suc)
          then show ?thesis
            by (smt "00" "001" "002" "003" "4.hyps"(6) "4.hyps"(9) vebt_member.simps(5) True add_numeral_left add_self_div_2 bit_split_inv le_add_diff_inverse mimaxyprop not_less not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
        next
          case False
          hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
            using \<open>vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)\<close> by auto
          moreover have 004:"naive_member (treeList ! (high y n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            by (metis "00" Suc_le_D add_self_div_2 naive_member.simps(3) one_add_one plus_1_eq_Suc xyprop)
          moreover have 001:"invar_vebt (treeList ! (high y n)) n \<and> treeList ! (high y n) \<in> set treeList "
            by (metis (full_types) "4.IH"(1) "4.hyps"(2) "4.hyps"(3) inthall member_def xyprop)
          moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
            by (metis "00" "000" "001" "004" Suc_le_D add_self_div_2 both_member_options_def member_valid_both_member_options membermima.simps(4) one_add_one plus_1_eq_Suc xyprop)
          then show ?thesis using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
              invar_vebt.intros(4)[of treeList n summary m deg mi ma] "4" by blast
        qed
      qed
    qed
  qed
next
  case (5 treeList n summary m deg mi ma)
  hence 00:"deg = n+m \<and> n \<ge> 0 \<and> Suc n = m \<and> deg \<ge> 2 \<and> length treeList =2^m \<and> n \<ge> 1"
    by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0 zero_le)
  hence xyprop: "high x n < 2^m \<and> high y n < 2^m"
    using "5.prems"(1) "5.prems"(2) exp_split_high_low(1) by auto
  have "low x n <2^n \<and> low y n< 2^n"
    by (simp add: low_def)
  then show ?case
  proof(cases "x = mi \<or> x = ma")
    case True
    then show ?thesis
      using "00" "5.prems"(3) insert_simp_mima by auto
  next
    case False
    hence mimaxyprop: "\<not> (x = mi \<or> x = ma) \<and> high x n < 2^m \<and> high mi n < 2^m \<and> low x n <2^n \<and> low mi n < 2^n \<and> length treeList = 2^m"
      using "00" "5"  \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans xyprop
      by (smt less_le_trans less_numeral_extra(1))
    then show ?thesis
    proof(cases "mi < x")
      case True
      hence "vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (mi, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
                               (if minNull (treeList ! (high x n)) then  vebt_insert summary (high x n) else summary)"
        using insert_simp_norm[of x deg treeList mi ma summary]
        by (smt "00" False add_Suc_right add_self_div_2 even_Suc_div_two odd_add xyprop)
      then show ?thesis
      proof(cases "y = mi \<or> y = max x ma")
        case True
        then show ?thesis
        proof(cases "y = mi")
          case True
          then show ?thesis
            by (metis "00" vebt_member.simps(5) le0 not_less_eq_eq numeral_2_eq_2 old.nat.exhaust)
        next
          case False
          hence "y = max x ma"
            using True by blast
          then show ?thesis
          proof(cases "x < ma")
            case True
            then show ?thesis
              by (metis (no_types, lifting) "00" vebt_member.simps(5) \<open>y = max x ma\<close> add_numeral_left le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
          next
            case False
            then show ?thesis
              using \<open>y = max x ma\<close> by linarith
          qed
        qed
      next
        case False
        hence "vebt_member ((treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high y n)) (low y n)"
          using "5.hyps"(3) "5.hyps"(4) "5.prems"(3) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)\<close> add_Suc_right add_self_div_2 member_inv by force
        then show ?thesis
        proof(cases "high x n  = high y n")
          case True
          hence 000:"vebt_member (vebt_insert (treeList ! (high x n)) (low x n)) (low y n)"
            by (metis "5.hyps"(2) \<open>vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)\<close> nth_list_update_eq xyprop)
          have 001:"invar_vebt (treeList ! (high x n)) n \<and> treeList ! (high x n) \<in> set treeList "
            by (simp add: "5.IH"(1) "5.hyps"(2) xyprop)
          hence 002:"vebt_member (treeList ! (high x n)) (low y n) \<or> low y n = low x n"
            using "000" "5.IH"(1) \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> by fastforce
          hence 003:"both_member_options (treeList ! (high x n)) (low y n) \<or> low y n = low x n"
            using \<open>invar_vebt (treeList ! high x n) n \<and> treeList ! high x n \<in> set treeList\<close> both_member_options_equiv_member by blast
          have 004:"naive_member (treeList ! (high x n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            using "00" True xyprop by auto
          hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y \<or> x = y"
            by (smt "00" "001" "002" True add_Suc_right add_self_div_2 bit_split_inv both_member_options_def even_Suc_div_two member_valid_both_member_options membermima.simps(4) odd_add xyprop)
          then show ?thesis
            using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
              invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by blast
        next
          case False
          hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
            using \<open>vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)\<close> by fastforce
          moreover have 004:"naive_member (treeList ! (high y n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            using "00" xyprop by auto
          moreover have 001:"invar_vebt (treeList ! (high y n)) n \<and> treeList ! (high y n) \<in> set treeList "
            by (metis (full_types) "5"inthall member_def xyprop)
          moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
            using "00" "000" "001" both_member_options_def member_valid_both_member_options xyprop by fastforce
          moreover have "vebt_member (Node (Some (mi, ma)) deg treeList summary) y"
            using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
              invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" calculation(4) by blast
          then show ?thesis  by simp
        qed
      qed
    next
      case False
      hence "x < mi"
        using mimaxyprop nat_neq_iff by blast
      hence "vebt_insert (Node (Some (mi,ma)) deg  treeList summary) x =
                 Node (Some (x, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
                               (if minNull (treeList ! (high mi n)) then  vebt_insert summary (high mi n) else summary)"
        using insert_simp_excp[of mi n treeList x ma summary] mimaxyprop "00" add_self_div_2 insert_simp_excp
        by (smt add_Suc_right even_Suc_div_two odd_add)
      then show ?thesis
      proof(cases "y = x \<or> y = max mi ma")
        case True
        then show ?thesis
        proof(cases "y = x")
          case True
          then show ?thesis
            by (simp add: "00")
        next
          case False
          hence "y = max mi ma"
            using True by blast
          then show ?thesis
          proof(cases "mi < ma")
            case True
            then show ?thesis  using "00" vebt_member.simps(5) \<open>y = max mi ma\<close> add_numeral_left
                le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2)
              by (metis (no_types, lifting))
          next
            case False
            then show ?thesis
              by (metis "00" "5.hyps"(7) vebt_member.simps(5) \<open>y = max mi ma\<close> add_numeral_left le_add_diff_inverse max.absorb2 numerals(1) plus_1_eq_Suc semiring_norm(2))
          qed
        qed
      next
        case False
        hence "vebt_member ((treeList[(high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high y n)) (low y n)"
          using "5.hyps"(3) "5.hyps"(4) "5.prems"(3) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)\<close> member_inv by force
        then show ?thesis
        proof(cases "high mi n  = high y n")
          case True
          hence 000:"vebt_member (vebt_insert (treeList ! (high mi n)) (low mi n)) (low y n)"
            by (metis \<open>vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)\<close> mimaxyprop nth_list_update_eq)
          have 001:"invar_vebt (treeList ! (high mi n)) n \<and> treeList ! (high mi n) \<in> set treeList "
            by (simp add: "5.IH"(1) mimaxyprop)
          hence 002:"vebt_member (treeList ! (high mi n)) (low y n) \<or> low y n = low mi n"
            using "000" "5.IH"(1) \<open>low x n < 2 ^ n \<and> low y n < 2 ^ n\<close> mimaxyprop by fastforce
          hence 003:"both_member_options (treeList ! (high mi n)) (low y n) \<or> low y n = low mi n"
            using \<open>invar_vebt (treeList ! high mi n) n \<and> treeList ! high mi n \<in> set treeList\<close> both_member_options_equiv_member by blast
          have 004:"naive_member (treeList ! (high mi n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y" using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary y]
            using "00" True mimaxyprop by fastforce
          hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y \<or> x = y"
            by (smt "00" "001" "002" True add_Suc_right add_self_div_2 bit_split_inv both_member_options_def even_Suc_div_two member_valid_both_member_options membermima.simps(4) odd_add xyprop)
          then show ?thesis using  "00" "001" "002" "003" "5"(14) "5.hyps"(6) "5.hyps"(7) "5.hyps"(9) vebt_member.simps(5) True
              add_Suc_right add_self_div_2 bit_split_inv even_Suc_div_two le_add_diff_inverse max.absorb2
              mimaxyprop not_less_iff_gr_or_eq odd_add plus_1_eq_Suc
            by (smt (z3) \<open>vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)\<close>)
        next
          case False
          hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
            using \<open>vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)\<close> by auto
          moreover have 004:"naive_member (treeList ! (high y n)) (low y n) \<Longrightarrow>
              naive_member (Node (Some (mi , ma)) deg treeList summary) y"
            using "00" xyprop by auto
          moreover have 001:"invar_vebt (treeList ! (high y n)) n \<and> treeList ! (high y n) \<in> set treeList "
            by (metis (full_types) "5.IH"(1) "5.hyps"(2) "5.hyps"(3) inthall member_def xyprop)
          moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
            using "00" "000" "001" both_member_options_def member_valid_both_member_options xyprop by fastforce
          then show ?thesis using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
              invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by simp
        qed
      qed
    qed
  qed
qed

end
end


theory BinNums imports Main "Word_Lib.Bits_Int" begin

section \<open>Positive\<close>

type_synonym positive = num

instantiation num :: semiring_numeral
begin
definition "one_num \<equiv> Num.One"
instance
  apply standard
proof -
  fix a b c :: num
  show "a * b * c = a * (b * c)"
    by (metis (no_types, lifting) mult_numeral_left_semiring_numeral numeral_eq_iff numeral_times_numeral)

  show "1 * a = a"
    by (simp add: one_num_def)

  show "a * 1 = a"
    by (simp add: one_num_def)

  show "a + b + c = a + (b + c)"
  proof -
    have "numeral (a + b + c) = (numeral a::nat) + (numeral b + numeral c)"
      by (metis (full_types) group_cancel.add1 numeral_plus_numeral)
    then show ?thesis
      by auto
  qed

  show "a + b = b + a"
  proof -
    have "(numeral (a + b)::nat) = numeral (b + a)"
      by (metis add.commute numeral_plus_numeral)
    then show ?thesis
      by force
  qed

  show "(a + b) * c = a * c + b * c"
    unfolding times_num_def
    by (metis add_mult_distrib nat_of_num_mult nat_of_num_numeral num_eq_iff numeral_plus_numeral times_num_def)

  show "a * (b + c) = a * b + a * c"
    unfolding times_num_def
    by (metis distrib_left_numeral nat_of_num_mult nat_of_num_numeral numeral_plus_numeral plus_num_def times_num_def)
qed
end

instantiation num :: strict_ordered_ab_semigroup_add
begin
instance proof (standard, goal_cases)
  case (1 a b c)
  then show ?case
    unfolding less_eq_num_def
    by (simp add: nat_of_num_add)
next
  case (2 a b c d)
  then show ?case
    unfolding less_num_def
    by (simp add: nat_of_num_add)
  qed
end

instantiation num :: order_bot
begin
definition "bot_num \<equiv> (1::num)"
instance
  apply standard
  unfolding bot_num_def one_num_def
  by (simp)
end

lemma pos_geq_1[iff]: "b \<ge> 1" for b :: positive
  by (simp add: one_num_def)

lemma pos_lt_1[simp]: "b < 1 = False" for b :: positive
  by (simp add: one_num_def)

lemma pos_less_plus[iff]: "p < p + 1" for p :: positive
  unfolding one_num_def less_num_def
  by (simp add: nat_of_num_add)

lemma pos_less_trans: "p < p' \<Longrightarrow> p < p' + 1" for p :: positive
  unfolding one_num_def less_num_def
  by (simp add: nat_of_num_add)

lemma pos_larger: "p + 1 \<le> p' \<Longrightarrow> p \<le> p'" for p :: positive
  by (meson leD leI pos_less_trans)

lemma pos_less_pos_plus1: "(p' < p + 1) = (p' = p \<or> p' < p)"  for p :: positive
  unfolding plus_num_def less_num_def
  by (smt (verit, del_insts) int_eq_iff_numeral int_ops(2) nat_of_num_inverse nat_of_num_numeral nat_of_num_pos num_of_nat_inverse numerals(1) of_nat_add of_nat_less_iff one_num_def)

section \<open>Z\<close>

type_synonym Z = int

end


theory T30
imports Main
begin
lemma "(
(\<forall> x::nat. \<forall> y::nat. meet(x, y) = meet(y, x)) &
(\<forall> x::nat. \<forall> y::nat. join(x, y) = join(y, x)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, meet(y, z)) = meet(meet(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(x, join(y, z)) = join(join(x, y), z)) &
(\<forall> x::nat. \<forall> y::nat. meet(x, join(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. join(x, meet(x, y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, join(y, z)) = join(mult(x, y), mult(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(join(x, y), z) = join(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(x, over(join(mult(x, y), z), y)) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. meet(y, undr(x, join(mult(x, y), z))) = y) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(over(x, y), y), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. join(mult(y, undr(y, x)), x) = x) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(meet(x, y), z) = meet(mult(x, z), mult(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(x, join(y, z)) = join(undr(x, y), undr(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(join(x, y), z) = join(over(x, z), over(y, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. over(x, meet(y, z)) = join(over(x, y), over(x, z))) &
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. undr(meet(x, y), z) = join(undr(x, z), undr(y, z))) &
(\<forall> x::nat. \<forall> y::nat. invo(join(x, y)) = meet(invo(x), invo(y))) &
(\<forall> x::nat. \<forall> y::nat. invo(meet(x, y)) = join(invo(x), invo(y))) &
(\<forall> x::nat. invo(invo(x)) = x)
) \<longrightarrow>
(\<forall> x::nat. \<forall> y::nat. \<forall> z::nat. mult(x, meet(y, z)) = meet(mult(x, y), mult(x, z)))
"
nitpick[card nat=8,timeout=86400]
oops
end


chapter \<open>Union-Find Data-Structure with Explain Operation\<close>
theory Explain_Definition
  imports
    "Separation_Logic_Imperative_HOL.Union_Find"
    "HOL-Library.Sublist"
    "HOL-Library.Option_ord"
begin

no_notation Ref.update ("_ := _" 62)

text \<open>
  Formalization of an explain operation, based on the Union Find implementation
  of \<open>Separation_Logic_Imperative_HOL.Union_Find\<close>. Path compression is omitted.
  Reference paper: Proof-Producing Congruence Closure, Robert Nieuwenhuis and Albert Oliveras
\<close>

subsection \<open>Definitions\<close>
text \<open>
Data structure for the union, find and explain operations:
  \<open>uf_list\<close>: parents of the tree data structure without path compression
  \<open>unions\<close>: list of all the union operations made
  \<open>au\<close>: (associated union) contains which union corresponds to each edge
\<close>
record ufe_data_structure =
  uf_list :: "nat list"
  unions :: "(nat * nat) list"
  au :: "nat option list"

text \<open>For the initialisation of the union find algorithm.\<close>
abbreviation "initial_ufe n \<equiv> \<lparr>uf_list = [0..<n], unions = [], au = replicate n None\<rparr>"

paragraph \<open>Union\<close>
text \<open>Extension of the union operations to the \<open>ufe_data_structure\<close>.\<close>
fun ufe_union :: "ufe_data_structure \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ufe_data_structure"
  where
    "ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y = (
if (rep_of l x \<noteq> rep_of l y) then
    \<lparr>uf_list = ufa_union l x y,
     unions = u @ [(x,y)],
     au = a[rep_of l x := Some (length u)]\<rparr>
else \<lparr>uf_list = l, unions = u, au = a\<rparr>)"

text \<open>Helper lemmata for \<open>ufe_union\<close>.\<close>
lemma ufe_union1[simp]: "rep_of l x = rep_of l y \<Longrightarrow> ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y = \<lparr>uf_list = l, unions = u, au = a\<rparr>"
  by simp
lemma ufe_union1_ufe[simp]: "rep_of (uf_list ufe) x = rep_of (uf_list ufe) y \<Longrightarrow> ufe_union ufe x y = ufe"
  by (metis (full_types) old.unit.exhaust ufe_data_structure.surjective ufe_union1)
lemma ufe_union1_uf_list[simp]: "rep_of (uf_list ufe) x = rep_of (uf_list ufe) y \<Longrightarrow> uf_list (ufe_union ufe x y) = uf_list ufe"
  by (metis (full_types) old.unit.exhaust ufe_data_structure.surjective ufe_union1)
lemma ufe_union1_unions[simp]: "rep_of (uf_list ufe) x = rep_of (uf_list ufe) y \<Longrightarrow> unions (ufe_union ufe x y) = unions ufe"
  by (metis (full_types) old.unit.exhaust ufe_data_structure.surjective ufe_union1)
lemma ufe_union1_au[simp]: "rep_of (uf_list ufe) x = rep_of (uf_list ufe) y \<Longrightarrow> au (ufe_union ufe x y) = au ufe"
  by (metis (full_types) old.unit.exhaust ufe_data_structure.surjective ufe_union1)
lemma ufe_union2[simp]: "rep_of l x \<noteq> rep_of l y \<Longrightarrow> ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y = \<lparr>uf_list = ufa_union l x y,
     unions = u @ [(x,y)],
     au =  a[rep_of l x := Some (length u)]\<rparr>"
  by simp
lemma ufe_union2_uf_list[simp]: "rep_of (uf_list ufe) x \<noteq> rep_of (uf_list ufe) y \<Longrightarrow> uf_list (ufe_union ufe x y) = ufa_union (uf_list ufe) x y"
  using ufe_data_structure.cases ufe_union2 by (metis ufe_data_structure.select_convs(1))
lemma ufe_union2_unions[simp]: "rep_of (uf_list ufe) x \<noteq> rep_of (uf_list ufe) y \<Longrightarrow> unions (ufe_union ufe x y) = unions ufe @ [(x,y)]"
  using ufe_data_structure.cases ufe_union2 by (metis ufe_data_structure.select_convs(1,2))
lemma ufe_union2_au[simp]: "rep_of (uf_list ufe) x \<noteq> rep_of (uf_list ufe) y \<Longrightarrow> au (ufe_union ufe x y) = (au ufe)[rep_of (uf_list ufe) x := Some (length (unions ufe))]"
  using ufe_data_structure.cases ufe_union2 by (metis ufe_data_structure.select_convs(1,2,3))

lemma P_ufe_unionE[consumes 1, case_names rep_neq]:
  assumes "P l u a"
  assumes "\<And> x y. rep_of l x \<noteq> rep_of l y \<Longrightarrow>
          P (ufa_union l x y) (u @ [(x,y)]) (a[rep_of l x := Some (length u)])"
  shows "P (uf_list (ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y))
           (unions (ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y))
           (au (ufe_union \<lparr>uf_list = l, unions = u, au = a\<rparr> x y))"
  using assms by auto

text \<open>For the application of a list of unions.\<close>
fun apply_unions :: "(nat * nat) list \<Rightarrow> ufe_data_structure \<Rightarrow> ufe_data_structure"
  where
    "apply_unions [] p = p" |
    "apply_unions ((x, y) # u) p = apply_unions u (ufe_union p x y)"

lemma apply_unions_cons: "apply_unions u1 a = b \<Longrightarrow> apply_unions u2 b = c \<Longrightarrow> apply_unions (u1 @ u2) a = c"
  by(induction u1 a rule: apply_unions.induct, simp_all)

paragraph \<open>Explain\<close>

text \<open>Finds the path from x to \<open>rep_of\<close> x.\<close>
function path_to_root :: "nat list \<Rightarrow> nat \<Rightarrow> nat list"
  where
    "path_to_root l x = (if l ! x = x then [x] else path_to_root l (l ! x) @ [x])"
  by pat_completeness auto

text \<open>Finds the lowest common ancestor of x and y in the
      tree represented by the array l.\<close>
fun lowest_common_ancestor :: "nat list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
  where
    "lowest_common_ancestor l x y =
last (longest_common_prefix (path_to_root l x) (path_to_root l y))"

lemma lowest_common_ancestor_symmetric:
  "lowest_common_ancestor l x y = lowest_common_ancestor l y x"
proof-
  have "longest_common_prefix (path_to_root l x) (path_to_root l y) =
longest_common_prefix (path_to_root l y) (path_to_root l x)"
    by (simp add: longest_common_prefix_max_prefix longest_common_prefix_prefix1 longest_common_prefix_prefix2 prefix_order.dual_order.eq_iff)
  then show ?thesis by auto
qed

text \<open>Finds the newest edge on the path from x to y
      (where y is nearer to the root than x).\<close>
function (domintros) find_newest_on_path  :: "nat list \<Rightarrow> nat option list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat option"
  where
    "find_newest_on_path l a x y =
  (if x = y then None
    else max (a ! x) (find_newest_on_path l a (l ! x) y))"
  by pat_completeness auto

text \<open>Explain operation, as described in the paper.\<close>
function (domintros) explain :: "ufe_data_structure \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (nat * nat) set"
  where
    "explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x y =
      (if x = y \<or> rep_of l x \<noteq> rep_of l y then {}
      else
          (let lca = lowest_common_ancestor l x y;
           newest_index_x = find_newest_on_path l a x lca;
           newest_index_y = find_newest_on_path l a y lca
        in
        (if newest_index_x \<ge> newest_index_y then
            let (ax, bx) = u ! the (newest_index_x) in
              {(ax, bx)} \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x ax
                \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> bx y
        else
            let (ay, by) = u ! the (newest_index_y) in
              {(ay, by)} \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x by
                \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> ay y)
)
)"
  by pat_completeness auto

text \<open>The \<open>explain.cases\<close> theorem is not very useful, we define a better one.
      It also defines variables which will be useful in the proofs. \<close>
thm explain.cases
lemma explain_cases:
  obtains (base) ufe
  where "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>"
    and "x = y \<or> rep_of l x \<noteq> rep_of l y"
  | (case_x) ufe lca newest_index_x newest_index_y ax bx ay "by"
  where "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>"
    and "lca = lowest_common_ancestor l x y"
    and "newest_index_x = find_newest_on_path l a x lca"
    and "newest_index_y = find_newest_on_path l a y lca"
    and "(ax, bx) = u ! the (newest_index_x)"
    and "(ay, by) = u ! the (newest_index_y)"
    and "\<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)"
    and "newest_index_x \<ge> newest_index_y"
  | (case_y) ufe lca newest_index_x newest_index_y ax bx ay "by"
  where "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>"
    and "lca = lowest_common_ancestor l x y"
    and "newest_index_x = find_newest_on_path l a x lca"
    and "newest_index_y = find_newest_on_path l a y lca"
    and "(ax, bx) = u ! the (newest_index_x)"
    and "(ay, by) = u ! the (newest_index_y)"
    and "\<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)"
    and "\<not>(newest_index_x \<ge> newest_index_y)"
  by (metis old.prod.exhaust)

text \<open>We also rewrite the \<open>explain.domintros\<close> to a simpler form.\<close>
thm explain.domintros
lemma explain_empty_domain:
  "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>
  \<Longrightarrow> x = y \<or> rep_of l x \<noteq> rep_of l y
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, y)"
  using explain.domintros by blast

lemma explain_case_x_domain:
  "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, ax)
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, bx, y)
  \<Longrightarrow> \<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)
  \<Longrightarrow> lca = lowest_common_ancestor l x y
  \<Longrightarrow> newest_index_x = find_newest_on_path l a x lca
  \<Longrightarrow> newest_index_y = find_newest_on_path l a y lca
  \<Longrightarrow> (ax, bx) = u ! the (newest_index_x)
  \<Longrightarrow> newest_index_x \<ge> newest_index_y
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, y) "
  using explain.domintros
  by (smt (verit, best) Pair_inject lowest_common_ancestor.simps)

lemma explain_case_y_domain:
  "ufe = \<lparr>uf_list = l, unions = u, au = a\<rparr>
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, by)
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, ay, y)
  \<Longrightarrow> \<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)
  \<Longrightarrow> lca = lowest_common_ancestor l x y
  \<Longrightarrow> newest_index_x = find_newest_on_path l a x lca
  \<Longrightarrow> newest_index_y = find_newest_on_path l a y lca
  \<Longrightarrow> (ay, by) = u !  the (newest_index_y)
  \<Longrightarrow> \<not>(newest_index_x \<ge> newest_index_y)
  \<Longrightarrow> explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, y) "
  using explain.domintros
  by (smt (verit, best) lowest_common_ancestor.simps prod.inject)

text \<open>And we also rewrite the simp rules:\<close>
lemma explain_empty[simp]:
  "x = y \<or> rep_of (uf_list ufe) x \<noteq> rep_of (uf_list ufe) y
  \<Longrightarrow> explain ufe x y = {}"
  using explain_empty_domain ufe_data_structure.cases explain.psimps
  by (metis (no_types, opaque_lifting) ufe_data_structure.select_convs(1))

lemma explain_case_x[simp]:
  "explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, y)
  \<Longrightarrow> \<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)
  \<Longrightarrow> lca = lowest_common_ancestor l x y
  \<Longrightarrow> newest_index_x = find_newest_on_path l a x lca
  \<Longrightarrow> newest_index_y = find_newest_on_path l a y lca
  \<Longrightarrow> (ax, bx) = u ! the (newest_index_x)
  \<Longrightarrow> newest_index_x \<ge> newest_index_y
  \<Longrightarrow> explain  \<lparr>uf_list = l, unions = u, au = a\<rparr> x y =
          {(ax, bx)} \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x ax
             \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> bx y"
  by (auto simp add: explain.psimps Let_def)

lemma explain_case_y[simp]:
  "explain_dom (\<lparr>uf_list = l, unions = u, au = a\<rparr>, x, y)
  \<Longrightarrow> \<not>(x = y \<or> rep_of l x \<noteq> rep_of l y)
  \<Longrightarrow> lca = lowest_common_ancestor l x y
  \<Longrightarrow> newest_index_x = find_newest_on_path l a x lca
  \<Longrightarrow> newest_index_y = find_newest_on_path l a y lca
  \<Longrightarrow> (ay, by) = u !  the (newest_index_y)
  \<Longrightarrow> \<not>(newest_index_x \<ge> newest_index_y)
  \<Longrightarrow> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x y =
          {(ay, by)} \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> x by
            \<union> explain \<lparr>uf_list = l, unions = u, au = a\<rparr> ay y"
  by (auto simp add: explain.psimps Let_def)

subsection \<open>Lemmas about \<open>rep_of\<close>\<close>

lemma rep_of_less_length_l:
  "ufa_invar l \<Longrightarrow> x < length l \<Longrightarrow> rep_of l x < length l"
  by (induction rule: rep_of_induct, auto simp add: rep_of_simps)

lemma rep_of_root:
  "ufa_invar l \<Longrightarrow> x < length l \<Longrightarrow> l ! rep_of l x = rep_of l x"
  by (induction rule: rep_of_induct, auto simp add: rep_of_simps)

lemma rep_of_domain: "rep_of_dom (l, i) \<Longrightarrow> l ! i \<noteq> i \<Longrightarrow> rep_of_dom (l, l ! i)"
  apply(induction rule: rep_of.pinduct)
  using rep_of.domintros by blast

lemma rep_of_idx2:
  "rep_of_dom (l, i) \<Longrightarrow> rep_of l (l ! i) = rep_of l i"
  by (simp add: rep_of.psimps)

lemma ufe_union_uf_list: "ufa_invar (uf_list ufe) \<Longrightarrow> x < length (uf_list ufe)
\<Longrightarrow> uf_list (ufe_union ufe x y) = ufa_union (uf_list ufe) x y"
proof (cases "rep_of (uf_list ufe) x = rep_of (uf_list ufe) y")
  case True
  assume invar: "ufa_invar (uf_list ufe)" "x < length (uf_list ufe)"
  from True invar rep_of_root have "(uf_list ufe) ! rep_of (uf_list ufe) x = rep_of (uf_list ufe) y"
    by metis
  with True have "ufa_union (uf_list ufe) x y = uf_list ufe"
    by (metis list_update_id)
  then show ?thesis
    by (simp add: True)
next
  case False
  then show ?thesis using ufe_data_structure.cases ufe_union2 by (metis ufe_data_structure.select_convs(1))
qed

lemma ufa_union_root:
  assumes "(ufa_union l a b) ! i = i" "ufa_invar l"
    "a < length l" "b < length l"
  shows "l ! i = i"
  using assms by (metis nth_list_update_neq rep_of_root)

end