(*
  File:     Balanced.thy
  Author:   Martin Rau, TU München
*)

section \<open>Building a balanced \<open>k\<close>-d Tree from a List of Points\<close>

theory Balanced
imports
  KDTree
  Median_Of_Medians_Selection.Median_Of_Medians_Selection
begin

text \<open>
  Build a balanced \<open>k\<close>-d Tree by recursively partition the points into two lists.
  The partitioning criteria will be the median at a particular axis \<open>k\<close>.
  The left list will contain all points \<open>p\<close> with @{term "p$k \<le> median"}.
  The right list will contain all points with median at axis @{term "median < p$k"}.
  The left and right list differ in length by one or none.
  The axis \<open>k\<close> will the widest spread axis.
\<close>

subsection "Auxiliary Lemmas"

lemma length_filter_mset_sorted_nth:
  assumes "distinct xs" "n < length xs" "sorted xs"
  shows "{# x \<in># mset xs. x \<le> xs ! n #} = mset (take (n + 1) xs)"
  using assms
proof (induction xs arbitrary: n rule: list.induct)
  case (Cons x xs)
  thus ?case
  proof (cases n)
    case 0
    thus ?thesis
      using Cons.prems(1,3) filter_mset_is_empty_iff by fastforce
  next
    case (Suc n')
    thus ?thesis
      using Cons by simp
  qed
qed auto

lemma length_filter_sort_nth:
  assumes "distinct xs" "n < length xs"
  shows "length (filter (\<lambda>x. x \<le> sort xs ! n) xs) = n + 1"
proof -
  have "length (filter (\<lambda>x. x \<le> sort xs ! n) xs) = length (filter (\<lambda>x. x \<le> sort xs ! n) (sort xs))"
    by (simp add: filter_sort)
  also have "... = size (mset (filter (\<lambda>x. x \<le> sort xs ! n) (sort xs)))"
    using size_mset by metis
  also have "... = size ({# x \<in># mset (sort xs). x \<le> sort xs ! n #})"
    using mset_filter by simp
  also have "... = size (mset (take (n + 1) (sort xs)))"
    using length_filter_mset_sorted_nth assms sorted_sort distinct_sort length_sort by metis
  finally show ?thesis
    using assms(2) by auto
qed

subsection \<open>Widest Spread Axis\<close>

definition calc_spread :: "('k::finite) \<Rightarrow> 'k point list \<Rightarrow> real" where
  "calc_spread k ps = (case ps of [] \<Rightarrow> 0 | ps \<Rightarrow>
    let ks = map (\<lambda>p. p$k) (tl ps) in
    fold max ks ((hd ps)$k) - fold min ks ((hd ps)$k)
  )"

fun widest_spread :: "('k::finite) list \<Rightarrow> 'k point list \<Rightarrow> 'k \<times> real" where
  "widest_spread [] _ = undefined"
| "widest_spread [k] ps = (k, calc_spread k ps)"
| "widest_spread (k # ks) ps = (
    let (k', s') = widest_spread ks ps in
    let s = calc_spread k ps in
    if s \<le> s' then (k', s') else (k, s)
  )"

lemma calc_spread_spec:
  "calc_spread k ps = spread k (set ps)"
  using Max.set_eq_fold[of "(hd ps)$k"] Min.set_eq_fold[of "(hd ps)$k"]
  by (auto simp: Let_def spread_def calc_spread_def split: list.splits, metis set_map)

lemma widest_spread_calc_spread:
  "ks \<noteq> [] \<Longrightarrow> (k, s) = widest_spread ks ps \<Longrightarrow> s = calc_spread k ps"
  by (induction ks ps rule: widest_spread.induct) (auto simp: Let_def split: prod.splits if_splits)

lemma widest_spread_axis_Un:
  shows "widest_spread_axis k K P \<Longrightarrow> spread k' P \<le> spread k P \<Longrightarrow> widest_spread_axis k (K \<union> { k' }) P"
    and "widest_spread_axis k K P \<Longrightarrow> spread k P \<le> spread k' P \<Longrightarrow> widest_spread_axis k' (K \<union> { k' }) P"
  unfolding widest_spread_axis_def by auto

lemma widest_spread_spec:
  "(k, s) = widest_spread ks ps \<Longrightarrow> widest_spread_axis k (set ks) (set ps)"
proof (induction ks ps arbitrary: k s rule: widest_spread.induct)
  case (3 k\<^sub>0 k\<^sub>1 ks ps)
  obtain K' S' where K'_def: "(K', S') = widest_spread (k\<^sub>1 # ks) ps"
    by (metis surj_pair)
  hence IH: "widest_spread_axis K' (set (k\<^sub>1 # ks)) (set ps)"
    using "3.IH" by blast
  hence 0: "S' = spread K' (set ps)"
    using K'_def widest_spread_calc_spread calc_spread_spec by blast
  define S where "S = calc_spread k\<^sub>0 ps"
  hence 1: "S = spread k\<^sub>0 (set ps)"
    using calc_spread_spec by blast
  show ?case
  proof (cases "S \<le> S'")
    case True
    hence "widest_spread_axis K' (set (k\<^sub>0 # k\<^sub>1 # ks)) (set ps)"
      using 0 1 widest_spread_axis_Un(1)[OF IH, of k\<^sub>0]  by auto
    thus ?thesis
      using True K'_def S_def "3.prems" by (auto split: prod.splits)
  next
    case False
    hence "widest_spread_axis k\<^sub>0 (set (k\<^sub>0 # k\<^sub>1 # ks)) (set ps)"
      using 0 1 widest_spread_axis_Un(2)[OF IH, of k\<^sub>0] "3.prems"(1) by auto
    thus ?thesis
      using False K'_def S_def "3.prems" by (auto split: prod.splits)
  qed
qed (auto simp: widest_spread_axis_def)

subsection \<open>Fast Axis Median\<close>

definition axis_median :: "('k::finite) \<Rightarrow> 'k point list \<Rightarrow> real" where
  "axis_median k ps = (let n = (length ps - 1) div 2 in fast_select n (map (\<lambda>p. p$k) ps))"

lemma length_filter_le_axis_median:
  assumes "0 < length ps" "\<forall>k. distinct (map (\<lambda>p. p$k) ps)"
  shows "length (filter (\<lambda>p. p$k \<le> axis_median k ps) ps) = (length ps - 1) div 2 + 1"
proof -
  let ?n = "(length ps - 1) div 2"
  let ?ps = "map (\<lambda>p. p$k) ps"
  let ?m = "fast_select ?n ?ps"
  have 0: "?n < length ?ps"
    using assms(1) by (auto, linarith)
  have 1: "distinct ?ps"
    using assms(2) by blast
  have "?m = select ?n ?ps"
    using fast_select_correct[OF 0] by blast
  hence "length (filter (\<lambda>p. p$k \<le> axis_median k ps) ps) =
        length (filter (\<lambda>p. p$k \<le> sort ?ps ! ?n) ps)"
    unfolding axis_median_def by (auto simp add: Let_def select_def simp del: fast_select.simps)
  also have "... = length (filter (\<lambda>v. v \<le> sort ?ps ! ?n) ?ps)"
    by (induction ps) (auto, metis comp_apply)
  also have "... = ?n + 1"
    using length_filter_sort_nth[OF 1 0] by blast
  finally show ?thesis .
qed

definition partition_by_median :: "('k::finite) \<Rightarrow> 'k point list \<Rightarrow> 'k point list \<times> real \<times> 'k point list" where
  "partition_by_median k ps = (
     let m = axis_median k ps in
     let (l, r) = partition (\<lambda>p. p$k \<le> m) ps in
     (l, m, r)
  )"

lemma set_partition_by_median:
  "(l, m, r) = partition_by_median k ps \<Longrightarrow> set ps = set l \<union> set r"
  unfolding partition_by_median_def by (auto simp: Let_def)

lemma filter_partition_by_median:
  assumes "(l, m, r) = partition_by_median k ps"
  shows "\<forall>p \<in> set l. p$k \<le> m"
    and "\<forall>p \<in> set r. \<not>p$k \<le> m"
  using assms unfolding partition_by_median_def by (auto simp: Let_def)

lemma sum_length_partition_by_median:
  assumes "(l, m, r) = partition_by_median k ps"
  shows "length ps = length l + length r"
  using assms sum_length_filter_compl[of "(\<lambda>p. p $ k \<le> axis_median k ps)"]
  unfolding partition_by_median_def by (simp add: Let_def o_def)

lemma length_l_partition_by_median:
  assumes "0 < length ps" "\<forall>k. distinct (map (\<lambda>p. p$k) ps)" "(l, m, r) = partition_by_median k ps"
  shows "length l = (length ps - 1) div 2 + 1"
  using assms unfolding partition_by_median_def by (auto simp: Let_def length_filter_le_axis_median)

corollary lengths_partition_by_median_1:
  assumes "0 < length ps"  "\<forall>k. distinct (map (\<lambda>p. p$k) ps)" "(l, m, r) = partition_by_median k ps"
  shows "length l - length r \<le> 1"
    and "length r \<le> length l"
    and "0 < length l"
    and "length r < length ps"
  using length_l_partition_by_median[OF assms] sum_length_partition_by_median[OF assms(3)] by auto

corollary lengths_partition_by_median_2:
  assumes "1 < length ps" "\<forall>k. distinct (map (\<lambda>p. p$k) ps)" "(l, m, r) = partition_by_median k ps"
  shows "0 < length r"
    and "length l < length ps"
proof -
  have *: "0 < length ps"
    using assms(1) by auto
  show "0 < length r" "length l < length ps"
    using length_l_partition_by_median[OF * assms(2,3)] sum_length_partition_by_median[OF assms(3)]
    using assms(1) by linarith+
qed

lemmas length_partition_by_median =
  sum_length_partition_by_median length_l_partition_by_median
  lengths_partition_by_median_1 lengths_partition_by_median_2

subsection \<open>Building the Tree\<close>

function (domintros, sequential) build :: "('k::finite) list \<Rightarrow> 'k point list \<Rightarrow> 'k kdt" where
  "build _ [] = undefined"
| "build _ [p] = Leaf p"
| "build ks ps = (
    let (k, _) = widest_spread ks ps in
    let (l, m, r) = partition_by_median k ps in
    Node k m (build ks l) (build ks r)
  )"
  by pat_completeness auto

lemma build_domintros3:
  assumes "(k, s) = widest_spread ks (x # y # zs)" "(l, m, r) = partition_by_median k (x # y # zs)"
  assumes "build_dom (ks, l)" "build_dom (ks, r)"
  shows "build_dom (ks, x # y # zs)"
proof -
  {
    fix k s l m r
    assume "(k, s) = widest_spread ks (x # y # zs)" "(l, m, r) = partition_by_median k (x # y # zs)"
    hence "build_dom (ks, l)" "build_dom (ks, r)"
      using assms by (metis Pair_inject)+
  }
  thus ?thesis
    by (simp add: build.domintros(3))
qed

lemma build_termination:
  assumes "\<forall>k. distinct (map (\<lambda>p. p$k) ps)"
  shows "build_dom (ks, ps)"
  using assms
proof (induction ps rule: length_induct)
  case (1 xs)
  consider (A) "xs = []" | (B) "\<exists>x. xs = [x]" | (C) "\<exists>x y zs. xs = x # y # zs"
    by (induction xs rule: induct_list012) auto
  then show ?case
  proof cases
    case C
    then obtain x y zs where xyzs_def: "xs = x # y # zs"
      by blast
    obtain k s where ks_def: "(k, s) = widest_spread ks xs"
      by (metis surj_pair)
    obtain l m r where lmr_def: "(l, m, r) = partition_by_median k xs"
      by (metis prod_cases3)
    note defs = xyzs_def ks_def lmr_def
    have "\<forall>k. distinct (map (\<lambda>p. p $ k) l)" "\<forall>k. distinct (map (\<lambda>p. p $ k) r)"
      using lmr_def unfolding partition_by_median_def
      by (auto simp: Let_def "1.prems" distinct_map_filter)
    moreover have "length l < length xs" "length r < length xs"
      using length_partition_by_median(8)[OF _ "1.prems"] length_partition_by_median(6)[OF _ "1.prems"]
      using defs by auto
    ultimately have "build_dom (ks, l)" "build_dom (ks, r)"
      using "1.IH" by blast+
    thus ?thesis
      using build_domintros3 defs by blast
  qed (auto intro: build.domintros)
qed

lemma build_psimp_1:
  "ps = [p] \<Longrightarrow> build k ps = Leaf p"
  by (simp add: build.domintros(2) build.psimps(2))

lemma build_psimp_2:
  assumes "(k, s) = widest_spread ks (x # y # zs)" "(l, m, r) = partition_by_median k (x # y # zs)"
  assumes "build_dom (ks, l)" "build_dom (ks, r)"
  shows "build ks (x # y # zs) = Node k m (build ks l) (build ks r)"
proof -
  have 0: "build_dom (ks, x # y # zs)"
    using assms build_domintros3 by blast
  thus ?thesis
    using build.psimps(3)[OF 0] assms(1,2) by (auto split: prod.splits)
qed

lemma length_xs_gt_1:
  "1 < length xs \<Longrightarrow> \<exists>x y ys. xs = x # y # ys"
  by (cases xs, auto simp: neq_Nil_conv)

lemma build_psimp_3:
  assumes "1 < length ps" "(k, s) = widest_spread ks ps" "(l, m, r) = partition_by_median k ps"
  assumes "build_dom (ks, l)" "build_dom (ks, r)"
  shows "build ks ps = Node k m (build ks l) (build ks r)"
  using build_psimp_2 length_xs_gt_1 assms by blast

lemmas build_psimps[simp] = build_psimp_1 build_psimp_3

subsection \<open>Main Theorems\<close>

theorem set_build:
  "0 < length ps \<Longrightarrow> \<forall>k. distinct (map (\<lambda>p. p$k) ps) \<Longrightarrow> set ps = set_kdt (build ks ps)"
proof (induction ps rule: length_induct)
  case (1 ps)
  show ?case
  proof (cases "1 < length ps")
    case True
    obtain k s where ks_def: "(k, s) = widest_spread ks ps"
      by (metis surj_pair)
    obtain l m r where lmr_def: "(l, m, r) = partition_by_median k ps"
      by (metis prod_cases3)
    have D: "\<forall>k. distinct (map (\<lambda>p. p$k) l)" "\<forall>k. distinct (map (\<lambda>p. p$k) r)"
      using lmr_def unfolding partition_by_median_def
      by (auto simp: "1.prems"(2) Let_def distinct_map_filter)
    moreover have "length l < length ps" "0 < length l"
                  "length r < length ps" "0 < length r"
      using length_partition_by_median(8)[OF True "1.prems"(2)]
            length_partition_by_median(5)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(6)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(7)[OF True "1.prems"(2)]
            lmr_def by blast+
    ultimately have "set l = set_kdt (build ks l)" "set r = set_kdt (build ks r)"
      using "1.IH" by blast+
    moreover have "set ps = set l \<union> set r"
      using lmr_def unfolding partition_by_median_def by (auto simp: Let_def)
    moreover have "build ks ps = Node k m (build ks l) (build ks r)"
      using build_psimp_3[OF True ks_def lmr_def] build_termination D by blast
    ultimately show ?thesis
      by simp
  next
    case False
    thus ?thesis
      using "1.prems" by (cases ps) auto
  qed
qed

theorem invar_build:
  "0 < length ps \<Longrightarrow> \<forall>k. distinct (map (\<lambda>p. p$k) ps) \<Longrightarrow> set ks = UNIV \<Longrightarrow> invar (build ks ps)"
proof (induction ps rule: length_induct)
  case (1 ps)
  show ?case
  proof (cases "1 < length ps")
    case True
    obtain k s where ks_def: "(k, s) = widest_spread ks ps"
      by (metis surj_pair)
    obtain l m r where lmr_def: "(l, m, r) = partition_by_median k ps"
      by (metis prod_cases3)
    have D: "\<forall>k. distinct (map (\<lambda>p. p$k) l)" "\<forall>k. distinct (map (\<lambda>p. p$k) r)"
      using lmr_def unfolding partition_by_median_def
      by (auto simp: "1.prems"(2) Let_def distinct_map_filter)
    moreover have "length l < length ps" "0 < length l"
                  "length r < length ps" "0 < length r"
      using length_partition_by_median(8)[OF True "1.prems"(2)]
            length_partition_by_median(5)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(6)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(7)[OF True "1.prems"(2)]
            lmr_def by blast+
    ultimately have "invar (build ks l)" "invar (build ks r)"
      using "1.IH" "1.prems"(3) by blast+
    moreover have "\<forall>p \<in> set l. p$k \<le> m" "\<forall>p \<in> set r. m < p$k"
      using filter_partition_by_median(1)[OF lmr_def]
            filter_partition_by_median(2)[OF lmr_def] by auto
    moreover have "widest_spread_axis k UNIV (set l \<union> set r)"
      using widest_spread_spec[OF ks_def] "1.prems"(3) set_partition_by_median[OF lmr_def] by simp
    moreover have "build ks ps = Node k m (build ks l) (build ks r)"
      using build_psimp_3[OF True ks_def lmr_def] build_termination D by blast
    ultimately show ?thesis
      using set_build[OF \<open>0 < length l\<close> D(1)] set_build[OF \<open>0 < length r\<close> D(2)] by simp
  next
    case False
    thus ?thesis
      using "1.prems" by (cases ps) auto
  qed
qed

theorem size_build:
  "0 < length ps \<Longrightarrow> \<forall>k. distinct (map (\<lambda>p. p$k) ps) \<Longrightarrow> size_kdt (build ks ps) = length ps"
proof (induction ps rule: length_induct)
  case (1 ps)
  show ?case
  proof (cases "1 < length ps")
    case True
    obtain k s where ks_def: "(k, s) = widest_spread ks ps"
      by (metis surj_pair)
    obtain l m r where lmr_def: "(l, m, r) = partition_by_median k ps"
      by (metis prod_cases3)
    have D: "\<forall>k. distinct (map (\<lambda>p. p$k) l)" "\<forall>k. distinct (map (\<lambda>p. p$k) r)"
      using lmr_def unfolding partition_by_median_def
      by (auto simp: "1.prems"(2) Let_def distinct_map_filter)
    moreover have "length l < length ps" "0 < length l"
                  "length r < length ps" "0 < length r"
      using length_partition_by_median(8)[OF True "1.prems"(2)]
            length_partition_by_median(5)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(6)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(7)[OF True "1.prems"(2)]
            lmr_def by blast+
    ultimately have "size_kdt (build ks l) = length l" "size_kdt (build ks r) = length r"
      using "1.IH" by blast+
    moreover have "build ks ps = Node k m (build ks l) (build ks r)"
      using build_psimp_3[OF True ks_def lmr_def] build_termination D by blast
    ultimately show ?thesis
      using length_partition_by_median(1)[OF lmr_def] by simp
  next
    case False
    thus ?thesis
      using "1.prems" by (cases ps) auto
  qed
qed

theorem balanced_build:
  "0 < length ps \<Longrightarrow> \<forall>k. distinct (map (\<lambda>p. p$k) ps) \<Longrightarrow> balanced (build ks ps)"
proof (induction ps rule: length_induct)
  case (1 ps)
  show ?case
  proof (cases "1 < length ps")
    case True
    obtain k s where ks_def: "(k, s) = widest_spread ks ps"
      by (metis surj_pair)
    obtain l m r where lmr_def: "(l, m, r) = partition_by_median k ps"
      by (metis prod_cases3)
    have D: "\<forall>k. distinct (map (\<lambda>p. p$k) l)" "\<forall>k. distinct (map (\<lambda>p. p$k) r)"
      using lmr_def unfolding partition_by_median_def
      by (auto simp: "1.prems"(2) Let_def distinct_map_filter)
    moreover have "length l < length ps" "0 < length l"
                  "length r < length ps" "0 < length r"
      using length_partition_by_median(8)[OF True "1.prems"(2)]
            length_partition_by_median(5)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(6)[OF "1.prems"(1) "1.prems"(2)]
            length_partition_by_median(7)[OF True "1.prems"(2)]
            lmr_def by blast+
    ultimately have IH: "balanced (build ks l)" "balanced (build ks r)"
      using "1.IH" by blast+
    have "build ks ps = Node k m (build ks l) (build ks r)"
      using build_psimp_3[OF True ks_def lmr_def] build_termination D by blast
    moreover have "length r + 1 = length l \<or> length r = length l"
      using length_partition_by_median(1)[OF lmr_def]
            length_partition_by_median(3)[OF "1.prems"(1) "1.prems"(2) lmr_def]
            length_partition_by_median(4)[OF "1.prems"(1) "1.prems"(2) lmr_def]
      by linarith
    ultimately show ?thesis
      using balanced_Node_if_wbal1[OF IH] balanced_Node_if_wbal2[OF IH]
            size_build[OF \<open>0 < length l\<close> D(1)] size_build[OF \<open>0 < length r\<close> D(2)]
      by auto
  next
    case False
    thus ?thesis
      using "1.prems" by (cases ps) (auto simp: balanced_def)
  qed
qed

lemma complete_if_balanced_size_2powh:
  assumes "balanced kdt" "size_kdt kdt = 2 ^ h"
  shows "complete kdt"
proof (rule ccontr)
  assume "\<not> complete kdt"
  hence "2 ^ (min_height kdt) < size_kdt kdt" "size_kdt kdt < 2 ^ height kdt"
    by (simp_all add: min_height_size_if_incomplete size_height_if_incomplete)
  hence "height kdt - min_height kdt > 1"
    using assms(2) by simp
  hence "\<not> balanced kdt"
    using balanced_def by force
  thus "False"
    using assms(1) by simp
qed

theorem complete_build:
  "length ps = 2 ^ h \<Longrightarrow> \<forall>k. distinct (map (\<lambda>p. p$k) ps) \<Longrightarrow> complete (build k ps)"
  by (simp add: balanced_build complete_if_balanced_size_2powh size_build)

corollary height_build:
  assumes "length ps = 2 ^ h" "\<forall>k. distinct (map (\<lambda>p. p$k) ps)"
  shows "h = height (build k ps)"
  using complete_build[OF assms] size_build[OF _ assms(2)] by (simp add: assms(1) complete_iff_size)

end


(* Suma de los primeros números impares *)

(*<*)
theory SumaImpares
imports Main "HOL-Library.LaTeXsugar" "HOL-Library.OptionalSugar"
begin
(*>*)

section \<open>Suma de los primeros números impares \<close>
subsection \<open>Demostración en lenguaje natural\<close>

text \<open>El primer teorema es una propiedad de los números naturales.

  \begin{teorema}
    La suma de los $n$ primeros números impares es $n^2$.
  \end{teorema}

  \begin{demostracion}
    La demostración la haremos por inducción sobre $n$.

    (Base de la inducción) El caso $n = 0$ es trivial.

    (Paso de la inducción) Supongamos que la propiedad se verifica para
    $n$ y veamos que también se verifica para $n+1$.

    Tenemos que demostrar que $\sum_{j=1}^{n+1} k_j = (n+1)^2$ donde
    $k_j$ el j--ésimo impar; es decir, $k_j = 2j - 1$.

    $$\begin{array}{l}
      \sum_{j = 1}^{n+1} k_j    \\
      = k_{n+1} + \sum^{n}_{j=1} k_j   \\
      = k_{n+1} + n^2  \quad @{text " (Hipótesis inducción) "} \\
      = 2(n+1) - 1 + n^2 \\
      = n^2 + 2n + 1   \\
      = (n+1)^2
      \end{array}$$
  \end{demostracion}
\<close>

subsection \<open>Especificación en Isabelle/HOL\<close>

text \<open>Para especificar el teorema en Isabelle, se comienza definiendo
  la función @{term "suma_impares"} tal que @{term "suma_impares n"} es
  la suma de los $n$ primeros números impares\<close>

fun suma_impares :: "nat \<Rightarrow> nat" where
  "suma_impares 0 = 0"
| "suma_impares (Suc n) = (2*(Suc n) - 1) + suma_impares n"

text \<open>El enunciado del teorema es el siguiente:\<close>

lemma "suma_impares n = n * n"
oops

text \<open>En la demostración se usará la táctica @{text induct} que hace
  uso del esquema de inducción sobre los naturales:
  \begin{itemize}
  \item[] @{thm[mode=Rule] nat.induct[no_vars]}
          \hfill (@{text nat.induct})
  \end{itemize}

  Vamos a presentar distintas demostraciones del teorema. La
  primera es la demostración automática.\<close>

subsection \<open>Demostración automática\<close>

text \<open>La correspondiente demostración automática es\<close>

lemma "suma_impares n = n * n"
  by (induct n) simp_all

subsection \<open>Demostración estructurada\<close>

text \<open>La demostración estructurada y detallada del lema anterior es:\<close>

lemma "suma_impares n = n * n"
proof (induct n)
  have "suma_impares 0 = 0"
    by (simp only: suma_impares.simps(1))
  also have "\<dots> = 0 * 0"
    by (simp only:  mult_0)
  finally show "suma_impares 0 = 0 * 0"
   by (simp only: mult_0_right)
next
  fix n
  assume HI: "suma_impares n = n * n"
  have "suma_impares (Suc n) = (2 * (Suc n) - 1) + suma_impares n"
    by (simp only: suma_impares.simps(2))
  also have "\<dots> = (2 * (Suc n) - 1) + n * n"
    by (simp only: HI)
  also have "\<dots> = n * n + 2 * n + 1"
    by (simp only: mult_Suc_right)
  also have "\<dots> = (Suc n) * (Suc n)"
    by (simp only: mult_Suc mult_Suc_right)
  finally show "suma_impares (Suc n) = (Suc n) * (Suc n)"
   by this
qed

text \<open>En la demostración anterior se pueden ocultar detalles.\<close>

lemma "suma_impares n = n * n"
proof (induct n)
  show "suma_impares 0 = 0 * 0" by simp
next
  fix n
  assume HI: "suma_impares n = n * n"
  have "suma_impares (Suc n) = (2 * (Suc n) - 1) + suma_impares n"
    by simp
  also have "\<dots> = (2 * (Suc n) - 1) + n * n"
    using HI by simp
  also have "\<dots> = (Suc n) * (Suc n)"
    by simp
  finally show "suma_impares (Suc n) = (Suc n) * (Suc n)"
    by simp
qed

subsection \<open>Demostración con patrones\<close>

text \<open>La demostración anterior se puede simplificar usando patrones.\<close>

lemma "suma_impares n = n * n" (is "?P n = ?Q n")
proof (induct n)
  show "?P 0 = ?Q 0" by simp
next
  fix n
  assume HI: "?P n = ?Q n"
  have "?P (Suc n) = (2 * (Suc n) - 1) + suma_impares n"
    by simp
  also have "\<dots> = (2 * (Suc n) - 1) + n * n" using HI by simp
  also have "\<dots> = ?Q (Suc n)" by simp
  finally show "?P (Suc n) = ?Q (Suc n)" by simp
qed

text \<open>La demostración usando otro patrón es\<close>

lemma "suma_impares n = n * n" (is "?P n")
proof (induct n)
  show "?P 0" by simp
next
  fix n
  assume "?P n"
  then show "?P (Suc n)" by simp
qed

(*<*)
end
(*>*)


section "Abstract Interpretation"

theory Complete_Lattice
imports Main
begin

locale Complete_Lattice =
fixes L :: "'a::order set" and Glb :: "'a set \<Rightarrow> 'a"
assumes Glb_lower: "A \<subseteq> L \<Longrightarrow> a \<in> A \<Longrightarrow> Glb A \<le> a"
and Glb_greatest: "b : L \<Longrightarrow> \<forall>a\<in>A. b \<le> a \<Longrightarrow> b \<le> Glb A"
and Glb_in_L: "A \<subseteq> L \<Longrightarrow> Glb A : L"
begin

definition lfp :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a" where
"lfp f = Glb {a : L. f a \<le> a}"

lemma index_lfp: "lfp f : L"
by(auto simp: lfp_def intro: Glb_in_L)

lemma lfp_lowerbound:
  "\<lbrakk> a : L;  f a \<le> a \<rbrakk> \<Longrightarrow> lfp f \<le> a"
by (auto simp add: lfp_def intro: Glb_lower)

lemma lfp_greatest:
  "\<lbrakk> a : L;  \<And>u. \<lbrakk> u : L; f u \<le> u\<rbrakk> \<Longrightarrow> a \<le> u \<rbrakk> \<Longrightarrow> a \<le> lfp f"
by (auto simp add: lfp_def intro: Glb_greatest)

end

end


(*  Title:      HOL/Library/Lub_Glb.thy
    Author:     Jacques D. Fleuriot, University of Cambridge
    Author:     Amine Chaieb, University of Cambridge *)

section \<open>Definitions of Least Upper Bounds and Greatest Lower Bounds\<close>

theory Lub_Glb
imports Complex_Main
begin

text \<open>Thanks to suggestions by James Margetson\<close>

definition setle :: "'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"  (infixl \<open>*<=\<close> 70)
  where "S *<= x = (\<forall>y\<in>S. y \<le> x)"

definition setge :: "'a::ord \<Rightarrow> 'a set \<Rightarrow> bool"  (infixl \<open><=*\<close> 70)
  where "x <=* S = (\<forall>y\<in>S. x \<le> y)"

subsection \<open>Rules for the Relations \<open>*<=\<close> and \<open><=*\<close>\<close>

lemma setleI: "\<forall>y\<in>S. y \<le> x \<Longrightarrow> S *<= x"
  by (simp add: setle_def)

lemma setleD: "S *<= x \<Longrightarrow> y\<in>S \<Longrightarrow> y \<le> x"
  by (simp add: setle_def)

lemma setgeI: "\<forall>y\<in>S. x \<le> y \<Longrightarrow> x <=* S"
  by (simp add: setge_def)

lemma setgeD: "x <=* S \<Longrightarrow> y\<in>S \<Longrightarrow> x \<le> y"
  by (simp add: setge_def)

definition leastP :: "('a \<Rightarrow> bool) \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "leastP P x = (P x \<and> x <=* Collect P)"

definition isUb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isUb R S x = (S *<= x \<and> x \<in> R)"

definition isLub :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isLub R S x = leastP (isUb R S) x"

definition ubs :: "'a set \<Rightarrow> 'a::ord set \<Rightarrow> 'a set"
  where "ubs R S = Collect (isUb R S)"

subsection \<open>Rules about the Operators \<^term>\<open>leastP\<close>, \<^term>\<open>ub\<close> and \<^term>\<open>lub\<close>\<close>

lemma leastPD1: "leastP P x \<Longrightarrow> P x"
  by (simp add: leastP_def)

lemma leastPD2: "leastP P x \<Longrightarrow> x <=* Collect P"
  by (simp add: leastP_def)

lemma leastPD3: "leastP P x \<Longrightarrow> y \<in> Collect P \<Longrightarrow> x \<le> y"
  by (blast dest!: leastPD2 setgeD)

lemma isLubD1: "isLub R S x \<Longrightarrow> S *<= x"
  by (simp add: isLub_def isUb_def leastP_def)

lemma isLubD1a: "isLub R S x \<Longrightarrow> x \<in> R"
  by (simp add: isLub_def isUb_def leastP_def)

lemma isLub_isUb: "isLub R S x \<Longrightarrow> isUb R S x"
  unfolding isUb_def by (blast dest: isLubD1 isLubD1a)

lemma isLubD2: "isLub R S x \<Longrightarrow> y \<in> S \<Longrightarrow> y \<le> x"
  by (blast dest!: isLubD1 setleD)

lemma isLubD3: "isLub R S x \<Longrightarrow> leastP (isUb R S) x"
  by (simp add: isLub_def)

lemma isLubI1: "leastP(isUb R S) x \<Longrightarrow> isLub R S x"
  by (simp add: isLub_def)

lemma isLubI2: "isUb R S x \<Longrightarrow> x <=* Collect (isUb R S) \<Longrightarrow> isLub R S x"
  by (simp add: isLub_def leastP_def)

lemma isUbD: "isUb R S x \<Longrightarrow> y \<in> S \<Longrightarrow> y \<le> x"
  by (simp add: isUb_def setle_def)

lemma isUbD2: "isUb R S x \<Longrightarrow> S *<= x"
  by (simp add: isUb_def)

lemma isUbD2a: "isUb R S x \<Longrightarrow> x \<in> R"
  by (simp add: isUb_def)

lemma isUbI: "S *<= x \<Longrightarrow> x \<in> R \<Longrightarrow> isUb R S x"
  by (simp add: isUb_def)

lemma isLub_le_isUb: "isLub R S x \<Longrightarrow> isUb R S y \<Longrightarrow> x \<le> y"
  unfolding isLub_def by (blast intro!: leastPD3)

lemma isLub_ubs: "isLub R S x \<Longrightarrow> x <=* ubs R S"
  unfolding ubs_def isLub_def by (rule leastPD2)

lemma isLub_unique: "[| isLub R S x; isLub R S y |] ==> x = (y::'a::linorder)"
  apply (frule isLub_isUb)
  apply (frule_tac x = y in isLub_isUb)
  apply (blast intro!: order_antisym dest!: isLub_le_isUb)
  done

lemma isUb_UNIV_I: "(\<And>y. y \<in> S \<Longrightarrow> y \<le> u) \<Longrightarrow> isUb UNIV S u"
  by (simp add: isUbI setleI)

definition greatestP :: "('a \<Rightarrow> bool) \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "greatestP P x = (P x \<and> Collect P *<=  x)"

definition isLb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isLb R S x = (x <=* S \<and> x \<in> R)"

definition isGlb :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a::ord \<Rightarrow> bool"
  where "isGlb R S x = greatestP (isLb R S) x"

definition lbs :: "'a set \<Rightarrow> 'a::ord set \<Rightarrow> 'a set"
  where "lbs R S = Collect (isLb R S)"

subsection \<open>Rules about the Operators \<^term>\<open>greatestP\<close>, \<^term>\<open>isLb\<close> and \<^term>\<open>isGlb\<close>\<close>

lemma greatestPD1: "greatestP P x \<Longrightarrow> P x"
  by (simp add: greatestP_def)

lemma greatestPD2: "greatestP P x \<Longrightarrow> Collect P *<= x"
  by (simp add: greatestP_def)

lemma greatestPD3: "greatestP P x \<Longrightarrow> y \<in> Collect P \<Longrightarrow> x \<ge> y"
  by (blast dest!: greatestPD2 setleD)

lemma isGlbD1: "isGlb R S x \<Longrightarrow> x <=* S"
  by (simp add: isGlb_def isLb_def greatestP_def)

lemma isGlbD1a: "isGlb R S x \<Longrightarrow> x \<in> R"
  by (simp add: isGlb_def isLb_def greatestP_def)

lemma isGlb_isLb: "isGlb R S x \<Longrightarrow> isLb R S x"
  unfolding isLb_def by (blast dest: isGlbD1 isGlbD1a)

lemma isGlbD2: "isGlb R S x \<Longrightarrow> y \<in> S \<Longrightarrow> y \<ge> x"
  by (blast dest!: isGlbD1 setgeD)

lemma isGlbD3: "isGlb R S x \<Longrightarrow> greatestP (isLb R S) x"
  by (simp add: isGlb_def)

lemma isGlbI1: "greatestP (isLb R S) x \<Longrightarrow> isGlb R S x"
  by (simp add: isGlb_def)

lemma isGlbI2: "isLb R S x \<Longrightarrow> Collect (isLb R S) *<= x \<Longrightarrow> isGlb R S x"
  by (simp add: isGlb_def greatestP_def)

lemma isLbD: "isLb R S x \<Longrightarrow> y \<in> S \<Longrightarrow> y \<ge> x"
  by (simp add: isLb_def setge_def)

lemma isLbD2: "isLb R S x \<Longrightarrow> x <=* S "
  by (simp add: isLb_def)

lemma isLbD2a: "isLb R S x \<Longrightarrow> x \<in> R"
  by (simp add: isLb_def)

lemma isLbI: "x <=* S \<Longrightarrow> x \<in> R \<Longrightarrow> isLb R S x"
  by (simp add: isLb_def)

lemma isGlb_le_isLb: "isGlb R S x \<Longrightarrow> isLb R S y \<Longrightarrow> x \<ge> y"
  unfolding isGlb_def by (blast intro!: greatestPD3)

lemma isGlb_ubs: "isGlb R S x \<Longrightarrow> lbs R S *<= x"
  unfolding lbs_def isGlb_def by (rule greatestPD2)

lemma isGlb_unique: "[| isGlb R S x; isGlb R S y |] ==> x = (y::'a::linorder)"
  apply (frule isGlb_isLb)
  apply (frule_tac x = y in isGlb_isLb)
  apply (blast intro!: order_antisym dest!: isGlb_le_isLb)
  done

lemma bdd_above_setle: "bdd_above A \<longleftrightarrow> (\<exists>a. A *<= a)"
  by (auto simp: bdd_above_def setle_def)

lemma bdd_below_setge: "bdd_below A \<longleftrightarrow> (\<exists>a. a <=* A)"
  by (auto simp: bdd_below_def setge_def)

lemma isLub_cSup:
  "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> (\<exists>b. S *<= b) \<Longrightarrow> isLub UNIV S (Sup S)"
  by  (auto simp add: isLub_def setle_def leastP_def isUb_def
            intro!: setgeI cSup_upper cSup_least)

lemma isGlb_cInf:
  "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> (\<exists>b. b <=* S) \<Longrightarrow> isGlb UNIV S (Inf S)"
  by  (auto simp add: isGlb_def setge_def greatestP_def isLb_def
            intro!: setleI cInf_lower cInf_greatest)

lemma cSup_le: "(S::'a::conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> S *<= b \<Longrightarrow> Sup S \<le> b"
  by (metis cSup_least setle_def)

lemma cInf_ge: "(S::'a :: conditionally_complete_lattice set) \<noteq> {} \<Longrightarrow> b <=* S \<Longrightarrow> Inf S \<ge> b"
  by (metis cInf_greatest setge_def)

lemma cSup_bounds:
  fixes S :: "'a :: conditionally_complete_lattice set"
  shows "S \<noteq> {} \<Longrightarrow> a <=* S \<Longrightarrow> S *<= b \<Longrightarrow> a \<le> Sup S \<and> Sup S \<le> b"
  using cSup_least[of S b] cSup_upper2[of _ S a]
  by (auto simp: bdd_above_setle setge_def setle_def)

lemma cSup_unique: "(S::'a :: {conditionally_complete_linorder, no_bot} set) *<= b \<Longrightarrow> (\<forall>b'<b. \<exists>x\<in>S. b' < x) \<Longrightarrow> Sup S = b"
  by (rule cSup_eq) (auto simp: not_le[symmetric] setle_def)

lemma cInf_unique: "b <=* (S::'a :: {conditionally_complete_linorder, no_top} set) \<Longrightarrow> (\<forall>b'>b. \<exists>x\<in>S. b' > x) \<Longrightarrow> Inf S = b"
  by (rule cInf_eq) (auto simp: not_le[symmetric] setge_def)

text\<open>Use completeness of reals (supremum property) to show that any bounded sequence has a least upper bound\<close>

lemma reals_complete: "\<exists>X. X \<in> S \<Longrightarrow> \<exists>Y. isUb (UNIV::real set) S Y \<Longrightarrow> \<exists>t. isLub (UNIV :: real set) S t"
  by (intro exI[of _ "Sup S"] isLub_cSup) (auto simp: setle_def isUb_def intro!: cSup_upper)

lemma Bseq_isUb: "\<And>X :: nat \<Rightarrow> real. Bseq X \<Longrightarrow> \<exists>U. isUb (UNIV::real set) {x. \<exists>n. X n = x} U"
  by (auto intro: isUbI setleI simp add: Bseq_def abs_le_iff)

lemma Bseq_isLub: "\<And>X :: nat \<Rightarrow> real. Bseq X \<Longrightarrow> \<exists>U. isLub (UNIV::real set) {x. \<exists>n. X n = x} U"
  by (blast intro: reals_complete Bseq_isUb)

lemma isLub_mono_imp_LIMSEQ:
  fixes X :: "nat \<Rightarrow> real"
  assumes u: "isLub UNIV {x. \<exists>n. X n = x} u" (* FIXME: use \<open>range X\<close> *)
  assumes X: "\<forall>m n. m \<le> n \<longrightarrow> X m \<le> X n"
  shows "X \<longlonglongrightarrow> u"
proof -
  have "X \<longlonglongrightarrow> (SUP i. X i)"
    using u[THEN isLubD1] X
    by (intro LIMSEQ_incseq_SUP) (auto simp: incseq_def image_def eq_commute bdd_above_setle)
  also have "(SUP i. X i) = u"
    using isLub_cSup[of "range X"] u[THEN isLubD1]
    by (intro isLub_unique[OF _ u]) (auto simp add: image_def eq_commute)
  finally show ?thesis .
qed

lemmas real_isGlb_unique = isGlb_unique[where 'a=real]

lemma real_le_inf_subset: "t \<noteq> {} \<Longrightarrow> t \<subseteq> s \<Longrightarrow> \<exists>b. b <=* s \<Longrightarrow> Inf s \<le> Inf (t::real set)"
  by (rule cInf_superset_mono) (auto simp: bdd_below_setge)

lemma real_ge_sup_subset: "t \<noteq> {} \<Longrightarrow> t \<subseteq> s \<Longrightarrow> \<exists>b. s *<= b \<Longrightarrow> Sup s \<ge> Sup (t::real set)"
  by (rule cSup_subset_mono) (auto simp: bdd_above_setle)

end


(*  Title:      ZF/Perm.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge

The theory underlying permutation groups
  -- Composition of relations, the identity relation
  -- Injections, surjections, bijections
  -- Lemmas for the Schroeder-Bernstein Theorem
*)

section\<open>Injections, Surjections, Bijections, Composition\<close>

theory Perm imports func begin

definition
  (*composition of relations and functions; NOT Suppes's relative product*)
  comp     :: "[i,i]\<Rightarrow>i"      (infixr \<open>O\<close> 60)  where
    "r O s \<equiv> {xz \<in> domain(s)*range(r) .
               \<exists>x y z. xz=\<langle>x,z\<rangle> \<and> \<langle>x,y\<rangle>:s \<and> \<langle>y,z\<rangle>:r}"

definition
  (*the identity function for A*)
  id    :: "i\<Rightarrow>i"  where
    "id(A) \<equiv> (\<lambda>x\<in>A. x)"

definition
  (*one-to-one functions from A to B*)
  inj   :: "[i,i]\<Rightarrow>i"  where
    "inj(A,B) \<equiv> { f \<in> A->B. \<forall>w\<in>A. \<forall>x\<in>A. f`w=f`x \<longrightarrow> w=x}"

definition
  (*onto functions from A to B*)
  surj  :: "[i,i]\<Rightarrow>i"  where
    "surj(A,B) \<equiv> { f \<in> A->B . \<forall>y\<in>B. \<exists>x\<in>A. f`x=y}"

definition
  (*one-to-one and onto functions*)
  bij   :: "[i,i]\<Rightarrow>i"  where
    "bij(A,B) \<equiv> inj(A,B) \<inter> surj(A,B)"

subsection\<open>Surjective Function Space\<close>

lemma surj_is_fun: "f \<in> surj(A,B) \<Longrightarrow> f \<in> A->B"
  unfolding surj_def
apply (erule CollectD1)
done

lemma fun_is_surj: "f \<in> Pi(A,B) \<Longrightarrow> f \<in> surj(A,range(f))"
  unfolding surj_def
apply (blast intro: apply_equality range_of_fun domain_type)
done

lemma surj_range: "f \<in> surj(A,B) \<Longrightarrow> range(f)=B"
  unfolding surj_def
apply (best intro: apply_Pair elim: range_type)
done

text\<open>A function with a right inverse is a surjection\<close>

lemma f_imp_surjective:
    "\<lbrakk>f \<in> A->B;  \<And>y. y \<in> B \<Longrightarrow> d(y): A;  \<And>y. y \<in> B \<Longrightarrow> f`d(y) = y\<rbrakk>
     \<Longrightarrow> f \<in> surj(A,B)"
  by (simp add: surj_def, blast)

lemma lam_surjective:
    "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
        \<And>y. y \<in> B \<Longrightarrow> d(y): A;
        \<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y
\<rbrakk> \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> surj(A,B)"
apply (rule_tac d = d in f_imp_surjective)
apply (simp_all add: lam_type)
done

text\<open>Cantor's theorem revisited\<close>
lemma cantor_surj: "f \<notin> surj(A,Pow(A))"
apply (unfold surj_def, safe)
apply (cut_tac cantor)
apply (best del: subsetI)
done

subsection\<open>Injective Function Space\<close>

lemma inj_is_fun: "f \<in> inj(A,B) \<Longrightarrow> f \<in> A->B"
  unfolding inj_def
apply (erule CollectD1)
done

text\<open>Good for dealing with sets of pairs, but a bit ugly in use [used in AC]\<close>
lemma inj_equality:
    "\<lbrakk>\<langle>a,b\<rangle>:f;  \<langle>c,b\<rangle>:f;  f \<in> inj(A,B)\<rbrakk> \<Longrightarrow> a=c"
  unfolding inj_def
apply (blast dest: Pair_mem_PiD)
done

lemma inj_apply_equality: "\<lbrakk>f \<in> inj(A,B);  f`a=f`b;  a \<in> A;  b \<in> A\<rbrakk> \<Longrightarrow> a=b"
by (unfold inj_def, blast)

text\<open>A function with a left inverse is an injection\<close>

lemma f_imp_injective: "\<lbrakk>f \<in> A->B;  \<forall>x\<in>A. d(f`x)=x\<rbrakk> \<Longrightarrow> f \<in> inj(A,B)"
apply (simp (no_asm_simp) add: inj_def)
apply (blast intro: subst_context [THEN box_equals])
done

lemma lam_injective:
    "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
        \<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x\<rbrakk>
     \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> inj(A,B)"
apply (rule_tac d = d in f_imp_injective)
apply (simp_all add: lam_type)
done

subsection\<open>Bijections\<close>

lemma bij_is_inj: "f \<in> bij(A,B) \<Longrightarrow> f \<in> inj(A,B)"
  unfolding bij_def
apply (erule IntD1)
done

lemma bij_is_surj: "f \<in> bij(A,B) \<Longrightarrow> f \<in> surj(A,B)"
  unfolding bij_def
apply (erule IntD2)
done

lemma bij_is_fun: "f \<in> bij(A,B) \<Longrightarrow> f \<in> A->B"
  by (rule bij_is_inj [THEN inj_is_fun])

lemma lam_bijective:
    "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> c(x): B;
        \<And>y. y \<in> B \<Longrightarrow> d(y): A;
        \<And>x. x \<in> A \<Longrightarrow> d(c(x)) = x;
        \<And>y. y \<in> B \<Longrightarrow> c(d(y)) = y
\<rbrakk> \<Longrightarrow> (\<lambda>x\<in>A. c(x)) \<in> bij(A,B)"
  unfolding bij_def
apply (blast intro!: lam_injective lam_surjective)
done

lemma RepFun_bijective: "(\<forall>y\<in>x. \<exists>!y'. f(y') = f(y))
      \<Longrightarrow> (\<lambda>z\<in>{f(y). y \<in> x}. THE y. f(y) = z) \<in> bij({f(y). y \<in> x}, x)"
apply (rule_tac d = f in lam_bijective)
apply (auto simp add: the_equality2)
done

subsection\<open>Identity Function\<close>

lemma idI [intro!]: "a \<in> A \<Longrightarrow> \<langle>a,a\<rangle> \<in> id(A)"
  unfolding id_def
apply (erule lamI)
done

lemma idE [elim!]: "\<lbrakk>p \<in> id(A);  \<And>x.\<lbrakk>x \<in> A; p=\<langle>x,x\<rangle>\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow>  P"
by (simp add: id_def lam_def, blast)

lemma id_type: "id(A) \<in> A->A"
  unfolding id_def
apply (rule lam_type, assumption)
done

lemma id_conv [simp]: "x \<in> A \<Longrightarrow> id(A)`x = x"
  unfolding id_def
apply (simp (no_asm_simp))
done

lemma id_mono: "A<=B \<Longrightarrow> id(A) \<subseteq> id(B)"
  unfolding id_def
apply (erule lam_mono)
done

lemma id_subset_inj: "A<=B \<Longrightarrow> id(A): inj(A,B)"
apply (simp add: inj_def id_def)
apply (blast intro: lam_type)
done

lemmas id_inj = subset_refl [THEN id_subset_inj]

lemma id_surj: "id(A): surj(A,A)"
  unfolding id_def surj_def
apply (simp (no_asm_simp))
done

lemma id_bij: "id(A): bij(A,A)"
  unfolding bij_def
apply (blast intro: id_inj id_surj)
done

lemma subset_iff_id: "A \<subseteq> B \<longleftrightarrow> id(A) \<in> A->B"
  unfolding id_def
apply (force intro!: lam_type dest: apply_type)
done

text\<open>\<^term>\<open>id\<close> as the identity relation\<close>
lemma id_iff [simp]: "\<langle>x,y\<rangle> \<in> id(A) \<longleftrightarrow> x=y \<and> y \<in> A"
by auto

subsection\<open>Converse of a Function\<close>

lemma inj_converse_fun: "f \<in> inj(A,B) \<Longrightarrow> converse(f) \<in> range(f)->A"
  unfolding inj_def
apply (simp (no_asm_simp) add: Pi_iff function_def)
apply (erule CollectE)
apply (simp (no_asm_simp) add: apply_iff)
apply (blast dest: fun_is_rel)
done

text\<open>Equations for converse(f)\<close>

text\<open>The premises are equivalent to saying that f is injective...\<close>
lemma left_inverse_lemma:
     "\<lbrakk>f \<in> A->B;  converse(f): C->A;  a \<in> A\<rbrakk> \<Longrightarrow> converse(f)`(f`a) = a"
by (blast intro: apply_Pair apply_equality converseI)

lemma left_inverse [simp]: "\<lbrakk>f \<in> inj(A,B);  a \<in> A\<rbrakk> \<Longrightarrow> converse(f)`(f`a) = a"
by (blast intro: left_inverse_lemma inj_converse_fun inj_is_fun)

lemma left_inverse_eq:
     "\<lbrakk>f \<in> inj(A,B); f ` x = y; x \<in> A\<rbrakk> \<Longrightarrow> converse(f) ` y = x"
by auto

lemmas left_inverse_bij = bij_is_inj [THEN left_inverse]

lemma right_inverse_lemma:
     "\<lbrakk>f \<in> A->B;  converse(f): C->A;  b \<in> C\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
by (rule apply_Pair [THEN converseD [THEN apply_equality]], auto)

(*Should the premises be f \<in> surj(A,B), b \<in> B for symmetry with left_inverse?
  No: they would not imply that converse(f) was a function! *)
lemma right_inverse [simp]:
     "\<lbrakk>f \<in> inj(A,B);  b \<in> range(f)\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
by (blast intro: right_inverse_lemma inj_converse_fun inj_is_fun)

lemma right_inverse_bij: "\<lbrakk>f \<in> bij(A,B);  b \<in> B\<rbrakk> \<Longrightarrow> f`(converse(f)`b) = b"
by (force simp add: bij_def surj_range)

subsection\<open>Converses of Injections, Surjections, Bijections\<close>

lemma inj_converse_inj: "f \<in> inj(A,B) \<Longrightarrow> converse(f): inj(range(f), A)"
apply (rule f_imp_injective)
apply (erule inj_converse_fun, clarify)
apply (rule right_inverse)
 apply assumption
apply blast
done

lemma inj_converse_surj: "f \<in> inj(A,B) \<Longrightarrow> converse(f): surj(range(f), A)"
by (blast intro: f_imp_surjective inj_converse_fun left_inverse inj_is_fun
                 range_of_fun [THEN apply_type])

text\<open>Adding this as an intro! rule seems to cause looping\<close>
lemma bij_converse_bij [TC]: "f \<in> bij(A,B) \<Longrightarrow> converse(f): bij(B,A)"
  unfolding bij_def
apply (fast elim: surj_range [THEN subst] inj_converse_inj inj_converse_surj)
done

subsection\<open>Composition of Two Relations\<close>

text\<open>The inductive definition package could derive these theorems for \<^term>\<open>r O s\<close>\<close>

lemma compI [intro]: "\<lbrakk>\<langle>a,b\<rangle>:s; \<langle>b,c\<rangle>:r\<rbrakk> \<Longrightarrow> \<langle>a,c\<rangle> \<in> r O s"
by (unfold comp_def, blast)

lemma compE [elim!]:
    "\<lbrakk>xz \<in> r O s;
        \<And>x y z. \<lbrakk>xz=\<langle>x,z\<rangle>;  \<langle>x,y\<rangle>:s;  \<langle>y,z\<rangle>:r\<rbrakk> \<Longrightarrow> P\<rbrakk>
     \<Longrightarrow> P"
by (unfold comp_def, blast)

lemma compEpair:
    "\<lbrakk>\<langle>a,c\<rangle> \<in> r O s;
        \<And>y. \<lbrakk>\<langle>a,y\<rangle>:s;  \<langle>y,c\<rangle>:r\<rbrakk> \<Longrightarrow> P\<rbrakk>
     \<Longrightarrow> P"
by (erule compE, simp)

lemma converse_comp: "converse(R O S) = converse(S) O converse(R)"
by blast

subsection\<open>Domain and Range -- see Suppes, Section 3.1\<close>

text\<open>Boyer et al., Set Theory in First-Order Logic, JAR 2 (1986), 287-327\<close>
lemma range_comp: "range(r O s) \<subseteq> range(r)"
by blast

lemma range_comp_eq: "domain(r) \<subseteq> range(s) \<Longrightarrow> range(r O s) = range(r)"
by (rule range_comp [THEN equalityI], blast)

lemma domain_comp: "domain(r O s) \<subseteq> domain(s)"
by blast

lemma domain_comp_eq: "range(s) \<subseteq> domain(r) \<Longrightarrow> domain(r O s) = domain(s)"
by (rule domain_comp [THEN equalityI], blast)

lemma image_comp: "(r O s)``A = r``(s``A)"
by blast

lemma inj_inj_range: "f \<in> inj(A,B) \<Longrightarrow> f \<in> inj(A,range(f))"
  by (auto simp add: inj_def Pi_iff function_def)

lemma inj_bij_range: "f \<in> inj(A,B) \<Longrightarrow> f \<in> bij(A,range(f))"
  by (auto simp add: bij_def intro: inj_inj_range inj_is_fun fun_is_surj)

subsection\<open>Other Results\<close>

lemma comp_mono: "\<lbrakk>r'<=r; s'<=s\<rbrakk> \<Longrightarrow> (r' O s') \<subseteq> (r O s)"
by blast

text\<open>composition preserves relations\<close>
lemma comp_rel: "\<lbrakk>s<=A*B;  r<=B*C\<rbrakk> \<Longrightarrow> (r O s) \<subseteq> A*C"
by blast

text\<open>associative law for composition\<close>
lemma comp_assoc: "(r O s) O t = r O (s O t)"
by blast

(*left identity of composition; provable inclusions are
        id(A) O r \<subseteq> r
  and   \<lbrakk>r<=A*B; B<=C\<rbrakk> \<Longrightarrow> r \<subseteq> id(C) O r *)
lemma left_comp_id: "r<=A*B \<Longrightarrow> id(B) O r = r"
by blast

(*right identity of composition; provable inclusions are
        r O id(A) \<subseteq> r
  and   \<lbrakk>r<=A*B; A<=C\<rbrakk> \<Longrightarrow> r \<subseteq> r O id(C) *)
lemma right_comp_id: "r<=A*B \<Longrightarrow> r O id(A) = r"
by blast

subsection\<open>Composition Preserves Functions, Injections, and Surjections\<close>

lemma comp_function: "\<lbrakk>function(g);  function(f)\<rbrakk> \<Longrightarrow> function(f O g)"
by (unfold function_def, blast)

text\<open>Don't think the premises can be weakened much\<close>
lemma comp_fun: "\<lbrakk>g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> (f O g) \<in> A->C"
apply (auto simp add: Pi_def comp_function Pow_iff comp_rel)
apply (subst range_rel_subset [THEN domain_comp_eq], auto)
done

(*Thanks to the new definition of "apply", the premise f \<in> B->C is gone!*)
lemma comp_fun_apply [simp]:
     "\<lbrakk>g \<in> A->B;  a \<in> A\<rbrakk> \<Longrightarrow> (f O g)`a = f`(g`a)"
apply (frule apply_Pair, assumption)
apply (simp add: apply_def image_comp)
apply (blast dest: apply_equality)
done

text\<open>Simplifies compositions of lambda-abstractions\<close>
lemma comp_lam:
    "\<lbrakk>\<And>x. x \<in> A \<Longrightarrow> b(x): B\<rbrakk>
     \<Longrightarrow> (\<lambda>y\<in>B. c(y)) O (\<lambda>x\<in>A. b(x)) = (\<lambda>x\<in>A. c(b(x)))"
apply (subgoal_tac "(\<lambda>x\<in>A. b(x)) \<in> A -> B")
 apply (rule fun_extension)
   apply (blast intro: comp_fun lam_funtype)
  apply (rule lam_funtype)
 apply simp
apply (simp add: lam_type)
done

lemma comp_inj:
     "\<lbrakk>g \<in> inj(A,B);  f \<in> inj(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> inj(A,C)"
apply (frule inj_is_fun [of g])
apply (frule inj_is_fun [of f])
apply (rule_tac d = "\<lambda>y. converse (g) ` (converse (f) ` y)" in f_imp_injective)
 apply (blast intro: comp_fun, simp)
done

lemma comp_surj:
    "\<lbrakk>g \<in> surj(A,B);  f \<in> surj(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> surj(A,C)"
  unfolding surj_def
apply (blast intro!: comp_fun comp_fun_apply)
done

lemma comp_bij:
    "\<lbrakk>g \<in> bij(A,B);  f \<in> bij(B,C)\<rbrakk> \<Longrightarrow> (f O g) \<in> bij(A,C)"
  unfolding bij_def
apply (blast intro: comp_inj comp_surj)
done

subsection\<open>Dual Properties of \<^term>\<open>inj\<close> and \<^term>\<open>surj\<close>\<close>

text\<open>Useful for proofs from
    D Pastre.  Automatic theorem proving in set theory.
    Artificial Intelligence, 10:1--27, 1978.\<close>

lemma comp_mem_injD1:
    "\<lbrakk>(f O g): inj(A,C);  g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> g \<in> inj(A,B)"
by (unfold inj_def, force)

lemma comp_mem_injD2:
    "\<lbrakk>(f O g): inj(A,C);  g \<in> surj(A,B);  f \<in> B->C\<rbrakk> \<Longrightarrow> f \<in> inj(B,C)"
apply (unfold inj_def surj_def, safe)
apply (rule_tac x1 = x in bspec [THEN bexE])
apply (erule_tac [3] x1 = w in bspec [THEN bexE], assumption+, safe)
apply (rule_tac t = "(`) (g) " in subst_context)
apply (erule asm_rl bspec [THEN bspec, THEN mp])+
apply (simp (no_asm_simp))
done

lemma comp_mem_surjD1:
    "\<lbrakk>(f O g): surj(A,C);  g \<in> A->B;  f \<in> B->C\<rbrakk> \<Longrightarrow> f \<in> surj(B,C)"
  unfolding surj_def
apply (blast intro!: comp_fun_apply [symmetric] apply_funtype)
done

lemma comp_mem_surjD2:
    "\<lbrakk>(f O g): surj(A,C);  g \<in> A->B;  f \<in> inj(B,C)\<rbrakk> \<Longrightarrow> g \<in> surj(A,B)"
apply (unfold inj_def surj_def, safe)
apply (drule_tac x = "f`y" in bspec, auto)
apply (blast intro: apply_funtype)
done

subsubsection\<open>Inverses of Composition\<close>

text\<open>left inverse of composition; one inclusion is
        \<^term>\<open>f \<in> A->B \<Longrightarrow> id(A) \<subseteq> converse(f) O f\<close>\<close>
lemma left_comp_inverse: "f \<in> inj(A,B) \<Longrightarrow> converse(f) O f = id(A)"
apply (unfold inj_def, clarify)
apply (rule equalityI)
 apply (auto simp add: apply_iff, blast)
done

text\<open>right inverse of composition; one inclusion is
                \<^term>\<open>f \<in> A->B \<Longrightarrow> f O converse(f) \<subseteq> id(B)\<close>\<close>
lemma right_comp_inverse:
    "f \<in> surj(A,B) \<Longrightarrow> f O converse(f) = id(B)"
apply (simp add: surj_def, clarify)
apply (rule equalityI)
apply (best elim: domain_type range_type dest: apply_equality2)
apply (blast intro: apply_Pair)
done

subsubsection\<open>Proving that a Function is a Bijection\<close>

lemma comp_eq_id_iff:
    "\<lbrakk>f \<in> A->B;  g \<in> B->A\<rbrakk> \<Longrightarrow> f O g = id(B) \<longleftrightarrow> (\<forall>y\<in>B. f`(g`y)=y)"
apply (unfold id_def, safe)
 apply (drule_tac t = "\<lambda>h. h`y " in subst_context)
 apply simp
apply (rule fun_extension)
  apply (blast intro: comp_fun lam_type)
 apply auto
done

lemma fg_imp_bijective:
    "\<lbrakk>f \<in> A->B;  g \<in> B->A;  f O g = id(B);  g O f = id(A)\<rbrakk> \<Longrightarrow> f \<in> bij(A,B)"
  unfolding bij_def
apply (simp add: comp_eq_id_iff)
apply (blast intro: f_imp_injective f_imp_surjective apply_funtype)
done

lemma nilpotent_imp_bijective: "\<lbrakk>f \<in> A->A;  f O f = id(A)\<rbrakk> \<Longrightarrow> f \<in> bij(A,A)"
by (blast intro: fg_imp_bijective)

lemma invertible_imp_bijective:
     "\<lbrakk>converse(f): B->A;  f \<in> A->B\<rbrakk> \<Longrightarrow> f \<in> bij(A,B)"
by (simp add: fg_imp_bijective comp_eq_id_iff
              left_inverse_lemma right_inverse_lemma)

subsubsection\<open>Unions of Functions\<close>

text\<open>See similar theorems in func.thy\<close>

text\<open>Theorem by KG, proof by LCP\<close>
lemma inj_disjoint_Un:
     "\<lbrakk>f \<in> inj(A,B);  g \<in> inj(C,D);  B \<inter> D = 0\<rbrakk>
      \<Longrightarrow> (\<lambda>a\<in>A \<union> C. if a \<in> A then f`a else g`a) \<in> inj(A \<union> C, B \<union> D)"
apply (rule_tac d = "\<lambda>z. if z \<in> B then converse (f) `z else converse (g) `z"
       in lam_injective)
apply (auto simp add: inj_is_fun [THEN apply_type])
done

lemma surj_disjoint_Un:
    "\<lbrakk>f \<in> surj(A,B);  g \<in> surj(C,D);  A \<inter> C = 0\<rbrakk>
     \<Longrightarrow> (f \<union> g) \<in> surj(A \<union> C, B \<union> D)"
apply (simp add: surj_def fun_disjoint_Un)
apply (blast dest!: domain_of_fun
             intro!: fun_disjoint_apply1 fun_disjoint_apply2)
done

text\<open>A simple, high-level proof; the version for injections follows from it,
  using  \<^term>\<open>f \<in> inj(A,B) \<longleftrightarrow> f \<in> bij(A,range(f))\<close>\<close>
lemma bij_disjoint_Un:
     "\<lbrakk>f \<in> bij(A,B);  g \<in> bij(C,D);  A \<inter> C = 0;  B \<inter> D = 0\<rbrakk>
      \<Longrightarrow> (f \<union> g) \<in> bij(A \<union> C, B \<union> D)"
apply (rule invertible_imp_bijective)
apply (subst converse_Un)
apply (auto intro: fun_disjoint_Un bij_is_fun bij_converse_bij)
done

subsubsection\<open>Restrictions as Surjections and Bijections\<close>

lemma surj_image:
    "f \<in> Pi(A,B) \<Longrightarrow> f \<in> surj(A, f``A)"
apply (simp add: surj_def)
apply (blast intro: apply_equality apply_Pair Pi_type)
done

lemma surj_image_eq: "f \<in> surj(A, B) \<Longrightarrow> f``A = B"
  by (auto simp add: surj_def image_fun) (blast dest: apply_type)

lemma restrict_image [simp]: "restrict(f,A) `` B = f `` (A \<inter> B)"
by (auto simp add: restrict_def)

lemma restrict_inj:
    "\<lbrakk>f \<in> inj(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): inj(C,B)"
  unfolding inj_def
apply (safe elim!: restrict_type2, auto)
done

lemma restrict_surj: "\<lbrakk>f \<in> Pi(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): surj(C, f``C)"
apply (insert restrict_type2 [THEN surj_image])
apply (simp add: restrict_image)
done

lemma restrict_bij:
    "\<lbrakk>f \<in> inj(A,B);  C<=A\<rbrakk> \<Longrightarrow> restrict(f,C): bij(C, f``C)"
apply (simp add: inj_def bij_def)
apply (blast intro: restrict_surj surj_is_fun)
done

subsubsection\<open>Lemmas for Ramsey's Theorem\<close>

lemma inj_weaken_type: "\<lbrakk>f \<in> inj(A,B);  B<=D\<rbrakk> \<Longrightarrow> f \<in> inj(A,D)"
  unfolding inj_def
apply (blast intro: fun_weaken_type)
done

lemma inj_succ_restrict:
     "\<lbrakk>f \<in> inj(succ(m), A)\<rbrakk> \<Longrightarrow> restrict(f,m) \<in> inj(m, A-{f`m})"
apply (rule restrict_bij [THEN bij_is_inj, THEN inj_weaken_type], assumption, blast)
  unfolding inj_def
apply (fast elim: range_type mem_irrefl dest: apply_equality)
done

lemma inj_extend:
    "\<lbrakk>f \<in> inj(A,B);  a\<notin>A;  b\<notin>B\<rbrakk>
     \<Longrightarrow> cons(\<langle>a,b\<rangle>,f) \<in> inj(cons(a,A), cons(b,B))"
  unfolding inj_def
apply (force intro: apply_type  simp add: fun_extend)
done

end


(*  Title:       ODEs and Dynamical Systems for HS verification
    Author:      Jonathan Julián Huerta y Munive, 2020
    Maintainer:  Jonathan Julián Huerta y Munive <jonjulian23@gmail.com>
*)

section \<open> Ordinary Differential Equations \<close>

text \<open>Vector fields @{text "f::real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector)"} represent systems
of ordinary differential equations (ODEs). Picard-Lindeloef's theorem guarantees existence
and uniqueness of local solutions to initial value problems involving Lipschitz continuous
vector fields. A (local) flow @{text "\<phi>::real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector)"} for such
a system is the function that maps initial conditions to their unique solutions. In dynamical
systems, the set of all points @{text "\<phi> t s::'a"} for a fixed @{text "s::'a"} is the flow's
orbit. If the orbit of each @{text "s \<in> I"} is conatined in @{text I}, then @{text I} is an
invariant set of this system. This section formalises these concepts with a focus on hybrid
systems (HS) verification.\<close>

theory HS_ODEs
  imports "HS_Preliminaries"
begin

subsection \<open> Initial value problems and orbits \<close>

notation image ("\<P>")

lemma image_le_pred[simp]: "(\<P> f A \<subseteq> {s. G s}) = (\<forall>x\<in>A. G (f x))"
  unfolding image_def by force

definition ivp_sols :: "(real \<Rightarrow> 'a \<Rightarrow> ('a::real_normed_vector)) \<Rightarrow> ('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow>
  real \<Rightarrow> 'a \<Rightarrow> (real \<Rightarrow> 'a) set" ("Sols")
  where "Sols f U S t\<^sub>0 s = {X \<in> U s \<rightarrow> S. (D X = (\<lambda>t. f t (X t)) on U s) \<and> X t\<^sub>0 = s \<and> t\<^sub>0 \<in> U s}"

lemma ivp_solsI:
  assumes "D X = (\<lambda>t. f t (X t)) on U s" and "X t\<^sub>0 = s"
      and "X \<in> U s \<rightarrow> S" and "t\<^sub>0 \<in> U s"
    shows "X \<in> Sols f U S t\<^sub>0 s"
  using assms unfolding ivp_sols_def by blast

lemma ivp_solsD:
  assumes "X \<in> Sols f U S t\<^sub>0 s"
  shows "D X = (\<lambda>t. f t (X t)) on U s" and "X t\<^sub>0 = s"
    and "X \<in> U s \<rightarrow> S" and "t\<^sub>0 \<in> U s"
  using assms unfolding ivp_sols_def by auto

lemma in_ivp_sols_subset:
  "t\<^sub>0 \<in> (U s) \<Longrightarrow> (U s) \<subseteq> (T s) \<Longrightarrow> X \<in> Sols f T S t\<^sub>0 s \<Longrightarrow> X \<in> Sols f U S t\<^sub>0 s "
  apply(rule ivp_solsI)
  using ivp_solsD(1,2) has_vderiv_on_subset
     apply blast+
  by (drule ivp_solsD(3)) auto

abbreviation "down U t \<equiv> {\<tau> \<in> U. \<tau> \<le> t}"

definition g_orbit :: "(('a::ord) \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> 'b set" ("\<gamma>")
  where "\<gamma> X G U = \<Union>{\<P> X (down U t) |t. \<P> X (down U t) \<subseteq> {s. G s}}"

lemma g_orbit_eq:
  fixes X::"('a::preorder) \<Rightarrow> 'b"
  shows "\<gamma> X G U = {X t |t. t \<in> U \<and> (\<forall>\<tau>\<in>down U t. G (X \<tau>))}"
  unfolding g_orbit_def using order_trans by auto blast

definition g_orbital :: "(real \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow>
  ('a::real_normed_vector) \<Rightarrow> 'a set"
  where "g_orbital f G U S t\<^sub>0 s = \<Union>{\<gamma> X G (U s) |X. X \<in> ivp_sols f U S t\<^sub>0 s}"

lemma g_orbital_eq: "g_orbital f G U S t\<^sub>0 s =
  {X t |t X. t \<in> U s \<and> \<P> X (down (U s) t) \<subseteq> {s. G s} \<and> X \<in> Sols f U S t\<^sub>0 s }"
  unfolding g_orbital_def ivp_sols_def g_orbit_eq by auto

lemma g_orbitalI:
  assumes "X \<in> Sols f U S t\<^sub>0 s"
    and "t \<in> U s" and "(\<P> X (down (U s) t) \<subseteq> {s. G s})"
  shows "X t \<in> g_orbital f G U S t\<^sub>0 s"
  using assms unfolding g_orbital_eq(1) by auto

lemma g_orbitalD:
  assumes "s' \<in> g_orbital f G U S t\<^sub>0 s"
  obtains X and t where "X \<in> Sols f U S t\<^sub>0 s"
  and "X t = s'" and "t \<in> U s" and "(\<P> X (down (U s) t) \<subseteq> {s. G s})"
  using assms unfolding g_orbital_def g_orbit_eq by auto

lemma "g_orbital f G U S t\<^sub>0 s = {X t |t X. X t \<in> \<gamma> X G (U s) \<and> X \<in> Sols f U S t\<^sub>0 s}"
  unfolding g_orbital_eq g_orbit_eq by auto

lemma "X \<in> Sols f U S t\<^sub>0 s \<Longrightarrow> \<gamma> X G (U s) \<subseteq> g_orbital f G U S t\<^sub>0 s"
  unfolding g_orbital_eq g_orbit_eq by auto

lemma "g_orbital f G U S t\<^sub>0 s \<subseteq> g_orbital f (\<lambda>s. True) U S t\<^sub>0 s"
  unfolding g_orbital_eq by auto

no_notation g_orbit ("\<gamma>")

subsection \<open> Differential Invariants \<close>

definition diff_invariant :: "('a \<Rightarrow> bool) \<Rightarrow> (real \<Rightarrow> ('a::real_normed_vector) \<Rightarrow> 'a) \<Rightarrow>
  ('a \<Rightarrow> real set) \<Rightarrow> 'a set \<Rightarrow> real \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
  where "diff_invariant I f U S t\<^sub>0 G \<equiv> (\<Union> \<circ> (\<P> (g_orbital f G U S t\<^sub>0))) {s. I s} \<subseteq> {s. I s}"

lemma diff_invariant_eq: "diff_invariant I f U S t\<^sub>0 G =
  (\<forall>s. I s \<longrightarrow> (\<forall>X\<in>Sols f U S t\<^sub>0 s. (\<forall>t\<in>U s.(\<forall>\<tau>\<in>(down (U s) t). G (X \<tau>)) \<longrightarrow> I (X t))))"
  unfolding diff_invariant_def g_orbital_eq image_le_pred by auto

lemma diff_inv_eq_inv_set:
  "diff_invariant I f U S t\<^sub>0 G = (\<forall>s. I s \<longrightarrow> (g_orbital f G U S t\<^sub>0 s) \<subseteq> {s. I s})"
  unfolding diff_invariant_eq g_orbital_eq image_le_pred by auto

lemma "diff_invariant I f U S t\<^sub>0 (\<lambda>s. True) \<Longrightarrow> diff_invariant I f U S t\<^sub>0 G"
  unfolding diff_invariant_eq by auto

named_theorems diff_invariant_rules "rules for certifying differential invariants."

lemma diff_invariant_eq_rule [diff_invariant_rules]:
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and dX: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (D (\<lambda>\<tau>. \<mu>(X \<tau>)-\<nu>(X \<tau>)) = ((*\<^sub>R) 0) on U(X t\<^sub>0))"
  shows "diff_invariant (\<lambda>s. \<mu> s = \<nu> s) f U S t\<^sub>0 G"
proof(simp add: diff_invariant_eq ivp_sols_def, clarsimp)
  fix X t
  assume xivp:"D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U (X t\<^sub>0)" "\<mu> (X t\<^sub>0) = \<nu> (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
    and tHyp:"t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)"
    using closed_segment_subset_interval[OF Uhyp t0Hyp tHyp] by blast
  hence "D (\<lambda>\<tau>. \<mu> (X \<tau>) - \<nu> (X \<tau>)) = (\<lambda>\<tau>. \<tau> *\<^sub>R 0) on {t\<^sub>0--t}"
    using has_vderiv_on_subset[OF dX[OF xivp(1)]] by auto
  then obtain \<tau> where "\<mu> (X t) - \<nu> (X t) - (\<mu> (X t\<^sub>0) - \<nu> (X t\<^sub>0)) = (t - t\<^sub>0) * \<tau> *\<^sub>R 0"
    using mvt_very_simple_closed_segmentE by blast
  thus "\<mu> (X t) = \<nu> (X t)"
    by (simp add: xivp(2))
qed

lemma diff_invariant_leq_rule [diff_invariant_rules]:
  fixes \<mu>::"'a::banach \<Rightarrow> real"
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and Gg: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> > t\<^sub>0 \<longrightarrow> G (X \<tau>) \<longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>))"
    and Gl: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> < t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>))"
    and dX: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> D (\<lambda>\<tau>. \<mu>(X \<tau>)-\<nu>(X \<tau>)) = (\<lambda>\<tau>. \<mu>'(X \<tau>)-\<nu>'(X \<tau>)) on U(X t\<^sub>0)"
  shows "diff_invariant (\<lambda>s. \<nu> s \<le> \<mu> s) f U S t\<^sub>0 G"
proof(simp_all add: diff_invariant_eq ivp_sols_def, safe)
  fix X t assume Ghyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "\<nu> (X t\<^sub>0) \<le> \<mu> (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  assume tHyp: "t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence obs1: "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)" "{t\<^sub>0<--<t} \<subseteq> U (X t\<^sub>0)"
    using closed_segment_subset_interval[OF Uhyp t0Hyp tHyp] xivp(3) segment_open_subset_closed
    by (force, metis PiE \<open>X t\<^sub>0 \<in> S \<Longrightarrow> {t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)\<close> dual_order.trans)
  hence obs2: "D (\<lambda>\<tau>. \<mu> (X \<tau>) - \<nu> (X \<tau>)) = (\<lambda>\<tau>. \<mu>' (X \<tau>) - \<nu>' (X \<tau>)) on {t\<^sub>0--t}"
    using has_vderiv_on_subset[OF dX[OF xivp(1)]] by auto
  {assume "t \<noteq> t\<^sub>0"
    then obtain r where rHyp: "r \<in> {t\<^sub>0<--<t}"
      and "(\<mu>(X t)-\<nu>(X t)) - (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) = (\<lambda>\<tau>. \<tau>*(\<mu>'(X r)-\<nu>'(X r))) (t - t\<^sub>0)"
      using mvt_simple_closed_segmentE obs2 by blast
    hence mvt: "\<mu>(X t)-\<nu>(X t) = (t - t\<^sub>0)*(\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0))"
      by force
    have primed: "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> > t\<^sub>0 \<Longrightarrow> G (X \<tau>) \<Longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>)"
      "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> < t\<^sub>0 \<Longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>)"
      using Gg[OF xivp(1)] Gl[OF xivp(1)] by auto
    have "t > t\<^sub>0 \<Longrightarrow> r > t\<^sub>0 \<and> G (X r)" "\<not> t\<^sub>0 \<le> t \<Longrightarrow> r < t\<^sub>0" "r \<in> U (X t\<^sub>0)"
      using \<open>r \<in> {t\<^sub>0<--<t}\<close> obs1 Ghyp
      unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl by auto
    moreover have "r > t\<^sub>0 \<Longrightarrow> G (X r) \<Longrightarrow> (\<mu>'(X r)- \<nu>'(X r)) \<ge> 0" "r < t\<^sub>0 \<Longrightarrow> (\<mu>'(X r)-\<nu>'(X r)) \<le> 0"
      using primed(1,2)[OF \<open>r \<in> U (X t\<^sub>0)\<close>] by auto
    ultimately have "(t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) \<ge> 0"
      by (case_tac "t \<ge> t\<^sub>0", force, auto simp: split_mult_pos_le)
    hence "(t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) \<ge> 0"
      using xivp(2) by auto
    hence "\<nu> (X t) \<le> \<mu> (X t)"
      using mvt by simp}
  thus "\<nu> (X t) \<le> \<mu> (X t)"
    using xivp by blast
qed

lemma diff_invariant_less_rule [diff_invariant_rules]:
  fixes \<mu>::"'a::banach \<Rightarrow> real"
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)"
    and Gg: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> > t\<^sub>0 \<longrightarrow> G (X \<tau>) \<longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>))"
    and Gl: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> (\<forall>\<tau>\<in>U(X t\<^sub>0). \<tau> < t\<^sub>0 \<longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>))"
    and dX: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> D (\<lambda>\<tau>. \<mu>(X \<tau>)-\<nu>(X \<tau>)) = (\<lambda>\<tau>. \<mu>'(X \<tau>)-\<nu>'(X \<tau>)) on U(X t\<^sub>0)"
  shows "diff_invariant (\<lambda>s. \<nu> s < \<mu> s) f U S t\<^sub>0 G"
proof(simp_all add: diff_invariant_eq ivp_sols_def, safe)
  fix X t assume Ghyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  assume tHyp: "t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence obs1: "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)" "{t\<^sub>0<--<t} \<subseteq> U (X t\<^sub>0)"
    using closed_segment_subset_interval[OF Uhyp t0Hyp tHyp] xivp(3) segment_open_subset_closed
    by (force, metis PiE \<open>X t\<^sub>0 \<in> S \<Longrightarrow> {t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)\<close> dual_order.trans)
  hence obs2: "D (\<lambda>\<tau>. \<mu> (X \<tau>) - \<nu> (X \<tau>)) = (\<lambda>\<tau>. \<mu>' (X \<tau>) - \<nu>' (X \<tau>)) on {t\<^sub>0--t}"
    using has_vderiv_on_subset[OF dX[OF xivp(1)]] by auto
  {assume "t \<noteq> t\<^sub>0"
    then obtain r where rHyp: "r \<in> {t\<^sub>0<--<t}"
      and "(\<mu>(X t)-\<nu>(X t)) - (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) = (\<lambda>\<tau>. \<tau>*(\<mu>'(X r)-\<nu>'(X r))) (t - t\<^sub>0)"
      using mvt_simple_closed_segmentE obs2 by blast
    hence mvt: "\<mu>(X t)-\<nu>(X t) = (t - t\<^sub>0)*(\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0))"
      by force
    have primed: "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> > t\<^sub>0 \<Longrightarrow> G (X \<tau>) \<Longrightarrow> \<mu>' (X \<tau>) \<ge> \<nu>' (X \<tau>)"
      "\<And>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<Longrightarrow> \<tau> < t\<^sub>0 \<Longrightarrow> \<mu>' (X \<tau>) \<le> \<nu>' (X \<tau>)"
      using Gg[OF xivp(1)] Gl[OF xivp(1)] by auto
    have "t > t\<^sub>0 \<Longrightarrow> r > t\<^sub>0 \<and> G (X r)" "\<not> t\<^sub>0 \<le> t \<Longrightarrow> r < t\<^sub>0" "r \<in> U (X t\<^sub>0)"
      using \<open>r \<in> {t\<^sub>0<--<t}\<close> obs1 Ghyp
      unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl by auto
    moreover have "r > t\<^sub>0 \<Longrightarrow> G (X r) \<Longrightarrow> (\<mu>'(X r)- \<nu>'(X r)) \<ge> 0" "r < t\<^sub>0 \<Longrightarrow> (\<mu>'(X r)-\<nu>'(X r)) \<le> 0"
      using primed(1,2)[OF \<open>r \<in> U (X t\<^sub>0)\<close>] by auto
    ultimately have "(t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) \<ge> 0"
      by (case_tac "t \<ge> t\<^sub>0", force, auto simp: split_mult_pos_le)
    hence "(t - t\<^sub>0) * (\<mu>'(X r)-\<nu>'(X r)) + (\<mu>(X t\<^sub>0)-\<nu>(X t\<^sub>0)) > 0"
      using xivp(2) by auto
    hence "\<nu> (X t) < \<mu> (X t)"
      using mvt by simp}
  thus "\<nu> (X t) < \<mu> (X t)"
    using xivp by blast
qed

lemma diff_invariant_nleq_rule:
  fixes \<mu>::"'a::banach \<Rightarrow> real"
  shows "diff_invariant (\<lambda>s. \<not> \<nu> s \<le> \<mu> s) f U S t\<^sub>0 G \<longleftrightarrow> diff_invariant (\<lambda>s. \<nu> s > \<mu> s) f U S t\<^sub>0 G"
  unfolding diff_invariant_eq apply safe
  by (clarsimp, erule_tac x=s in allE, simp, erule_tac x=X in ballE, force, force)+

lemma diff_invariant_neq_rule [diff_invariant_rules]:
  fixes \<mu>::"'a::banach \<Rightarrow> real"
  assumes "diff_invariant (\<lambda>s. \<nu> s < \<mu> s) f U S t\<^sub>0 G"
    and "diff_invariant (\<lambda>s. \<nu> s > \<mu> s) f U S t\<^sub>0 G"
  shows "diff_invariant (\<lambda>s. \<nu> s \<noteq> \<mu> s) f U S t\<^sub>0 G"
proof(unfold diff_invariant_eq, clarsimp)
  fix s::'a and X::"real \<Rightarrow> 'a" and t::real
  assume "\<nu> s \<noteq> \<mu> s" and Xhyp: "X \<in> Sols f U S t\<^sub>0 s"
     and thyp: "t \<in> U s" and Ghyp: "\<forall>\<tau>. \<tau> \<in> U s \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  hence "\<nu> s < \<mu> s \<or> \<nu> s > \<mu> s"
    by linarith
  moreover have "\<nu> s < \<mu> s \<Longrightarrow> \<nu> (X t) < \<mu> (X t)"
    using assms(1) Xhyp thyp Ghyp unfolding diff_invariant_eq by auto
  moreover have "\<nu> s > \<mu> s \<Longrightarrow> \<nu> (X t) > \<mu> (X t)"
    using assms(2) Xhyp thyp Ghyp unfolding diff_invariant_eq by auto
  ultimately show "\<nu> (X t) = \<mu> (X t) \<Longrightarrow> False"
    by auto
qed

lemma diff_invariant_neq_rule_converse:
  fixes \<mu>::"'a::banach \<Rightarrow> real"
  assumes Uhyp: "\<And>s. s \<in> S \<Longrightarrow> is_interval (U s)" "\<And>s t. s \<in> S \<Longrightarrow> t \<in> U s \<Longrightarrow> t\<^sub>0 \<le> t"
    and conts: "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> continuous_on (\<P> X (U (X t\<^sub>0))) \<nu>"
      "\<And>X. (D X = (\<lambda>\<tau>. f \<tau> (X \<tau>)) on U(X t\<^sub>0)) \<Longrightarrow> continuous_on (\<P> X (U (X t\<^sub>0))) \<mu>"
    and dI:"diff_invariant (\<lambda>s. \<nu> s \<noteq> \<mu> s) f U S t\<^sub>0 G"
  shows "diff_invariant (\<lambda>s. \<nu> s < \<mu> s) f U S t\<^sub>0 G"
proof(unfold diff_invariant_eq ivp_sols_def, clarsimp)
  fix X t assume Ghyp: "\<forall>\<tau>. \<tau> \<in> U (X t\<^sub>0) \<and> \<tau> \<le> t \<longrightarrow> G (X \<tau>)"
  assume xivp: "D X = (\<lambda>x. f x (X x)) on U (X t\<^sub>0)" "\<nu> (X t\<^sub>0) < \<mu> (X t\<^sub>0)" "X \<in> U (X t\<^sub>0) \<rightarrow> S"
  assume tHyp: "t \<in> U (X t\<^sub>0)" and t0Hyp: "t\<^sub>0 \<in> U (X t\<^sub>0)"
  hence "t\<^sub>0 \<le> t" and "\<mu> (X t) \<noteq> \<nu> (X t)"
    using xivp(3) Uhyp(2) apply force
    using dI tHyp xivp(2) Ghyp ivp_solsI[of X f U "X t\<^sub>0", OF xivp(1) _ xivp(3) t0Hyp]
    unfolding diff_invariant_eq by force
  moreover
  {assume ineq2:"\<nu> (X t) > \<mu> (X t)"
    note continuous_on_compose[OF vderiv_on_continuous_on[OF xivp(1)]]
    hence "continuous_on (U (X t\<^sub>0)) (\<nu> \<circ> X)" and "continuous_on (U (X t\<^sub>0)) (\<mu> \<circ> X)"
      using xivp(1) conts by blast+
    also have "{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)"
      using closed_segment_subset_interval[OF Uhyp(1) t0Hyp tHyp] xivp(3) t0Hyp by auto
    ultimately have "continuous_on {t\<^sub>0--t} (\<lambda>\<tau>. \<nu> (X \<tau>))"
      and "continuous_on {t\<^sub>0--t} (\<lambda>\<tau>. \<mu> (X \<tau>))"
      using continuous_on_subset by auto
    then obtain \<tau> where "\<tau> \<in> {t\<^sub>0--t}" "\<mu> (X \<tau>) = \<nu> (X \<tau>)"
      using IVT_two_functions_real_ivl[OF _ _ xivp(2) ineq2] by force
    hence "\<forall>r\<in>down (U (X t\<^sub>0)) \<tau>. G (X r)" and "\<tau> \<in> U (X t\<^sub>0)"
      using Ghyp \<open>\<tau> \<in> {t\<^sub>0--t}\<close> \<open>t\<^sub>0 \<le> t\<close> \<open>{t\<^sub>0--t} \<subseteq> U (X t\<^sub>0)\<close>
      by (auto simp: closed_segment_eq_real_ivl)
    hence "\<mu> (X \<tau>) \<noteq> \<nu> (X \<tau>)"
      using dI tHyp xivp(2) ivp_solsI[of X f U "X t\<^sub>0", OF xivp(1) _ xivp(3) t0Hyp]
      unfolding diff_invariant_eq by force
    hence "False"
      using \<open>\<mu> (X \<tau>) = \<nu> (X \<tau>)\<close> by blast}
  ultimately show "\<nu> (X t) < \<mu> (X t)"
    by fastforce
qed

lemma diff_invariant_conj_rule [diff_invariant_rules]:
  assumes "diff_invariant I\<^sub>1 f U S t\<^sub>0 G"
    and "diff_invariant I\<^sub>2 f U S t\<^sub>0 G"
  shows "diff_invariant (\<lambda>s. I\<^sub>1 s \<and> I\<^sub>2 s) f U S t\<^sub>0 G"
  using assms unfolding diff_invariant_def by auto

lemma diff_invariant_disj_rule [diff_invariant_rules]:
  assumes "diff_invariant I\<^sub>1 f U S t\<^sub>0 G"
    and "diff_invariant I\<^sub>2 f U S t\<^sub>0 G"
  shows "diff_invariant (\<lambda>s. I\<^sub>1 s \<or> I\<^sub>2 s) f U S t\<^sub>0 G"
  using assms unfolding diff_invariant_def by auto

subsection \<open> Picard-Lindeloef \<close>

text\<open> A locale with the assumptions of Picard-Lindeloef's theorem. It extends
@{term "ll_on_open_it"} by providing an initial time @{term "t\<^sub>0 \<in> T"}.\<close>

locale picard_lindeloef =
  fixes f::"real \<Rightarrow> ('a::{heine_borel,banach}) \<Rightarrow> 'a" and T::"real set" and S::"'a set" and t\<^sub>0::real
  assumes open_domain: "open T" "open S"
    and interval_time: "is_interval T"
    and init_time: "t\<^sub>0 \<in> T"
    and cont_vec_field: "\<forall>s \<in> S. continuous_on T (\<lambda>t. f t s)"
    and lipschitz_vec_field: "local_lipschitz T S f"
begin

sublocale ll_on_open_it T f S t\<^sub>0
  by (unfold_locales) (auto simp: cont_vec_field lipschitz_vec_field interval_time open_domain)

lemma ll_on_open: "ll_on_open T f S"
  using local.general.ll_on_open_axioms .

lemmas subintervalI = closed_segment_subset_domain
   and init_time_ex_ivl = existence_ivl_initial_time[OF init_time]
   and flow_at_init[simp] = general.flow_initial_time[OF init_time]

abbreviation "ex_ivl s \<equiv> existence_ivl t\<^sub>0 s"

lemma flow_has_vderiv_on_ex_ivl:
  assumes "s \<in> S"
  shows "D flow t\<^sub>0 s = (\<lambda>t. f t (flow t\<^sub>0 s t)) on ex_ivl s"
  using flow_usolves_ode[OF init_time \<open>s \<in> S\<close>]
  unfolding usolves_ode_from_def solves_ode_def by blast

lemma flow_funcset_ex_ivl:
  assumes "s \<in> S"
  shows "flow t\<^sub>0 s \<in> ex_ivl s \<rightarrow> S"
  using flow_usolves_ode[OF init_time \<open>s \<in> S\<close>]
  unfolding usolves_ode_from_def solves_ode_def by blast

lemma flow_in_ivp_sols_ex_ivl:
  assumes "s \<in> S"
  shows "flow t\<^sub>0 s \<in> Sols f (\<lambda>s. ex_ivl s) S t\<^sub>0 s"
  using flow_has_vderiv_on_ex_ivl[OF assms] apply(rule ivp_solsI)
    apply(simp_all add: init_time assms)
  by (rule flow_funcset_ex_ivl[OF assms])

lemma csols_eq: "csols t\<^sub>0 s = {(x, t). t \<in> T \<and>  x \<in> Sols f (\<lambda>s. {t\<^sub>0--t}) S t\<^sub>0 s}"
  unfolding ivp_sols_def csols_def solves_ode_def
  using closed_segment_subset_domain init_time by auto

lemma subset_ex_ivlI:
  "Y\<^sub>1 \<in> Sols f (\<lambda>s. T) S t\<^sub>0 s \<Longrightarrow> {t\<^sub>0--t} \<subseteq> T \<Longrightarrow> A \<subseteq> {t\<^sub>0--t} \<Longrightarrow> A \<subseteq> ex_ivl s"
  apply(clarsimp simp: existence_ivl_def)
  apply(subgoal_tac "t\<^sub>0 \<in> T", clarsimp simp: csols_eq)
   apply(rule_tac x=Y\<^sub>1 in exI, rule_tac x=t in exI, safe, force)
  by (rule in_ivp_sols_subset[where T="\<lambda>s. T"], auto)

lemma unique_solution: \<comment> \<open> proved for a subset of T for general applications \<close>
  assumes "s \<in> S" and "t\<^sub>0 \<in> U" and "t \<in> U"
    and "is_interval U" and "U \<subseteq> ex_ivl s"
    and xivp: "D Y\<^sub>1 = (\<lambda>t. f t (Y\<^sub>1 t)) on U" "Y\<^sub>1 t\<^sub>0 = s" "Y\<^sub>1 \<in> U \<rightarrow> S"
    and yivp: "D Y\<^sub>2 = (\<lambda>t. f t (Y\<^sub>2 t)) on U" "Y\<^sub>2 t\<^sub>0 = s" "Y\<^sub>2 \<in> U \<rightarrow> S"
  shows "Y\<^sub>1 t = Y\<^sub>2 t"
proof-
  have "t\<^sub>0 \<in> T"
    using assms existence_ivl_subset by auto
  have key: "(flow t\<^sub>0 s usolves_ode f from t\<^sub>0) (ex_ivl s) S"
    using flow_usolves_ode[OF \<open>t\<^sub>0 \<in> T\<close> \<open>s \<in> S\<close>] .
  hence "\<forall>t\<in>U. Y\<^sub>1 t = flow t\<^sub>0 s t"
    unfolding usolves_ode_from_def solves_ode_def apply safe
    by (erule_tac x=Y\<^sub>1 in allE, erule_tac x=U in allE, auto simp: assms)
  also have "\<forall>t\<in>U. Y\<^sub>2 t = flow t\<^sub>0 s t"
    using key unfolding usolves_ode_from_def solves_ode_def apply safe
    by (erule_tac x=Y\<^sub>2 in allE, erule_tac x=U in allE, auto simp: assms)
  ultimately show "Y\<^sub>1 t = Y\<^sub>2 t"
    using assms by auto
qed

text \<open>Applications of lemma @{text "unique_solution"}: \<close>

lemma unique_solution_closed_ivl:
  assumes xivp: "D X = (\<lambda>t. f t (X t)) on {t\<^sub>0--t}" "X t\<^sub>0 = s" "X \<in> {t\<^sub>0--t} \<rightarrow> S" and "t \<in> T"
    and yivp: "D Y = (\<lambda>t. f t (Y t)) on {t\<^sub>0--t}" "Y t\<^sub>0 = s" "Y \<in> {t\<^sub>0--t} \<rightarrow> S" and "s \<in> S"
  shows "X t = Y t"
  apply(rule unique_solution[OF \<open>s \<in> S\<close>, of "{t\<^sub>0--t}"], simp_all add: assms)
  apply(unfold existence_ivl_def csols_eq ivp_sols_def, clarsimp)
  using xivp \<open>t \<in> T\<close> by blast

lemma solution_eq_flow:
  assumes xivp: "D X = (\<lambda>t. f t (X t)) on ex_ivl s" "X t\<^sub>0 = s" "X \<in> ex_ivl s \<rightarrow> S"
    and "t \<in> ex_ivl s" and "s \<in> S"
  shows "X t = flow t\<^sub>0 s t"
  apply(rule unique_solution[OF \<open>s \<in> S\<close> init_time_ex_ivl \<open>t \<in> ex_ivl s\<close>])
  using flow_has_vderiv_on_ex_ivl flow_funcset_ex_ivl \<open>s \<in> S\<close> by (auto simp: assms)

lemma ivp_unique_solution:
  assumes "s \<in> S" and ivl: "is_interval (U s)" and "U s \<subseteq> T" and "t \<in> U s"
    and ivp1: "Y\<^sub>1 \<in> Sols f U S t\<^sub>0 s" and ivp2: "Y\<^sub>2 \<in> Sols f U S t\<^sub>0 s"
  shows "Y\<^sub>1 t = Y\<^sub>2 t"
proof(rule unique_solution[OF \<open>s \<in> S\<close>, of "{t\<^sub>0--t}"], simp_all)
  have "t\<^sub>0 \<in> U s"
    using ivp_solsD[OF ivp1] by auto
  hence obs0: "{t\<^sub>0--t} \<subseteq> U s"
    using closed_segment_subset_interval[OF ivl] \<open>t \<in> U s\<close> by blast
  moreover have obs1: "Y\<^sub>1 \<in> Sols f (\<lambda>s. {t\<^sub>0--t}) S t\<^sub>0 s"
    by (rule in_ivp_sols_subset[OF _ calculation(1) ivp1], simp)
  moreover have obs2: "Y\<^sub>2 \<in> Sols f (\<lambda>s. {t\<^sub>0--t}) S t\<^sub>0 s"
    by (rule in_ivp_sols_subset[OF _ calculation(1) ivp2], simp)
  ultimately show "{t\<^sub>0--t} \<subseteq> ex_ivl s"
    apply(unfold existence_ivl_def csols_eq, clarsimp)
    apply(rule_tac x=Y\<^sub>1 in exI, rule_tac x=t in exI)
    using \<open>t \<in> U s\<close> and \<open>U s \<subseteq> T\<close> by force
  show "D Y\<^sub>1 = (\<lambda>t. f t (Y\<^sub>1 t)) on {t\<^sub>0--t}"
    by (rule ivp_solsD[OF in_ivp_sols_subset[OF _ _ ivp1]], simp_all add: obs0)
  show "D Y\<^sub>2 = (\<lambda>t. f t (Y\<^sub>2 t)) on {t\<^sub>0--t}"
    by (rule ivp_solsD[OF in_ivp_sols_subset[OF _ _ ivp2]], simp_all add: obs0)
  show "Y\<^sub>1 t\<^sub>0 = s" and "Y\<^sub>2 t\<^sub>0 = s"
    using ivp_solsD[OF ivp1] ivp_solsD[OF ivp2] by auto
  show "Y\<^sub>1 \<in> {t\<^sub>0--t} \<rightarrow> S" and "Y\<^sub>2 \<in> {t\<^sub>0--t} \<rightarrow> S"
    using ivp_solsD[OF obs1] ivp_solsD[OF obs2] by auto
qed

lemma g_orbital_orbit:
  assumes "s \<in> S" and ivl: "is_interval (U s)" and "U s \<subseteq> T"
    and ivp: "Y \<in> Sols f U S t\<^sub>0 s"
  shows "g_orbital f G U S t\<^sub>0 s = g_orbit Y G (U s)"
proof-
  have eq1: "\<forall>Z \<in> Sols f U S t\<^sub>0 s. \<forall>t\<in>U s. Z t = Y t"
    by (clarsimp, rule ivp_unique_solution[OF assms(1,2,3) _ _ ivp], auto)
  have "g_orbital f G U S t\<^sub>0 s \<subseteq> g_orbit (\<lambda>t. Y t) G (U s)"
  proof
    fix x assume "x \<in> g_orbital f G U S t\<^sub>0 s"
    then obtain Z and t
      where z_def: "x = Z t \<and> t \<in> U s \<and> (\<forall>\<tau>\<in>down (U s) t. G (Z \<tau>)) \<and> Z \<in> Sols f U S t\<^sub>0 s"
      unfolding g_orbital_eq by auto
    hence "{t\<^sub>0--t} \<subseteq> U s"
      using closed_segment_subset_interval[OF ivl ivp_solsD(4)[OF ivp]] by blast
    hence "\<forall>\<tau>\<in>{t\<^sub>0--t}. Z \<tau> = Y \<tau>"
      using z_def apply clarsimp
      by (rule ivp_unique_solution[OF assms(1,2,3) _ _ ivp], auto)
    thus "x \<in> g_orbit Y G (U s)"
      using z_def eq1 unfolding g_orbit_eq by simp metis
  qed
  moreover have "g_orbit Y G (U s) \<subseteq> g_orbital f G U S t\<^sub>0 s"
    apply(unfold g_orbital_eq g_orbit_eq ivp_sols_def, clarsimp)
    apply(rule_tac x=t in exI, rule_tac x=Y in exI)
    using ivp_solsD[OF ivp] by auto
  ultimately show ?thesis
    by blast
qed

end

lemma local_lipschitz_add:
  fixes f1 f2 :: "real \<Rightarrow> 'a::banach \<Rightarrow> 'a"
  assumes "local_lipschitz T S f1"
      and "local_lipschitz T S f2"
    shows "local_lipschitz T S (\<lambda>t s. f1 t s + f2 t s)"
proof(unfold local_lipschitz_def, clarsimp)
  fix s and t assume "s \<in> S" and "t \<in> T"
  obtain \<epsilon>\<^sub>1 L1 where "\<epsilon>\<^sub>1 > 0" and L1: "\<And>\<tau>. \<tau>\<in>cball t \<epsilon>\<^sub>1 \<inter> T \<Longrightarrow> L1-lipschitz_on (cball s \<epsilon>\<^sub>1 \<inter> S) (f1 \<tau>)"
    using local_lipschitzE[OF assms(1) \<open>t \<in> T\<close> \<open>s \<in> S\<close>] by blast
  obtain \<epsilon>\<^sub>2 L2 where "\<epsilon>\<^sub>2 > 0" and L2: "\<And>\<tau>. \<tau>\<in>cball t \<epsilon>\<^sub>2 \<inter> T \<Longrightarrow> L2-lipschitz_on (cball s \<epsilon>\<^sub>2 \<inter> S) (f2 \<tau>)"
    using local_lipschitzE[OF assms(2) \<open>t \<in> T\<close> \<open>s \<in> S\<close>] by blast
  have ballH: "cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S \<subseteq> cball s \<epsilon>\<^sub>1 \<inter> S" "cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S \<subseteq> cball s \<epsilon>\<^sub>2 \<inter> S"
    by auto
  have obs1: "\<forall>\<tau>\<in>cball t \<epsilon>\<^sub>1 \<inter> T. L1-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (f1 \<tau>)"
    using lipschitz_on_subset[OF L1 ballH(1)] by blast
  also have obs2: "\<forall>\<tau>\<in>cball t \<epsilon>\<^sub>2 \<inter> T. L2-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (f2 \<tau>)"
    using lipschitz_on_subset[OF L2 ballH(2)] by blast
  ultimately have "\<forall>\<tau>\<in>cball t (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> T.
    (L1 + L2)-lipschitz_on (cball s (min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2) \<inter> S) (\<lambda>s. f1 \<tau> s + f2 \<tau> s)"
    using lipschitz_on_add by fastforce
  thus "\<exists>u>0. \<exists>L. \<forall>t\<in>cball t u \<inter> T. L-lipschitz_on (cball s u \<inter> S) (\<lambda>s. f1 t s + f2 t s)"
    apply(rule_tac x="min \<epsilon>\<^sub>1 \<epsilon>\<^sub>2" in exI)
    using \<open>\<epsilon>\<^sub>1 > 0\<close> \<open>\<epsilon>\<^sub>2 > 0\<close> by force
qed

lemma picard_lindeloef_add: "picard_lindeloef f1 T S t\<^sub>0 \<Longrightarrow> picard_lindeloef f2 T S t\<^sub>0 \<Longrightarrow>
  picard_lindeloef (\<lambda>t s. f1 t s + f2 t s) T S t\<^sub>0"
  unfolding picard_lindeloef_def apply(clarsimp, rule conjI)
  using continuous_on_add apply fastforce
  using local_lipschitz_add by blast

lemma picard_lindeloef_constant: "picard_lindeloef (\<lambda>t s. c) UNIV UNIV t\<^sub>0"
  apply(unfold_locales, simp_all add: local_lipschitz_def lipschitz_on_def, clarsimp)
  by (rule_tac x=1 in exI, clarsimp, rule_tac x="1/2" in exI, simp)

subsection \<open> Flows for ODEs \<close>

text\<open> A locale designed for verification of hybrid systems. The user can select the interval
of existence and the defining flow equation via the variables @{term "T"} and @{term "\<phi>"}.\<close>

locale local_flow = picard_lindeloef "(\<lambda> t. f)" T S 0
  for f::"'a::{heine_borel,banach} \<Rightarrow> 'a" and T S L +
  fixes \<phi> :: "real \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes ivp:
    "\<And> t s. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--t}"
    "\<And> s. s \<in> S \<Longrightarrow> \<phi> 0 s = s"
    "\<And> t s. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> (\<lambda>t. \<phi> t s) \<in> {0--t} \<rightarrow> S"
begin

lemma in_ivp_sols_ivl:
  assumes "t \<in> T" "s \<in> S"
  shows "(\<lambda>t. \<phi> t s) \<in> Sols (\<lambda>t. f) (\<lambda>s. {0--t}) S 0 s"
  apply(rule ivp_solsI)
  using ivp assms by auto

lemma eq_solution_ivl:
  assumes xivp: "D X = (\<lambda>t. f (X t)) on {0--t}" "X 0 = s" "X \<in> {0--t} \<rightarrow> S"
    and indom: "t \<in> T" "s \<in> S"
  shows "X t = \<phi> t s"
  apply(rule unique_solution_closed_ivl[OF xivp \<open>t \<in> T\<close>])
  using \<open>s \<in> S\<close> ivp indom by auto

lemma ex_ivl_eq:
  assumes "s \<in> S"
  shows "ex_ivl s = T"
  using existence_ivl_subset[of s] apply safe
  unfolding existence_ivl_def csols_eq
  using in_ivp_sols_ivl[OF _ assms] by blast

lemma has_derivative_on_open1:
  assumes  "t > 0" "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball t r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) \<open>t \<in> T\<close> by blast
  moreover have "t + r/2 > 0"
    using \<open>r > 0\<close> \<open>t > 0\<close> by auto
  moreover have "{0--t} \<subseteq> T"
    using subintervalI[OF init_time \<open>t \<in> T\<close>] .
  ultimately have subs: "{0<--<t + r/2} \<subseteq> T"
    unfolding abs_le_eq abs_le_eq real_ivl_eqs[OF \<open>t > 0\<close>] real_ivl_eqs[OF \<open>t + r/2 > 0\<close>]
    by clarify (case_tac "t < x", simp_all add: cball_def ball_def dist_norm subset_eq field_simps)
  have "t + r/2 \<in> T"
    using rHyp unfolding real_ivl_eqs[OF rHyp(1)] by (simp add: subset_eq)
  hence "{0--t + r/2} \<subseteq> T"
    using subintervalI[OF init_time] by blast
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(t + r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  hence vderiv: "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0<--<t + r/2})"
    apply(rule has_vderiv_on_subset)
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] by auto
  have "t \<in> {0<--<t + r/2}"
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] using rHyp \<open>t > 0\<close> by simp
  moreover have "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) (at t within {0<--<t + r/2})"
    using vderiv calculation unfolding has_vderiv_on_def has_vector_derivative_def by blast
  moreover have "open {0<--<t + r/2}"
    unfolding real_ivl_eqs[OF \<open>t + r/2 > 0\<close>] by simp
  ultimately show ?thesis
    using subs that by blast
qed

lemma has_derivative_on_open2:
  assumes "t < 0" "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball t r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) \<open>t \<in> T\<close> by blast
  moreover have "t - r/2 < 0"
    using \<open>r > 0\<close> \<open>t < 0\<close> by auto
  moreover have "{0--t} \<subseteq> T"
    using subintervalI[OF init_time \<open>t \<in> T\<close>] .
  ultimately have subs: "{0<--<t - r/2} \<subseteq> T"
    unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl
      real_ivl_eqs[OF rHyp(1)] by(auto simp: subset_eq)
  have "t - r/2 \<in> T"
    using rHyp unfolding real_ivl_eqs by (simp add: subset_eq)
  hence "{0--t - r/2} \<subseteq> T"
    using subintervalI[OF init_time] by blast
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(t - r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  hence vderiv: "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0<--<t - r/2})"
    apply(rule has_vderiv_on_subset)
    unfolding open_segment_eq_real_ivl closed_segment_eq_real_ivl by auto
  have "t \<in> {0<--<t - r/2}"
    unfolding open_segment_eq_real_ivl using rHyp \<open>t < 0\<close> by simp
  moreover have "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) (at t within {0<--<t - r/2})"
    using vderiv calculation unfolding has_vderiv_on_def has_vector_derivative_def by blast
  moreover have "open {0<--<t - r/2}"
    unfolding open_segment_eq_real_ivl by simp
  ultimately show ?thesis
    using subs that by blast
qed

lemma has_derivative_on_open3:
  assumes "s \<in> S"
  obtains B where "0 \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> 0 s)) at 0 within B"
proof-
  obtain r::real where rHyp: "r > 0" "ball 0 r \<subseteq> T"
    using open_contains_ball_eq open_domain(1) init_time by blast
  hence "r/2 \<in> T" "-r/2 \<in> T" "r/2 > 0"
    unfolding real_ivl_eqs by auto
  hence subs: "{0--r/2} \<subseteq> T" "{0--(-r/2)} \<subseteq> T"
    using subintervalI[OF init_time] by auto
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--r/2})"
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(-r/2)})"
    using ivp(1)[OF _ \<open>s \<in> S\<close>] by auto
  also have "{0--r/2} = {0--r/2} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)}"
    "{0--(-r/2)} = {0--(-r/2)} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)}"
    unfolding closed_segment_eq_real_ivl \<open>r/2 > 0\<close> by auto
  ultimately have vderivs:
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--r/2} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)})"
    "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {0--(-r/2)} \<union> closure {0--r/2} \<inter> closure {0--(-r/2)})"
    unfolding closed_segment_eq_real_ivl \<open>r/2 > 0\<close> by auto
  have obs: "0 \<in> {-r/2<--<r/2}"
    unfolding open_segment_eq_real_ivl using \<open>r/2 > 0\<close> by auto
  have union: "{-r/2--r/2} = {0--r/2} \<union> {0--(-r/2)}"
    unfolding closed_segment_eq_real_ivl by auto
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {-r/2--r/2})"
    using has_vderiv_on_union[OF vderivs] by simp
  hence "(D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on {-r/2<--<r/2})"
    using has_vderiv_on_subset[OF _ segment_open_subset_closed[of "-r/2" "r/2"]] by auto
  hence "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> 0 s)) (at 0 within {-r/2<--<r/2})"
    unfolding has_vderiv_on_def has_vector_derivative_def using obs by blast
  moreover have "open {-r/2<--<r/2}"
    unfolding open_segment_eq_real_ivl by simp
  moreover have "{-r/2<--<r/2} \<subseteq> T"
    using subs union segment_open_subset_closed by blast
  ultimately show ?thesis
    using obs that by blast
qed

lemma has_derivative_on_open:
  assumes "t \<in> T" "s \<in> S"
  obtains B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and "D (\<lambda>\<tau>. \<phi> \<tau> s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
  apply(subgoal_tac "t < 0 \<or> t = 0 \<or> t > 0")
  using has_derivative_on_open1[OF _ assms] has_derivative_on_open2[OF _ assms]
    has_derivative_on_open3[OF \<open>s \<in> S\<close>] by blast force

lemma in_domain:
  assumes "s \<in> S"
  shows "(\<lambda>t. \<phi> t s) \<in> T \<rightarrow> S"
  using ivp(3)[OF _ assms] by blast

lemma has_vderiv_on_domain:
  assumes "s \<in> S"
  shows "D (\<lambda>t. \<phi> t s) = (\<lambda>t. f (\<phi> t s)) on T"
proof(unfold has_vderiv_on_def has_vector_derivative_def, clarsimp)
  fix t assume "t \<in> T"
  then obtain B where "t \<in> B" and "open B" and "B \<subseteq> T"
    and Dhyp: "D (\<lambda>t. \<phi> t s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within B"
    using assms has_derivative_on_open[OF \<open>t \<in> T\<close>] by blast
  hence "t \<in> interior B"
    using interior_eq by auto
  thus "D (\<lambda>t. \<phi> t s) \<mapsto> (\<lambda>\<tau>. \<tau> *\<^sub>R f (\<phi> t s)) at t within T"
    using has_derivative_at_within_mono[OF _ \<open>B \<subseteq> T\<close> Dhyp] by blast
qed

lemma in_ivp_sols:
  assumes "s \<in> S" and "0 \<in> U s" and "U s \<subseteq> T"
  shows "(\<lambda>t. \<phi> t s) \<in> Sols (\<lambda>t. f) U S 0 s"
  apply(rule in_ivp_sols_subset[OF _ _ ivp_solsI, of _ _ _ "\<lambda>s. T"])
  using  ivp(2)[OF \<open>s \<in> S\<close>] has_vderiv_on_domain[OF \<open>s \<in> S\<close>]
    in_domain[OF \<open>s \<in> S\<close>] assms by auto

lemma eq_solution:
  assumes "s \<in> S" and "is_interval (U s)" and "U s \<subseteq> T" and "t \<in> U s"
    and xivp: "X \<in> Sols (\<lambda>t. f) U S 0 s"
  shows "X t = \<phi> t s"
  apply(rule ivp_unique_solution[OF assms], rule in_ivp_sols)
  by (simp_all add: ivp_solsD(4)[OF xivp] assms)

lemma ivp_sols_collapse:
  assumes "T = UNIV" and "s \<in> S"
  shows "Sols (\<lambda>t. f) (\<lambda>s. T) S 0 s = {(\<lambda>t. \<phi> t s)}"
  apply (safe, simp_all add: fun_eq_iff, clarsimp)
   apply(rule eq_solution[of _ "\<lambda>s. T"]; simp add: assms)
  by (rule in_ivp_sols; simp add: assms)

lemma additive_in_ivp_sols:
  assumes "s \<in> S" and "\<P> (\<lambda>\<tau>. \<tau> + t) T \<subseteq> T"
  shows "(\<lambda>\<tau>. \<phi> (\<tau> + t) s) \<in> Sols (\<lambda>t. f) (\<lambda>s. T) S 0 (\<phi> (0 + t) s)"
  apply(rule ivp_solsI[OF vderiv_on_composeI])
       apply(rule has_vderiv_on_subset[OF has_vderiv_on_domain])
  using in_domain assms init_time by (auto intro!: poly_derivatives)

lemma is_monoid_action:
  assumes "s \<in> S" and "T = UNIV"
  shows "\<phi> 0 s = s" and "\<phi> (t\<^sub>1 + t\<^sub>2) s = \<phi> t\<^sub>1 (\<phi> t\<^sub>2 s)"
proof-
  show "\<phi> 0 s = s"
    using ivp assms by simp
  have "\<phi> (0 + t\<^sub>2) s = \<phi> t\<^sub>2 s"
    by simp
  also have "\<phi> (0 + t\<^sub>2) s \<in> S"
    using in_domain assms by auto
  ultimately show "\<phi> (t\<^sub>1 + t\<^sub>2) s = \<phi> t\<^sub>1 (\<phi> t\<^sub>2 s)"
    using eq_solution[OF _ _ _ _ additive_in_ivp_sols] assms by auto
qed

lemma g_orbital_collapses:
  assumes "s \<in> S" and "is_interval (U s)" and "U s \<subseteq> T" and "0 \<in> U s"
  shows "g_orbital (\<lambda>t. f) G U S 0 s = {\<phi> t s| t. t \<in> U s \<and> (\<forall>\<tau>\<in>down (U s) t. G (\<phi> \<tau> s))}"
  apply (subst g_orbital_orbit[of _ _ "\<lambda>t. \<phi> t s"], simp_all add: assms g_orbit_eq)
  by (rule in_ivp_sols, simp_all add: assms)

definition orbit :: "'a \<Rightarrow> 'a set" ("\<gamma>\<^sup>\<phi>")
  where "\<gamma>\<^sup>\<phi> s = g_orbital (\<lambda>t. f) (\<lambda>s. True) (\<lambda>s. T) S 0 s"

lemma orbit_eq:
  assumes "s \<in> S"
  shows "\<gamma>\<^sup>\<phi> s = {\<phi> t s| t. t \<in> T}"
  apply(unfold orbit_def, subst g_orbital_collapses)
  by (simp_all add: assms init_time interval_time)

lemma true_g_orbit_eq:
  assumes "s \<in> S"
  shows "g_orbit (\<lambda>t. \<phi> t s) (\<lambda>s. True) T = \<gamma>\<^sup>\<phi> s"
  unfolding g_orbit_eq orbit_eq[OF assms] by simp

end

lemma line_is_local_flow:
  "0 \<in> T \<Longrightarrow> is_interval T \<Longrightarrow> open T \<Longrightarrow> local_flow (\<lambda> s. c) T UNIV (\<lambda> t s. s + t *\<^sub>R c)"
  apply(unfold_locales, simp_all add: local_lipschitz_def lipschitz_on_def, clarsimp)
   apply(rule_tac x=1 in exI, clarsimp, rule_tac x="1/2" in exI, simp)
  apply(rule_tac f'1="\<lambda> s. 0" and g'1="\<lambda> s. c" in has_vderiv_on_add[THEN has_vderiv_on_eq_rhs])
    apply(rule derivative_intros, simp)+
  by simp_all

end