theory Why3_Number
imports
  Why3_Int
  "HOL-Computational_Algebra.Primes"
begin

section {* Parity properties *}

why3_open "number/Parity.xml"

why3_vc evenqtdef by arith

why3_vc oddqtdef by arith

why3_vc even_or_odd by auto

why3_vc even_not_odd using assms by simp

why3_vc odd_not_even using assms by simp

why3_vc even_odd using assms by simp

why3_vc odd_even using assms by simp

why3_vc even_even using assms by simp

why3_vc odd_odd using assms by simp

why3_vc even_2k by simp

why3_vc odd_2k1 by simp

why3_vc even_mod2
  by (auto simp add: evenqtdef cmod_def sgn_if minus_equation_iff [of n])

why3_end

section {* Divisibility *}

why3_open "number/Divisibility.xml"

why3_vc dividesqtdef
  by (auto simp add: cmod_def sgn_if minus_equation_iff [of n])

why3_vc divides_refl by simp

why3_vc divides_1_n by simp

why3_vc divides_0 by simp

why3_vc divides_left using assms by simp

why3_vc divides_right using assms by simp

why3_vc divides_oppr using assms by simp

why3_vc divides_oppl using assms by simp

why3_vc divides_oppr_rev using assms by simp

why3_vc divides_oppl_rev using assms by simp

why3_vc divides_plusr using assms by simp

why3_vc divides_minusr using assms by simp

why3_vc divides_multl using assms by simp

why3_vc divides_multr using assms by simp

why3_vc divides_factorl by simp

why3_vc divides_factorr by simp

why3_vc divides_n_1 using assms by auto

why3_vc divides_antisym
  using assms
  by (auto dest: zdvd_antisym_abs)

why3_vc divides_trans using assms by (rule dvd_trans)

why3_vc divides_bounds using assms by (simp add: dvd_imp_le_int)

why3_vc mod_divides_euclidean
  using assms
  by (auto simp add: emod_def split: if_split_asm)

why3_vc divides_mod_euclidean
  using assms
  by (simp add: emod_def dvd_eq_mod_eq_0 zabs_def zmod_zminus2_eq_if)

why3_vc mod_divides_computer
  using assms
  by (auto simp add: cmod_def zabs_def sgn_0_0 zmod_zminus1_eq_if
    not_sym [OF less_imp_neq [OF pos_mod_bound]]
    split: if_split_asm)

why3_vc divides_mod_computer
  using assms
  by (simp add: cmod_def dvd_eq_mod_eq_0 zabs_def
    zmod_zminus1_eq_if zmod_zminus2_eq_if)

why3_vc even_divides ..

why3_vc odd_divides ..

why3_vc dividesqtspec
  by (simp add: dvd_def mult.commute)

why3_end

section {* Greatest Common Divisor *}

why3_open "number/Gcd.xml"

why3_vc gcd_nonneg by simp

why3_vc gcd_def1 by simp

why3_vc gcd_def2 by simp

why3_vc gcd_def3 using assms by (rule gcd_greatest)

why3_vc gcd_unique using assms
  by (simp add: gcd_unique_int [symmetric])

why3_vc Comm by (rule gcd.commute)

why3_vc Assoc by (rule gcd.assoc)

why3_vc gcd_0_pos using assms by simp

why3_vc gcd_0_neg using assms by simp

why3_vc gcd_opp by simp

why3_vc gcd_euclid
  using gcd_add_mult [of a "- q" b]
  by (simp add: algebra_simps)

why3_vc Gcd_computer_mod
  using assms gcd_add_mult [of b "- 1" "a mod b"]
  by (simp add: cmod_def zabs_def gcd_red_int [symmetric] sgn_if algebra_simps del: gcd_mod_right)
    (simp add: zmod_zminus2_eq_if gcd_red_int [of a b] del: gcd_mod_right)

why3_vc Gcd_euclidean_mod
  using assms gcd_add_mult [of b "- 1" "a mod b"]
  by (simp add: emod_def zabs_def gcd_red_int [symmetric] algebra_simps del: gcd_mod_right)
    (simp add: zmod_zminus2_eq_if gcd_red_int [of a b] del: gcd_mod_right)

why3_vc gcd_mult using assms
  by (simp add: gcd_mult_distrib_int [symmetric])

why3_end

section {* Prime numbers *}

why3_open "number/Prime.xml"

why3_vc primeqtdef
  by (auto simp add: prime_int_iff')

why3_vc not_prime_1 by simp

why3_vc prime_2 by simp

why3_vc prime_3 by simp

why3_vc prime_divisors
  using assms
  by (auto simp add: prime_int_altdef dest: spec [of _ "\<bar>d\<bar>"])

lemma small_divisors_aux:
  "1 < (n::nat) \<Longrightarrow> n < p \<Longrightarrow> n dvd p \<Longrightarrow> \<exists>d. prime d \<and> d * d \<le> p \<and> d dvd p"
proof (induct n rule: less_induct)
  case (less n)
  then obtain m where "p = n * m" by (auto simp add: dvd_def)
  show ?case
  proof (cases "prime n")
    case True
    show ?thesis
    proof (cases "n \<le> m")
      case True
      with `p = n * m` `prime n`
      show ?thesis by auto
    next
      case False
      then have "m < n" by simp
      moreover from `n < p` `p = n * m` have "1 < m" by simp
      moreover from `1 < n` `n < p` `p = n * m` have "m < p" by simp
      moreover from `p = n * m` have "m dvd p" by simp
      ultimately show ?thesis by (rule less)
    qed
  next
    case False
    with `1 < n` obtain k where "k dvd n" "k \<noteq> 1" "k \<noteq> n"
      by (auto simp add: prime_nat_iff)
    with `1 < n` have "k \<le> n" by (simp add: dvd_imp_le)
    with `k \<noteq> n` have "k < n" by simp
    moreover from `k dvd n` `1 < n` have "k \<noteq> 0" by (rule_tac notI) simp
    with `k \<noteq> 1` have "1 < k" by simp
    moreover from `k < n` `n < p` have "k < p" by simp
    moreover from `k dvd n` `n dvd p` have "k dvd p" by (rule dvd_trans)
    ultimately show ?thesis by (rule less)
  qed
qed

why3_vc small_divisors
  unfolding primeqtdef
proof
  show "2 \<le> p" by fact

  show "\<forall>n. 1 < n \<and> n < p \<longrightarrow> \<not> n dvd p"
  proof (intro strip)
    fix n
    assume "1 < n \<and> n < p"
    show "\<not> n dvd p"
    proof
      assume "n dvd p"
      with `1 < n \<and> n < p`
      have "1 < nat n" "nat n < nat p" "nat n dvd nat p"
        by (simp_all add: nat_dvd_iff)
      then have "\<exists>d. prime d \<and> d * d \<le> nat p \<and> d dvd (nat p)"
        by (rule small_divisors_aux)
      with `2 \<le> p` obtain d
        where d: "prime (int d)" "int d * int d \<le> p" "int d dvd p"
        by (auto simp add: int_dvd_int_iff [symmetric] le_nat_iff)
      from `prime (int d)` have "2 \<le> int d" by (simp add: prime_ge_2_int)
      then have "2 \<le> int d" by simp
      with `2 \<le> int d` have "2 * 2 \<le> int d * int d"
        by (rule mult_mono) simp_all
      with d assms `2 \<le> int d` show False by auto
    qed
  qed
qed

why3_vc even_prime
proof -
  from `prime p` have "0 \<le> p" by (simp add: primeqtdef)
  from `prime p` have "2 \<le> p" by (simp add: prime_ge_2_int)
  with `prime p` `even p` `0 \<le> p` show ?thesis
    by (auto simp add: order_le_less prime_odd_int)
qed

why3_vc odd_prime
proof -
  from `prime p` have "2 \<le> p" by (simp add: prime_ge_2_int)
  with `prime p` `3 \<le> p` show ?thesis
    by (auto simp add: order_le_less prime_odd_int)
qed

why3_end

section {* Coprime numbers *}

why3_open "number/Coprime.xml"

why3_vc coprimeqtdef by (rule coprime_iff_gcd_eq_1)

why3_vc prime_coprime
proof -
  have "(\<forall>n. 1 < n \<and> n < p \<longrightarrow> \<not> n dvd p) =
    (\<forall>n. 1 \<le> n \<and> n < p \<longrightarrow> coprime n p)"
  proof
    assume H: "\<forall>n. 1 < n \<and> n < p \<longrightarrow> \<not> n dvd p"
    show "\<forall>n. 1 \<le> n \<and> n < p \<longrightarrow> coprime n p"
    proof (intro strip)
      fix n
      assume H': "1 \<le> n \<and> n < p"
      {
        fix d
        assume "0 \<le> d" "d dvd n" "d dvd p"
        with H' have "d \<noteq> 0" by auto
        have "d = 1"
        proof (rule ccontr)
          assume "d \<noteq> 1"
          with `0 \<le> d` `d \<noteq> 0` have "1 < d" by simp
          moreover from `d dvd p` H' have "d \<le> p" by (auto dest: zdvd_imp_le)
          moreover from `d dvd n` H' have "d \<noteq> p" by (auto dest: zdvd_imp_le)
          ultimately show False using `d dvd p` H by auto
        qed
      }
      then show "coprime n p"
        by (auto simp add: coprime_iff_gcd_eq_1)
    qed
  next
    assume H: "\<forall>n. 1 \<le> n \<and> n < p \<longrightarrow> coprime n p"
    show "\<forall>n. 1 < n \<and> n < p \<longrightarrow> \<not> n dvd p"
    proof (intro strip notI)
      fix n
      assume H': "1 < n \<and> n < p" "n dvd p"
      then have "1 \<le> n \<and> n < p" by simp
      with H have "coprime n p" by simp
      with H' show False by (simp add: coprime_iff_gcd_eq_1)
    qed
  qed
  then show ?thesis by (simp add: primeqtdef)
qed

why3_vc Gauss
proof -
  from assms
  have "coprime a b" "a dvd c * b" by (simp_all add: mult.commute)
  then show ?thesis by (simp add: coprime_dvd_mult_left_iff)
qed

why3_vc Euclid
  using assms
  by (simp add: prime_dvd_multD)

why3_vc gcd_coprime
proof -
  have "gcd a (b * c) = gcd (b * c) a" by (simp add: gcd.commute)
  also from assms have "coprime a b" by (simp add: gcd.commute coprime_iff_gcd_eq_1)
  then have "gcd (b * c) a = gcd c a" by (simp add: gcd_mult_left_left_cancel)
  finally show ?thesis by (simp add: gcd.commute)
qed

why3_end

end


theory Exercise5p6
imports Main
begin

fun elems :: "'a list \<Rightarrow> 'a set" where
    "elems [] = {}"
  | "elems (x#xs) = {x} \<union> elems xs"

value "elems [1,2,3,3,2,4]"

lemma "x \<in> elems xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> elems ys"
proof (induction xs)
  case Nil
  then show ?case by auto
next
  case (Cons a xs)
  then show ?case
  proof cases
    assume "a = x"
    obtain ys where ys: "(ys:: 'a list) = []" by auto
    obtain zs where zs: "zs = xs" by auto
    then have "x \<notin> elems ys" using `a = x` ys by auto
    thus ?case using ys zs `a = x` by blast
  next
    (* \<exists>ys zs. a # xs = ys @ x # zs \<and> x \<notin> elems ys *)
    assume prems: "x \<in> elems (a # xs)"
    assume IH: "(x \<in> elems xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> elems ys)"
    assume "a \<noteq> x"
    then have "x \<in> elems xs" using prems by auto
    then obtain ys old_ys zs where
      "ys = a # old_ys"
      "xs = old_ys @ x # zs"
      "x \<notin> elems old_ys"
      using IH by auto
    then have "a # xs = ys @ x # zs \<and> x \<notin> elems ys" using `a \<noteq> x` by auto
    thus ?case by auto
  qed
qed

end


theory "Denotational_Semantics"
imports
  Ordinary_Differential_Equations.ODE_Analysis
  "./Lib"
  "./Syntax"
begin
subsection \<open>Denotational Semantics\<close>
text \<open>
  The canonical dynamic semantics of dL are given as a denotational semantics.
  The important definitions for the denotational semantics are states $\nu$,
  interpretations I and the semantic functions $[[\psi]]I$, $[[\theta]]I\nu$,
  $[[\alpha]]I$, which are represented by the Isabelle functions \verb|fml_sem|,
  \verb|dterm_sem| and \verb|prog_sem|, respectively.
  \<close>
subsection \<open>States\<close>
text \<open>We formalize a state S as a pair $(S_V, S_V') : R^n \times R^n $, where $S_V$ assigns
  values to the program variables and $S_V$' assigns values to their
  differentials. Function constants are also formalized as having a fixed arity
  m \verb|(Rvec_dim)| which may differ from n. If a function does not need to
  have m arguments, any remaining arguments can be uniformly set to 0,
  which simulates the affect of having functions of less arguments.

  Most semantic proofs need to reason about states agreeing on variables.
  We say Vagree A B V if states A and B have the same values on all variables in V,
  similarly with VSagree A B V for simple states A and B and Iagree I J V for interpretations
  I and J.
  \<close>

(* Vector of reals of length 'a *)
type_synonym Rvec = "real^ident"
(* A state specifies one vector of values for unprimed variables x and a second vector for x'*)
type_synonym state = "Rvec \<times> Rvec"
(* 'a simple_state is half a state - either the xs or the x's *)
type_synonym simple_state = "Rvec"

definition Vagree :: "state \<Rightarrow> state \<Rightarrow> (ident + ident) set \<Rightarrow> bool"
where "Vagree \<nu> \<nu>' V \<equiv>
   (\<forall>i. Inl i \<in> V \<longrightarrow> fst \<nu> $ i = fst \<nu>' $ i)
 \<and> (\<forall>i. Inr i \<in> V \<longrightarrow> snd \<nu> $ i = snd \<nu>' $ i)"

definition VSagree :: "simple_state \<Rightarrow> simple_state \<Rightarrow> ident set \<Rightarrow> bool"
where "VSagree \<nu> \<nu>' V \<longleftrightarrow> (\<forall>i \<in> V. (\<nu> $ i) = (\<nu>' $ i))"

(* Agreement lemmas *)
lemma agree_nil:"Vagree \<nu> \<omega> {}"
  by (auto simp add: Vagree_def)

lemma agree_supset:"A \<supseteq> B \<Longrightarrow> Vagree \<nu> \<nu>' A \<Longrightarrow> Vagree \<nu> \<nu>' B"
  by (auto simp add: Vagree_def)

lemma VSagree_nil:"VSagree \<nu> \<omega> {}"
  by (auto simp add: VSagree_def)

lemma VSagree_supset:"A \<supseteq> B \<Longrightarrow> VSagree \<nu> \<nu>' A \<Longrightarrow> VSagree \<nu> \<nu>' B"
  by (auto simp add: VSagree_def)

lemma VSagree_UNIV_eq:"VSagree A B UNIV \<Longrightarrow> A = B"
  unfolding VSagree_def by (auto simp add: vec_eq_iff)

lemma agree_comm:"\<And>A B V. Vagree A B V \<Longrightarrow> Vagree B A V" unfolding Vagree_def by auto

lemma agree_eq:"\<And>A B V. A = B \<Longrightarrow> Vagree A B V" unfolding Vagree_def by auto

lemma agree_sub:"\<And>\<nu> \<omega> A B . A \<subseteq> B \<Longrightarrow> Vagree \<nu> \<omega> B \<Longrightarrow> Vagree \<nu> \<omega> A"
  unfolding Vagree_def by auto

lemma agree_UNIV_eq:"\<And>\<nu> \<omega>. Vagree \<nu> \<omega> UNIV \<Longrightarrow> \<nu> = \<omega>"
  unfolding Vagree_def by (auto simp add: vec_eq_iff)

lemma agree_UNIV_fst:"\<And>\<nu> \<omega>. Vagree \<nu> \<omega> (Inl ` UNIV) \<Longrightarrow> (fst \<nu>) = (fst \<omega>)"
  unfolding Vagree_def by (auto simp add: vec_eq_iff)

lemma Vagree_univ:"\<And>a b c d. Vagree (a,b) (c,d) UNIV \<Longrightarrow> a = c \<and> b = d"
  by (auto simp add: Vagree_def vec_eq_iff)

lemma agree_union:"\<And>\<nu> \<omega> A B. Vagree \<nu> \<omega> A \<Longrightarrow> Vagree \<nu> \<omega> B \<Longrightarrow> Vagree \<nu> \<omega> (A \<union> B)"
  unfolding Vagree_def by (auto simp add: vec_eq_iff)

lemma agree_refl:"Vagree \<nu> \<nu> A"
  by (auto simp add: Vagree_def)

lemma VSagree_sub:"\<And>\<nu> \<omega> A B . A \<subseteq> B \<Longrightarrow> VSagree \<nu> \<omega> B \<Longrightarrow> VSagree \<nu> \<omega> A"
  unfolding VSagree_def by auto

lemma VSagree_refl:"VSagree \<nu> \<nu> A"
  by (auto simp add: VSagree_def)

subsection Interpretations
text\<open>
    For convenience we pretend interpretations contain an extra field called
  FunctionFrechet specifying the Frechet derivative \verb|(FunctionFrechet f \<nu>)| : $R^m \rightarrow R$
  for every function in every state. The proposition \verb|(is_interp I)| says that such a
  derivative actually exists and is continuous (i.e. all functions are C1-continuous)
  without saying what the exact derivative is.

  The type parameters 'a, 'b, 'c are finite types whose cardinalities indicate the maximum number
  of functions, contexts, and <everything else defined by the interpretation>, respectively.
\<close>
record interp =
  Functions       :: "ident \<Rightarrow> Rvec \<Rightarrow> real"
  Funls           :: "ident \<Rightarrow> state \<Rightarrow> real"
  Predicates      :: "ident \<Rightarrow> Rvec \<Rightarrow> bool"
  Contexts        :: "ident \<Rightarrow> state set \<Rightarrow> state set"
  Programs        :: "ident \<Rightarrow> (state * state) set"
  ODEs            :: "ident \<Rightarrow> space \<Rightarrow> simple_state \<Rightarrow> simple_state"
  ODEBV           :: "ident \<Rightarrow> space \<Rightarrow> ident set"

fun FunctionFrechet :: "interp \<Rightarrow> ident \<Rightarrow> Rvec \<Rightarrow> Rvec \<Rightarrow> real"
  where "FunctionFrechet I i = (THE f'. \<forall> x. (Functions I i has_derivative f' x) (at x))"

(* For an interpretation to be valid, all functions must be differentiable everywhere.*)
definition is_interp :: "interp \<Rightarrow> bool"
  where "is_interp I \<equiv>
   (\<forall>x. \<forall>i.  ((FDERIV (Functions I i) x :> (FunctionFrechet I i x)) \<and> continuous_on UNIV (\<lambda>x. Blinfun (FunctionFrechet I i x))))
\<and>  (\<forall> ode. \<forall> x. ODEBV I ode (NB x) \<subseteq> -{x})"

lemma is_interpD:"is_interp I \<Longrightarrow> \<forall>x. \<forall>i. (FDERIV (Functions I i) x :> (FunctionFrechet I i x))"
  unfolding is_interp_def by auto

(* Agreement between interpretations. *)
definition Iagree :: "interp \<Rightarrow> interp \<Rightarrow> (ident + ident + ident) set \<Rightarrow> bool"
where "Iagree I J V \<equiv>
  (\<forall>i\<in>V.
    (\<forall>x. i = Inl x \<longrightarrow> Functions I x = Functions J x) \<and>
\<^cancel>\<open>    (\<forall>x. i = Inl x \<longrightarrow> DFunls I x = DFunls J x) \<and>\<close>
    (\<forall>x. i = Inl x \<longrightarrow> Funls I x = Funls J x) \<and>
    (\<forall>x. i = Inr (Inl x) \<longrightarrow> Contexts I x = Contexts J x) \<and>
    (\<forall>x. i = Inr (Inr x) \<longrightarrow> Predicates I x = Predicates J x) \<and>
    (\<forall>x. i = Inr (Inr x) \<longrightarrow> Programs I x = Programs J x) \<and>
    (\<forall>x. i = Inr (Inr x) \<longrightarrow> ODEs I x = ODEs J x) \<and>
    (\<forall>x. i = Inr (Inr x) \<longrightarrow> ODEBV I x = ODEBV J x))"

lemma Iagree_Func:"Iagree I J V \<Longrightarrow> Inl f \<in> V \<Longrightarrow> Functions I f = Functions J f"
  unfolding Iagree_def by auto

(*lemma Iagree_DFunl:"Iagree I J V \<Longrightarrow> Inl f \<in> V \<Longrightarrow> DFunls I f = DFunls J f"
  unfolding Iagree_def by auto*)

lemma Iagree_Funl:"Iagree I J V \<Longrightarrow> Inl f \<in> V \<Longrightarrow> Funls I f = Funls J f"
  unfolding Iagree_def by auto

lemma Iagree_Contexts:"Iagree I J V \<Longrightarrow> Inr (Inl C) \<in> V \<Longrightarrow> Contexts I C = Contexts J C"
  unfolding Iagree_def by auto

lemma Iagree_Pred:"Iagree I J V \<Longrightarrow> Inr (Inr p) \<in> V \<Longrightarrow> Predicates I p = Predicates J p"
  unfolding Iagree_def by auto

lemma Iagree_Prog:"Iagree I J V \<Longrightarrow> Inr (Inr a) \<in> V \<Longrightarrow> Programs I a = Programs J a"
  unfolding Iagree_def by auto

lemma Iagree_ODE:"Iagree I J V \<Longrightarrow> Inr (Inr a) \<in> V \<Longrightarrow> ODEs I a = ODEs J a"
  unfolding Iagree_def by auto

lemma Iagree_ODEBV:"Iagree I J V \<Longrightarrow> Inr (Inr a) \<in> V \<Longrightarrow> ODEBV I a = ODEBV J a"
  unfolding Iagree_def by auto

lemma Iagree_comm:"\<And>A B V. Iagree A B V \<Longrightarrow> Iagree B A V"
  unfolding Iagree_def by auto

lemma Iagree_sub:"\<And>I J A B . A \<subseteq> B \<Longrightarrow> Iagree I J B \<Longrightarrow> Iagree I J A"
  unfolding Iagree_def by auto

lemma Iagree_refl:"Iagree I I A"
  by (auto simp add: Iagree_def)

(* Semantics for differential-free terms. Because there are no differentials, depends only on the "x" variables
 * and not the "x'" variables. *)
primrec sterm_sem :: "interp \<Rightarrow> trm \<Rightarrow> simple_state \<Rightarrow> real"
where
  ssem_Var:"sterm_sem I (Var x) v = v $ x"
| ssem_Fun:"sterm_sem I (Function f args) v = Functions I f (\<chi> i. sterm_sem I (args i) v)"
| ssem_Neg:"sterm_sem I (Neg t) v = - sterm_sem I t v"
| ssem_Plus:"sterm_sem I (Plus t1 t2) v = sterm_sem I t1 v + sterm_sem I t2 v"
| ssem_Times:"sterm_sem I (Times t1 t2) v = sterm_sem I t1 v * sterm_sem I t2 v"
| ssem_Const:"sterm_sem I (Const b) v = sint (Rep_bword b)"
| ssem_DiffVar:"sterm_sem I ($' c) v = undefined"
| ssem_Funl:"sterm_sem I ($$F f) v = undefined"
| ssem_Diff:"sterm_sem I (Differential d) v = undefined"
| ssem_Max:"sterm_sem I (Max _ _ ) v = undefined"
| ssem_Min:"sterm_sem I (Min _ _ ) v = undefined"
| ssem_Abs:"sterm_sem I (Abs _) v = undefined"
| ssem_Div:"sterm_sem I (Div t1 t2) v = undefined"

(* frechet I \<theta> \<nu> syntactically computes the frechet derivative of the term \<theta> in the interpretation
 * I at state \<nu> (containing only the unprimed variables). The frechet derivative is a
 * linear map from the differential state \<nu> to reals.
 *)
primrec frechet :: "interp \<Rightarrow> trm \<Rightarrow> simple_state \<Rightarrow> simple_state \<Rightarrow> real"
where
  Frechet_Var:"frechet I (Var x) v = (\<lambda>v'. v' \<bullet> axis x 1)"
| Frechet_Fun:"frechet I (Function f args) v =
    (\<lambda>v'. FunctionFrechet I f (\<chi> i. sterm_sem I (args i) v) (\<chi> i. frechet I (args i) v v'))"
| Frechet_Neg:"frechet I (Neg t) v = (\<lambda>v'. - frechet I t v v')"
| Frechet_Plus:"frechet I (Plus t1 t2) v = (\<lambda>v'. frechet I t1 v v' + frechet I t2 v v')"
| Frechet_Times:"frechet I (Times t1 t2) v =
    (\<lambda>v'. sterm_sem I t1 v * frechet I t2 v v' + frechet I t1 v v' * sterm_sem I t2 v)"
| Frechet_Const:"frechet I (Const r) v = (\<lambda>v'. 0)"
(*| "frechet I ($$F' f) v = DFunls I f v"*)
| Frechet_DiffVar:"frechet I ($' c) v = undefined"
| Frechet_Diff:"frechet I (Differential d) v = undefined"
| Frechet_Funl:"frechet I ($$F f) v = undefined"

lemma Frechet_Zero[simp]: "frechet I \<^bold>0 v = (\<lambda>_. 0)"
  by (simp add: Zero_def)

definition directional_derivative :: "interp \<Rightarrow> trm \<Rightarrow> state \<Rightarrow> real"
where "directional_derivative I t = (\<lambda>v. frechet I t (fst v) (snd v))"

(* Sem for terms that are allowed to contain differentials.
 * Note there is some duplication with sterm_sem.*)
primrec dterm_sem :: "interp \<Rightarrow> trm \<Rightarrow> state \<Rightarrow> real"
where
  "dterm_sem I (Var x) = (\<lambda>v. fst v $ x)"
| "dterm_sem I (DiffVar x) = (\<lambda>v. snd v $ x)"
| "dterm_sem I (Function f args) = (\<lambda>v. Functions I f (\<chi> i. dterm_sem I (args i) v))"
| "dterm_sem I (Neg t) = (\<lambda>v. - (dterm_sem I t v) )"
| "dterm_sem I (Plus t1 t2) = (\<lambda>v. (dterm_sem I t1 v) + (dterm_sem I t2 v))"
| "dterm_sem I (Times t1 t2) = (\<lambda>v. (dterm_sem I t1 v) * (dterm_sem I t2 v))"
| "dterm_sem I (Div t1 t2) = (\<lambda>v. (dterm_sem I t1 v) / (dterm_sem I t2 v))"
| "dterm_sem I (Differential t) = (\<lambda>v. directional_derivative I t v)"
| "dterm_sem I ($$F f) = (\<lambda>v. Funls I f v)"
| "dterm_sem I (Const b) = (\<lambda>v. sint (Rep_bword b))"
| "dterm_sem I (Max t1 t2) = (\<lambda>v. max (dterm_sem I t1 v) (dterm_sem I t2 v))"
| "dterm_sem I (Min t1 t2) = (\<lambda>v. min (dterm_sem I t1 v) (dterm_sem I t2 v))"
| "dterm_sem I (Abs t1) = (\<lambda>v. abs (dterm_sem I t1 v))"

text\<open> The semantics of an ODE is the vector field at a given point. ODE's are all time-independent
  so no time variable is necessary. Terms on the RHS of an ODE must be differential-free, so
  depends only on the xs.

  The safety predicate \texttt{osafe} ensures the domains of ODE1 and ODE2 are disjoint, so vector addition
  is equivalent to saying "take things defined from ODE1 from ODE1, take things defined
  by ODE2 from ODE2"\<close>
fun ODE_sem:: "interp \<Rightarrow> ODE \<Rightarrow> Rvec \<Rightarrow> Rvec"
  where
  ODE_sem_OVar:"ODE_sem I (OVar x sp) = (\<lambda>\<nu>. (\<chi> i. if i \<in> ODEBV I x sp then ODEs I x sp  \<nu> $ i else 0))"
| ODE_sem_OSing:"ODE_sem I (OSing x \<theta>) =  (\<lambda>\<nu>. (\<chi> i. if i = x then sterm_sem I \<theta> \<nu> else 0))"
(* Note: Could define using SOME operator in a way that more closely matches above description,
 * but that gets complicated in the OVar case because not all variables are bound by the OVar *)
| ODE_sem_OProd:"ODE_sem I (OProd ODE1 ODE2) = (\<lambda>\<nu>. ODE_sem I ODE1 \<nu> + ODE_sem I ODE2 \<nu>)"

lemma ODE_sem_assoc:"ODE_sem I (oprod ODE1 ODE2) = ODE_sem I (OProd ODE1 ODE2)"
  apply(induction ODE1 arbitrary:ODE2)
  by(auto)

(* The bound variables of an ODE *)
fun ODE_vars :: "interp \<Rightarrow> ODE \<Rightarrow> ident set"
  where
  "ODE_vars I (OVar c sp) = ODEBV I c sp"
| "ODE_vars I (OSing x \<theta>) = {x}"
| "ODE_vars I (OProd ODE1 ODE2) = ODE_vars I ODE1 \<union> ODE_vars I ODE2"

lemma ODE_vars_assoc:"ODE_vars I (oprod ODE1 ODE2) = ODE_vars I (OProd ODE1 ODE2)"
  apply(induction ODE1 arbitrary:ODE2)
  by(auto)

fun semBV ::"interp \<Rightarrow> ODE \<Rightarrow> (ident + ident) set"
  where "semBV I ODE = Inl ` (ODE_vars I ODE) \<union> Inr ` (ODE_vars I ODE)"

lemma ODE_vars_lr:
  fixes x::"ident" and ODE::"ODE" and I::"interp"
  shows "Inl x \<in> semBV I ODE \<longleftrightarrow> Inr x \<in> semBV I ODE"
  by (induction "ODE", auto)

fun mk_xode::"interp \<Rightarrow> ODE \<Rightarrow>  simple_state \<Rightarrow> state"
where "mk_xode I ODE sol = (sol, ODE_sem I ODE sol)"

text\<open> Given an initial state $\nu$ and solution to an ODE at some point, construct the resulting state $\omega$.
  This is defined using the SOME operator because the concrete definition is unwieldy. \<close>
definition mk_v::"interp \<Rightarrow> ODE \<Rightarrow> state \<Rightarrow> simple_state \<Rightarrow> state"
where "mk_v I ODE \<nu> sol = (THE \<omega>.
  Vagree \<omega> \<nu> (- semBV I ODE)
\<and> Vagree \<omega> (mk_xode I ODE sol) (semBV I ODE))"

(* repv \<nu> x r replaces the value of (unprimed) variable x in the state \<nu> with r *)
fun repv :: "state \<Rightarrow> ident \<Rightarrow> real \<Rightarrow> state"
where "repv v x r = ((\<chi> y. if x = y then r else vec_nth (fst v) y), snd v)"

(* repd \<nu> x' r replaces the value of (primed) variable x' in the state \<nu> with r *)
fun repd :: "state \<Rightarrow> ident \<Rightarrow> real \<Rightarrow> state"
where "repd v x r = (fst v, (\<chi> y. if x = y then r else vec_nth (snd v) y))"

(* Semantics for formulas, differential formulas, programs. *)
fun fml_sem  :: "interp \<Rightarrow> formula \<Rightarrow> state set" and
  prog_sem :: "interp \<Rightarrow>  hp \<Rightarrow> (state * state) set"
where
  "fml_sem I (Geq t1 t2) = {v. dterm_sem I t1 v \<ge> dterm_sem I t2 v}"
| "fml_sem I (Prop P terms) = {\<nu>. Predicates I P (\<chi> i. dterm_sem I (terms i) \<nu>)}"
| "fml_sem I (Not \<phi>) = {v. v \<notin> fml_sem I \<phi>}"
| "fml_sem I (And \<phi> \<psi>) = fml_sem I \<phi> \<inter> fml_sem I \<psi>"
| "fml_sem I (Exists x \<phi>) = {v | v r. (repv v x r) \<in> fml_sem I \<phi>}"
| "fml_sem I (Diamond \<alpha> \<phi>) = {\<nu> | \<nu> \<omega>. (\<nu>, \<omega>) \<in> prog_sem I \<alpha> \<and> \<omega> \<in> fml_sem I \<phi>}"
| "fml_sem I (InContext c \<phi>) = Contexts I c (fml_sem I \<phi>)"

| "prog_sem I (Pvar p) = Programs I p"
| "prog_sem I (Assign x t) = {(\<nu>, \<omega>). \<omega> = repv \<nu> x (dterm_sem I t \<nu>)}"
| "prog_sem I (AssignAny x) = {(\<nu>, \<omega>) | \<omega> \<nu> r. \<omega> = repv \<nu> x r}"
| "prog_sem I (DiffAssign x t) = {(\<nu>, \<omega>). \<omega> = repd \<nu> x (dterm_sem I t \<nu>)}"
| "prog_sem I (Test \<phi>) = {(\<nu>, \<nu>) | \<nu>. \<nu> \<in> fml_sem I \<phi>}"
| "prog_sem I (Choice \<alpha> \<beta>) = prog_sem I \<alpha> \<union> prog_sem I \<beta>"
| "prog_sem I (Sequence \<alpha> \<beta>) = prog_sem I \<alpha> O prog_sem I \<beta>"
| "prog_sem I (Loop \<alpha>) = (prog_sem I \<alpha>)\<^sup>*"
| "prog_sem I (EvolveODE ODE \<phi>) =
  ({(\<nu>, mk_v I ODE \<nu> (sol t)) | \<nu> sol t.
      t \<ge> 0 \<and>
      (sol solves_ode (\<lambda>_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE \<nu> x \<in> fml_sem I \<phi>} \<and>
      sol 0 = fst \<nu>})"

definition valid :: "formula \<Rightarrow> bool"
where "valid \<phi> \<equiv> (\<forall> I. \<forall> \<nu>. is_interp I \<longrightarrow> \<nu> \<in> fml_sem I \<phi>)"

text\<open> Because mk\_v is defined with the SOME operator, need to construct a state that satisfies
    ${\tt Vagree} \omega \nu (- {\tt ODE\_vars\ ODE})
     \wedge {\tt Vagree} \omega {\tt (mk\_xode\ I\ ODE\ sol)\ (ODE\_vars\ ODE)})$
    to do anything useful \<close>
fun concrete_v::"interp \<Rightarrow> ODE \<Rightarrow> state \<Rightarrow> simple_state \<Rightarrow> state"
where "concrete_v I ODE \<nu> sol =
((\<chi> i. (if Inl i \<in> semBV I ODE then sol else (fst \<nu>)) $ i),
 (\<chi> i. (if Inr i \<in> semBV I ODE then ODE_sem I ODE sol else (snd \<nu>)) $ i))"

lemma mk_v_exists:"\<exists>\<omega>. Vagree \<omega> \<nu> (- semBV I ODE)
\<and> Vagree \<omega> (mk_xode I ODE sol) (semBV I ODE)"
  by(rule exI[where x="(concrete_v I ODE \<nu> sol)"], auto simp add: Vagree_def)

lemma mk_v_agree:"Vagree (mk_v I ODE \<nu> sol) \<nu> (- semBV I ODE)
\<and> Vagree (mk_v I ODE \<nu> sol) (mk_xode I ODE sol) (semBV I ODE)"
  unfolding mk_v_def
  apply(rule theI[where a= "((\<chi> i. (if Inl i \<in> semBV I ODE then sol else (fst \<nu>)) $ i),
  (\<chi> i. (if Inr i \<in> semBV I ODE then ODE_sem I ODE sol else (snd \<nu>)) $ i))"])
   using exE[OF mk_v_exists, of \<nu> I ODE sol]
   by (auto simp add: Vagree_def vec_eq_iff)

lemma mk_v_concrete:"mk_v I ODE \<nu> sol = ((\<chi> i. (if Inl i \<in> semBV I ODE then sol else (fst \<nu>)) $ i),
  (\<chi> i. (if Inr i \<in> semBV I ODE then ODE_sem I ODE sol else (snd \<nu>)) $ i))"
  apply(rule agree_UNIV_eq)
  using mk_v_agree[of I ODE \<nu> sol]
  unfolding Vagree_def by auto

subsection \<open>Trivial Simplification Lemmas\<close>
text \<open>
 We often want to pretend the definitions in the semantics are written slightly
 differently than they are. Since the simplifier has some trouble guessing that
 these are the right simplifications to do, we write them all out explicitly as
 lemmas, even though they prove trivially.
\<close>

lemma svar_case:
  "sterm_sem I (Var x) = (\<lambda>v. v $ x)"
  by auto

lemma sconst_case:
  "sterm_sem I (Const b) = (\<lambda>v. sint (Rep_bword b))"
  by auto

lemma sfunction_case:
  "sterm_sem I (Function f args) = (\<lambda>v. Functions I f (\<chi> i. sterm_sem I (args i) v))"
  by auto

lemma splus_case:
  "sterm_sem I (Plus t1 t2) = (\<lambda>v. (sterm_sem I t1 v) + (sterm_sem I t2 v))"
  by auto

lemma stimes_case:
  "sterm_sem I (Times t1 t2) = (\<lambda>v. (sterm_sem I t1 v) * (sterm_sem I t2 v))"
  by auto

lemma or_sem [simp]:
  "fml_sem I (Or \<phi> \<psi>) = fml_sem I \<phi> \<union> fml_sem I \<psi>"
  by (auto simp add: Or_def)

lemma iff_sem [simp]: "(\<nu> \<in> fml_sem I (A \<leftrightarrow> B))
  \<longleftrightarrow> ((\<nu> \<in> fml_sem I A) \<longleftrightarrow> (\<nu> \<in> fml_sem I B))"
  by (auto simp add: Equiv_def)

lemma box_sem [simp]:"fml_sem I (Box \<alpha> \<phi>) = {\<nu>. \<forall> \<omega>. (\<nu>, \<omega>) \<in> prog_sem I \<alpha> \<longrightarrow> \<omega> \<in> fml_sem I \<phi>}"
  unfolding Box_def fml_sem.simps
  using Collect_cong by (auto)

lemma forall_sem [simp]:"fml_sem I (Forall x \<phi>) = {v. \<forall>r. (repv v x r) \<in> fml_sem I \<phi>}"
  unfolding Forall_def fml_sem.simps
  using Collect_cong by (auto)

lemma greater_sem[simp]:"fml_sem I (Greater \<theta> \<theta>') = {v. dterm_sem I \<theta> v > dterm_sem I \<theta>' v}"
  unfolding Greater_def by auto

lemma sterm_sem_zero[simp]: "sterm_sem I \<^bold>0 \<nu> = 0"
  by (auto simp: Zero_def bword_zero.rep_eq)

lemma dterm_sem_zero[simp]: "dterm_sem I \<^bold>0 = (\<lambda>_. 0)"
  by (auto simp: Zero_def bword_zero.rep_eq)

lemma sterm_sem_one[simp]: "sterm_sem I \<^bold>1 \<nu> = 1"
  by (auto simp: One_def bword_one.rep_eq)

lemma dterm_sem_one[simp]: "dterm_sem I \<^bold>1 = (\<lambda>_. 1)"
  by (auto simp: One_def bword_one.rep_eq)

lemma loop_sem:"prog_sem I (Loop \<alpha>) = (prog_sem I \<alpha>)\<^sup>*"
  by (auto)

lemma impl_sem [simp]: "(\<nu> \<in> fml_sem I (A \<rightarrow> B))
  = ((\<nu> \<in> fml_sem I A) \<longrightarrow> (\<nu> \<in> fml_sem I B))"
  by (auto simp add: Implies_def)

lemma equals_sem [simp]: "(\<nu> \<in> fml_sem I (Equals \<theta> \<theta>'))
  = (dterm_sem I \<theta> \<nu> = dterm_sem I \<theta>' \<nu>)"
  by (auto simp add: Equals_def)

lemma diamond_sem [simp]: "fml_sem I (Diamond \<alpha> \<phi>)
  = {\<nu>. \<exists> \<omega>. (\<nu>, \<omega>) \<in> prog_sem I \<alpha> \<and> \<omega> \<in> fml_sem I \<phi>}"
  by auto

lemma tt_sem [simp]:"fml_sem I TT = UNIV" unfolding TT_def by auto
lemma ff_sem [simp]:"fml_sem I FF = {}"
  using Abs_bword_inverse[of 0] Abs_bword_inverse[of 1]
  unfolding FF_def POS_INF_def NEG_INF_def bword_zero_def bword_one_def by (auto)

lemma iff_to_impl: "((\<nu> \<in> fml_sem I A) \<longleftrightarrow> (\<nu> \<in> fml_sem I B))
  \<longleftrightarrow> (((\<nu> \<in> fml_sem I A) \<longrightarrow> (\<nu> \<in> fml_sem I B))
     \<and> ((\<nu> \<in> fml_sem I B) \<longrightarrow> (\<nu> \<in> fml_sem I A)))"
  by (auto)

    fun seq2fml :: "sequent \<Rightarrow> formula"
where
  "seq2fml (ante,succ) = Implies (foldr And ante TT) (foldr Or succ FF)"

fun seq_sem ::"interp \<Rightarrow> sequent \<Rightarrow> state set"
where "seq_sem I S = fml_sem I (seq2fml S)"

lemma and_foldl_sem:"\<nu> \<in> fml_sem I (foldr And \<Gamma> TT) \<Longrightarrow> (\<And>\<phi>. List.member \<Gamma> \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I \<phi>)"
  by(induction \<Gamma>, auto simp add: member_rec)

lemma and_foldl_sem_conv:"(\<And>\<phi>. List.member \<Gamma> \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I \<phi>) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr And \<Gamma> TT)"
  by(induction \<Gamma>, auto simp add: member_rec)

lemma or_foldl_sem:"List.member \<Gamma> \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I (foldr Or \<Gamma> FF)"
  by(induction \<Gamma>, auto simp add: member_rec)

lemma or_foldl_sem_conv:"\<nu> \<in> fml_sem I (foldr Or \<Gamma> FF) \<Longrightarrow> \<exists> \<phi>. \<nu> \<in> fml_sem I \<phi> \<and> List.member \<Gamma> \<phi>"
  by(induction \<Gamma>, auto simp add: member_rec)

lemma seq_sem_UNIV_I:"(\<And>\<nu>. \<nu> \<in> fml_sem I (foldr And \<Gamma> TT) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr Or \<Delta> FF)) \<Longrightarrow> seq_sem I (\<Gamma>,\<Delta>) = UNIV"
  by auto

lemma seq_semD':"\<And>P. \<nu> \<in> seq_sem I (\<Gamma>,\<Delta>) \<Longrightarrow> ((\<nu> \<in> fml_sem I (foldr And \<Gamma> TT) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr Or \<Delta> FF)) \<Longrightarrow> P) \<Longrightarrow> P"
  by simp

definition sublist::"'a list \<Rightarrow> 'a list \<Rightarrow> bool"
where "sublist A B \<equiv> (\<forall>x. List.member A x \<longrightarrow> List.member B x)"

lemma sublistI:"(\<And>x. List.member A x \<Longrightarrow> List.member B x) \<Longrightarrow> sublist A B"
  unfolding sublist_def by auto

lemma \<Gamma>_sub_sem:"sublist \<Gamma>1 \<Gamma>2 \<Longrightarrow> \<nu> \<in> fml_sem I (foldr And \<Gamma>2 TT) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr And \<Gamma>1 TT)"
  unfolding sublist_def
  by (metis and_foldl_sem and_foldl_sem_conv)

lemma seq_semI:"List.member \<Delta> \<psi> \<Longrightarrow>((\<And>\<phi>. List.member \<Gamma> \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I \<phi>) \<Longrightarrow> \<nu> \<in> fml_sem I \<psi>) \<Longrightarrow> \<nu> \<in> seq_sem I (\<Gamma>,\<Delta>)"
  apply(rule seq_semI')
  using and_foldl_sem[of \<nu> I \<Gamma>] or_foldl_sem by blast

lemma seq_semD:"\<nu> \<in> seq_sem I (\<Gamma>,\<Delta>) \<Longrightarrow> (\<And>\<phi>. List.member \<Gamma> \<phi> \<Longrightarrow> \<nu> \<in> fml_sem I \<phi>) \<Longrightarrow> \<exists>\<phi>. (List.member \<Delta> \<phi>) \<and>\<nu> \<in> fml_sem I \<phi> "
  apply(rule seq_semD')
  using and_foldl_sem_conv or_foldl_sem_conv
  by blast+

lemma seq_MP:"\<nu> \<in> seq_sem I (\<Gamma>,\<Delta>) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr And \<Gamma> TT) \<Longrightarrow> \<nu> \<in> fml_sem I (foldr Or \<Delta> FF)"
  by(induction \<Delta>, auto)

definition seq_valid
where "seq_valid S \<equiv> \<forall>I. is_interp I \<longrightarrow> seq_sem I S = UNIV"

text\<open> Soundness for derived rules is local soundness, i.e. if the premisses are all true in the same interpretation,
  then the conclusion is also true in that same interpretation. \<close>
definition sound :: "rule \<Rightarrow> bool"
where "sound R \<longleftrightarrow> (\<forall>I. is_interp I \<longrightarrow> (\<forall>i. i \<ge> 0 \<longrightarrow> i < length (fst R) \<longrightarrow> seq_sem I (nth (fst R) i) = UNIV) \<longrightarrow> seq_sem I (snd R) = UNIV)"

lemma soundI:"(\<And>I. is_interp I \<Longrightarrow> (\<And>i. i \<ge> 0 \<Longrightarrow> i < length SG \<Longrightarrow> seq_sem I (nth SG i) = UNIV) \<Longrightarrow> seq_sem I G = UNIV) \<Longrightarrow> sound (SG,G)"
  unfolding sound_def by auto

lemma soundI':"(\<And>I \<nu>. is_interp I \<Longrightarrow> (\<And>i . i \<ge> 0 \<Longrightarrow> i < length SG \<Longrightarrow> \<nu> \<in> seq_sem I (nth SG i)) \<Longrightarrow> \<nu> \<in> seq_sem I G) \<Longrightarrow> sound (SG,G)"
  unfolding sound_def by auto

lemma soundI_mem:"(\<And>I. is_interp I \<Longrightarrow> (\<And>\<phi>. List.member SG \<phi> \<Longrightarrow> seq_sem I \<phi> = UNIV) \<Longrightarrow> seq_sem I C = UNIV) \<Longrightarrow> sound (SG,C)"
  apply (auto simp add: sound_def)
  by (metis in_set_conv_nth in_set_member iso_tuple_UNIV_I seq2fml.simps)

lemma soundI_memv:"(\<And>I. is_interp I \<Longrightarrow> (\<And>\<phi> \<nu>. List.member SG \<phi> \<Longrightarrow> \<nu> \<in> seq_sem I \<phi>) \<Longrightarrow> (\<And>\<nu>. \<nu> \<in> seq_sem I C)) \<Longrightarrow> sound (SG,C)"
  apply(rule soundI_mem)
  using impl_sem by blast

lemma soundI_memv':"(\<And>I. is_interp I \<Longrightarrow> (\<And>\<phi> \<nu>. List.member SG \<phi> \<Longrightarrow> \<nu> \<in> seq_sem I \<phi>) \<Longrightarrow> (\<And>\<nu>. \<nu> \<in> seq_sem I C)) \<Longrightarrow> R = (SG,C) \<Longrightarrow> sound R"
  using  soundI_mem
  using impl_sem by blast

lemma soundD_mem:"sound (SG,C) \<Longrightarrow> (\<And>I. is_interp I \<Longrightarrow> (\<And>\<phi>. List.member SG \<phi> \<Longrightarrow> seq_sem I \<phi> = UNIV) \<Longrightarrow> seq_sem I C = UNIV)"
  apply (auto simp add: sound_def)
  using in_set_conv_nth in_set_member iso_tuple_UNIV_I seq2fml.simps
  by (metis seq2fml.elims)

lemma soundD_memv:"sound (SG,C) \<Longrightarrow> (\<And>I. is_interp I \<Longrightarrow> (\<And>\<phi> \<nu>. List.member SG \<phi> \<Longrightarrow> \<nu> \<in> seq_sem I \<phi>) \<Longrightarrow> (\<And>\<nu>. \<nu> \<in> seq_sem I C))"
  using soundD_mem
  by (metis UNIV_I UNIV_eq_I)

end


chapter \<open>Log Upper and Lower Bounds\<close>

theory Log_CF_Bounds
imports Bounds_Lemmas

begin

theorem ln_upper_1: "0<x \<Longrightarrow> ln(x::real) \<le> x - 1"
by (rule ln_le_minus_one)

definition ln_lower_1 :: "real \<Rightarrow> real"
  where "ln_lower_1 \<equiv> \<lambda>x. 1 - (inverse x)"

corollary ln_lower_1: "0<x \<Longrightarrow> ln_lower_1 x \<le> ln x"
  unfolding ln_lower_1_def
  by (metis ln_inverse ln_le_minus_one positive_imp_inverse_positive minus_diff_eq minus_le_iff)

theorem ln_lower_1_eq: "0<x \<Longrightarrow> ln_lower_1 x = (x - 1)/x"
  by (auto simp: ln_lower_1_def divide_simps)

section \<open>Upper Bound 3\<close>

definition ln_upper_3 :: "real \<Rightarrow> real"
  where "ln_upper_3 \<equiv> \<lambda>x. (x + 5)*(x - 1) / (2*(2*x + 1))"

definition diff_delta_ln_upper_3 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_3 \<equiv> \<lambda>x. (x - 1)^3 / ((2*x + 1)^2 * x)"

lemma d_delta_ln_upper_3: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_3 x - ln x) has_field_derivative diff_delta_ln_upper_3 x) (at x)"
unfolding ln_upper_3_def diff_delta_ln_upper_3_def
apply (intro derivative_eq_intros | simp)+
apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
done

text\<open>Strict inequalities also possible\<close>
lemma ln_upper_3_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_3 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_3])
apply (auto simp: diff_delta_ln_upper_3_def ln_upper_3_def)
done

lemma ln_upper_3_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_3 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_3])
using assms
apply (auto simp: diff_delta_ln_upper_3_def divide_simps ln_upper_3_def)
done

theorem ln_upper_3: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_3 x"
by (metis le_less_linear less_eq_real_def ln_upper_3_neg ln_upper_3_pos)

definition ln_lower_3 :: "real \<Rightarrow> real"
  where "ln_lower_3 \<equiv> \<lambda>x. - ln_upper_3 (inverse x)"

corollary ln_lower_3: "0<x \<Longrightarrow> ln_lower_3 x \<le> ln x"
  unfolding ln_lower_3_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_3)

theorem ln_lower_3_eq: "0<x \<Longrightarrow> ln_lower_3 x = (1/2)*(1 + 5*x)*(x - 1) / (x*(2 + x))"
  unfolding ln_lower_3_def ln_upper_3_def
  by (simp add: divide_simps) algebra

section \<open>Upper Bound 5\<close>

definition ln_upper_5 :: "real \<Rightarrow> real"
  where "ln_upper_5 x \<equiv> (x^2 + 19*x + 10)*(x - 1) / (3*(3*x^2 + 6*x + 1))"

definition diff_delta_ln_upper_5 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_5 \<equiv> \<lambda>x. (x - 1)^5 / ((3*x^2 + 6*x + 1)^2*x)"

lemma d_delta_ln_upper_5: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_5 x - ln x) has_field_derivative diff_delta_ln_upper_5 x) (at x)"
  unfolding ln_upper_5_def diff_delta_ln_upper_5_def
  apply (intro derivative_eq_intros | simp add: add_nonneg_eq_0_iff)+
  apply (simp add: divide_simps add_nonneg_eq_0_iff, algebra)
  done

lemma ln_upper_5_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_5 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_5])
apply (auto simp: diff_delta_ln_upper_5_def ln_upper_5_def)
done

lemma ln_upper_5_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_5 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_5])
using assms
apply (auto simp: diff_delta_ln_upper_5_def divide_simps ln_upper_5_def mult_less_0_iff)
done

theorem ln_upper_5: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_5 x"
by (metis le_less_linear less_eq_real_def ln_upper_5_neg ln_upper_5_pos)

definition ln_lower_5 :: "real \<Rightarrow> real"
  where "ln_lower_5 \<equiv> \<lambda>x. - ln_upper_5 (inverse x)"

corollary ln_lower_5: "0<x \<Longrightarrow> ln_lower_5 x \<le> ln x"
  unfolding ln_lower_5_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_5)

theorem ln_lower_5_eq: "0<x \<Longrightarrow>
    ln_lower_5 x = (1/3)*(10*x^2 + 19*x + 1)*(x - 1) / (x*(x^2 + 6*x + 3))"
  unfolding ln_lower_5_def ln_upper_5_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq divide_simps)
     algebra

section \<open>Upper Bound 7\<close>

definition ln_upper_7 :: "real \<Rightarrow> real"
  where "ln_upper_7 x \<equiv> (3*x^3 + 131*x^2 + 239*x + 47)*(x - 1) / (12*(4*x^3 + 18*x^2 + 12*x + 1))"

definition diff_delta_ln_upper_7 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_7 \<equiv> \<lambda>x. (x - 1)^7 / ((4*x^3 + 18*x^2 + 12*x + 1)^2 * x)"

lemma d_delta_ln_upper_7: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_7 x - ln x) has_field_derivative diff_delta_ln_upper_7 x) (at x)"
unfolding ln_upper_7_def diff_delta_ln_upper_7_def
apply (intro derivative_eq_intros | simp)+
apply auto
apply (auto simp: add_pos_pos dual_order.strict_implies_not_eq divide_simps, algebra)
done

lemma ln_upper_7_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_7 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_7])
apply (auto simp: diff_delta_ln_upper_7_def ln_upper_7_def)
done

lemma ln_upper_7_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_7 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_7])
using assms
apply (auto simp: diff_delta_ln_upper_7_def divide_simps ln_upper_7_def mult_less_0_iff)
done

theorem ln_upper_7: "0 < x \<Longrightarrow> ln(x) \<le> ln_upper_7 x"
  by (metis le_less_linear less_eq_real_def ln_upper_7_neg ln_upper_7_pos)

definition ln_lower_7 :: "real \<Rightarrow> real"
  where "ln_lower_7 \<equiv> \<lambda>x. - ln_upper_7 (inverse x)"

corollary ln_lower_7: "0 < x \<Longrightarrow> ln_lower_7 x \<le> ln x"
  unfolding ln_lower_7_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_7)

theorem ln_lower_7_eq: "0 < x \<Longrightarrow>
  ln_lower_7 x = (1/12)*(47*x^3 + 239*x^2 + 131*x + 3)*(x - 1) / (x*(x^3 + 12*x^2 + 18*x + 4))"
  unfolding ln_lower_7_def ln_upper_7_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq divide_simps)
     algebra

section \<open>Upper Bound 9\<close>

definition ln_upper_9 :: "real \<Rightarrow> real"
  where "ln_upper_9 x \<equiv> (6*x^4 + 481*x^3 + 1881*x^2 + 1281*x + 131)*(x - 1) /
                         (30 * (5*x^4 + 40*x^3 + 60*x^2 + 20*x + 1))"

definition diff_delta_ln_upper_9 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_9 \<equiv> \<lambda>x. (x - 1)^9 / (((5*x^4 + 40*x^3 + 60*x^2 + 20*x + 1)^2) * x)"

lemma d_delta_ln_upper_9: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_9 x - ln x) has_field_derivative diff_delta_ln_upper_9 x) (at x)"
unfolding ln_upper_9_def diff_delta_ln_upper_9_def
apply (intro derivative_eq_intros | simp)+
apply auto
apply (auto simp: add_pos_pos dual_order.strict_implies_not_eq divide_simps, algebra)
done

lemma ln_upper_9_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_9 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_9])
apply (auto simp: diff_delta_ln_upper_9_def ln_upper_9_def)
done

lemma ln_upper_9_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_9 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_9])
using assms
apply (auto simp: diff_delta_ln_upper_9_def divide_simps ln_upper_9_def mult_less_0_iff)
done

theorem ln_upper_9: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_9 x"
by (metis le_less_linear less_eq_real_def ln_upper_9_neg ln_upper_9_pos)

definition ln_lower_9 :: "real \<Rightarrow> real"
  where "ln_lower_9 \<equiv> \<lambda>x. - ln_upper_9 (inverse x)"

corollary ln_lower_9: "0 < x \<Longrightarrow> ln_lower_9 x \<le> ln x"
  unfolding ln_lower_9_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_9)

theorem ln_lower_9_eq: "0 < x \<Longrightarrow>
      ln_lower_9 x = (1/30)*(6 + 481*x + 1881*x^2 + 1281*x^3 + 131*x^4)*(x - 1) /
                     (x*(5 + 40*x + 60*x^2 + 20*x^3 + x^4))"
  unfolding ln_lower_9_def ln_upper_9_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq divide_simps)
     algebra

section \<open>Upper Bound 11\<close>

text\<open>Extended bounds start here\<close>

definition ln_upper_11 :: "real \<Rightarrow> real"
  where "ln_upper_11 x \<equiv>
           (5*x^5 + 647*x^4 + 4397*x^3 + 6397*x^2 + 2272*x + 142) * (x - 1) /
           (30*(6*x^5 + 75*x^4 + 200*x^3 + 150*x^2 + 30*x + 1))"

definition diff_delta_ln_upper_11 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_11 \<equiv> \<lambda>x. (x - 1)^11 / ((6*x^5 + 75*x^4 + 200*x^3 + 150*x^2 + 30*x + 1)^2 * x)"

lemma d_delta_ln_upper_11: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_11 x - ln x) has_field_derivative diff_delta_ln_upper_11 x) (at x)"
unfolding ln_upper_11_def diff_delta_ln_upper_11_def
apply (intro derivative_eq_intros | simp)+
apply auto
apply (auto simp: add_pos_pos dual_order.strict_implies_not_eq divide_simps, algebra)
done

lemma ln_upper_11_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_11 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_11])
apply (auto simp: diff_delta_ln_upper_11_def ln_upper_11_def)
done

lemma ln_upper_11_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_11 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_11])
using assms
apply (auto simp: diff_delta_ln_upper_11_def divide_simps ln_upper_11_def mult_less_0_iff)
done

theorem ln_upper_11: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_11 x"
by (metis le_less_linear less_eq_real_def ln_upper_11_neg ln_upper_11_pos)

definition ln_lower_11 :: "real \<Rightarrow> real"
  where "ln_lower_11 \<equiv> \<lambda>x. - ln_upper_11 (inverse x)"

corollary ln_lower_11: "0<x \<Longrightarrow> ln_lower_11 x \<le> ln x"
  unfolding ln_lower_11_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_11)

theorem ln_lower_11_eq: "0<x \<Longrightarrow>
    ln_lower_11 x = (1/30)*(142*x^5 + 2272*x^4 + 6397*x^3 + 4397*x^2 + 647*x + 5)*(x - 1) /
                    (x*(x^5 + 30*x^4 + 150*x^3 + 200*x^2 + 75*x + 6))"
  unfolding ln_lower_11_def ln_upper_11_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq divide_simps)
     algebra

section \<open>Upper Bound 13\<close>

definition ln_upper_13 :: "real \<Rightarrow> real"
  where "ln_upper_13 x \<equiv> (353 + 8389*x + 20149*x^4 + 50774*x^3 + 38524*x^2 + 1921*x^5 + 10*x^6) * (x - 1)
                          / (70*(1 + 42*x + 525*x^4 + 700*x^3 + 315*x^2 + 126*x^5 + 7*x^6))"

definition diff_delta_ln_upper_13 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_13 \<equiv> \<lambda>x. (x - 1)^13 /
                     ((1 + 42*x + 525*x^4 + 700*x^3 + 315*x^2 + 126*x^5 + 7*x^6)^2*x)"

lemma d_delta_ln_upper_13: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_13 x - ln x) has_field_derivative diff_delta_ln_upper_13 x) (at x)"
unfolding ln_upper_13_def diff_delta_ln_upper_13_def
apply (intro derivative_eq_intros | simp)+
apply auto
apply (auto simp: add_pos_pos dual_order.strict_implies_not_eq divide_simps, algebra)
done

lemma ln_upper_13_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_13 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_13])
apply (auto simp: diff_delta_ln_upper_13_def ln_upper_13_def)
done

lemma ln_upper_13_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_13 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_13])
using assms
apply (auto simp: diff_delta_ln_upper_13_def divide_simps ln_upper_13_def mult_less_0_iff)
done

theorem ln_upper_13: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_13 x"
  by (metis le_less_linear less_eq_real_def ln_upper_13_neg ln_upper_13_pos)

definition ln_lower_13 :: "real \<Rightarrow> real"
  where "ln_lower_13 \<equiv> \<lambda>x. - ln_upper_13 (inverse x)"

corollary ln_lower_13: "0<x \<Longrightarrow> ln_lower_13 x \<le> ln x"
  unfolding ln_lower_13_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_13)

theorem ln_lower_13_eq: "0<x \<Longrightarrow>
    ln_lower_13 x = (1/70)*(10 + 1921*x + 20149*x^2 + 50774*x^3 + 38524*x^4 + 8389*x^5 + 353*x^6)*(x - 1) /
                    (x*(7 + 126*x + 525*x^2 + 700*x^3 + 315*x^4 + 42*x^5 + x^6))"
  unfolding ln_lower_13_def ln_upper_13_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq divide_simps)
     algebra

section \<open>Upper Bound 15\<close>

definition ln_upper_15 :: "real \<Rightarrow> real"
  where "ln_upper_15 x \<equiv>
           (1487 + 49199*x + 547235*x^4 + 718735*x^3 + 334575*x^2 + 141123*x^5 + 35*x^7 + 9411*x^6)*(x - 1) /
           (280*(1 + 56*x + 2450*x^4 + 1960*x^3 + 588*x^2 + 1176*x^5 + 8*x^7 + 196*x^6))"

definition diff_delta_ln_upper_15 :: "real \<Rightarrow> real"
  where "diff_delta_ln_upper_15
         \<equiv> \<lambda>x. (x - 1)^15 / ((1+56*x+2450*x^4+1960*x^3+588*x^2+8*x^7+196*x^6+1176*x^5)^2 * x)"

lemma d_delta_ln_upper_15: "x > 0 \<Longrightarrow>
    ((\<lambda>x. ln_upper_15 x - ln x) has_field_derivative diff_delta_ln_upper_15 x) (at x)"
unfolding ln_upper_15_def diff_delta_ln_upper_15_def
apply (intro derivative_eq_intros | simp)+
apply auto
apply (auto simp: add_pos_pos dual_order.strict_implies_not_eq divide_simps, algebra)
done

lemma ln_upper_15_pos:
  assumes "1 \<le> x" shows "ln(x) \<le> ln_upper_15 x"
apply (rule gen_upper_bound_increasing [OF assms d_delta_ln_upper_15])
apply (auto simp: diff_delta_ln_upper_15_def ln_upper_15_def)
done

lemma ln_upper_15_neg:
  assumes "0 < x" and x1: "x \<le> 1" shows "ln(x) \<le> ln_upper_15 x"
apply (rule gen_upper_bound_decreasing [OF x1 d_delta_ln_upper_15])
using assms
apply (auto simp: diff_delta_ln_upper_15_def divide_simps ln_upper_15_def mult_less_0_iff)
done

theorem ln_upper_15: "0<x \<Longrightarrow> ln(x) \<le> ln_upper_15 x"
  by (metis le_less_linear less_eq_real_def ln_upper_15_neg ln_upper_15_pos)

definition ln_lower_15 :: "real \<Rightarrow> real"
  where "ln_lower_15 \<equiv> \<lambda>x. - ln_upper_15 (inverse x)"

corollary ln_lower_15: "0<x \<Longrightarrow> ln_lower_15 x \<le> ln x"
  unfolding ln_lower_15_def
  by (metis ln_inverse inverse_positive_iff_positive minus_le_iff ln_upper_15)

theorem ln_lower_15_eq: "0<x \<Longrightarrow>
    ln_lower_15 x = (1/280)*(35 + 9411*x + 141123*x^2 + 547235*x^3 + 718735*x^4 + 334575*x^5 + 49199*x^6 + 1487*x^7)*(x - 1) /
                    (x*(8 + 196*x + 1176*x^2 + 2450*x^3 + 1960*x^4 + 588*x^5 + 56*x^6 + x^7))"
  unfolding ln_lower_15_def ln_upper_15_def
  by (simp add: zero_less_mult_iff add_pos_pos dual_order.strict_implies_not_eq
              divide_simps) algebra

end


theory ex211
  imports Main
begin
datatype exp = Var | Const "int" | Add "exp" "exp" | Mult "exp" "exp"

value "Const 2"
value "Add (Var) (Const 3)"

fun eval::"exp \<Rightarrow> int \<Rightarrow> int" where
  "eval Var n = n"|
  "eval (Const i) n = i"|
  "eval (Add l r) n = (eval l n) + (eval r n)"|
  "eval (Mult l r) n = (eval l n) * (eval r n)"

value "eval (Var) 2"
value "eval (Const 1) 3"
value "eval (Add Var (Mult Var (Const 2))) 4"

fun evalp::"int list \<Rightarrow> int \<Rightarrow> int" where
  "evalp [] n = 0"|
  "evalp [x] n = x"|
  "evalp (x#xs) n = x + n * (evalp xs n)"

value "evalp [1,2,3] 2"

fun adlist::"int list \<Rightarrow> int list \<Rightarrow> int list" where
  "adlist [] [] = []"|
  "adlist [] (y#ys) = (y#ys)"|
  "adlist (x#xs) [] = (x#xs)"|
  "adlist [x] [y] = [x+y]"|
  "adlist [x] (y#ys) = ((x+y)#ys)"|
  "adlist (x#xs) [y] = ((x+y)#xs)"|
  "adlist (x#xs) (y#ys) = ((x+y)#(adlist xs ys))"

value "adlist [0,1,2] [3,4,5]"

fun lm::"int list \<Rightarrow> int \<Rightarrow> int list" where
  "lm [] n = []"|
  "lm (x#xs) n = (x*n)#(lm xs n)"

value "lm [1,2,3] 2"

fun mllist::"int list \<Rightarrow> int list \<Rightarrow> int list" where
  "mllist [] [] = []"|
  "mllist [] y = []"|
  "mllist x [] = []"|
  "mllist x (y#ys) = adlist (lm x y)(mllist (0#x)(ys))"

value "mllist [1,2,1][3,1]"

fun coeffs::"exp \<Rightarrow> int list" where
  "coeffs (Const i) = [i]"|
  "coeffs Var = [0,1]"|
  "coeffs (Add l r) = adlist (coeffs l) (coeffs r)"|
  "coeffs (Mult l r) = mllist (coeffs l) (coeffs r)"

value "evalp (coeffs (Add Var (Mult Var (Const 2)))) 6"
value "eval (Add Var (Mult Var (Const 2))) 6"

lemma ex210: "evalp (coeffs e) x = eval e x"
  apply(induction x arbitrary: e)
   apply(auto simp add: algebra_simps)
    sorry

end


section \<open>Three-Way Comparison\<close>

theory Cmp
imports Main
begin

datatype cmp_val = LT | EQ | GT

definition cmp :: "'a:: linorder \<Rightarrow> 'a \<Rightarrow> cmp_val" where
"cmp x y = (if x < y then LT else if x=y then EQ else GT)"

lemma
    LT[simp]: "cmp x y = LT \<longleftrightarrow> x < y"
and EQ[simp]: "cmp x y = EQ \<longleftrightarrow> x = y"
and GT[simp]: "cmp x y = GT \<longleftrightarrow> x > y"
by (auto simp: cmp_def)

lemma case_cmp_if[simp]: "(case c of EQ \<Rightarrow> e | LT \<Rightarrow> l | GT \<Rightarrow> g) =
  (if c = LT then l else if c = GT then g else e)"
by(simp split: cmp_val.split)

end


theory Ex5_2
  imports Main
begin

(*
By: Vadim Zaliva <vzaliva@cmu.edu>
From: T. Nipkow and G. Klein, Concrete Semantics with Isabelle/HOL. Springer, 2014.
Exercise 5.2:
*)

lemma  "
  (\<exists> ys zs . xs=ys@zs \<and> length ys = length zs) \<or>
  (\<exists> ys zs . xs=ys@zs \<and> length ys = length zs +1)" (is "?C1 \<or> ?C2")
proof -
  {
    fix n assume A1: "length xs=n+n"
    hence ?C1 proof -
      obtain ys zs where "ys = take n xs \<and> zs = drop n xs" by blast
      hence "xs=ys@zs \<and> length ys = length zs" by (metis A1 add_diff_cancel_right' append_take_drop_id length_append length_drop length_splice)
      thus ?thesis by blast
    qed
  }
  note g1 = this

  {
    fix n assume A2:"length xs=(Suc n)+n"
    hence ?C2 proof -
      obtain ys zs where "ys = take (Suc n) xs \<and> zs = drop (Suc n) xs" by blast
      hence "xs=ys@zs \<and> length ys = length zs+1"
        by (metis A2 Suc_eq_plus1_left ab_semigroup_add_class.add_ac(1) add_diff_cancel_right' append_take_drop_id comm_monoid_diff_class.add_diff_cancel_left length_append length_drop)
      thus ?thesis by blast
    qed
  }
  note g2 = this

  have "\<exists> b . (length xs=(b+b)) \<or> (length xs=((Suc b)+b))" by presburger
  then obtain b where "(length xs=(b+b)) \<or> (length xs=((Suc b)+b))" by blast
  from this g1 g2 show ?thesis by auto
qed

end