(* Author: Tobias Nipkow *)

theory Abs_Int1_parity
imports Abs_Int1
begin

subsection "Parity Analysis"

datatype parity = Even | Odd | Either

text\<open>Instantiation of class @{class preord} with type @{typ parity}:\<close>

instantiation parity :: preord
begin

text\<open>First the definition of the interface function \<open>\<sqsubseteq>\<close>. Note that
the header of the definition must refer to the ascii name @{const le} of the
constants as \<open>le_parity\<close> and the definition is named \<open>le_parity_def\<close>.  Inside the definition the symbolic names can be used.\<close>

definition le_parity where
"x \<sqsubseteq> y = (y = Either \<or> x=y)"

text\<open>Now the instance proof, i.e.\ the proof that the definition fulfills
the axioms (assumptions) of the class. The initial proof-step generates the
necessary proof obligations.\<close>

instance
proof
  fix x::parity show "x \<sqsubseteq> x" by(auto simp: le_parity_def)
next
  fix x y z :: parity assume "x \<sqsubseteq> y" "y \<sqsubseteq> z" thus "x \<sqsubseteq> z"
    by(auto simp: le_parity_def)
qed

end

text\<open>Instantiation of class @{class SL_top} with type @{typ parity}:\<close>

instantiation parity :: SL_top
begin

definition join_parity where
"x \<squnion> y = (if x \<sqsubseteq> y then y else if y \<sqsubseteq> x then x else Either)"

definition Top_parity where
"\<top> = Either"

text\<open>Now the instance proof. This time we take a lazy shortcut: we do not
write out the proof obligations but use the \<open>goali\<close> primitive to refer
to the assumptions of subgoal i and \<open>case?\<close> to refer to the
conclusion of subgoal i. The class axioms are presented in the same order as
in the class definition.\<close>

instance
proof (standard, goal_cases)
  case 1 (*join1*) show ?case by(auto simp: le_parity_def join_parity_def)
next
  case 2 (*join2*) show ?case by(auto simp: le_parity_def join_parity_def)
next
  case 3 (*join least*) thus ?case by(auto simp: le_parity_def join_parity_def)
next
  case 4 (*Top*) show ?case by(auto simp: le_parity_def Top_parity_def)
qed

end

text\<open>Now we define the functions used for instantiating the abstract
interpretation locales. Note that the Isabelle terminology is
\emph{interpretation}, not \emph{instantiation} of locales, but we use
instantiation to avoid confusion with abstract interpretation.\<close>

fun \<gamma>_parity :: "parity \<Rightarrow> val set" where
"\<gamma>_parity Even = {i. i mod 2 = 0}" |
"\<gamma>_parity Odd  = {i. i mod 2 = 1}" |
"\<gamma>_parity Either = UNIV"

fun num_parity :: "val \<Rightarrow> parity" where
"num_parity i = (if i mod 2 = 0 then Even else Odd)"

fun plus_parity :: "parity \<Rightarrow> parity \<Rightarrow> parity" where
"plus_parity Even Even = Even" |
"plus_parity Odd  Odd  = Even" |
"plus_parity Even Odd  = Odd" |
"plus_parity Odd  Even = Odd" |
"plus_parity Either y  = Either" |
"plus_parity x Either  = Either"

text\<open>First we instantiate the abstract value interface and prove that the
functions on type @{typ parity} have all the necessary properties:\<close>

interpretation Val_abs
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
proof (standard, goal_cases) txt\<open>of the locale axioms\<close>
  fix a b :: parity
  assume "a \<sqsubseteq> b" thus "\<gamma>_parity a \<subseteq> \<gamma>_parity b"
    by(auto simp: le_parity_def)
next txt\<open>The rest in the lazy, implicit way\<close>
  case 2 show ?case by(auto simp: Top_parity_def)
next
  case 3 show ?case by auto
next
  case (4 _ a1 _ a2) thus ?case
  proof(cases a1 a2 rule: parity.exhaust[case_product parity.exhaust])
  qed (auto, presburger)
qed

text\<open>Instantiating the abstract interpretation locale requires no more
proofs (they happened in the instatiation above) but delivers the
instantiated abstract interpreter which we call AI:\<close>

global_interpretation Abs_Int
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
defines aval_parity = aval' and step_parity = step' and AI_parity = AI
..

subsubsection "Tests"

definition "test1_parity =
  ''x'' ::= N 1;;
  WHILE Less (V ''x'') (N 100) DO ''x'' ::= Plus (V ''x'') (N 2)"

value "show_acom_opt (AI_parity test1_parity)"

definition "test2_parity =
  ''x'' ::= N 1;;
  WHILE Less (V ''x'') (N 100) DO ''x'' ::= Plus (V ''x'') (N 3)"

value "show_acom ((step_parity \<top> ^^1) (anno None test2_parity))"
value "show_acom ((step_parity \<top> ^^2) (anno None test2_parity))"
value "show_acom ((step_parity \<top> ^^3) (anno None test2_parity))"
value "show_acom ((step_parity \<top> ^^4) (anno None test2_parity))"
value "show_acom ((step_parity \<top> ^^5) (anno None test2_parity))"
value "show_acom_opt (AI_parity test2_parity)"

subsubsection "Termination"

global_interpretation Abs_Int_mono
where \<gamma> = \<gamma>_parity and num' = num_parity and plus' = plus_parity
proof (standard, goal_cases)
  case (1 a1 a2 b1 b2) thus ?case
  proof(cases a1 a2 b1 b2
   rule: parity.exhaust[case_product parity.exhaust[case_product parity.exhaust[case_product parity.exhaust]]]) (* FIXME - UGLY! *)
  qed (auto simp add:le_parity_def)
qed

definition m_parity :: "parity \<Rightarrow> nat" where
"m_parity x = (if x=Either then 0 else 1)"

lemma measure_parity:
  "(strict{(x::parity,y). x \<sqsubseteq> y})^-1 \<subseteq> measure m_parity"
by(auto simp add: m_parity_def le_parity_def)

lemma measure_parity_eq:
  "\<forall>x y::parity. x \<sqsubseteq> y \<and> y \<sqsubseteq> x \<longrightarrow> m_parity x = m_parity y"
by(auto simp add: m_parity_def le_parity_def)

lemma AI_parity_Some: "\<exists>c'. AI_parity c = Some c'"
by(rule AI_Some_measure[OF measure_parity measure_parity_eq])

end


theory FMap
  imports AT Complex_Main
begin

(* some general techniques for mapping function on finite sets *)
(* general scheme for map over finite sets.
   This would be a useful provision for the Finite_Set library: everyone needs
   a simple map on Finite Sets all the time! *)
definition fmap :: "['a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b set"
  where "fmap f S = Finite_Set.fold (\<lambda> x y. insert (f x) y) {} S"

(* doesn't work since not commutative -- consider
   linear sorted domains and then use sorted_list_of_set
definition fmapL :: "['a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b list"
  where "fmapL f S = Finite_Set.fold (\<lambda> x y. (f x) # y) [] S"
*)

lemma fmap_lem_map[rule_format]: "finite S \<Longrightarrow> n \<in> S \<longrightarrow> (f n) \<in> (fmap f S)"
  apply (erule_tac F = S in finite_induct)
   apply simp
  apply clarify
  apply (simp add: fmap_def)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (drule_tac A = "F" in Finite_Set.comp_fun_commute.fold_insert)
     apply assumption+
   apply (erule ssubst)
   apply (erule disjE)
  apply force+
apply (simp add: comp_fun_commute_def)
by force

lemma fmap_lem_map_rev[rule_format]: "finite S \<Longrightarrow> inj f \<Longrightarrow> (f n) \<in> (fmap f S) \<longrightarrow> n \<in> S"
  apply (erule_tac F = S in finite_induct)
   apply (simp add: fmap_def)
  apply clarify
  apply (simp add: fmap_def)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (drule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert)
     apply assumption+
   apply (subgoal_tac "f n \<in> insert (f x) (Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} F)")
    prefer 2
    apply simp
   apply (subgoal_tac "f n = f x")
    prefer 2
    apply simp
   apply (erule injD, assumption)
apply (simp add: comp_fun_commute_def)
by force

lemma fold_one: "Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} {n} = {f n}"
  thm Finite_Set.comp_fun_commute.fold_insert
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (drule_tac A = "{}" in Finite_Set.comp_fun_commute.fold_insert)
     apply simp+
  apply (simp add: comp_fun_commute_def)
  by force

(*
lemma fold_oneL: "Finite_Set.fold (\<lambda> (x::'a). (#)(f x)) [] {n} = [f n]"
  apply (subgoal_tac "comp_fun_commute (\<lambda> (x::'a). (#)(f x))")
   apply (drule_tac A = "{}" and z = "[]" in Finite_Set.comp_fun_commute.fold_insert)
     apply simp+
  apply (simp add: comp_fun_commute_def)
fails here
by force
*)

lemma fold_one_plus: "Finite_Set.fold (+) (b::real) {a::real} = a + b"
  apply (subgoal_tac "comp_fun_commute (+)")
   apply (drule_tac A = "{}" in Finite_Set.comp_fun_commute.fold_insert)
  apply simp+
  apply (simp add: comp_fun_commute_def)
  apply (simp add: comp_def)
by force

lemma fold_two_plus: "a \<noteq> c \<Longrightarrow> Finite_Set.fold (+) (b::real) {a::real, c} = a + b + c"
  apply (subgoal_tac "comp_fun_commute (+)")
   apply (drule_tac A = "{ c}" and x = a in Finite_Set.comp_fun_commute.fold_insert)
     apply simp+
   apply (simp add: fold_one_plus)
   apply (subgoal_tac "a + (c + b) = a + b + c")
    apply (erule ssubst)
    apply assumption
  apply simp
  apply (simp add: comp_fun_commute_def)
  apply (simp add: comp_def)
by force

lemma fold_three_plus: "a \<noteq> c \<Longrightarrow> a \<noteq> b \<Longrightarrow> b \<noteq> c \<Longrightarrow> Finite_Set.fold (+) (d::real) {a::real, b, c} = a + b + c + d"
  apply (subgoal_tac "comp_fun_commute (+)")
   apply (drule_tac A = "{b, c}" and x = a and z = d in Finite_Set.comp_fun_commute.fold_insert)
     apply simp+
   apply (simp add: fold_two_plus)
  apply (simp add: comp_fun_commute_def)
  apply (simp add: comp_def)
by force

lemma fmap_lem_one: "fmap f {a} = {f a}"
  by (simp add: fmap_def fold_one)

(*
lemma fmapL_lem_one: "fmapL f {a} = [f a]"
  by (simp add: fmapL_def fold_one)
*)

lemma fmap_lem[rule_format]: "finite S \<Longrightarrow> \<forall> n. (fmap f (insert n S)) = (insert (f n) (fmap f S))"
  thm finite.induct
  apply (erule_tac F = S in finite_induct)
   apply (rule allI)
   apply (simp add: fmap_def)
   apply (rule fold_one)
(* *)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (rule allI)
   apply (drule_tac x = x in spec)
   apply (erule ssubst)
   apply (subgoal_tac "fmap f (insert n (insert x F)) = insert (f n) (fmap f (insert x F))")
  apply (erule ssubst)
    apply (subgoal_tac "fmap f (insert x F) = insert (f x) (fmap f F)")
     apply simp
    apply (drule_tac A = "F" in Finite_Set.comp_fun_commute.fold_insert)
      apply assumption
     apply assumption
    apply (unfold fmap_def, assumption)
   apply (case_tac "n \<in> insert x F")
    defer
    apply (drule_tac A = "insert x F" in Finite_Set.comp_fun_commute.fold_insert)
     apply simp
  apply assumption+
  apply (simp add: comp_fun_commute_def)
  apply force
(* n \<in> insert x F *)
  apply (simp add: Finite_Set.comp_fun_commute.fold_rec)
  apply (subgoal_tac "Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} (insert n (insert x F)) =
                     Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} (insert x F)")
   prefer 2
   apply (subgoal_tac "insert n (insert x F) = insert x F")
    apply simp
  apply blast
  apply (erule ssubst)
  apply (rule Finite_Set.comp_fun_commute.fold_rec)
apply (simp add: comp_fun_commute_def)
   apply force
  by simp

lemma insert_delete: "x \<notin> S \<Longrightarrow> (insert x S) - {x} = S"
by simp

lemma fmap_lem_del[rule_format]: "finite S \<Longrightarrow> inj f \<Longrightarrow> \<forall> n \<in> S. fmap f (S - {n}) = (fmap f S) - {f n}"
  apply (erule_tac F = S in finite_induct)
   apply (rule ballI)
   apply (simp add: fmap_def)
(* *)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (rule ballI)
apply simp
   apply (erule disjE)
(* n = x *)
    apply simp
    apply (drule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert)
      apply assumption+
    apply (unfold fmap_def)
    apply (rotate_tac -1)
  apply (erule ssubst)
  apply (rule sym)
    apply (rule insert_delete)
    apply (erule contrapos_nn)
  apply (rule fmap_lem_map_rev, assumption, assumption)
  apply (simp add: fmap_def)
(* n \<in> F *)
    apply (frule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert, assumption, assumption)
   apply (rotate_tac -1)
   apply (erule ssubst)
  apply (subgoal_tac "insert (f x) (Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} F) - {f n} =
                      insert (f x) ((Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} F) - {f n})")
   apply (rotate_tac -1)
   apply (erule ssubst)
   apply (drule_tac x = n in bspec,assumption)
   apply (rotate_tac -1)
   apply (erule subst)
    apply (drule_tac A = "F - {n}" and z = "{}" and x = x in Finite_Set.comp_fun_commute.fold_insert)
      apply simp+
    apply (subgoal_tac "insert x (F - {n}) = insert x F - {n}")
     apply simp
    apply blast
   apply (subgoal_tac "f x \<noteq> f n")
    apply force
   apply (subgoal_tac "x \<noteq> n")
  apply (rotate_tac -1)
  apply (erule contrapos_nn)
    apply (erule injD, assumption)
  apply blast
apply (simp add: comp_fun_commute_def)
by force

lemma fmap_empty1: "(fmap f {} = S) \<Longrightarrow> (S = {})"
  by (simp add: fmap_def)

lemma fmap_empty2: "S = {} \<Longrightarrow> fmap f {} = S"
  by (simp add: fmap_def)

lemma fmap_empty: "(fmap f {} = S) = (S = {})"
proof
  show "fmap f {} = S \<Longrightarrow> S = {}"
    by (erule fmap_empty1)
next show  "S = {} \<Longrightarrow> fmap f {} = S"
    by (erule fmap_empty2)
qed

lemma fmap_empty3: "fmap f {} = {}"
  by (simp add: fmap_def)

lemma fmap_empty4[rule_format]: "finite S \<Longrightarrow> fmap f S = {} \<longrightarrow> S = {}"
  apply (erule_tac F = S in finite_induct)
  apply simp
  apply (simp add: fmap_def)
  apply (subgoal_tac "Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} ({x}) \<noteq> {}")
  apply (subgoal_tac "Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} ({x}) \<subseteq>
                      Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} (insert x F)")
    apply blast
  apply (subst fold_one)
   apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
  thm Finite_Set.comp_fun_commute.fold_insert
   apply (drule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert)
     apply simp
     apply simp
  apply (erule ssubst)
    apply simp
     apply (simp add: comp_fun_commute_def)
     apply force
    apply (subst fold_one)
  by simp

lemma insert_delete0: "x \<in> A \<Longrightarrow> A = insert x (A - {x})"
  by auto

lemma fmap_inj[rule_format]:
  assumes "finite S" and "inj f"
  shows "\<forall> S'. finite S' \<longrightarrow> fmap f S = fmap f S' \<longrightarrow> S = S'"
  using assms
proof (erule_tac F = S in finite_induct, clarify)
  show "\<And>S'::'a set. inj f \<Longrightarrow> finite S \<Longrightarrow> inj f \<Longrightarrow> finite S' \<Longrightarrow>
        fmap f {} = fmap f S' \<Longrightarrow> {} = S'"
    apply (rule sym)
    apply (rule_tac f = f in fmap_empty4)
    apply assumption
by (erule fmap_empty1)
next show "\<And>(x::'a) F::'a set.
       inj f \<Longrightarrow>
       finite F \<Longrightarrow>
       x \<notin> F \<Longrightarrow>
       \<forall>S'::'a set. finite S' \<longrightarrow> fmap f F = fmap f S' \<longrightarrow> F = S' \<Longrightarrow>
       \<forall>S'::'a set. finite S' \<longrightarrow> fmap f (insert x F) = fmap f S' \<longrightarrow> insert x F = S'"
  proof (clarify)
    fix x F S'
    assume a0: "inj f"
       and a1: "finite F"
       and a1a: "x \<notin> F"
       and a2: "\<forall>S'::'a set. finite S' \<longrightarrow> fmap f F = fmap f S' \<longrightarrow> F = S'"
       and a3: "finite S'"
       and a4: "fmap f (insert x F) = fmap f S'"
    show "insert x F = S'"
    proof -
      have a5: "insert (f x) (fmap f F) = fmap f S'"
        by (insert fmap_lem[of F f x], drule meta_mp, rule a1, erule subst, rule a4)
      have a6: "f x \<in> fmap f S'" by (insert a5, erule subst, simp)
      have a6a: "x \<in> S'" by (rule fmap_lem_map_rev, rule a3, rule a0, rule a6)
      have a7: "fmap f S' = insert (f x) ((fmap f S') - {f x})"
        by (insert insert_delete0[of "f x" "(fmap f S')"],drule meta_mp, rule a6)
      have a8: "insert (f x) (fmap f F) = insert (f x) ((fmap f S') - {f x})"
        by (subst a5, subst a7, rule refl)
      have a9: "f x \<notin> (fmap f F)" using a0 a1 a1a
        apply (rule_tac P = "f x \<in> fmap f F" in notI, subgoal_tac "x \<in> F")
          apply (rule notE, rule a1a, assumption)
        by (rule fmap_lem_map_rev)
      have a10: "f x \<notin> ((fmap f S') - {f x})" by simp
      have a11: "fmap f F = ((fmap f S') - {f x})" by (insert a8 a9 a10, force)
      have a12: "x \<in> S' \<Longrightarrow> fmap f F = fmap f (S' - {x})"
        apply (insert fmap_lem_del[of S' f x])
        apply (drule meta_mp)
         apply (rule a3)
        apply (drule meta_mp)
         apply (rule a0)
        apply (drule meta_mp, assumption)
        apply (erule ssubst)
        by (rule a11)
(*      have a13: "x \<notin> S' \<Longrightarrow> f x \<notin> fmap f S'"
        by (erule contrapos_nn, rule fmap_lem_map_rev, rule a3, rule a0)
      have a14: "x \<notin> S' \<Longrightarrow> fmap f F = (fmap f S')"
        by (insert a13, drule meta_mp, assumption, subst a11, simp) *)
      show "insert x F = S'"
        apply (insert a6a)
         apply (insert a2)
         apply (drule_tac x = "S' - {x}" in spec)
         apply (drule mp)
          apply (simp add: a3)
         apply (drule mp)
          apply (erule a12)
         apply (erule ssubst)
        apply (rule sym)
        by (erule insert_delete0)
    qed
  qed
qed

lemma fmap_inj0: "inj f \<Longrightarrow> inj_on (fmap f){S. finite S}"
  apply (rule inj_onI)
  apply (rule fmap_inj)
  by simp+

lemma fmap_lem_map_rev0[rule_format]: "finite S \<Longrightarrow> (\<forall>y\<in>S. f y \<noteq> f n) \<longrightarrow> (f n) \<in> (fmap f S) \<longrightarrow> n \<in> S"
  apply (erule_tac F = S in finite_induct)
   apply (simp add: fmap_def)
  apply clarify
  apply (simp add: fmap_def)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (drule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert)
     apply assumption+
   apply (subgoal_tac "f n \<in> insert (f x) (Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} F)")
    prefer 2
    apply simp
   apply (subgoal_tac "f n = f x")
  apply simp
    apply simp
apply (simp add: comp_fun_commute_def)
by force

lemma fmap_lem_map_rev1: "finite S \<Longrightarrow> (\<forall>y\<in>S. f y \<noteq> f n) \<Longrightarrow> (f n) \<in> (fmap f S) \<Longrightarrow> n \<in> S"
  apply (erule fmap_lem_map_rev0)
  apply (drule bspec, assumption, assumption)
  by assumption

lemma fmap_lem_del_set1[rule_format]: "finite S \<Longrightarrow>
                        \<forall> n \<in> S. fmap f (S - {y. f y = f n}) = (fmap f S) - {f n}"
  apply (erule_tac F = S in finite_induct)
   apply (rule ballI)
   apply (simp add: fmap_def)
(* *)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x::'a. insert (f x))")
   apply (rule ballI)
   prefer 2
apply (simp add: comp_fun_commute_def)
   apply force
(* *)
  apply (case_tac "n = x")
   apply (simp add: fmap_def)
   apply (frule_tac A = "F" and z = "{}" in Finite_Set.comp_fun_commute.fold_insert)
     apply assumption+
   apply (rotate_tac -1)
  apply (erule ssubst)
(* *)
    apply simp
    apply (case_tac "\<exists> y \<in> F. f y = f x")
     apply (erule bexE)
     apply (drule_tac x = y in bspec, assumption)
     apply simp+
   apply (subgoal_tac "F - {y::'a. f y = f x} = F - {x}")
    prefer 2
  apply blast
  apply (rotate_tac -1)
  apply (erule ssubst)
   apply simp
  apply (subgoal_tac "(f x) \<notin> Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} F ")
    apply simp
   apply (erule contrapos_nn)
   apply (rule fmap_lem_map_rev1, assumption, assumption)
   apply (simp add: fmap_def)
(* *)
  apply (subgoal_tac "n \<in> F")
   apply (drule_tac x = n in bspec, assumption)
  apply (frule_tac f = f and n = x in fmap_lem)
   apply (rotate_tac -1)
   apply (erule ssubst)
(* *)
  apply (case_tac "f x = f n")
    apply simp
  apply simp
   apply (subgoal_tac "insert (f x) (fmap f F) - {f n} = insert (f x) ((fmap f F) - {f n})")
    prefer 2
    apply force
  apply (rotate_tac -1)
   apply (erule ssubst)
   apply (subgoal_tac "insert x F - {y::'a. f y = f n} = insert x (F - {y::'a. f y = f n})")
    prefer 2
    apply force
  apply (rotate_tac -1)
   apply (erule ssubst)
   apply (subgoal_tac "finite (F - {y::'a. f y = f n})")
    apply (rotate_tac -1)
  apply (drule_tac S = "(F - {y::'a. f y = f n})" and f = f and n = x in fmap_lem)
    apply simp
   apply simp
  by (simp add: comp_fun_commute_def)

lemma fmap_set_rep_lem[rule_format]: "finite S \<Longrightarrow>
        S \<noteq> {} \<longrightarrow> x \<in> Finite_Set.fold (\<lambda>x::'a. insert (f x)) {} S \<longrightarrow> (\<exists>y::'a\<in>S. x = f y)"
  apply (erule_tac F = S in finite_induct)
   apply simp
  apply (case_tac "F = {}")
   apply (simp add: fold_one)
  apply simp
  by (metis (full_types) empty_iff fold_infinite image_fold_insert image_insert insert_iff)

lemma fmap_set_rep[rule_format]: "finite S \<Longrightarrow>  fmap f S = {x. \<exists> y \<in> S. x = f y}"
proof (rule equalityI, rule subsetI, rule CollectI)
  show "\<And>x::'b. finite S \<Longrightarrow> x \<in> fmap f S \<Longrightarrow> \<exists>y::'a\<in>S. x = f y"
    apply (simp add: fmap_def)
    apply (case_tac "S = {}")
     apply simp
    by (simp add: fmap_set_rep_lem)
next show "finite S \<Longrightarrow> {x::'b. \<exists>y::'a\<in>S. x = f y} \<subseteq> fmap f S"
    apply (rule subsetI)
    apply (drule CollectD)
    apply (erule bexE)
    apply (erule ssubst)
  by (erule fmap_lem_map, assumption)
qed

lemma fmap_set_rep'[rule_format]: "finite S \<Longrightarrow>  fmap f S = f `S"
proof (subst fmap_set_rep, assumption, simp add: image_def)
qed

lemma fmap_set_del_set0[rule_format]: "finite S \<Longrightarrow>
   \<forall> S'.  inj_on f S \<longrightarrow> S' \<subseteq> S \<longrightarrow> f ` S - f ` S' = f ` (S - S')"
  apply (erule_tac F = S in finite_induct)
   apply simp
  by (metis Diff_subset inj_on_image_set_diff)

thm inj_on_image_set_diff
thm fmap_def

lemma fmap_set_del_set1[rule_format]: "inj_on f S \<Longrightarrow> S' \<subseteq> S
        \<Longrightarrow> f ` S - f ` S' = f ` (S - S')"
  by (metis Diff_subset inj_on_image_set_diff)

lemma fmap_set_del_set: "finite S \<Longrightarrow> inj_on f S \<Longrightarrow>
    S' \<subseteq> S \<Longrightarrow> fmap f S - fmap f S' = fmap f (S - S')"
  apply (subst fmap_set_rep', assumption)
  apply (subst fmap_set_rep')
   apply (erule finite_subset, assumption)
  apply (subst fmap_set_rep')
  apply (rule_tac A = "S - S'" and B = S in finite_subset)
  apply blast
  apply assumption
by (erule fmap_set_del_set0)

lemma fmap_set_del_set: "finite S \<Longrightarrow> inj f \<Longrightarrow>
    finite S' \<Longrightarrow>  fmap f S - fmap f S' = fmap f (S - S')"
  apply (subst fmap_set_rep', assumption)
  apply (subst fmap_set_rep', assumption)
  apply (subst fmap_set_rep')
  apply simp

apply (erule fmap_set_del_set0)
  oops

lemma image_inj[rule_format]: "inj f \<Longrightarrow> f ` S = f ` S' \<Longrightarrow> S = S'"
  by (simp add: inj_image_eq_iff)

(* In a similar vain: some simple summation on finite sets
definition fmap :: "['a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b set"
  where "fmap f S = Finite_Set.fold (\<lambda> x y. insert (f x) y) {} S"
*)
definition fsum :: "real set \<Rightarrow>  real"
  where "fsum S = Finite_Set.fold (\<lambda> x y. x + y) 0 S"

definition fsumap :: "['a \<Rightarrow> real, 'a set] \<Rightarrow> real"
  where "fsumap f S = Finite_Set.fold (\<lambda> x y. (f x) + y) (0 :: real) S"

lemma fsumap_fold_one: "Finite_Set.fold (\<lambda>x y. (f x) + y) (0 :: real) {n} = f n"
  thm Finite_Set.comp_fun_commute.fold_insert
  apply (subgoal_tac "comp_fun_commute (\<lambda>x. (+)(f x))")
   apply (drule_tac A = "{}" and z = 0 and x = n in Finite_Set.comp_fun_commute.fold_insert)
     apply simp+
  apply (simp add: comp_fun_commute_def)
  by force

lemma fsumap_lem[rule_format]: "finite S \<Longrightarrow> \<forall> n. n \<notin> S \<longrightarrow> (fsumap f (insert n S)) = (f n) + (fsumap f S)"
  thm finite.induct
  apply (erule_tac F = S in finite_induct)
   apply (rule allI)
   apply (simp add: fsumap_def)
   apply (rule fsumap_fold_one)
(* *)
  apply (subgoal_tac "comp_fun_commute (\<lambda>x. (+)(f x))")
   apply (rule allI, rule impI)
   apply (drule_tac x = x in spec)
  apply (drule mp, assumption)
   apply (erule ssubst)
  apply (subgoal_tac "fsumap f (insert n (insert x F)) = f n + (fsumap f (insert x F))")
    apply (erule ssubst)
    apply (subgoal_tac "fsumap f (insert x F) = (f x + fsumap f F)")
         apply simp
    apply (drule_tac A = "F" in Finite_Set.comp_fun_commute.fold_insert)
      apply assumption
     apply assumption
    apply (unfold fsumap_def, assumption)
   apply (case_tac "n \<in> insert x F")
    defer
    apply (drule_tac A = "insert x F" in Finite_Set.comp_fun_commute.fold_insert)
     apply simp
  apply assumption+
  apply (simp add: comp_fun_commute_def)
by force+
(* n \<in> insert x F is not possible
  apply (subgoal_tac "Finite_Set.fold (\<lambda>x::'a. (+) (f x)) (0::real) (insert n (insert x F)) =
                      Finite_Set.fold (\<lambda>x::'a. (+) (f x)) (0::real) (insert x F)")
     prefer 2
   apply (subgoal_tac "insert n (insert x F) = insert x F")
    apply simp
  apply blast
  apply (erule ssubst)
  apply (simp add: Finite_Set.comp_fun_commute.fold_rec)
apply (simp add: comp_fun_commute_def)
   apply force
*)

primrec map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list"
  where
   map_empty: "map f [] = []"
|  map_step: "map f (a # l) = (f a) #(map f l)"

definition lsum :: "real list \<Rightarrow> real"
  where "lsum rl \<equiv>  fold (\<lambda> x y. x + y) rl 0"

end


theory ext_Analysis_More
  imports Ordinary_Differential_Equations.Flow
begin

subsection \<open>Some results about derivatives\<close>

text \<open>Projection of has_vector_derivative onto components.\<close>
lemma has_vector_derivative_proj:
  assumes "(p has_vector_derivative q t) (at t within D)"
  shows "((\<lambda>t. p t $ i) has_vector_derivative q t $ i) (at t within D)"
  using assms unfolding has_vector_derivative_def has_derivative_def
  apply (simp add: bounded_linear_scaleR_left)
  using tendsto_vec_nth by fastforce

lemma has_vderiv_on_proj:
  assumes "(p has_vderiv_on q) D"
  shows "((\<lambda>t. p t $ i) has_vderiv_on (\<lambda>t. q t $ i)) D"
  using assms unfolding has_vderiv_on_def
  by (simp add: has_vector_derivative_proj)

lemma has_vector_derivative_projI:
  assumes "\<forall>i. ((\<lambda>t. p t $ i) has_vector_derivative q t $ i) (at t within D)"
  shows "(p has_vector_derivative q t) (at t within D)"
  using assms unfolding has_vector_derivative_def has_derivative_def
  apply (auto simp add: bounded_linear_scaleR_left)
  by (auto intro: vec_tendstoI)

lemma has_derivative_coords [simp,derivative_intros]:
  "((\<lambda>t. t$i) has_derivative (\<lambda>t. t$i)) (at x)"
  unfolding has_derivative_def by auto

lemma has_vector_derivative_divide[derivative_intros]:
  fixes a:: "'a::real_normed_field"
  shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. f x / a) has_vector_derivative (x/a)) F"
  unfolding divide_inverse by(fact has_vector_derivative_mult_left)

lemma has_derivative_divide[derivative_intros]:
  fixes a:: "'a::real_normed_field"
  shows "(f has_derivative g) F \<Longrightarrow> ((\<lambda>x. f x / a) has_derivative (\<lambda>x. g x / a)) F"
  unfolding divide_inverse by(fact has_derivative_mult_left)

text \<open>If the derivative is always 0, then the function is always 0.\<close>
lemma mvt_real_eq:
  fixes p :: "real \<Rightarrow> real"
  assumes "\<forall>t\<in>{0 .. d}. (p has_derivative q t) (at t within {0 .. d}) "
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. \<forall>s. q t s = 0"
    and "x \<in> {0 .. d}"
  shows "p 0 = p x"
proof -
  have "\<forall>t\<in>{0 .. x}. (p has_derivative q t) (at t within {0 .. x})"
    using assms
    by (meson atLeastAtMost_iff atLeastatMost_subset_iff has_derivative_subset in_mono order_refl)
  then show ?thesis
  using assms
  using mvt_simple[of 0 x p q]
  by force
qed

text \<open>If the derivative is always non-negative, then the function is increasing.\<close>
lemma mvt_real_ge:
  fixes p :: "real \<Rightarrow>real"
 assumes "\<forall>t\<in>{0 .. d}. (p has_derivative q t) (at t within {0 .. d}) "
  and "d \<ge> 0"
  and "\<forall>t\<in>{0 ..<d}. \<forall>s\<ge>0. q t s \<ge> 0"
  and "x \<in> {0 .. d}"
  shows "p 0 \<le> p x"
proof -
  have "\<forall>t\<in>{0 .. x}. (p has_derivative q t) (at t within {0 .. x})"
    using assms
    by (meson atLeastAtMost_iff atLeastatMost_subset_iff has_derivative_subset in_mono order_refl)
  then show ?thesis
  using assms
  using mvt_simple[of 0 x p q]
  by (smt atLeastAtMost_iff atLeastLessThan_iff greaterThanLessThan_iff)
qed

text \<open>If the derivative is always non-positive, then the function is decreasing.\<close>
lemma mvt_real_le:
  fixes p :: "real \<Rightarrow>real"
  assumes "\<forall>t\<in>{0 .. d}. (p has_derivative q t) (at t within {0 .. d}) "
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. \<forall>s\<ge>0 . q t s \<le> 0"
    and "x \<in> {0 .. d}"
  shows "p 0 \<ge> p x"
proof -
  have "\<forall>t\<in>{0 .. x}. (p has_derivative q t) (at t within {0 .. x})"
    using assms
    by (meson atLeastAtMost_iff atLeastatMost_subset_iff has_derivative_subset in_mono order_refl)
  then obtain xa where "xa\<in>{0<..<x}" " p x - p 0 = q xa (x - 0)" if "x>0"
    using  mvt_simple[of 0 x p q]
    using atLeastAtMost_iff by blast
  then have "p x \<le> p 0" if "x>0"
  using assms
  by (smt atLeastAtMost_iff atLeastLessThan_iff greaterThanLessThan_iff)
  then show ?thesis
    using assms  by fastforce

qed

lemma real_inv_le:
  fixes p :: "real \<Rightarrow> real" and con :: real
  assumes "\<forall>t\<in>{-e..d+e}. (p has_derivative q t) (at t within {-e..d+e})"
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. (p t = con \<longrightarrow> q t 1 < 0)"
    and "p 0 \<le> con "
    and "x \<in> {0 .. d}"
    and "e > 0"
  shows "p x \<le> con"
proof (rule ccontr)
  assume a:" \<not> p x \<le> con"
  have 1:"p x > con"
    using a by auto
  have 2:"\<forall>t\<in>{0 .. d}. continuous (at t within {-e<..<d+e}) p"
    using assms has_derivative_subset
    using has_derivative_continuous
    by (smt atLeastAtMost_iff continuous_within_subset greaterThanLessThan_subseteq_atLeastAtMost_iff greaterThan_iff)
  have 3:"\<forall>t\<in>{0 .. d}. isCont p t"
    apply auto subgoal for t
      using continuous_within_open[of t "{-e<..<d+e}" p]
      using 2 assms(5) assms(6) by auto
    done
  have 4:"{y. p y = con \<and> y \<in> {0 .. x}} \<noteq> {}"
    using IVT[of p 0 con x] using 3 1 assms
    by auto
  have 5: "{y. p y = con \<and> y \<in> {0 .. x}} = ({0 .. x} \<inter> p -` {con})"
    by auto
  have 6: "closed ({0 .. x} \<inter> p -` {con})"
    using 3 assms(5) apply simp
    apply (rule continuous_closed_preimage)
      apply auto
    by (simp add: continuous_at_imp_continuous_on)
  have 7: "compact {0 .. x}"
    using assms
    by blast
  have 8: "compact {y. p y = con \<and> y \<in> {0 .. x}}"
    apply auto
    using 4 5 6 7
    by (smt Collect_cong Int_left_absorb atLeastAtMost_iff compact_Int_closed)
  obtain t where t1:"t \<in> {y. p y = con \<and> y \<in> {0 .. x}}" and t2:"\<forall> tt\<in> {y. p y = con \<and> y \<in> {0 .. x}}. tt \<le>t"
    using compact_attains_sup[of "{y. p y = con \<and> y \<in> {0 .. x}}"] 4 8
    by blast
  have 9:"t<x"
    using t1 1
    using leI by fastforce
  have 10:"p tt > con" if "tt\<in>{t<..x}" for tt
  proof(rule ccontr)
    assume "\<not> con < p tt"
    then have not:"p tt \<le>con" by auto
    have "\<exists> t' \<in> {t<..x}. p t' = con"
    proof(cases "p tt = con")
      case True
      then show ?thesis using that by auto
    next
      case False
      then have "p tt < con"
        using not by auto
      then have "{y. p y = con \<and> y \<in> {tt .. x}} \<noteq> {}"
        using IVT[of p tt con x] using 3 1 assms that t1
        by auto
      then show ?thesis using that by auto
    qed
    then show False using t1 t2 9
      using atLeastAtMost_iff greaterThanAtMost_iff by auto
  qed
  have 11:"(p has_derivative q t) (at t within {-e..d+e})"
    using assms t1 by auto
  then have 12:"\<forall>s . q t s = q t 1 * s"
    using has_derivative_bounded_linear[of p "q t" "(at t within {-e..d+e})"]
    using real_bounded_linear by auto
  have 13:"(p has_real_derivative q t 1) (at t within {-e..d+e})"
    using 11 12
    by (metis has_derivative_imp_has_field_derivative mult.commute)
  have 14:"q t 1 < 0" using t1 assms 9 by auto
  have 15:"\<exists>dd>0. \<forall>h>0. t + h \<in> {-e..d+e} \<longrightarrow> h < dd \<longrightarrow> p (t + h) < p t"
    using has_real_derivative_neg_dec_right[of p "q t 1" t "{-e..d+e}"] 13 14
    by auto
  then obtain dd where d1:"\<forall>h>0. t + h \<in> {-e..d+e} \<longrightarrow> h < dd \<longrightarrow> p (t + h) < p t" and d2:"dd>0" by auto
  then have 16:"min (dd/2) (x-t)/2 < dd" and "min (dd/2) (x-t)/2 > 0"
    using 9 by auto
  then have 17:"(t + min (dd/2) (x-t)/2)> t" "(t + min (dd/2) (x-t)/2) < x"
    apply auto
    using d2 9
     by (smt field_sum_of_halves)
   then have 18:"p (t + min (dd/2) (x-t)/2) < p t"
    using d1 t1 16 assms(5) assms(6) by auto
  have 19:"p (t + min (dd/2) (x-t)/2)>con" using 10 17 by auto
  show False using 18 19 t1
    by auto
  qed

lemma real_inv_ge:
  fixes p :: "real \<Rightarrow> real" and con :: real
  assumes "\<forall>t\<in>{-e..d+e}. (p has_derivative q t) (at t within {-e..d+e})"
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. (p t = con \<longrightarrow> q t 1 > 0)"
    and "p 0 \<ge> con "
    and "x \<in> {0 .. d}"
    and "e > 0"
  shows "p x \<ge> con"
proof (rule ccontr)
  assume a:" \<not> p x \<ge> con"
  have 1:"p x < con"
    using a by auto
  have " \<forall>t\<in>{- e..d + e}. (p has_derivative q t) (at t within {- e<..<d + e})"
    using assms has_derivative_subset
    by (smt greaterThanLessThan_subseteq_atLeastAtMost_iff)
  then have " \<forall>t\<in>{0..d}. (p has_derivative q t) (at t within {- e<..<d + e})"
    using assms by auto
  then have 2:"\<forall>t\<in>{0 .. d}. continuous (at t within {-e<..<d+e}) p"
    using has_derivative_continuous
    by blast
  have 3:"\<forall>t\<in>{0 .. d}. isCont p t"
    apply auto subgoal for t
      using continuous_within_open[of t "{-e<..<d+e}" p]
      using 2 assms(5) assms(6) by auto
    done
  have 4:"{y. p y = con \<and> y \<in> {0 .. x}} \<noteq> {}"
    using IVT2[of p x con 0] using 3 1 assms
    by auto
  have 5: "{y. p y = con \<and> y \<in> {0 .. x}} = ({0 .. x} \<inter> p -` {con})"
    by auto
  have 6: "closed ({0 .. x} \<inter> p -` {con})"
    using 3 assms(5) apply simp
    apply (rule continuous_closed_preimage)
      apply auto
    by (simp add: continuous_at_imp_continuous_on)
  have 7: "compact {0 .. x}"
    using assms
    by blast
  have 8: "compact {y. p y = con \<and> y \<in> {0 .. x}}"
    apply auto
    using 4 5 6 7
    by (smt Collect_cong Int_left_absorb atLeastAtMost_iff compact_Int_closed)
  obtain t where t1:"t \<in> {y. p y = con \<and> y \<in> {0 .. x}}" and t2:"\<forall> tt\<in> {y. p y = con \<and> y \<in> {0 .. x}}. tt \<le>t"
    using compact_attains_sup[of "{y. p y = con \<and> y \<in> {0 .. x}}"] 4 8
    by blast
  have 9:"t<x"
    using t1 1
    using leI by fastforce
  have 10:"p tt < con" if "tt\<in>{t<..x}" for tt
  proof(rule ccontr)
    assume "\<not> con > p tt"
    then have not:"p tt \<ge> con" by auto
    have "\<exists> t' \<in> {t<..x}. p t' = con"
    proof(cases "p tt = con")
      case True
      then show ?thesis using that by auto
    next
      case False
      then have "p tt > con"
        using not by auto
      then have "{y. p y = con \<and> y \<in> {tt .. x}} \<noteq> {}"
        using IVT2[of p x con tt] using 3 1 assms that t1
        by auto
      then show ?thesis using that by auto
    qed
    then show False using t1 t2 9
      using atLeastAtMost_iff greaterThanAtMost_iff by auto
  qed
  have 11:"(p has_derivative q t) (at t within {-e..d+e})"
    using assms t1 by auto
  then have 12:"\<forall>s . q t s = q t 1 * s"
    using has_derivative_bounded_linear[of p "q t" "(at t within {-e..d+e})"]
    using real_bounded_linear by auto
  have 13:"(p has_real_derivative q t 1) (at t within {-e..d+e})"
    using 11 12
    by (metis has_derivative_imp_has_field_derivative mult.commute)
  have 14:"q t 1 > 0" using t1 assms 9 by auto
  have 15:"\<exists>dd>0. \<forall>h>0. t + h \<in> {-e..d+e} \<longrightarrow> h < dd \<longrightarrow> p (t + h) > p t"
    using has_real_derivative_pos_inc_right[of p "q t 1" t "{-e..d+e}"] 13 14
    by auto
  then obtain dd where d1:"\<forall>h>0. t + h \<in> {-e..d+e} \<longrightarrow> h < dd \<longrightarrow> p (t + h) > p t" and d2:"dd>0" by auto
  then have 16:"min (dd/2) (x-t)/2 < dd" and "min (dd/2) (x-t)/2 > 0"
    using 9 by auto
  then have 17:"(t + min (dd/2) (x-t)/2)> t" "(t + min (dd/2) (x-t)/2) < x"
    apply auto
    using d2 9
     by (smt field_sum_of_halves)
   then have 18:"p (t + min (dd/2) (x-t)/2) > p t"
    using d1 t1 16 assms(5) assms(6) by auto
  have 19:"p (t + min (dd/2) (x-t)/2)< con" using 10 17 by auto
  show False using 18 19 t1
    by auto
qed

lemma real_inv_l:
  fixes p :: "real \<Rightarrow> real" and con :: real
  assumes "\<forall>t\<in>{-e..d+e}. (p has_derivative q t) (at t within {-e..d+e})"
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. (p t \<le> con \<longrightarrow> q t 1 < 0)"
    and "p 0 < con "
    and "x \<in> {0 .. d}"
    and "e > 0"
  shows "p x < con"
proof (rule ccontr)
  assume a:" \<not> p x < con"
  have 1:"p x \<ge> con"
    using a by auto
  have 2:"\<forall>t\<in>{0 .. d}. continuous (at t within {-e<..<d+e}) p"
    using assms has_derivative_subset
    using has_derivative_continuous
    by (smt atLeastAtMost_iff continuous_within_subset greaterThanLessThan_subseteq_atLeastAtMost_iff greaterThan_iff)
  have 3:"\<forall>t\<in>{0 .. d}. isCont p t"
    apply auto subgoal for t
      using continuous_within_open[of t "{-e<..<d+e}" p]
      using 2 assms(5) assms(6) by auto
    done
  have 4:"{y. p y = con \<and> y \<in> {0 .. x}} \<noteq> {}"
    using IVT[of p 0 con x] using 3 1 assms
    by auto
  have 5: "{y. p y = con \<and> y \<in> {0 .. x}} = ({0 .. x} \<inter> p -` {con})"
    by auto
  have 6: "closed ({0 .. x} \<inter> p -` {con})"
    using 3 assms(5) apply simp
    apply (rule continuous_closed_preimage)
      apply auto
    by (simp add: continuous_at_imp_continuous_on)
  have 7: "compact {0 .. x}"
    using assms
    by blast
  have 8: "compact {y. p y = con \<and> y \<in> {0 .. x}}"
    apply auto
    using 4 5 6 7
    by (smt Collect_cong Int_left_absorb atLeastAtMost_iff compact_Int_closed)
  obtain t where t1:"t \<in> {y. p y = con \<and> y \<in> {0 .. x}}" and t2:"\<forall> tt\<in> {y. p y = con \<and> y \<in> {0 .. x}}. tt \<ge> t"
    using compact_attains_inf[of "{y. p y = con \<and> y \<in> {0 .. x}}"] 4 8
    by blast
  have 9:"t > 0"
    using t1 1 assms(4)
    using less_eq_real_def by auto
  have 10:"p tt < con" if "tt\<in>{0..<t}" for tt
  proof(rule ccontr)
    assume "\<not> p tt < con"
    then have not:"p tt \<ge> con" by auto
    have "\<exists> t' \<in> {0..<t}. p t' = con"
    proof(cases "p tt = con")
      case True
      then show ?thesis using that by auto
    next
      case False
      then have "p tt > con"
        using not by auto
      then have "{y. p y = con \<and> y \<in> {0 .. tt}} \<noteq> {}"
        using IVT[of p 0 con tt] using 3 1 assms that t1
        by auto
      then show ?thesis using that by auto
    qed
    then show False using t1 t2 9
      using atLeastAtMost_iff greaterThanAtMost_iff by auto
  qed
  have 11:"(p has_derivative q y) (at y within {0..t})" if "y \<in> {0 ..t}"for y
    apply(rule has_derivative_subset [where s = "{-e<..<d+e}"])
    using assms that t1
    apply auto
    by (smt atLeastAtMost_iff at_within_Icc_at has_derivative_at_withinI)
  have 12:"\<exists> tt \<in> {0<..<t} . p t - p 0 = q tt t "
    using mvt_simple[of 0 t p q] 9 11
    by auto
  obtain tt where tt1:"p t - p 0 = q tt t" and tt2:"tt \<in> {0<..<t}"
    using 12 by auto
  have 13:"\<forall>s . q tt s = q tt 1 * s"
    using has_derivative_bounded_linear[of p "q tt" "(at tt within {0..t})"]
    using real_bounded_linear 11 tt2 by auto
  have 14:"p t - p 0 = q tt 1 * t" using tt1 13
    by metis
  have 15:"q tt 1 > 0" using 14 assms(4) t1 9
    by (metis (mono_tags, lifting) diff_gt_0_iff_gt mem_Collect_eq zero_less_mult_pos2)
  then show False using assms(3) 10[of tt] tt2
    by (smt "10" a assms(5) atLeastAtMost_iff atLeastLessThan_iff greaterThanLessThan_iff)
qed

lemma real_inv_g:
  fixes p :: "real \<Rightarrow> real" and con :: real
  assumes "\<forall>t\<in>{-e..d+e}. (p has_derivative q t) (at t within {-e..d+e})"
    and "d \<ge> 0"
    and "\<forall>t\<in>{0 ..<d}. (p t \<ge> con \<longrightarrow> q t 1 \<ge> 0)"
    and "p 0 > con "
    and "x \<in> {0 .. d}"
    and "e > 0"
  shows "p x > con"
proof (rule ccontr)
  assume a:" \<not> p x > con"
  have 1:"p x \<le> con"
    using a by auto
  have 2:"\<forall>t\<in>{0 .. d}. continuous (at t within {-e<..<d+e}) p"
    using assms has_derivative_subset
    using has_derivative_continuous
    by (smt atLeastAtMost_iff continuous_within_subset greaterThanLessThan_subseteq_atLeastAtMost_iff greaterThan_iff)
  have 3:"\<forall>t\<in>{0 .. d}. isCont p t"
    apply auto subgoal for t
      using continuous_within_open[of t "{-e<..<d+e}" p]
      using 2 assms(5) assms(6) by auto
    done
  have 4:"{y. p y = con \<and> y \<in> {0 .. x}} \<noteq> {}"
    using IVT2[of p x con 0] using 3 1 assms
    by auto
  have 5: "{y. p y = con \<and> y \<in> {0 .. x}} = ({0 .. x} \<inter> p -` {con})"
    by auto
  have 6: "closed ({0 .. x} \<inter> p -` {con})"
    using 3 assms(5) apply simp
    apply (rule continuous_closed_preimage)
      apply auto
    by (simp add: continuous_at_imp_continuous_on)
  have 7: "compact {0 .. x}"
    using assms
    by blast
  have 8: "compact {y. p y = con \<and> y \<in> {0 .. x}}"
    apply auto
    using 4 5 6 7
    by (smt Collect_cong Int_left_absorb atLeastAtMost_iff compact_Int_closed)
  obtain t where t1:"t \<in> {y. p y = con \<and> y \<in> {0 .. x}}" and t2:"\<forall> tt\<in> {y. p y = con \<and> y \<in> {0 .. x}}. tt \<ge> t"
    using compact_attains_inf[of "{y. p y = con \<and> y \<in> {0 .. x}}"] 4 8
    by blast
  have 9:"t > 0"
    using t1 1 assms(4)
    using less_eq_real_def by auto
  have 10:"p tt > con" if "tt\<in>{0..<t}" for tt
  proof(rule ccontr)
    assume "\<not> p tt > con"
    then have not:"p tt \<le> con" by auto
    have "\<exists> t' \<in> {0..<t}. p t' = con"
    proof(cases "p tt = con")
      case True
      then show ?thesis using that by auto
    next
      case False
      then have "p tt < con"
        using not by auto
      then have "{y. p y = con \<and> y \<in> {0 .. tt}} \<noteq> {}"
        using IVT2[of p tt con 0] using 3 1 assms that t1
        by auto
      then show ?thesis using that by auto
    qed
    then show False using t1 t2 9
      using atLeastAtMost_iff greaterThanAtMost_iff by auto
  qed
  have 11:"(p has_derivative q y) (at y within {0..t})" if "y \<in> {0 ..t}"for y
    apply(rule has_derivative_subset [where s = "{-e<..<d+e}"])
    using assms that t1
    apply auto
    by (smt atLeastAtMost_iff at_within_Icc_at has_derivative_at_withinI)
  have 12:"\<exists> tt \<in> {0<..<t} . p t - p 0 = q tt t "
    using mvt_simple[of 0 t p q] 9 11
    by auto
  obtain tt where tt1:"p t - p 0 = q tt t" and tt2:"tt \<in> {0<..<t}"
    using 12 by auto
  have 13:"\<forall>s . q tt s = q tt 1 * s"
    using has_derivative_bounded_linear[of p "q tt" "(at tt within {0..t})"]
    using real_bounded_linear 11 tt2 by auto
  have 14:"p t - p 0 = q tt 1 * t" using tt1 13
    by metis
  have 15:"q tt 1 < 0" using 14 assms(4) t1 9
    by (metis (mono_tags, lifting) less_iff_diff_less_0 mem_Collect_eq mult_less_0_iff not_less_iff_gr_or_eq)
  then show False using assms(3) 10[of tt] tt2
    by (smt "1" "10" assms(5) atLeastAtMost_iff atLeastLessThan_iff greaterThanLessThan_iff)
qed

subsection \<open>Definition of states\<close>

text \<open>Variable names\<close>
type_synonym var = char

text \<open>State\<close>
type_synonym state = "var \<Rightarrow> real"

text \<open>Expressions\<close>
type_synonym exp = "state \<Rightarrow> real"

text \<open>Predicates\<close>
type_synonym fform = "state \<Rightarrow> bool"

text \<open>States as a vector\<close>
type_synonym vec = "real^(var)"

text \<open>Conversion between state and vector\<close>
definition state2vec :: "state \<Rightarrow> vec" where
  "state2vec s = (\<chi> x. s x)"

definition vec2state :: "vec \<Rightarrow> state" where
  "(vec2state v) x = v $ x"

lemma vec_state_map1[simp]: "vec2state (state2vec s) = s"
  unfolding vec2state_def state2vec_def by auto

lemma vec_state_map2[simp]: "state2vec (vec2state s) = s"
  unfolding vec2state_def state2vec_def by auto

subsection \<open>Definition of ODEs\<close>

datatype ODE =
  ODE "var \<Rightarrow> exp"

text \<open>Given ODE and a state, find the derivative vector.\<close>
fun ODE2Vec :: "ODE \<Rightarrow> state \<Rightarrow> vec" where
  "ODE2Vec (ODE f) s = state2vec (\<lambda>a. f a s)"

text \<open>History p on time {0 .. d} is a solution to ode.\<close>
definition ODEsol :: "ODE \<Rightarrow> (real \<Rightarrow> state) \<Rightarrow> real \<Rightarrow> bool" where
  "ODEsol ode p d = (d \<ge> 0 \<and> (\<exists>\<epsilon>>0. ((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-\<epsilon> .. d+\<epsilon>}))"

text \<open>History p on time {0 ..} is a solution to ode.\<close>
definition ODEsolInf :: "ODE \<Rightarrow> (real \<Rightarrow> state) \<Rightarrow> bool" where
  "ODEsolInf ode p = (\<exists>\<epsilon>>0. ((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-\<epsilon> ..})"

subsection \<open>Further results in analysis\<close>

lemma ODEsol_old:
  assumes "ODEsol ode p d"
  shows "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {0 .. d}"
proof-
  obtain e where e: "e > 0" "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-e .. d+e}"
    using assms(1) unfolding ODEsol_def by blast
  then show ?thesis
    using e(1) has_vderiv_on_subset[OF e(2)] by auto
qed

lemma ODEsolInf_old:
   assumes "ODEsolInf  ode p"
   shows "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {0 ..}"
proof-
  obtain e where e: "e > 0" "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-e ..}"
    using assms(1) unfolding ODEsolInf_def by blast
  then show ?thesis
    using e(1) has_vderiv_on_subset[OF e(2)] by auto
qed

lemma ODEsol_merge:
  assumes "ODEsol ode p d"
    and "ODEsol ode p2 d2"
    and "p2 0 = p d"
  shows "ODEsol ode (\<lambda>\<tau>. if \<tau> < d then p \<tau> else p2 (\<tau> - d)) (d + d2)"
  unfolding ODEsol_def
  apply auto
  subgoal
    using assms(1,2) unfolding ODEsol_def by auto
  subgoal
  proof-
    have step1:"d\<ge>0 \<and> d2\<ge>0"
      using assms unfolding ODEsol_def by auto
    then have step2:"{0 .. d+d2} = {0 .. d}\<union>{d .. d+d2}"
      by auto
    have step3:"({0..d} \<union> closure {d..d + d2} \<inter> closure {0..d}) = {0..d}"
      using step1 by auto
    have step4:"({d..d + d2} \<union> closure {d..d + d2} \<inter> closure {0..d}) = {d..d+d2}"
      using step1 by auto
    obtain e1 where e1: "e1 > 0" "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-e1 .. d+e1}"
      using assms(1) unfolding ODEsol_def by blast
    obtain e2 where e2: "e2 > 0" "((\<lambda>t. state2vec (p2 t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p2 t))) {-e2 .. d2+e2}"
      using assms(2) unfolding ODEsol_def by blast
    obtain e where e: "e > 0" "e < e1" "e < e2"
      using e1(1) e2(1) field_lbound_gt_zero by auto
    then have stepe:"{0 .. d2+e}\<subseteq>{- e2..d2 + e2}" "{-e .. d}\<subseteq>{- e1..d + e1}" "{- e..d + d2 + e} = {- e..d} \<union> {d..d + d2 + e}"
      using step1  by auto
    have stepclo1:"({- e..d} \<union> closure {d..d + d2 + e} \<inter> closure {- e..d}) = {- e..d}"
      using e step1 by auto
    have stepclo2:" ({d..d + d2 + e} \<union> closure {d..d + d2 + e} \<inter> closure {- e..d}) = {d..d + d2 + e}"
      using e step1 by auto
    have stepclo3: "x \<in> closure {d..d + d2 + e} \<Longrightarrow>
          x \<in> closure {- e..d} \<Longrightarrow> x = d" for x
      using e step1  by auto
    have step5: "((\<lambda>t. t - d) has_vderiv_on (\<lambda>t. 1)) {d .. d+d2+e}"
      by (auto intro!: derivative_intros)
    then have step6: "((\<lambda>t. state2vec (p2 (t-d))) has_vderiv_on (\<lambda>t. ODE2Vec ode (p2 (t-d)))) {d .. d+d2+e}"
      using has_vderiv_on_compose2[of "(\<lambda>t. state2vec (p2 t))" "(\<lambda>t. ODE2Vec ode (p2 (t)))" "{0 .. d2+e}" "(\<lambda>t. (t-d))" "(\<lambda>t. 1)" "{d .. d+d2+e}"]
      using e2 e unfolding ODEsol_def
      using has_vderiv_on_subset[OF e2(2) stepe(1)] by auto
     have step7:" ((\<lambda>t. if t \<in> {-e..d} then state2vec (p t) else state2vec (p2 (t - d))) has_vderiv_on
     (\<lambda>t. if t \<in> {-e..d} then ODE2Vec ode (p t) else ODE2Vec ode (p2 (t - d)))){-e..d + d2+e}"
      using has_vderiv_on_If[of "{-e .. d+d2+e}" "{-e .. d}" "{d .. d+d2+e}" "(\<lambda>t. state2vec (p t))" "(\<lambda>t. ODE2Vec ode (p t))" "(\<lambda>t. state2vec (p2 (t-d)))" "(\<lambda>t. ODE2Vec ode (p2 (t-d)))"]
      using step1 step2 step3 step4 step6 stepclo1 stepclo2 stepclo3
      using has_vderiv_on_subset[OF e1(2) stepe(2)] e stepe assms(3)
      by auto
    show ?thesis
      apply(rule exI[where x=e])
      using has_vderiv_eq[of "(\<lambda>t. if t \<in> {-e..d} then state2vec (p t) else state2vec (p2 (t - d)))" "(\<lambda>t. if t \<in> {-e..d} then ODE2Vec ode (p t) else ODE2Vec ode (p2 (t - d)))" "{-e..d + d2+e}" "(\<lambda>t. state2vec (if t < d then p t else p2 (t - d)))" "(\<lambda>t. ODE2Vec ode (if t < d then p t else p2 (t - d)))" "{-e..d + d2+e}"]
      using step7
      using assms(3) step1 e
      by auto
  qed
  done

lemma ODEsol_split:
  assumes "ODEsol ode p d"
    and "0 < t1" and "t1 < d"
  shows "ODEsol ode p t1"
        "ODEsol ode (\<lambda>t. p (t + t1)) (d - t1)"
  subgoal
  proof-
    obtain e where e: "e > 0" "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-e .. d+e}"
      using assms(1) unfolding ODEsol_def by blast
    then show ?thesis unfolding ODEsol_def
    using has_vderiv_on_subset[of "(\<lambda>t. state2vec (p t))" " (\<lambda>t. ODE2Vec ode (p t))" "{-e .. d+e}" "{-e..t1+e}"]
    using assms unfolding ODEsol_def by auto
qed
  subgoal
    unfolding ODEsol_def apply auto
    subgoal using assms by auto
    subgoal
    proof-
      obtain e where e: "e > 0" "((\<lambda>t. state2vec (p t)) has_vderiv_on (\<lambda>t. ODE2Vec ode (p t))) {-e .. d+e}"
        using assms(1) unfolding ODEsol_def by blast
      have step1:"((\<lambda>t. state2vec (p (t))) has_vderiv_on (\<lambda>t. ODE2Vec ode (p (t)))) {t1-e..d+e}"
        using has_vderiv_on_subset[of "(\<lambda>t. state2vec (p t))" " (\<lambda>t. ODE2Vec ode (p t))" "{-e..d+e}" "{t1-e..d+e}"]
        using e assms  by auto
      have step2:"((\<lambda>t.(t+t1)) has_vderiv_on (\<lambda>t. 1)) {-e..d-t1+e}"
        by (auto intro!: derivative_intros)
      have step3:"t \<in> {- e..d - t1 + e} \<Longrightarrow> t + t1 \<in> {t1 - e..d + e}" for t
        using e assms by auto
      show ?thesis
        apply (rule exI[where x=e])
        apply auto
        subgoal using e by auto
        using has_vderiv_on_compose2[of "(\<lambda>t. state2vec (p (t)))" "(\<lambda>t. ODE2Vec ode (p (t)))" "{t1-e..d+e}" "(\<lambda>t.(t+t1))" "(\<lambda>t. 1)" " {-e..d-t1+e}"]
        using step1 step2 step3 by auto
    qed
    done
  done

end