theory DP
imports "../Imperative_HOL_Time/SepLogicTime/SepAuto" "../Imperative_HOL_Time/SepLogicTime/Asymptotics_1D"
begin

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

(* auxiliaries *)

lemma H[forward]: "i < length xs \<Longrightarrow> Suc i \<le> length xs" by auto

lemma weaken_pre: "<P> f <Q>\<^sub>t \<Longrightarrow> P' \<Longrightarrow>\<^sub>A P * true  \<Longrightarrow> <P'> f <\<lambda>x. Q x >\<^sub>t"
proof -
  have u: "\<And>R x. Q x * true * true = Q x * true" using top_assn_reduce assn_times_assoc by auto
  from pre_rule''[where Q="%x. Q x * true" and R="true"]
  show "<P> f <Q>\<^sub>t \<Longrightarrow> P' \<Longrightarrow>\<^sub>A P * true \<Longrightarrow> <P'> f <\<lambda>x. Q x >\<^sub>t" unfolding u .
qed

section "nth Fibonacci number by Dynamic Programming"

subsection "definition of functional version of Fibonacci numbers"

fun fib :: "nat \<Rightarrow> nat" where
  "fib 0 = 1"
| "fib (Suc 0) = 1"
| "fib (Suc (Suc n)) = fib (Suc n) + fib n"
declare fib.simps [rewrite]

subsection "setup for memoizaition in a functional list"

definition consistent_list where [rewrite]:
  "consistent_list xs= (\<forall>i<length xs. xs!i \<noteq> None \<longrightarrow> xs!i = Some (fib i))"

subsection "definition of functional version of Fibonacci numbers with memoization in a functional list"

fun fib_fun :: "nat \<Rightarrow> (nat option) list \<Rightarrow> (nat option) list * nat" where
  "fib_fun 0 xs = (let
      x = xs ! 0 in
      (case x of None \<Rightarrow> let v = fib 0;
                             xs' =  xs[0:= (Some v)] in (xs',v)
            | Some v \<Rightarrow> (xs, v)))"
|
  "fib_fun (Suc 0) xs = (let
      x = xs ! 1 in
      (case x of None \<Rightarrow> let v = fib (Suc 0);
                             xs' =  xs[1:= (Some v)] in (xs',v)
            | Some v \<Rightarrow> (xs, v)))"
| "fib_fun (Suc (Suc n)) xs = (let
      x = xs ! (Suc (Suc n)) in
      (case x of None \<Rightarrow> let (xs',a) = fib_fun (Suc n)  xs;
                            (xs'',b) = fib_fun n xs';
                             v = a + b;
                             xs''' =  xs''[(Suc (Suc n)):= (Some v)] in (xs''',v)
            | Some v \<Rightarrow> (xs, v)))"
declare fib_fun.simps(1,2) [rewrite]
setup {* add_fun_induct_rule (@{term fib_fun}, @{thm fib_fun.induct}) *}
setup {* register_wellform_data ("fib_fun i xs", ["i < length xs"]) *}

lemma fib_fun_stays[rewrite]: "n < length xs \<Longrightarrow> xs ! n \<noteq> None \<Longrightarrow> (fst (fib_fun n xs)) = xs"
  by(induction rule: fib_fun.induct) auto

lemma fib_fun_length [rewrite]: "i < length xs \<Longrightarrow> length (fst (fib_fun i xs)) = length xs"
  by (induction i xs rule: fib_fun.induct) (auto split: option.split prod.split simp: Let_def)

lemma consistent_list_update:
  "consistent_list (xs[i:= Some v])" if "v = fib i" "consistent_list xs" "i < length xs"
  using that by (auto simp add: consistent_list_def nth_list_update)

(* the statemet of this lemma should be independent of the function (here fib) that is computed,
  also the structure of the proof should be the same, only potentially more recursive calls
  must be adressed.
  Need to extract the over all/generic structure! *)
lemma fib_fun_effect: "i < length xs \<Longrightarrow> consistent_list xs
      \<Longrightarrow> (fst (fib_fun i xs)) ! i = Some (fib i) \<and> snd (fib_fun i xs) = fib i \<and> consistent_list (fst (fib_fun i xs))"
proof (induction i xs rule: fib_fun.induct)
  case (1 xs)
  then show ?case
    by (auto simp: consistent_list_def fib_fun_length nth_list_update split: option.split)
next
  case (2 xs)
  then show ?case
    by (auto simp: consistent_list_def fib_fun_length nth_list_update split: option.split)
next
  case (3 n xs)
  show ?case
  proof (cases "xs ! Suc (Suc n) = None")
    case True

    let ?xs' = "fst (fib_fun (Suc n) xs)"
    from True 3 have "?xs' ! Suc n = Some (fib (Suc n))"
        and a: "snd (fib_fun (Suc n) xs) = fib (Suc n)"
        and "consistent_list ?xs'" by auto

    let ?xs'' = "fst (fib_fun n ?xs')"
    from 3(2)[OF HOL.refl True HOL.refl prod.collapse] \<open>consistent_list ?xs'\<close> 3(3) have
      "?xs'' ! n = Some (fib n)" and b: "snd (fib_fun n ?xs') = fib n" and "consistent_list ?xs''"
      by (auto simp: fib_fun_length)

    then have c: "consistent_list (?xs''[Suc (Suc n) := Some (fib (Suc (Suc n)))] )"
      using 3(3) by (auto simp: fib_fun_length intro: consistent_list_update)

    from True show ?thesis
      apply(auto simp: Let_def split_beta 3 split: option.split)
      using c 3(3) by (auto simp: a b fib_fun_length)
  next
    case False
    with 3(3-4) show ?thesis unfolding consistent_list_def by auto
  qed
qed
(* dont know how to add this in a sensible way to auto2's rules, maybe do some
corollaries for each conjunct ? *)

corollary fib_fun_effect_snd: "i < length xs \<Longrightarrow> consistent_list xs
      \<Longrightarrow>  snd (fib_fun i xs) = fib i" using fib_fun_effect by metis

corollary fib_fun_effect_consist[backward]: "i < length xs \<Longrightarrow> consistent_list xs
      \<Longrightarrow> consistent_list (fst (fib_fun i xs))" using  fib_fun_effect by metis

lemma tailor[rewrite]: "xs ! Suc (Suc n) = None \<Longrightarrow> Suc (Suc n) < length xs  \<Longrightarrow> consistent_list xs \<Longrightarrow>
      fst (fib_fun (Suc (Suc n)) xs) = fst (fib_fun n (fst (fib_fun (Suc n) xs)))[Suc (Suc n) := Some (fib (n+2))]"
  apply (auto split: prod.split)
  using fib_fun_effect_snd[where xs="fst (fib_fun (Suc n) xs)" and i=n]
        fib_fun_effect_snd[where xs=xs and i="n+1"]
        fib_fun_effect_consist[where xs=xs and i="n+1"] apply (auto simp: fib_fun_length )
  using fib_fun_length by (metis Suc_lessD fst_conv)

lemma fib_fun_untouched[rewrite]: "j \<le> length xs \<Longrightarrow> i < j \<Longrightarrow> (fst (fib_fun i xs)) ! j = xs ! j"
  apply(induction i xs rule: fib_fun.induct) apply simp
    apply (auto simp: fib_fun_length split: option.split prod.split)
  using  fib_fun_length
  by (metis Suc_lessD fst_conv less_le_trans nat_neq_iff nth_list_update_neq)

subsection "imperative Implementation of memoized computation of Fibonacci numbers"

fun fibH :: "nat \<Rightarrow> nat option array \<Rightarrow> nat Heap" where
  "fibH 0 M = do {
     x \<leftarrow> Array.nth M 0;
     case x of None \<Rightarrow> do { v \<leftarrow> return (fib 0);
                            Array.upd 0 (Some v) M;
                            return v }
             | Some v \<Rightarrow> return v}"
| "fibH (Suc 0) M = do {
     x \<leftarrow> Array.nth M 1;
     case x of None \<Rightarrow> do { v \<leftarrow> return (fib 1);
                            Array.upd 1 (Some v) M;
                            return v }
             | Some v \<Rightarrow> return v}"
| "fibH (Suc (Suc n)) M = do {
     x \<leftarrow> Array.nth M (Suc (Suc n));
     case x of None \<Rightarrow> do {
           a \<leftarrow> fibH (Suc n) M;
           b \<leftarrow> fibH n M;
           v \<leftarrow> return (a + b);
           Array.upd (Suc (Suc n)) (Some v) M;
           return v
          }
             | Some v \<Rightarrow> return v}"

setup {* add_fun_induct_rule (@{term fibH}, @{thm fibH.induct}) *}

subsection "definition of time function"

fun f_time :: "nat \<Rightarrow> (nat option) list \<Rightarrow> nat" where
  "f_time 0 xs = (let
      x = xs ! 0 in
      (case x of None \<Rightarrow> 4
            | Some v \<Rightarrow> 2))"
|
  "f_time (Suc 0) xs = (let
      x = xs ! 1 in
      (case x of None \<Rightarrow> 4
            | Some v \<Rightarrow> 2))"
| "f_time (Suc (Suc n)) xs = (let
      x = xs ! (Suc (Suc n)) in
      (case x of None \<Rightarrow> let (xs',a) = fib_fun (Suc n) xs;
                            (xs'',b) = fib_fun n xs'  in
                            4 + f_time (Suc n) xs + f_time n (xs')
            | Some v \<Rightarrow> 2))"
declare f_time.simps [rewrite]
thm f_time.induct

subsubsection "the potential for the memoization Table"

definition "C = 8"
definition phi :: "(nat option) list \<Rightarrow> nat set \<Rightarrow> nat" where
  "phi xs S =  sum (\<lambda>i. case xs!i of None \<Rightarrow> C | Some _ \<Rightarrow> 0) S"

lemma assumes "(\<forall>i\<in>S. i<length xs) " "x\<in>S" "xs!x = None" "finite S"
  shows phi_update_extract: "phi (xs[x:=Some v]) S + C = phi xs S"
proof -
  from assms(2,4) have p: "C = sum (\<lambda>i. if i=x then C else 0) S"
    by simp
  let ?g ="\<lambda>i. case xs[x := Some v] ! i of None \<Rightarrow> C | Some x \<Rightarrow> 0"
  have "(\<Sum>i\<in>S. case xs[x := Some v] ! i of None \<Rightarrow> C | Some x \<Rightarrow> 0) + C
      = sum ?g S + sum (\<lambda>i. if i=x then C else 0) S"
    apply(subst (2) p) by simp
  also have "\<dots> = sum (\<lambda>i. ?g i + (\<lambda>i. if i=x then C else 0) i) S" by(rule sum.distrib[symmetric])
  also have "\<dots> = (\<Sum>i\<in>S. case xs ! i of None \<Rightarrow> C | Some x \<Rightarrow> 0)"
    apply(rule sum.cong)
     apply simp
    subgoal for x' apply(cases "x=x'") using assms(1,2,3) by auto done
  finally show ?thesis unfolding phi_def .
qed

lemma fib_fun_untouched_safe: "x'< y \<Longrightarrow>  y<length xs \<Longrightarrow>fst (fib_fun x' xs) ! y = xs ! y"
proof(induct x' xs rule: fib_fun.induct)
case (1 xs)
  then show ?case
    apply(cases "xs!0 = None") by auto
next
  case (2 xs)
  then show ?case
    apply(cases "xs!1 = None") by auto
next
  case (3 n xs)
  then show ?case
    apply(cases "xs!(Suc (Suc n)) = None")
     apply (auto simp: fib_fun_length split: prod.split)
    by (metis Suc_lessD fib_fun_length fst_conv less_irrefl less_le_trans less_trans_Suc nth_list_update_neq)

qed

subsubsection "proving the potential"

lemma fib_time_amor: "S={0..M} \<Longrightarrow> i\<le>M \<Longrightarrow> M < length xs  \<Longrightarrow> f_time i xs + phi (fst (fib_fun i xs)) S \<le> 4 + phi xs S"
proof(induct i xs rule: f_time.induct)
  case (1 xs)
  then show ?case apply(cases "xs!0") apply (auto simp: phi_def)
    apply(rule sum_mono) subgoal for i apply(cases "i=0") apply auto apply(subst nth_list_update_eq) apply auto done done
next
  case (2 xs)
  then show ?case apply(cases "xs!1") apply (auto simp: phi_def)
    apply(rule sum_mono) subgoal for i apply(cases "i=1") apply auto   done done
next
  case (3 n xs)
  show ?case
  proof (cases "xs ! Suc (Suc n) = None")
    case True
    then have r: "f_time (Suc (Suc n)) xs
        = 4 + f_time (Suc n) xs + f_time n (fst (fib_fun (Suc n) xs))"
      apply auto using split_beta by blast
    let ?xs' = "(fst (fib_fun (Suc n) xs))"
    let ?v' = "(snd (fib_fun (Suc n) xs))"
    let ?xs'' = "(fst (fib_fun n ?xs'))"
    let ?v'' = "(snd (fib_fun n ?xs'))"
    from 3(1)[OF _ True] 3(3-5) have 2: "f_time (Suc n) xs + phi ?xs' S \<le> 4 + phi xs S"
      by (metis Suc_leD old.prod.exhaust)
    have t: "length ?xs' = length xs" using fib_fun_length 3 by auto
    have *: "f_time n ?xs' + phi ?xs'' S \<le> 4 + phi ?xs' S"
      apply(rule 3(2))
      using True 3(3-5) apply(auto simp add: t split: prod.split)
      apply(rule prod.collapse) apply(rule prod.collapse) done
    let ?xs''' = "?xs''[Suc (Suc n) := Some (?v'+?v'')]"
    have tp: "(fst (fib_fun (Suc (Suc n)) xs)) = ?xs'''" using True by (auto simp: Let_def split: prod.split)

    have k: "phi ?xs''' S + C
        = phi ?xs'' S"
      apply(rule phi_update_extract)
      using 3(3-5) apply (auto simp: fib_fun_length fib_fun_untouched_safe)
      using True by auto

    have "f_time (Suc (Suc n)) xs + phi (fst (fib_fun (Suc (Suc n)) xs)) S + C
        = 4 + f_time (Suc n) xs + f_time n ?xs' + (phi ?xs''' S + C)"
      by (simp only: r tp)
    also have "\<dots> = 4 + f_time (Suc n) xs + f_time n ?xs' + phi ?xs'' S" by (simp only: k)
    also have "\<dots> \<le> f_time (Suc n) xs + phi ?xs' S + 8"
      using * by auto
    also have "\<dots> \<le> 4 + phi xs S + C" using 2 by (auto simp: C_def)
    finally show ?thesis by auto
  next
    case False
    then show ?thesis by auto
  qed
qed

corollary fib_time[backward]: assumes "S={0..<M+1}" "i\<le>M" "M < length xs"
  shows "f_time i xs \<le> 4 + phi xs S"
proof -
  have S: "S={0..M}" using assms by auto
  have "f_time i xs + phi (fst (fib_fun i xs)) {0..M} \<le> 4 + phi xs {0..M}"
    apply(rule fib_time_amor) using assms by auto
  then have "f_time i xs  \<le> 4 + phi xs {0..M}" by auto
  thus ?thesis using S by auto
qed

subsubsection "proving the correctness and time consumption of the imperative Program"

lemma fibH_rule[hoare_triple]:
  "i < length xs \<Longrightarrow> consistent_list xs \<Longrightarrow>
   <M \<mapsto>\<^sub>a xs * $(f_time i xs)>
   fibH i M
   <\<lambda>r. \<up>(r = fib i) * M \<mapsto>\<^sub>a (fst (fib_fun i xs))  * \<up>(consistent_list (fst (fib_fun i xs))) >\<^sub>t"
@proof @fun_induct "fibH i M" arbitrary xs @with
  @subgoal "(i = 0, M = M)"
  @let "x = xs ! 0"
  @case "x = None" @with
    @end
  @endgoal
  @subgoal "(i = Suc 0, M = M)"
    @let "x = xs ! 1"
    @case "x = None" @with
    @end
  @endgoal
  @subgoal "(i = Suc (Suc n), M = M)"
    @let "x = xs ! (Suc (Suc n))"
    @case "x = None" @with
      @have "(Suc (Suc n)) < length xs"
      @have "Suc (Suc n)\<le> length (fst (fib_fun (Suc n) xs))"
      @have "consistent_list (fst (fib_fun (Suc (Suc n)) xs))"
      @have "fst (fib_fun (Suc (Suc n)) xs) = fst (fib_fun n (fst (fib_fun (Suc n) xs)))[Suc (Suc n) := Some (fib (Suc (Suc n)))]"
    @end (* case *)
    @have "xs ! (Suc (Suc n)) = Some (fib (Suc (Suc n)))"
    @have "consistent_list (fst (fib_fun (Suc (Suc n)) xs))"
    @have "(fst (fib_fun (Suc (Suc n)) xs)) = xs"
  @endgoal
 @end
@qed

subsection "Wrap it up with an initialization phase and show run time complexity"

thm new_rule fibH_rule
fun fib_impl :: "nat \<Rightarrow> nat Heap" where
  "fib_impl n = do {
        M <- Array.new (n+1) None;
        fibH n M
      }"

lemma empty_consistent: "consistent_list (replicate (n+1) None) = True" by auto2

lemma "i \<le> n \<Longrightarrow> replicate (n+1) x ! i = x" apply(rule nth_replicate) by auto

lemma phi_empty_ub [rewrite]: "phi (replicate n None) {0..<n} = C * n"
  unfolding phi_def by auto

definition fib_time :: "nat \<Rightarrow> nat" where [rewrite]:
  "fib_time n = (n+2) + 4 + C * (n+1)"

(* the last two lemmas are the important result that is reported to the outside world *)

lemma fib_impl_rule[hoare_triple]: "<$(fib_time n)> fib_impl n <\<lambda>r. \<up> (r = fib n)>\<^sub>t"
@proof
  @have "fib_time n \<ge>\<^sub>t (n+2) + 4 + phi (replicate (n+1) None) {0..<n+1}"
  @have "4 + phi (replicate (n+1) None) {0..<n+1} \<ge>\<^sub>t f_time n (replicate (n+1) None)"
@qed

lemma fib_bound[asym_bound]: "(\<lambda>n. fib_time n) \<in> \<Theta>(%n. n)" unfolding C_def fib_time_def by auto2

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_list_nat_elem_nub_r
  imports "../../Test_Base"
begin

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

fun filter :: "('a => bool) => 'a list => 'a list" where
  "filter p (nil2) = nil2"
| "filter p (cons2 y xs) =
     (if p y then cons2 y (filter p xs) else filter p xs)"

(*fun did not finish the proof*)
function nubBy :: "('a => ('a => bool)) => 'a list => 'a list" where
  "nubBy x (nil2) = nil2"
| "nubBy x (cons2 z xs) =
     cons2 z (nubBy x (filter (% (y2 :: 'a) => (~ ((x z) y2))) xs))"
  by pat_completeness auto

fun elem :: "'a => 'a list => bool" where
  "elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

theorem property0 :
  "((elem x (nubBy (% (y :: 'a) => % (z :: 'a) => (y = z)) xs)) ==>
      (elem x xs))"
  oops

end


subsection "Quadratic Case"
theory QuadraticCase
  imports VSAlgos
begin

(*-------------------------------------------------------------------------------------------------------------*)
lemma quad_part_1_eq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D \<noteq> 0"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Eq p) (list_update L var ((A+B*C)/D)) = aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C)"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1 : "\<forall>i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have h2 : "((\<Sum>i = 0..<deg+1. f i / D ^ i) = 0) =((\<Sum>i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) =
      ((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) = 0)"
    by(simp add: hdeg insertion_sum insertion_add insertion_mult insertion_var insertion_pow ha hb hd lLength)
  also have "... =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) = 0)"
    using f_def h2 by auto
  also have "... =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) = 0)"
    by auto
  also have "... =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) = 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))=0)"
    using h1 by auto
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p =0)"
    using sum_over_degree_insertion hdeg lLength by auto
  also have "... = aEval (Eq p) (list_update L var ((A+B*C)/D))"
    using aEval.simps(1) by blast
  finally show ?thesis using assms by auto
qed

(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_less :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D \<noteq> 0"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Less p) (list_update L var ((A+B*C)/D)) = aEval (Less(quadratic_part_1 var a b d (Less p))) (list_update L var C)"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1a : "((\<Sum>i = 0..<deg+1. f i / D ^ i) < 0) =((\<Sum>i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) < 0)"
    using normalize_summation_less nonzero by(auto)
  have h4a : "\<forall>i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have "((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) < 0)
        =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) < 0)"
    using h1a f_def by auto
  also have "...=((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) < 0)"
    by auto
  also have "...=((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) < 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "... =((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D)))  (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))<0)"
    using h4a
    by auto
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p <0)"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var)
qed

(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_leq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D \<noteq> 0"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Leq p) (list_update L var ((A+B*C)/D)) = aEval (Leq(quadratic_part_1 var a b d (Leq p))) (list_update L var C)"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)" for i
  have h1a : "((\<Sum>i = 0..<deg+1. f i / D ^ i) < 0) =((\<Sum>i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) < 0)"
    using normalize_summation_less nonzero by(auto)
  have h1b : "((\<Sum>i = 0..<deg+1. f i / D ^ i) = 0) =((\<Sum>i = 0..<deg+1. (f i) * D ^ (deg - i)) = 0)"
    using normalize_summation nonzero by(auto)
  have h1c : "((\<Sum>i = 0..<deg+1. f i / D ^ i) \<le> 0) =((\<Sum>i = 0..<deg+1. (f i) * D ^ (deg - i))  * D ^ (deg mod 2) \<le> 0)"
    using h1a h1b nonzero by auto
  have h4a : "\<forall>i. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i)) = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i))"
    by(simp add: insertion_isovarspars_free)
  have "((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) * D ^ (deg - i)) * D ^ (deg mod 2) \<le> 0)=
    ((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C) ^ i)) / D ^ i) \<le> 0)"
    using h1c f_def by auto
  also have "...=((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)^i / (D ^ i)))) \<le> 0)"
    by auto
  also have "...=((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var C)) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i)) \<le> 0)"
    by (metis (no_types, lifting) power_divide sum.cong)
  also have "...=((\<Sum>i = 0..<deg+1. (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) (isolate_variable_sparse p var i) * ((A + B * C)/D) ^ i))\<le>0)"
    using h4a by auto
  also have "... = (insertion (nth_default 0 (list_update L var ((A+B*C)/D))) p\<le>0)"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add: hdeg lLength insertion_add insertion_mult ha hb hd insertion_sum insertion_pow insertion_var)
qed

(*------------------------------------------------------------------------------------------------*)
lemma quad_part_1_neq :
  assumes lLength : "length L > var"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg::nat)"
  assumes nonzero : "D \<noteq> 0"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) a = (A::real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) b = (B::real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) d = (D::real)"
  shows "aEval (Neq p) (list_update L var ((A+B*C)/D)) = aEval (Neq(quadratic_part_1 var a b d (Neq p))) (list_update L var C)"
proof -
  have "aEval (Eq(quadratic_part_1 var a b d (Eq p))) (list_update L var C) = aEval (Eq p) (list_update L var ((A+B*C)/D))"
    using quad_part_1_eq assms by blast
  then show ?thesis by auto
qed

(*------------------------------------------------------------------------------------------------*)

lemma sqrt_case :
  assumes detGreater0 : "SQ \<ge> 0"
  shows "((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
proof -
  have h1 : "i mod 2 = 0 \<or> (odd i \<and> (i mod 2 = 1))"
    by auto
  have h2 : "i mod 2 = 0 \<Longrightarrow> ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
    using detGreater0 apply auto
    by (simp add: real_sqrt_power_even)
  have h3 : "(odd i \<and> (i mod 2 = 1)) \<Longrightarrow> ((SQ^(i div 2)) * real (i mod 2) * sqrt SQ + SQ ^ (i div 2) * (1 - real (i mod 2))) = (sqrt SQ) ^ i"
    using detGreater0 apply auto
    by (smt One_nat_def add_Suc_right mult.commute nat_arith.rule0 odd_two_times_div_two_succ power.simps(2) power_mult real_sqrt_pow2)
  show ?thesis
    using h1 h2 h3
    by linarith
qed

lemma sum_over_sqrt :
  assumes detGreater0 : "SQ \<ge> 0"
  shows "(\<Sum>i\<in>{0..<n+1}. ((f i::real) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
        =(\<Sum>i\<in>{0..<n+1}. ((f i::real) * ((sqrt SQ)^i)))"
  apply (intro sum.cong refl)
  using sqrt_case[OF detGreater0] distrib_left mult.assoc by metis

lemma quad_part_2_eq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ\<ge>0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "\<forall>x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Eq p) (list_update L var (sqrt SQ)) = aEval (Eq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(\<Sum>i\<in>{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_less :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ\<ge>0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "\<forall>x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Less p) (list_update L var (sqrt SQ)) = aEval (Less(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(\<Sum>i\<in>{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_neq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ\<ge>0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "\<forall>x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Neq p) (list_update L var (sqrt SQ)) = aEval (Neq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(\<Sum>i\<in>{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_leq :
  assumes lLength : "length L > var"
  assumes detGreater0 : "SQ\<ge>0"
  assumes hdeg : "MPoly_Type.degree (p::real mpoly) var = (deg ::nat)"
  assumes hsq : "\<forall>x. insertion (nth_default 0 (list_update L var x)) sq = (SQ::real)"
  shows "aEval (Leq p) (list_update L var (sqrt SQ)) = aEval (Leq(quadratic_part_2 var sq p)) (list_update L var (sqrt SQ))"
proof -
  define f where "f i = insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)" for i
  have h1a : "(\<Sum>i\<in>{0..<deg+1}. (f i * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ +f i * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (f i * ((sqrt SQ)^i)))"
    using sum_over_sqrt detGreater0 by auto
  have "(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * (SQ^(i div 2)) * real (i mod 2) * sqrt SQ + (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i)) * SQ ^ (i div 2) * (1 - real (i mod 2))))
             =(\<Sum>i\<in>{0..<deg+1}. (insertion (nth_default 0 (list_update L var (sqrt SQ))) (isolate_variable_sparse p var i) * ((sqrt SQ)^i)))"
    using h1a f_def by auto
  also have "... = insertion (nth_default 0 (list_update L var (sqrt SQ))) p"
    using sum_over_degree_insertion hdeg lLength by auto
  finally show ?thesis
    by(simp add:hdeg hsq insertion_add insertion_sum insertion_mult insertion_pow insertion_var insertion_const lLength)
qed

lemma quad_part_2_deg :
  assumes sqfree : "(var::nat)\<notin>vars(sq::real mpoly)"
  shows "MPoly_Type.degree (quadratic_part_2 var sq p) var \<le> 1"
proof -
  define deg where "deg = MPoly_Type.degree (p::real mpoly) var"
  define f where "f i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (real (i mod 2)) * Var var" for i
  define g where "g i = isolate_variable_sparse p var i * sq ^ (i div 2) * Const (1 - real (i mod 2))" for i
  have h1a : "\<forall>i. MPoly_Type.degree (isolate_variable_sparse p var i) var = 0"
    by (simp add: varNotIn_degree not_in_isovarspar)
  have h1b : "\<forall>i. MPoly_Type.degree (sq ^ (i div 2)) var = 0"
    by (simp add: sqfree varNotIn_degree not_in_pow)
  have h1c : "\<forall>i. MPoly_Type.degree (Const (real (i mod 2))) var = 0"
    using degree_const by blast
  have h1d : "MPoly_Type.degree (Var var :: real mpoly) var = 1"
    using degree_one by auto
  have h1 : "\<forall>i<deg+1. MPoly_Type.degree (f i) var \<le> 1"
    using f_def degree_mult h1a h1b h1c h1d
    by (smt ExecutiblePolyProps.degree_one add.right_neutral mult.commute mult_eq_0_iff nat_le_linear not_one_le_zero)
  have h2a : "\<forall>i. MPoly_Type.degree (Const (1 - real (i mod 2))) var = 0"
    using degree_const by blast
  have h2 : "\<forall>i<deg+1. MPoly_Type.degree (g i) var = 0"
    using g_def degree_mult h1a h1b h2a
    by (metis (no_types, lifting) add.right_neutral mult_eq_0_iff)
  have h3 : "\<forall>i<deg+1. MPoly_Type.degree (f i + g i) var \<le> 1"
    using h1 h2 by (simp add: degree_add_leq)
  show ?thesis using atLeastLessThanSuc_atLeastAtMost degree_sum f_def g_def h3 deg_def by auto
qed

(*------------------------------------------------------------------------------------------------*)

lemma quad_equality_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv\<ge>0"
  assumes hC : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv)) = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*C)))) (list_update L var (sqrt Cv))"
proof-
  have h1 : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2a : "(Av + Bv * sqrt Cv = 0) = (Av = - Bv * sqrt Cv)"
    by auto
  have h2b : "(Av = - Bv * sqrt Cv) \<Longrightarrow> (Av^2 = (- Bv * sqrt Cv)^2)"
    by simp
  have h2c : "(Av^2 = (- Bv * sqrt Cv)^2) = (Av^2 = Bv^2 * (sqrt Cv)^2)"
    by (simp add: power_mult_distrib)
  have h2d : "(Av^2 = Bv^2 * (sqrt Cv)^2) = (Av^2 = Bv^2 * Cv)"
    by (simp add: detGreat0)
  have h2 : "(Av + Bv * sqrt Cv = 0) \<Longrightarrow> (Av^2 = Bv^2 * Cv)"
    using h2a h2b h2c h2d by blast
  have h3a : "(Av*Bv > 0) \<Longrightarrow> (Av + Bv * sqrt Cv \<noteq> 0)"
    by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero zero_less_mult_iff)
  have h3 : "(Av + Bv * sqrt Cv = 0) \<Longrightarrow> (Av*Bv\<le> 0)"
    using h3a by linarith
  have h4 : "(Av * Bv \<le> 0 \<and> Av\<^sup>2 = Bv\<^sup>2 * Cv) \<Longrightarrow> (Av + Bv * sqrt Cv = 0)"
    apply(cases "Av>0")
     apply (metis detGreat0 h2a h2c h2d mult_minus_left not_le power2_eq_iff real_sqrt_lt_0_iff zero_less_mult_iff)
    by (smt h2a real_sqrt_abs real_sqrt_mult zero_less_mult_iff)
  show ?thesis
    apply(simp add: hA hB h1 insertion_add insertion_mult insertion_var lLength)
    using h2 h3 h4 by blast
qed

lemma quadratic_sub_eq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h3c : "MPoly_Type.degree p2 var = 0 \<or> MPoly_Type.degree p2 var = 1"
    using freeC quad_part_2_deg p2_def by (meson le_neq_implies_less less_one)
  have h3d : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = (\<Sum>i\<le>1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis
  have h3g2a : "\<forall>f. (\<Sum>i::nat\<le>1. f i) = f 0 + f 1" by simp
  have h3g2 : "(\<Sum>i::nat\<le>1. isolate_variable_sparse p2 var i * Var var ^ i) =
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast
  have h3g : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast

  have "aEval (Eq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) =  aEval (Eq p1) (list_update L var (sqrt Cv))"
    using p1_def quad_part_1_eq nonzero ha hb hd lLength by blast
  also have h2 : "... = aEval (Eq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_eq lLength detGreater0 hc by metis
  also have "... = aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using quad_equality_helper hc detGreater0 h4a h4b lLength by blast
  also have "... = eval (quadratic_sub var a b c d (Eq p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis
  finally show ?thesis by blast
qed
  (*------------------------------------------------------------------------------------------------*)
lemma quadratic_sub_less_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv\<ge>0"
  assumes hC : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv)) = eval
     (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B\<^sup>2 * C - A\<^sup>2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A\<^sup>2 - B\<^sup>2 * C))))))
     (list_update L var (sqrt Cv)) "
proof-
  have h1 : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2 : "\<forall>x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h3 : "Av=0 \<Longrightarrow> Bv=0 \<Longrightarrow> (Av + Bv * sqrt Cv < 0) =
    (Av < 0 \<and> Bv\<^sup>2 * Cv < Av\<^sup>2 \<or> Bv \<le> 0 \<and> (Av < 0 \<or> Av\<^sup>2 < Bv\<^sup>2 * Cv))"
    by simp
  have h4 : "Av<0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av + Bv * sqrt Cv < 0) =
    (Av < 0 \<and> Bv\<^sup>2 * Cv < Av\<^sup>2 \<or> Bv \<le> 0 \<and> (Av < 0 \<or> Av\<^sup>2 < Bv\<^sup>2 * Cv))"
    by (metis add.right_neutral add_mono_thms_linordered_field(5) detGreat0 less_eq_real_def mult_less_0_iff mult_zero_class.mult_zero_left mult_zero_class.mult_zero_right real_sqrt_eq_zero_cancel_iff real_sqrt_gt_0_iff)
  have h5a : "Av\<ge>0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av < -Bv * sqrt Cv) \<Longrightarrow> (Av\<^sup>2 < Bv\<^sup>2 * Cv)"
  proof -
    assume a1: "0 \<le> Av"
    assume a2: "Av < - Bv * sqrt Cv"
    assume "Bv \<le> 0"
    then have "Av < sqrt (Cv * (Bv * Bv))"
      using a2 by (simp add: mult.commute real_sqrt_mult)
    then show ?thesis
      using a1 by (metis (no_types) mult.commute power2_eq_square real_sqrt_less_iff real_sqrt_mult real_sqrt_pow2_iff)
  qed
  have h5b : "Av\<ge>0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av\<^sup>2 < Bv\<^sup>2 * Cv) \<Longrightarrow> (Av < -Bv * sqrt Cv)"
    using real_less_rsqrt real_sqrt_mult by fastforce
  have h5 : "Av\<ge>0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av + Bv * sqrt Cv < 0) =
    (Av < 0 \<and> Bv\<^sup>2 * Cv < Av\<^sup>2 \<or> Bv \<le> 0 \<and> (Av < 0 \<or> Av\<^sup>2 < Bv\<^sup>2 * Cv))"
    using h5a h5b by linarith
  have h6 : "Av\<ge>0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av + Bv * sqrt Cv < 0) =
    (Av < 0 \<and> Bv\<^sup>2 * Cv < Av\<^sup>2 \<or> Bv \<le> 0 \<and> (Av < 0 \<or> Av\<^sup>2 < Bv\<^sup>2 * Cv))"
    by (smt detGreat0 mult_nonneg_nonneg real_sqrt_ge_zero)
  have h7a : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av < -Bv * sqrt Cv) \<Longrightarrow> (Bv\<^sup>2 * Cv < Av\<^sup>2)"
    by (smt mult_minus_left real_sqrt_abs real_sqrt_le_mono real_sqrt_mult)
  have h7b : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Bv\<^sup>2 * Cv < Av\<^sup>2) \<Longrightarrow> (Av < -Bv * sqrt Cv)"
    by (metis abs_of_nonneg abs_real_def add.commute less_eq_real_def mult.assoc mult_minus_left power2_eq_square real_add_less_0_iff real_sqrt_less_iff real_sqrt_mult real_sqrt_mult_self)
  have h7 : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av + Bv * sqrt Cv < 0) =
    (Av < 0 \<and> Bv\<^sup>2 * Cv < Av\<^sup>2 \<or> Bv \<le> 0 \<and> (Av < 0 \<or> Av\<^sup>2 < Bv\<^sup>2 * Cv))"
    using h7a h7b by linarith
  show ?thesis
    apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength)
    using h3 h4 h5 h6 h7 by smt
qed

lemma quadratic_sub_less :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var \<le> 1"
    using freeC quad_part_2_deg p2_def by blast
  then have h3c : "MPoly_Type.degree p2 var = 0 \<or> MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = (\<Sum>i\<le>1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis
  have h3g2a : "\<forall>f. (\<Sum>i::nat\<le>1. f i) = f 0 + f 1" by simp
  have h3g2 : "(\<Sum>i::nat\<le>1. isolate_variable_sparse p2 var i * Var var ^ i) =
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast
  have h3g : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0(list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0(list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast

  have h1 : "aEval (Less p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Less (quadratic_part_1 var a b d (Less p))) (list_update L var (sqrt Cv))"
    using quad_part_1_less assms by blast
  also have "... = aEval (Less p1) (list_update L var (sqrt Cv))"
    using p1_def by auto
  also have "... = aEval (Less (quadratic_part_2 var c p1)) (list_update L var (sqrt Cv))"
    using quad_part_2_less assms by blast
  also have "... = aEval (Less p2) (list_update L var (sqrt Cv))"
    using p2_def by auto
  also have "... = aEval (Less (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval
     (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B\<^sup>2 * c - A\<^sup>2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A\<^sup>2 - B\<^sup>2 * c))))))
     (list_update L var (sqrt Cv))"
    using quadratic_sub_less_helper hc detGreater0 h4a h4b lLength by blast
  also have  "... = eval (quadratic_sub var a b c d (Less p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis
  finally show ?thesis by blast
qed

(*------------------------------------------------------------------------------------------------*)
lemma quadratic_sub_leq_helper :
  assumes lLength : "length L > var"
  assumes detGreat0 : "Cv\<ge>0"
  assumes hC : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (C::real mpoly) = (Cv::real)"
  assumes hA : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A::real mpoly) = (Av::real)"
  assumes hB : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (B::real mpoly) = (Bv::real)"
  shows "aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv)) =
  eval (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*C-A^2))))(And (Atom(Leq B)) (Atom(Leq (A^2-B^2*C))))) (list_update L var (sqrt Cv))"
proof-
  have h1 : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (A^2-(B^2)*C) = Av^2-(Bv^2)*Cv"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h2 : "\<forall>x. insertion (nth_default 0 (list_update L var x)) ((B^2)*C-A^2) = (Bv^2)*Cv-Av^2"
    by(simp add: hA hB hC insertion_add insertion_mult insertion_sub insertion_pow)
  have h3 : "Av=0 \<Longrightarrow> Bv=0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    by simp
  have h4 : "Av<0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff)
  have h5 : "Av=0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    by (smt detGreat0 real_sqrt_ge_zero zero_less_mult_iff)
  have h6 : "Av\<ge>0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    by (smt detGreat0 mult_nonneg_nonneg mult_pos_pos real_sqrt_gt_0_iff real_sqrt_zero zero_le_power2 zero_less_mult_pos zero_less_power2)
  have h7a : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) \<Longrightarrow> Bv\<^sup>2 * Cv \<le> Av\<^sup>2"
    by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult)
  have h7b : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow>  Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) "
    by (smt real_sqrt_abs real_sqrt_less_mono real_sqrt_mult)
  have h7 : "Av<0 \<Longrightarrow> Bv>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    using h7a h7b by linarith
  have h8c : "(-Bv * sqrt Cv)^2 = Bv\<^sup>2 * Cv"
    by (simp add: detGreat0 power_mult_distrib)
  have h8a : "Av>0 \<Longrightarrow> Bv\<le>0  \<Longrightarrow> (Av \<le> -Bv * sqrt Cv) \<Longrightarrow>  Av\<^sup>2 \<le> Bv\<^sup>2 * Cv"
    using detGreat0 h8c power_both_sides by smt
  have h8b : "Av>0 \<Longrightarrow> Bv\<le>0  \<Longrightarrow>   Av\<^sup>2 \<le> Bv\<^sup>2 * Cv \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) "
    using detGreat0 h8c power_both_sides
    by (smt mult_minus_left real_sqrt_ge_zero zero_less_mult_iff)
  have h8 : "Av>0 \<Longrightarrow> Bv\<le>0 \<Longrightarrow> (Av + Bv * sqrt Cv \<le> 0) = (Av \<le> 0 \<and> Bv\<^sup>2 * Cv \<le> Av\<^sup>2 \<or> Bv \<le> 0 \<and> Av\<^sup>2 \<le> Bv\<^sup>2 * Cv)"
    using h8a h8b by linarith
  show ?thesis
    apply(simp add: hA hB h1 h2 insertion_add insertion_mult insertion_var lLength)
    using h3 h4 h5 h6 h7 h8 by smt
qed

lemma quadratic_sub_leq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var \<le> 1"
    using freeC quad_part_2_deg p2_def lLength by metis
  then have h3c : "MPoly_Type.degree p2 var = 0 \<or> MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = (\<Sum>i\<le>1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis
  have h3g2a : "\<forall>f. (\<Sum>i::nat\<le>1. f i) = f 0 + f 1" by simp
  have h3g2 : "(\<Sum>i::nat\<le>1. isolate_variable_sparse p2 var i * Var var ^ i) =
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast
  have h3g : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast

  have "aEval (Leq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Leq p1) (list_update L var (sqrt Cv))"
    using quad_part_1_leq nonzero ha hb hd p1_def lLength by metis
  also have "... = aEval (Leq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_leq hc detGreater0 lLength by metis
  also have "... = aEval (Leq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have h4 : "... = eval
     (Or
      (And
        (Atom(Leq(A)))
        (Atom (Leq(B^2*c-A^2))))
      (And
        (Atom(Leq B))
        (Atom(Leq (A^2-B^2*c)))))
     (list_update L var (sqrt Cv))"
    using quadratic_sub_leq_helper hc detGreater0 h4a h4b lLength by blast
  also have "... = eval (quadratic_sub var a b c d (Leq p)) (list_update L var (sqrt Cv))"
    using p1_def quadratic_sub.simps(3) p2_def A_def B_def by metis
  finally show ?thesis by blast
qed
  (*------------------------------------------------------------------------------------------------*)
lemma quadratic_sub_neq :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))"
proof -
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"

  have h3b : "MPoly_Type.degree p2 var \<le> 1"
    using freeC quad_part_2_deg p2_def lLength by metis
  then have h3c : "MPoly_Type.degree p2 var = 0 \<or> MPoly_Type.degree p2 var = 1"
    by auto
  have h3d : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> B = 0"
    by(simp add: B_def isovar_greater_degree)
  then have h3f : "MPoly_Type.degree p2 var = 0 \<Longrightarrow> p2 = A + B * Var var"
    by(simp add: h3d A_def degree0isovarspar)
  have h3g1 : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = (\<Sum>i\<le>1. isolate_variable_sparse p2 var i * Var var ^ i)"
    using sum_over_zero by metis
  have h3g2a : "\<forall>f. (\<Sum>i::nat\<le>1. f i) = f 0 + f 1" by simp
  have h3g2 : "(\<Sum>i::nat\<le>1. isolate_variable_sparse p2 var i * Var var ^ i) =
                isolate_variable_sparse p2 var 0 * Var var ^ 0 + isolate_variable_sparse p2 var 1 * Var var ^ 1"
    using h3g2a by blast
  have h3g : "MPoly_Type.degree p2 var = 1 \<Longrightarrow> p2 = A + B * Var var"
    apply(simp add: sum_over_zero A_def B_def)
    using h3g1 h3g2
    by (metis (no_types, lifting) One_nat_def mult_cancel_left2 power_0 power_one_right)
  have h3h : "p2 = A + B * Var var"
    using h3c h3f h3g by auto

  have h4a : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) A = x"
    using not_contains_insertion not_in_isovarspar A_def by blast
  have h4b : "\<exists>x::real. \<forall>y::real. insertion (nth_default 0 (list_update L var y)) B = x"
    using not_contains_insertion not_in_isovarspar B_def by blast
  have h4c : "aEval (Eq (A + B * Var var)) (list_update L var (sqrt Cv))
           = eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using quad_equality_helper hc detGreater0 h4a h4b lLength by blast
  have h4d : "aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv))
           = (\<not> (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))))"
    using aEval.simps(1) aEval.simps(4) h4c by blast
  have h4e : "(\<not> (eval (And (Atom(Leq (A*B))) (Atom (Eq (A^2-B^2*c)))) (list_update L var (sqrt Cv))))
                = eval (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    by (metis aNeg.simps(2) aNeg.simps(3) aNeg_aEval eval.simps(1) eval.simps(4) eval.simps(5) mult_minus_left)

  have "aEval (Neq p) (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = aEval (Neq p1) (list_update L var (sqrt Cv))"
    using quad_part_1_neq nonzero ha hb hd p1_def lLength by blast
  also have "... = aEval (Neq p2) (list_update L var (sqrt Cv))"
    using p2_def quad_part_2_neq hc detGreater0 lLength by metis
  also have "... = aEval (Neq (A + B * Var var)) (list_update L var (sqrt Cv))"
    using h3h by auto
  also have "... = eval (Or
      (Atom(Less(-A*B)))
      (Atom (Neq(A^2-B^2*c)))) (list_update L var (sqrt Cv))"
    using h4c h4d h4e by auto
  also have "... = eval (quadratic_sub var a b c d (Neq p)) (list_update L var (sqrt Cv))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(4) quadratic_part_1.simps(1) quadratic_part_1.simps(4)
    by (metis (no_types, lifting))
  finally show ?thesis by blast
qed
  (*-----------------------------------------------------------------------------------------------*)
theorem free_in_quad :
  assumes freeA : "var\<notin> vars a"
  assumes freeB : "var\<notin> vars b"
  assumes freeC : "var\<notin> vars c"
  assumes freeD : "var\<notin> vars d"
  shows "freeIn var (quadratic_sub var a b c d A)"
proof(cases A)
  case (Less p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Less p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Less p)) = freeIn var (Or (And (fm.Atom (Less A)) (fm.Atom (Less (B\<^sup>2 * c - A\<^sup>2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A\<^sup>2 - B\<^sup>2 * c))))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(2) by metis
  have h2d : "var\<notin>vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var ((Or (And (fm.Atom (Less A)) (fm.Atom (Less (B\<^sup>2 * c - A\<^sup>2))))
       (And (fm.Atom (Leq B)) (Or (fm.Atom (Less A)) (fm.Atom (Less (A\<^sup>2 - B\<^sup>2 * c)))))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Less by blast
next
  case (Eq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Eq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Eq p)) = freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A\<^sup>2 - B\<^sup>2 * c))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(1) by metis
  have h2d : "var\<notin>vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (And (Atom(Leq (A*B))) (Atom (Eq (A\<^sup>2 - B\<^sup>2 * c))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Eq by blast
next
  case (Leq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Leq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Leq p)) = freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(3) by metis
  have h2d : "var\<notin>vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (Or(And(Atom(Leq(A)))(Atom (Leq(B^2*c-A^2))))(And(Atom(Leq B))(Atom(Leq (A^2-B^2*c)))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Leq by blast
next
  case (Neq p)
  define p1 where "(p1::real mpoly) = quadratic_part_1 var a b d (Neq p)"
  define p2 where "(p2::real mpoly) = quadratic_part_2 var c p1"
  define A where "A = isolate_variable_sparse p2 var 0"
  define B where "B = isolate_variable_sparse p2 var 1"
  have h1 : "freeIn var (quadratic_sub var a b c d (Neq p)) = freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))"
    using p2_def A_def B_def p1_def quadratic_sub.simps(4) by metis
  have h2d : "var\<notin>vars(4::real mpoly)"
    by (metis freeB not_in_add not_in_pow numeral_Bit0 one_add_one power_0)
  have h2 : "freeIn var (Or (Atom(Less(-A*B))) (Atom (Neq(A^2-B^2*c))))"
    using vars_mult not_in_isovarspar A_def B_def not_in_sub not_in_mult not_in_neg not_in_pow not_in_isovarspar h2d freeC
    by (simp)
  show ?thesis using h1 h2 Neq by blast
qed

theorem quadratic_sub :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "aEval A (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub var a b c d A) (list_update L var (sqrt Cv))"
proof(cases A)
  case (Less x1)
  then show ?thesis using quadratic_sub_less assms by blast
next
  case (Eq x2)
  then show ?thesis using quadratic_sub_eq assms by blast
next
  case (Leq x3)
  then show ?thesis using quadratic_sub_leq assms by blast
next
  case (Neq x4)
  then show ?thesis using quadratic_sub_neq assms by blast
qed

lemma free_in_quad_fm_helper :
  assumes freeA : "var\<notin> vars a"
  assumes freeB : "var\<notin> vars b"
  assumes freeC : "var\<notin> vars c"
  assumes freeD : "var\<notin> vars d"
  shows "freeIn (var+z) (quadratic_sub_fm_helper var a b c d F z)"
proof(induction F arbitrary: z)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  then show ?case using free_in_quad[OF not_in_lift[OF assms(1)] not_in_lift[OF assms(2)] not_in_lift[OF assms(3)] not_in_lift[OF assms(4)], of z] by auto
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case by auto
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  show ?case using ExQ[of "z+1"] by simp
next
  case (AllQ F)
  show ?case using AllQ[of "z+1"] by simp
next
  case (ExN x1 F)
  then show ?case
    by (metis (no_types, lifting) add.assoc freeIn.simps(13) liftmap.simps(10) quadratic_sub_fm_helper.simps)
next
  case (AllN x1 F)
  then show ?case
    by (metis (no_types, lifting) freeIn.simps(12) group_cancel.add1 liftmap.simps(9) quadratic_sub_fm_helper.simps)
qed

theorem free_in_quad_fm :
  assumes freeA : "var\<notin> vars a"
  assumes freeB : "var\<notin> vars b"
  assumes freeC : "var\<notin> vars c"
  assumes freeD : "var\<notin> vars d"
  shows "freeIn var (quadratic_sub_fm var a b c d A)"
  using free_in_quad_fm_helper[OF assms, of 0] by auto

lemma quadratic_sub_fm_helper :
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes lLength : "length L > var+z"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update (drop z L) var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update (drop z L) var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update (drop z L) var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update (drop z L) var x)) (d::real mpoly) = (Dv :: real)"
  shows "eval F (list_update L (var+z) ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm_helper var a b c d F z) (list_update L (var+z) (sqrt Cv))"
  using assms proof(induction F arbitrary: z L)
  case TrueF
  then show ?case by auto
next
  case FalseF
  then show ?case by auto
next
  case (Atom x)
  define L1 where "L1 = drop z L"
  define L2 where "L2 = take z L"
  have L_def : "L = L2 @ L1" using L1_def L2_def by auto
  have lengthl2 : "length L2 = z" using L2_def
    using Atom.prems(4) by auto
  have "eval (Atom(Eq (a-Const Av))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (a- Const Av)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (a - Const Av)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(5) unfolding L1_def
    by (metis list_update_id)
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z a) = Av"
    using lift_minus by blast
  then have a1 : "\<forall>x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z a) = Av"
    unfolding L_def
    by (metis (no_types, lifting) Atom.prems(5) L1_def add.right_neutral add_diff_cancel_right' append_eq_append_conv append_eq_append_conv2 length_append lengthl2 lift_insertion list.size(3) list_update_append not_add_less2)
  have "eval (Atom(Eq (b-Const Bv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (b- Const Bv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (b - Const Bv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(6) unfolding L1_def
    by (metis list_update_id)
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z b) = Bv"
    using lift_minus by blast
  then have a2 : "\<forall>x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z b) = Bv"
    unfolding L_def using Atom(6) L1_def
    by (metis L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2)
  have "eval (Atom(Eq (c-Const Cv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (c- Const Cv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (c - Const Cv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(7) unfolding L1_def
    by (metis list_update_id)
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv"
    using lift_minus by blast
  then have a3 : "\<forall>x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z c) = Cv"
    unfolding L_def
  proof -
    obtain nn :: "(nat \<Rightarrow> real) \<Rightarrow> (nat \<Rightarrow> real) \<Rightarrow> real mpoly \<Rightarrow> nat" where
      "\<forall>x0 x1 x2. (\<exists>v3. v3 \<in> vars x2 \<and> x1 v3 \<noteq> x0 v3) = (nn x0 x1 x2 \<in> vars x2 \<and> x1 (nn x0 x1 x2) \<noteq> x0 (nn x0 x1 x2))"
      by moura
    then have f1: "\<forall>m f fa. nn fa f m \<in> vars m \<and> f (nn fa f m) \<noteq> fa (nn fa f m) \<or> insertion f m = insertion fa m"
      by (meson insertion_irrelevant_vars)
    obtain rr :: real where
      "(\<exists>v0. insertion (nth_default 0 ((L2 @ L1)[var + z := v0])) (liftPoly 0 z c) \<noteq> Cv) = (insertion (nth_default 0 ((L2 @ L1)[var + z := rr])) (liftPoly 0 z c) \<noteq> Cv)"
      by blast
    moreover
    { assume "var + z \<noteq> nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)"
      moreover
      { assume "(nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))) \<noteq> ((L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
        then have "nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) \<noteq> (L2 @ L1)[var + z := rr] ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) \<or> nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) \<noteq> (L2 @ L1) ! nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)"
          by linarith
        then have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) \<notin> vars (liftPoly 0 z c) \<or> nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
          by (metis (no_types) append_Nil2 length_list_update nth_default_append) }
      ultimately have "nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) \<notin> vars (liftPoly 0 z c) \<or> nth_default 0 (L2 @ L1) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c)) = nth_default 0 ((L2 @ L1)[var + z := rr]) (nn (nth_default 0 ((L2 @ L1)[var + z := rr])) (nth_default 0 (L2 @ L1)) (liftPoly 0 z c))"
        by force }
    ultimately show "\<forall>r. insertion (nth_default 0 ((L2 @ L1)[var + z := r])) (liftPoly 0 z c) = Cv"
      using f1 by (metis (full_types) Atom.prems(3) \<open>insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z c) = Cv\<close> not_in_lift)
  qed
  have "eval (Atom(Eq (d-Const Dv))) ([] @ L1) = eval (liftFm 0 z (Atom(Eq (d- Const Dv)))) ([] @ L2 @ L1)"
    by (metis eval_liftFm_helper lengthl2 list.size(3))
  then have "(insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z (d - Const Dv)) = 0)"
    apply(simp add: insertion_sub insertion_const)
    using Atom(8) unfolding L1_def
    by (metis list_update_id)
  then have "insertion (nth_default 0 (L2 @ L1)) (liftPoly 0 z d) = Dv"
    using lift_minus by blast
  then have a4 : "\<forall>x. insertion (nth_default 0 (L[var + z := x])) (liftPoly 0 z d) = Dv"
    unfolding L_def
    by (metis Atom(8) L1_def L_def add_diff_cancel_right' append.simps(1) lengthl2 lift_insertion list.size(3) list_update_append not_add_less2)
  then show ?case  apply(simp)
    using quadratic_sub[OF Atom(4) Atom(1) Atom(2) not_in_lift[OF Atom(3)], of "(liftPoly 0 z a)" Av "(liftPoly 0 z b)" Bv "(liftPoly 0 z d)" x
        , OF a1 a2 a3 a4] .
next
  case (And F1 F2)
  then show ?case by auto
next
  case (Or F1 F2)
  then show ?case by auto
next
  case (Neg F)
  then show ?case by auto
next
  case (ExQ F)
  have lengthG : "var + (z + 1) < length (x#L)" for x using ExQ(5) by auto
  have forall : "\<forall>x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av \<Longrightarrow>
      \<forall>x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av
    by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (ExQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) =
    (\<exists>x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))"
    by(simp)
  also have "... = (\<exists>x. eval
          (liftmap
            (\<lambda>x. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d))
            F (z + 1))
          (x # L[var + z := sqrt Cv]))"
    apply(rule ex_cong1)
    unfolding l
    using ExQ(1)[OF ExQ(2) ExQ(3) ExQ(4) lengthG forall[OF ExQ(6)] forall[OF ExQ(7)] forall[OF ExQ(8)] forall[OF ExQ(9)]]
    unfolding quadratic_sub_fm_helper.simps liftmap.simps
    by simp
  also have "... = eval (quadratic_sub_fm_helper var a b c d (ExQ F) z) (L[var + z := sqrt Cv])"
    unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto
  finally show ?case by simp
next
  case (AllQ F)
  have lengthG : "var + (z + 1) < length (x#L)" for x using AllQ(5) by auto
  have forall : "\<forall>x. insertion (nth_default 0 ((drop z L)[var := x])) a = Av \<Longrightarrow>
      \<forall>x. insertion (nth_default 0 ((drop (z + 1) (x1 # L))[var := x])) a = Av" for x1 a Av
    by auto
  have l : "x # L[var + z := v] = ((x#L)[var+(z+1):=v])" for x v
    by auto
  have "eval (AllQ F) (L[var + z := (Av + Bv * sqrt Cv) / Dv]) =
    (\<forall>x. eval F (x # L[var + z := (Av + Bv * sqrt Cv) / Dv]))"
    by(simp)
  also have "... = (\<forall>x. eval
          (liftmap
            (\<lambda>x. quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d))
            F (z + 1))
          (x # L[var + z := sqrt Cv]))"
    apply(rule all_cong1)
    unfolding l
    using AllQ(1)[OF AllQ(2) AllQ(3) AllQ(4) lengthG forall[OF AllQ(6)] forall[OF AllQ(7)] forall[OF AllQ(8)] forall[OF AllQ(9)]]
    unfolding quadratic_sub_fm_helper.simps liftmap.simps
    by simp
  also have "... = eval (quadratic_sub_fm_helper var a b c d (AllQ F) z) (L[var + z := sqrt Cv])"
    unfolding quadratic_sub_fm_helper.simps liftmap.simps eval.simps by auto
  finally show ?case by simp
next
  case (ExN x1 F)
  have list : "\<And>l. length l=x1 \<Longrightarrow> ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))"
    by auto
  have map : "\<And> z L. eval (liftmap (\<lambda>x A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1))
      L = eval (liftmap (\<lambda>x A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z)
      L"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case apply simp apply(rule ex_cong1)
    subgoal for l
      using map[of z] list[of l] ExN(1)[OF ExN(2-4), of "z+x1" "l@L"] ExN(5-9) list_update_append
      apply auto
      by (simp add: list_update_append) +
    done
next
  case (AllN x1 F)
  have list : "\<And>l. length l=x1 \<Longrightarrow> ((drop (z + x1) l @ drop (z + x1 - length l) L)) = ((drop z L))"
    by auto
  have map : "\<And> z L. eval (liftmap (\<lambda>x A. (quadratic_sub (var + x) (liftPoly 0 x a) (liftPoly 0 x b) (liftPoly 0 x c) (liftPoly 0 x d) A)) F (z + x1))
      L = eval (liftmap (\<lambda>x A. (quadratic_sub (var + x1 + x) (liftPoly 0 (x+x1) a) (liftPoly 0 (x+x1) b) (liftPoly 0 (x+x1) c) (liftPoly 0 (x+x1) d) A)) F z)
      L"
    apply(induction F) apply(simp_all add:add.commute add.left_commute)
    apply force
    apply force
    by (metis (mono_tags, lifting) ab_semigroup_add_class.add_ac(1))+
  show ?case apply simp apply(rule all_cong1)
    subgoal for l
      using map[of z] list[of l] AllN(1)[OF AllN(2-4), of "z+x1" "l@L"] AllN(5-9)
      apply auto
      by (simp add: list_update_append) +
    done
qed

theorem quadratic_sub_fm :
  assumes lLength : "length L > var"
  assumes nonzero : "Dv \<noteq> 0"
  assumes detGreater0 : "Cv \<ge> 0"
  assumes freeC : "var \<notin> vars c"
  assumes ha : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (a::real mpoly) = (Av :: real)"
  assumes hb : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (b::real mpoly) = (Bv :: real)"
  assumes hc : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (c::real mpoly) = (Cv :: real)"
  assumes hd : "\<forall>x. insertion (nth_default 0 (list_update L var x)) (d::real mpoly) = (Dv :: real)"
  shows "eval F (list_update L var ((Av+Bv*sqrt(Cv))/Dv)) = eval (quadratic_sub_fm var a b c d F) (list_update L var (sqrt Cv))"
  unfolding quadratic_sub_fm.simps using quadratic_sub_fm_helper[OF assms(2) assms(3) assms(4), of 0 L a Av b Bv d F] assms(1) assms(5) assms(6) assms(7) assms(8)
  by (simp add: lLength)
end


(* Title: PRF_UHF.thy
  Author: Bhargav Bhatt, ETH Zurich
  Author: Andreas Lochbihler, ETH Zurich *)

subsection \<open>Extending the input length of a PRF using a universal hash function\<close>

text \<open> This example is taken from \cite[\S 4.2]{Shoup2004IACR}.\<close>

theory PRF_UHF imports
  CryptHOL.GPV_Bisim
  Pseudo_Random_Function
begin

locale "hash" =
  fixes seed_gen :: "'seed spmf"
  and "hash" :: "'seed \<Rightarrow> 'domain \<Rightarrow> 'range"
begin

definition game_hash :: " 'domain \<Rightarrow> 'domain \<Rightarrow> bool spmf"
where
 "game_hash w w' = do {
    seed \<leftarrow> seed_gen;
    return_spmf (hash seed w = hash seed w' \<and> w \<noteq> w')
  }"

definition game_hash_set :: "'domain set \<Rightarrow> bool spmf"
where
  "game_hash_set W = do {
     seed  \<leftarrow> seed_gen;
     return_spmf (\<not> inj_on (hash seed) W)
   }"

definition \<epsilon>_uh :: "real"
where "\<epsilon>_uh  = (SUP w w'. spmf (game_hash w w') True)"

lemma \<epsilon>_uh_nonneg : "\<epsilon>_uh \<ge> 0"
by(auto 4 3 intro!: cSUP_upper2 bdd_aboveI2[where M=1] cSUP_least pmf_le_1 pmf_nonneg simp add: \<epsilon>_uh_def)

lemma hash_ineq_card:
  assumes "finite W"
  shows "spmf (game_hash_set W) True \<le> \<epsilon>_uh * card W * card W"
proof -
  let ?M = "measure (measure_spmf seed_gen)"
  have bound: "?M {x. hash x w = hash x w' \<and> w \<noteq> w'} \<le> \<epsilon>_uh" for w w'
  proof -
    have "?M {x. hash x w = hash x w' \<and> w \<noteq> w'} = spmf (game_hash w w') True"
      by(simp add: game_hash_def spmf_conv_measure_spmf map_spmf_conv_bind_spmf[symmetric] measure_map_spmf vimage_def)
    also have "\<dots> \<le> \<epsilon>_uh" unfolding \<epsilon>_uh_def
      by(auto intro!: cSUP_upper2 bdd_aboveI[where M=1] cSUP_least simp add: pmf_le_1)
    finally show ?thesis .
  qed

  have "spmf (game_hash_set W) True = ?M {x. \<exists>xa\<in>W. \<exists>y\<in>W. hash x xa = hash x y \<and> xa \<noteq> y}"
    by(auto simp add: game_hash_set_def inj_on_def map_spmf_conv_bind_spmf[symmetric] spmf_conv_measure_spmf measure_map_spmf vimage_def)
  also have "{x. \<exists>xa\<in>W. \<exists>y\<in>W. hash x xa = hash x y \<and> xa \<noteq> y} = (\<Union>(w, w') \<in> W\<times> W. {x. hash x w = hash x w' \<and> w \<noteq> w'})"
    by(auto)
  also have "?M \<dots> \<le> (\<Sum>(w, w')\<in>W \<times> W. ?M {x. hash x w = hash x w' \<and> w \<noteq> w'})"
    by(auto intro!: measure_spmf.finite_measure_subadditive_finite simp add: split_def assms)
  also have "\<dots> \<le> (\<Sum>(w, w')\<in>W \<times> W. \<epsilon>_uh)" by(rule sum_mono)(clarsimp simp add: bound)
  also have "\<dots> =  \<epsilon>_uh * card(W) * card(W)" by(simp add: card_cartesian_product)
  finally show ?thesis .
qed

end

locale prf_hash =
  fixes f :: "'key \<Rightarrow> '\<alpha> \<Rightarrow> '\<gamma>"
  and h :: "'seed \<Rightarrow> '\<beta> \<Rightarrow> '\<alpha>"
  and key_gen :: "'key spmf"
  and seed_gen :: "'seed spmf"
  and range_f :: "'\<gamma> set"
  assumes lossless_seed_gen: "lossless_spmf seed_gen"
  and range_f_finite: "finite range_f"
  and range_f_nonempty: "range_f \<noteq> {}"
begin

definition rand :: "'\<gamma> spmf"
where "rand = spmf_of_set range_f"

lemma lossless_rand [simp]: "lossless_spmf rand"
by(simp add: rand_def range_f_finite range_f_nonempty)

definition key_seed_gen :: "('key * 'seed) spmf"
where
  "key_seed_gen = do {
     k \<leftarrow> key_gen;
     s :: 'seed \<leftarrow> seed_gen;
     return_spmf (k, s)
   }"

interpretation "prf": "prf" key_gen f rand .
interpretation hash: hash "seed_gen" "h".

fun f' :: "'key \<times> 'seed \<Rightarrow> '\<beta> \<Rightarrow> '\<gamma>"
where "f' (key, seed) x = f key (h seed x)"

interpretation "prf'": "prf" key_seed_gen f' rand .

definition reduction_oracle :: "'seed \<Rightarrow> unit \<Rightarrow> '\<beta> \<Rightarrow> ('\<gamma> \<times> unit, '\<alpha>, '\<gamma>) gpv"
where "reduction_oracle seed x b = Pause (h seed b) (\<lambda>x. Done (x, ()))"

definition prf'_reduction :: " ('\<beta>, '\<gamma>) prf'.adversary \<Rightarrow> ('\<alpha>, '\<gamma>) prf.adversary"
where
  "prf'_reduction \<A> = do {
      seed  \<leftarrow> lift_spmf seed_gen;
      (b, \<sigma>) \<leftarrow> inline (reduction_oracle seed) \<A> ();
      Done b
  }"

theorem prf_prf'_advantage:
  assumes "prf'.lossless \<A>"
  and bounded: "prf'.ibounded_by \<A> q"
  shows "prf'.advantage \<A>  \<le> prf.advantage (prf'_reduction \<A>) + hash.\<epsilon>_uh * q * q"
  including lifting_syntax
proof -
  let ?\<A> = "prf'_reduction \<A>"

  { define cr where "cr = (\<lambda>_ :: unit \<times> unit. \<lambda>_ :: unit. True)"
    have [transfer_rule]: "cr ((), ()) ()" by(simp add: cr_def)
    have "prf.game_0 ?\<A> = prf'.game_0 \<A>"
      unfolding prf'.game_0_def prf.game_0_def prf'_reduction_def unfolding key_seed_gen_def
      by(simp add: exec_gpv_bind split_def exec_gpv_inline reduction_oracle_def bind_map_spmf prf.prf_oracle_def prf'.prf_oracle_def[abs_def])
        (transfer_prover) }
  note hop1 = this[symmetric]

  define semi_forgetful_RO where "semi_forgetful_RO = (\<lambda>seed :: 'seed. \<lambda>(\<sigma> :: '\<alpha> \<rightharpoonup> '\<beta> \<times> '\<gamma>, b :: bool). \<lambda>x.
    case \<sigma> (h seed x) of Some (a, y) \<Rightarrow> return_spmf (y, (\<sigma>, a \<noteq> x \<or> b))
     | None \<Rightarrow> bind_spmf rand (\<lambda>y. return_spmf (y, (\<sigma>(h seed x \<mapsto> (x, y)), b))))"

  define game_semi_forgetful where "game_semi_forgetful = do {
     seed :: 'seed \<leftarrow> seed_gen;
     (b, rep) \<leftarrow> exec_gpv (semi_forgetful_RO seed) \<A> (Map.empty, False);
     return_spmf (b, rep)
   }"

  have bad_semi_forgetful [simp]: "callee_invariant (semi_forgetful_RO seed) snd" for seed
    by(unfold_locales)(auto simp add: semi_forgetful_RO_def split: option.split_asm)
  have lossless_semi_forgetful [simp]: "lossless_spmf (semi_forgetful_RO seed s1 x)" for seed s1 x
    by(simp add: semi_forgetful_RO_def split_def split: option.split)

  { define cr
      where "cr = (\<lambda>(_ :: unit, \<sigma>) (\<sigma>' :: '\<alpha> \<Rightarrow> ('\<beta> \<times> '\<gamma>) option, _ :: bool). \<sigma> = map_option snd \<circ> \<sigma>')"
    define initial where "initial = (Map.empty :: '\<alpha> \<Rightarrow> ('\<beta> \<times> '\<gamma>) option, False)"
    have [transfer_rule]: "cr ((), Map.empty) initial" by(simp add: cr_def initial_def fun_eq_iff)
    have [transfer_rule]:  "((=) ===> cr ===> (=) ===> rel_spmf (rel_prod (=) cr))
        (\<lambda>y p ya. do {y \<leftarrow> prf.random_oracle (snd p) (h y ya); return_spmf (fst y, (), snd y) })
        semi_forgetful_RO"
      by(auto simp add: semi_forgetful_RO_def cr_def prf.random_oracle_def rel_fun_def fun_eq_iff split: option.split intro!: rel_spmf_bind_reflI)
    have "prf.game_1 ?\<A> = map_spmf fst game_semi_forgetful"
      unfolding prf.game_1_def prf'_reduction_def game_semi_forgetful_def
      by(simp add: exec_gpv_bind exec_gpv_inline split_def bind_map_spmf map_spmf_bind_spmf o_def map_spmf_conv_bind_spmf reduction_oracle_def initial_def[symmetric])
        (transfer_prover) }
  note hop2 = this

  define game_semi_forgetful_bad where "game_semi_forgetful_bad = do {
       seed :: 'seed \<leftarrow> seed_gen;
       x \<leftarrow> exec_gpv (semi_forgetful_RO seed) \<A> (Map.empty, False);
       return_spmf (snd x)
       }"
  have game_semi_forgetful_bad : "map_spmf snd game_semi_forgetful = game_semi_forgetful_bad"
    unfolding game_semi_forgetful_bad_def game_semi_forgetful_def
    by(simp add: map_spmf_bind_spmf o_def)

  have bad_random_oracle_A [simp]: "callee_invariant prf.random_oracle (\<lambda>\<sigma>. \<not> inj_on (h seed) (dom \<sigma>))" for seed
    by unfold_locales(auto simp add: prf.random_oracle_def split: option.split_asm)

  define invar
    where "invar = (\<lambda>seed (\<sigma>1, b) (\<sigma>2 :: '\<beta> \<Rightarrow> '\<gamma> option). \<not> b \<and> dom \<sigma>1 = h seed ` dom \<sigma>2 \<and>
      (\<forall>x \<in> dom \<sigma>2. \<sigma>1 (h seed x) = map_option (Pair x) (\<sigma>2 x)))"

  have rel_spmf_oracle_adv:
    "rel_spmf (\<lambda>(x, s1) (y, s2). snd s1 \<noteq> inj_on (h seed) (dom s2) \<and> (inj_on (h seed) (dom s2) \<longrightarrow> x = y \<and> invar seed s1 s2))
      (exec_gpv (semi_forgetful_RO seed) \<A> (Map.empty, False))
      (exec_gpv prf.random_oracle \<A> Map.empty)"
    if seed: "seed \<in> set_spmf seed_gen" for seed
  proof -
    have invar_initial [simp]: "invar seed (Map.empty, False) Map.empty" by(simp add: invar_def)
    have invarD_inj: "inj_on (h seed) (dom s2)" if "invar seed bs1 s2" for bs1 s2
      using that by(auto intro!: inj_onI simp add: invar_def)(metis domI domIff option.map_sel prod.inject)

    let ?R = "\<lambda>(a, s1) (b, s2 :: '\<beta> \<Rightarrow> '\<gamma> option).
        snd s1 = (\<not> inj_on (h seed) (dom s2)) \<and>
        (\<not> \<not> inj_on (h seed) (dom s2) \<longrightarrow> a = b \<and> invar seed s1 s2)"

    have step: "rel_spmf ?R (semi_forgetful_RO seed \<sigma>1b x) (prf.random_oracle s2 x)"
      if X: "invar seed \<sigma>1b s2" for s2 \<sigma>1b x
    proof -
      obtain \<sigma>1 b where [simp]: "\<sigma>1b = (\<sigma>1, b)" by(cases \<sigma>1b)
      from X have not_b: "\<not> b"
        and dom: "dom \<sigma>1 = h seed ` dom s2"
        and eq: "\<forall>x\<in>dom s2. \<sigma>1 (h seed x) = map_option (Pair x) (s2 x)"
        by(simp_all add: invar_def)
      from X have inj: "inj_on (h seed) (dom s2)" by(rule invarD_inj)

      have not_in_image: "h seed x \<notin> h seed ` (dom s2 - {x})" if "\<sigma>1 (h seed x) = None"
      proof (rule notI)
        assume "h seed x \<in> h seed ` (dom s2 - {x})"
        then obtain y where "y \<in> dom s2" and hx_hy: "h seed x = h seed y" by (auto)
        then have "\<sigma>1 (h seed y) = None" using that by (auto)
        then have "h seed y \<notin> h seed ` dom s2" using dom by (auto)
        then have "y \<notin> dom s2" by (auto)
        then show False using \<open>y \<in> dom s2\<close> by(auto)
      qed

      show ?thesis
      proof(cases "\<sigma>1 (h seed x)")
        case \<sigma>1: None
        hence s2: "s2 x = None" using dom by(auto)
        have "insert (h seed x) (dom \<sigma>1) = insert (h seed x) (h seed ` dom s2)" by(simp add: dom)
        then have invar_update: "invar seed (\<sigma>1(h seed x \<mapsto> (x, bs)), False) (s2(x \<mapsto> bs))" for bs
          using inj not_b not_in_image \<sigma>1 dom
          by(auto simp add: invar_def domIff eq) (metis domI domIff imageI)
        with \<sigma>1 s2 show ?thesis using inj not_b not_in_image
          by(auto simp add: semi_forgetful_RO_def prf.random_oracle_def intro: rel_spmf_bind_reflI)
      next
        case \<sigma>1: (Some "by")
        show ?thesis
        proof(cases "s2 x")
          case s2: (Some z)
          with eq \<sigma>1 have "by = (x, z)" by(auto simp add: domIff)
          thus ?thesis using \<sigma>1 inj not_b s2 X
            by(simp add: semi_forgetful_RO_def prf.random_oracle_def split_beta)
        next
          case s2: None
          from \<sigma>1 dom obtain y where y: "y \<in> dom s2" and *: "h seed x = h seed y"
            by(metis domIff imageE option.distinct(1))
          from y obtain z where z: "s2 y = Some z" by auto
          from eq z \<sigma>1 have "by": "by = (y, z)" by(auto simp add: * domIff)
          from y s2 have xny: "x \<noteq> y" by auto
          with y * have "h seed x \<in> h seed ` (dom s2 - {x})" by auto
          then show ?thesis using \<sigma>1 s2 not_b "by" xny inj
            by(simp add: semi_forgetful_RO_def prf.random_oracle_def split_beta)(rule rel_spmf_bindI2; simp)
        qed
      qed
    qed
    from invar_initial _ step show ?thesis
      by(rule exec_gpv_oracle_bisim_bad_full[where ?bad1.0 = "snd" and ?bad2.0 = "\<lambda>\<sigma>. \<not> inj_on (h seed) (dom \<sigma>)"])
        (simp_all add: assms)
  qed

  define game_A where "game_A = do {
      seed :: 'seed \<leftarrow> seed_gen;
      (b, \<sigma>) \<leftarrow> exec_gpv prf.random_oracle \<A> Map.empty;
      return_spmf (b, \<not> inj_on (h seed) (dom \<sigma>))
    }"

  let ?bad1 = "\<lambda>x. snd (snd x)" and ?bad2 = "snd"
  have hop3: "rel_spmf (\<lambda>x xa. (?bad1 x \<longleftrightarrow> ?bad2 xa) \<and> (\<not> ?bad2 xa \<longrightarrow> fst x \<longleftrightarrow> fst xa)) game_semi_forgetful game_A"
    unfolding game_semi_forgetful_def game_A_def
    by(clarsimp simp add: restrict_bind_spmf split_def map_spmf_bind_spmf restrict_return_spmf o_def intro!: rel_spmf_bind_reflI simp del: bind_return_spmf)
      (rule rel_spmf_bindI[OF rel_spmf_oracle_adv]; auto)
  have bad1_bad2: "spmf (map_spmf (snd \<circ> snd) game_semi_forgetful) True = spmf (map_spmf snd game_A) True"
    using fundamental_lemma_bad[OF hop3] by(simp add: measure_map_spmf spmf_conv_measure_spmf vimage_def)
  have bound_bad1_event: "\<bar>spmf (map_spmf fst game_semi_forgetful) True - spmf (map_spmf fst game_A) True\<bar> \<le> spmf (map_spmf (snd \<circ> snd) game_semi_forgetful) True"
    using fundamental_lemma[OF hop3] by(simp add: measure_map_spmf spmf_conv_measure_spmf vimage_def)

  then have bound_bad2_event : "\<bar>spmf (map_spmf fst game_semi_forgetful) True - spmf (map_spmf fst game_A) True\<bar> \<le> spmf (map_spmf snd game_A) True"
    using bad1_bad2 by (simp)

  define game_B where "game_B = do {
      (b, \<sigma>) \<leftarrow> exec_gpv prf.random_oracle \<A> Map.empty;
      hash.game_hash_set (dom \<sigma>)
    }"

  have game_A_game_B: "map_spmf snd game_A = game_B"
    unfolding game_B_def game_A_def hash.game_hash_set_def including monad_normalisation
    by(simp add: map_spmf_bind_spmf o_def split_def)

  have game_B_bound : "spmf game_B True \<le> hash.\<epsilon>_uh * q * q" unfolding game_B_def
  proof(rule spmf_bind_leI, clarify)
    fix b \<sigma>
    assume *: "(b, \<sigma>) \<in> set_spmf (exec_gpv prf.random_oracle \<A> Map.empty)"
    have "finite (dom \<sigma>)" by(rule prf.finite.exec_gpv_invariant[OF *]) simp_all
    then have "spmf (hash.game_hash_set (dom \<sigma>)) True \<le> hash.\<epsilon>_uh * (card (dom \<sigma>) * card (dom \<sigma>))"
      using hash.hash_ineq_card[of "dom \<sigma>"] by simp
    also have p1: "card (dom \<sigma>) \<le> q + card (dom (Map.empty :: '\<beta> \<Rightarrow> '\<gamma> option))"
      by(rule prf.card_dom_random_oracle[OF bounded *]) simp
    then have "card (dom \<sigma>) * card (dom \<sigma>) \<le> q * q" using mult_le_mono by auto
    finally show "spmf (hash.game_hash_set (dom \<sigma>)) True \<le> hash.\<epsilon>_uh * q * q"
      by(simp add: hash.\<epsilon>_uh_nonneg mult_left_mono)
  qed(simp add: hash.\<epsilon>_uh_nonneg)

  have hop4: "prf'.game_1 \<A> = map_spmf fst game_A"
    by(simp add: game_A_def prf'.game_1_def map_spmf_bind_spmf o_def split_def bind_spmf_const lossless_seed_gen lossless_weight_spmfD)

  have "prf'.advantage \<A> \<le> \<bar>spmf (prf.game_0 ?\<A>) True - spmf (prf'.game_1 \<A>) True\<bar>"
    using hop1 by(simp add: prf'.advantage_def)
  also have "\<dots> \<le> prf.advantage ?\<A> + \<bar>spmf (prf.game_1 ?\<A>) True - spmf (prf'.game_1 \<A>) True\<bar>"
    by(simp add: prf.advantage_def)
  also have "\<bar>spmf (prf.game_1 ?\<A>) True - spmf (prf'.game_1 \<A>) True\<bar> \<le>
    \<bar>spmf (map_spmf fst game_semi_forgetful) True - spmf (prf'.game_1 \<A>) True\<bar>"
    using hop2 by simp
  also have "\<dots> \<le> hash.\<epsilon>_uh * q * q"
    using game_A_game_B game_B_bound bound_bad2_event hop4 by(simp)
  finally show ?thesis by(simp add: add_left_mono)
qed

end

end