(*  Title:      Is_Nth_Power.thy
    Author:     Klaus Weidinger, TU Muenchen
    Copyright   2020

A simproc for the predicate "is_nth_power (n::nat) (x::nat)" from "Nth_Powers.thy".
*)

theory Is_Nth_Power
  imports
    Main
    Complex_Main
    "HOL-Computational_Algebra.Primes"
    "HOL-Computational_Algebra.Nth_Powers"
    HOL.Num
    Prime
begin

text\<open>
Case distinction:
  case "n = 0 & x = 1": lemma 'is_zeroth_power_of_1'
  case "n = 0 & x ~= 1": lemma 'is_zeroth_power_false'
  case "n ~= 0 & x = 0": lemma 'is_nth_power_0' from 'Nth_Power.thy'
  case "n ~= 0 & x ~= 0 & is_nth_power n x": lemma 'is_nth_power_true'
  case "n ~= 0 & x ~= 0 & ~is_nth_power n x": lemma 'is_nth_power_false'
\<close>

lemma is_nth_power_true:
  fixes n::nat and x::nat
  assumes "b ^ n = x"
  shows "is_nth_power n x"
proof -
  show "is_nth_power n x" using assms by (auto simp: is_nth_power_def)
qed

lemma is_nth_power_false:
  fixes n::nat and x::nat
  assumes "prime p" "p^m * k = x" "\<not> p^(m+1) dvd x" "\<not> n dvd m" "n > 0"
  shows "\<not> is_nth_power n x"
proof -
  have tmp: "multiplicity p x = m" using assms by (auto simp: multiplicity_eqI)
  have "n > 0 \<longrightarrow> \<not>(\<forall>p. prime p \<longrightarrow> n dvd multiplicity p x) \<longrightarrow> \<not> is_nth_power n x"
    using is_nth_power_conv_multiplicity_nat by simp
  hence "\<not>(\<forall>p. prime p \<longrightarrow> n dvd multiplicity p x) \<longrightarrow> \<not> is_nth_power n x"
    using assms by auto
  hence "(\<exists>p. \<not>(prime p \<longrightarrow> n dvd multiplicity p x)) \<longrightarrow> \<not> is_nth_power n x"
    using not_all by simp
  hence "(\<exists>p. (prime p & \<not> n dvd multiplicity p x)) \<longrightarrow> \<not> is_nth_power n x"
    using not_imp by simp
  thus "\<not> is_nth_power n x" using assms and tmp by auto
qed

lemma is_zeroth_power_of_1: "is_nth_power 0 1"
  by simp

lemma is_zeroth_power_false:
  fixes x::nat
  assumes "x \<noteq> 1"
  shows "\<not> is_nth_power 0 x"
proof -
  show "\<not> is_nth_power 0 x" using assms by simp
qed

ML_file\<open>algorithms.ML\<close>
ML_file\<open>tools.ML\<close>

ML\<open>
signature IS_NTH_POWER =
sig

(* defines the upper (and lower) bound for the simproc *)
(* only on second argument, as that needs to be factorized *)
val limit: int Config.T

val parse: Thm.cterm -> int * int

(*                             n     x     base                  n     x    prime  mult.   *)
datatype cert = TRUE_CERT of (int * int) * int | FALSE_CERT of (int * int) * int * int
              | ZEROTH_POWER of int | NTH_POWER_EQ_ZERO of int | ZERO_ONE
val mk_cert: int -> int -> cert
val generate_proof: Proof.context -> cert -> thm option

val prove: Proof.context -> int * int -> thm option
val simproc: Proof.context -> Thm.cterm -> thm option

(* helper tools *)
val get_cert_numbers : cert -> int * int

end

structure Is_Nth_Power : IS_NTH_POWER =
struct

val limit = Attrib.setup_config_int \<^binding>\<open>limit\<close> (K 1000000);
exception LIMIT

(*                             n     x     base                  n     x    prime  mult.   *)
datatype cert = TRUE_CERT of (int * int) * int | FALSE_CERT of (int * int) * int * int
              | ZEROTH_POWER of int | NTH_POWER_EQ_ZERO of int | ZERO_ONE

fun parse ct = Tools.parse2 ct @{const_name "is_nth_power"}

fun mk_cert n x =
    if n = 0 then ZEROTH_POWER x else
    if x = 0 then NTH_POWER_EQ_ZERO n else
    let
        val fs_mset = Algorithms.to_mset (Algorithms.factorize x)
        fun decide acc (n, x) ((p, m)::pms) =
            if m mod n = 0 then decide ((p, m div n)::acc) (n, x) pms
                           else FALSE_CERT ((n, x), p, m)
          | decide acc (n, x) [] = TRUE_CERT ((n, x), Algorithms.prod_mset acc)
    in
        decide [] (n, x)  fs_mset
    end

exception ERROR
fun generate_proof _ ZERO_ONE =
        @{thm is_zeroth_power_of_1}
            |> SOME
  | generate_proof ctxt (ZEROTH_POWER x) =
        @{thm is_zeroth_power_false}
            |> Drule.infer_instantiate' ctxt [Tools.nat2ct' ctxt x]
            |> Tools.simp ctxt 1
            |> SOME
  | generate_proof ctxt (NTH_POWER_EQ_ZERO n) =
        @{thm is_nth_power_0}
            |> Drule.infer_instantiate' ctxt [Tools.nat2ct' ctxt n]
            |> Tools.simp ctxt 1
            |> SOME
  | generate_proof ctxt (TRUE_CERT ((n, x), base)) =
        @{thm is_nth_power_true}
            |> Drule.infer_instantiate' ctxt
                      (map (Tools.nat2ct' ctxt) [base, n, x])
            |> Tools.simp ctxt 1
            |> SOME
  | generate_proof ctxt (FALSE_CERT ((n, x), p, mult)) =
      let val prime_p = case fst (Pratt.prove_prime [] p ctxt)
                          of SOME thm => thm |
                                 NONE => raise ERROR
      in
        @{thm is_nth_power_false}
            |> Drule.infer_instantiate' ctxt
                      (map (Tools.nat2ct' ctxt) [p, mult, x div (IntInf.pow (p, mult)), x, n])
            |> (fn thm => thm OF [prime_p])
            |> Tools.simp ctxt 4
            |> SOME
      end

fun prove ctxt (n, x) =               (* term           *)
    (n,x) |-> mk_cert                 (* cert           *)
          |> generate_proof ctxt      (* thm option     *)
    handle ERROR => NONE

fun simproc ctxt input =            (* term            *)
    input |> parse                  (* n, x            *)
          |> (fn (n, x) => if abs x < Config.get ctxt limit then (n, x) else raise LIMIT)
          |> prove ctxt             (* thm option      *)
          |> Tools.wrap             (* thm option      *)
    handle LIMIT => NONE
         | TERM _ => NONE

(* helper tools *)
fun get_cert_numbers ZERO_ONE = (0, 1)
  | get_cert_numbers (ZEROTH_POWER x) = (0, x)
  | get_cert_numbers (NTH_POWER_EQ_ZERO n) = (n, 0)
  | get_cert_numbers (TRUE_CERT ((n, x), _)) = (n, x)
  | get_cert_numbers (FALSE_CERT ((n, x), _, _)) = (n, x)

end
\<close>

simproc_setup is_nth_power_simproc ("is_nth_power (numeral n::nat) (numeral x::nat)") = \<open>K Is_Nth_Power.simproc\<close>

end


(* Title:      Kleene algebra with tests
   Author:     Alasdair Armstrong, Victor B. F. Gomes, Georg Struth
   Maintainer: Georg Struth <g.struth at sheffield.ac.uk>
*)

section \<open>Propositional Hoare Logic\<close>

theory PHL_KAT
  imports KAT Kleene_Algebra.PHL_KA
begin

text \<open>We define a class of pre-dioids with notions of assertions, tests and iteration. The above rules of PHL are derivable in that class.\<close>

class at_pre_dioid = pre_dioid_one +
  fixes alpha :: "'a \<Rightarrow> 'a" ("\<alpha>")
  and tau :: "'a \<Rightarrow> 'a" ("\<tau>")
  assumes at_pres: "\<alpha> x \<cdot> \<tau> y \<le> \<tau> y \<cdot> \<alpha> x \<cdot> \<tau> y"
  and as_left_supdistl: "\<alpha> x \<cdot> (y + z) \<le> \<alpha> x \<cdot> y + \<alpha> x \<cdot> z"

begin

text \<open>Only the conditional and the iteration rule need to be considered (in addition to the export laws.
In this context, they no longer depend on external assumptions. The other ones do not depend on any assumptions anyway.\<close>

lemma at_phl_cond:
assumes "\<alpha> u \<cdot> \<tau> v \<cdot> x \<le> x \<cdot> z" and "\<alpha> u \<cdot> \<tau> w \<cdot> y \<le> y \<cdot> z"
shows "\<alpha> u \<cdot> (\<tau> v \<cdot> x + \<tau> w \<cdot> y) \<le> (\<tau> v \<cdot> x + \<tau> w \<cdot> y) \<cdot> z"
  using assms as_left_supdistl at_pres phl_cond by blast

lemma ht_at_phl_cond:
assumes "\<lbrace>\<alpha> u \<cdot> \<tau> v\<rbrace> x \<lbrace>z\<rbrace>" and "\<lbrace>\<alpha> u \<cdot> \<tau> w\<rbrace> y \<lbrace>z\<rbrace>"
shows "\<lbrace>\<alpha> u\<rbrace> (\<tau> v \<cdot> x + \<tau> w \<cdot> y) \<lbrace>z\<rbrace>"
  using assms by (fact at_phl_cond)

lemma  ht_at_phl_export1:
assumes "\<lbrace>\<alpha> x \<cdot> \<tau> y\<rbrace> z \<lbrace>w\<rbrace>"
shows "\<lbrace>\<alpha> x\<rbrace> \<tau> y \<cdot> z \<lbrace>w\<rbrace>"
  by (simp add: assms at_pres ht_phl_export1)

lemma ht_at_phl_export2:
assumes "\<lbrace>x\<rbrace> y \<lbrace>\<alpha> z\<rbrace>"
shows "\<lbrace>x\<rbrace> y \<cdot> \<tau> w \<lbrace>\<alpha> z \<cdot> \<tau> w\<rbrace>"
  using assms at_pres ht_phl_export2 by auto

end

class at_it_pre_dioid = at_pre_dioid + it_pre_dioid
begin

lemma at_phl_while:
assumes "\<alpha> p \<cdot> \<tau> s \<cdot> x \<le> x \<cdot> \<alpha> p"
shows "\<alpha> p \<cdot> (it (\<tau> s \<cdot> x) \<cdot> \<tau> w)  \<le> it (\<tau> s \<cdot> x) \<cdot> \<tau> w \<cdot> (\<alpha> p \<cdot> \<tau> w)"
  by (simp add: assms at_pres it_simr phl_while)

lemma ht_at_phl_while:
assumes "\<lbrace>\<alpha> p \<cdot> \<tau> s\<rbrace> x \<lbrace>\<alpha> p\<rbrace>"
shows "\<lbrace>\<alpha> p\<rbrace> it (\<tau> s \<cdot> x) \<cdot> \<tau> w \<lbrace>\<alpha> p \<cdot> \<tau> w\<rbrace>"
  using assms by (fact at_phl_while)

end

text \<open>The following statements show that pre-Conway algebras, Kleene algebras with tests
and demonic refinement algebras form pre-dioids with test and assertions. This automatically
generates propositional Hoare logics for these structures.\<close>

sublocale test_pre_dioid_zerol < phl: at_pre_dioid where alpha = t and tau = t
proof
  show "\<And>x y. t x \<cdot> t y \<le> t y \<cdot> t x \<cdot> t y"
    by (simp add: n_mult_comm mult_assoc)
  show "\<And>x y z. t x \<cdot> (y + z) \<le> t x \<cdot> y + t x \<cdot> z"
    by (simp add: n_left_distrib)
qed

sublocale test_pre_conway < phl: at_it_pre_dioid where alpha = t and tau = t and it = dagger ..

sublocale kat_zerol < phl: at_it_pre_dioid where alpha = t and tau = t and it = star ..

context test_pre_dioid_zerol begin

abbreviation if_then_else :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" ("if _ then _ else _ fi" [64,64,64] 63) where
  "if p then x else y fi \<equiv> (p \<cdot> x + !p \<cdot> y)"

lemma phl_n_cond:
  "\<lbrace>n v \<cdot> n w\<rbrace> x \<lbrace>z\<rbrace> \<Longrightarrow> \<lbrace>n v \<cdot> t w\<rbrace> y \<lbrace>z\<rbrace> \<Longrightarrow> \<lbrace>n v\<rbrace> n w \<cdot> x + t w \<cdot> y \<lbrace>z\<rbrace>"
  by (metis phl.ht_at_phl_cond t_n_closed)

lemma phl_test_cond:
  assumes "test p" and "test b"
  and "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>q\<rbrace>" and "\<lbrace>p \<cdot> !b\<rbrace> y \<lbrace>q\<rbrace>"
  shows "\<lbrace>p\<rbrace> b \<cdot> x + !b \<cdot> y \<lbrace>q\<rbrace>"
  by (metis assms local.test_double_comp_var phl_n_cond)

lemma phl_cond_syntax:
  assumes "test p" and "test b"
  and "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>q\<rbrace>" and "\<lbrace>p \<cdot> !b\<rbrace> y \<lbrace>q\<rbrace>"
  shows "\<lbrace>p\<rbrace> if b then x else y fi \<lbrace>q\<rbrace>"
  using assms by (fact phl_test_cond)

lemma phl_cond_syntax_iff:
  assumes "test p" and "test b"
  shows "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>q\<rbrace> \<and> \<lbrace>p \<cdot> !b\<rbrace> y \<lbrace>q\<rbrace> \<longleftrightarrow> \<lbrace>p\<rbrace> if b then x else y fi \<lbrace>q\<rbrace>"
proof
  assume a: "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>q\<rbrace> \<and> \<lbrace>p \<cdot> !b\<rbrace> y \<lbrace>q\<rbrace>"
  show "\<lbrace>p\<rbrace> if b then x else y fi \<lbrace>q\<rbrace>"
    using a assms(1) assms(2) phl_test_cond by auto
next
  assume a: "\<lbrace>p\<rbrace> if b then x else y fi \<lbrace>q\<rbrace>"
  have "p \<cdot> b \<cdot> x \<le> b \<cdot> p \<cdot> (b \<cdot> x + !b \<cdot> y)"
    by (metis assms(1) assms(2) local.mult.assoc local.subdistl local.test_preserve)
  also have "... \<le> b \<cdot> (b \<cdot> x + !b \<cdot> y) \<cdot> q"
    using a local.mult_isol mult_assoc by auto
  also have "...  = (b \<cdot> b \<cdot> x + b \<cdot> !b \<cdot> y) \<cdot> q"
    using assms(2) local.n_left_distrib_var mult_assoc by presburger
  also have "... = b \<cdot> x \<cdot> q"
    by (simp add: assms(2))
  finally have b: "p \<cdot> b \<cdot> x \<le> x \<cdot> q"
    by (metis assms(2) local.order_trans local.test_restrictl mult_assoc)
  have "p \<cdot> !b \<cdot> y = !b \<cdot> p \<cdot> !b \<cdot> y"
    by (simp add: assms(1) assms(2) local.test_preserve)
  also have "... \<le> !b \<cdot> p \<cdot> (b \<cdot> x + !b \<cdot> y)"
    by (simp add: local.mult_isol mult_assoc)
  also have "... \<le> !b \<cdot> (b \<cdot> x + !b \<cdot> y) \<cdot> q"
    using a local.mult_isol mult_assoc by auto
  also have "... = (!b \<cdot> b \<cdot> x + !b \<cdot> !b \<cdot> y) \<cdot> q"
    using local.n_left_distrib mult_assoc by presburger
  also have "... = !b \<cdot> y \<cdot> q"
    by (simp add: assms(2))
  finally have c: "p \<cdot> !b \<cdot> y \<le> y \<cdot> q"
    by (metis local.dual_order.trans local.n_restrictl mult_assoc)
  show "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>q\<rbrace> \<and> \<lbrace>p \<cdot> !b\<rbrace> y \<lbrace>q\<rbrace>"
    using b c by auto
qed

end

context test_pre_conway
begin

lemma  phl_n_while:
  assumes "\<lbrace>n x \<cdot>  n y\<rbrace> z \<lbrace>n x\<rbrace>"
  shows "\<lbrace>n x\<rbrace> (n y \<cdot> z)\<^sup>\<dagger> \<cdot> t y \<lbrace>n x \<cdot> t y\<rbrace>"
  by (metis assms phl.ht_at_phl_while t_n_closed)

end

context kat_zerol
begin

abbreviation while :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" ("while _ do _ od" [64,64] 63) where
  "while b do x od \<equiv> (b \<cdot> x)\<^sup>\<star> \<cdot> !b"

lemma  phl_n_while:
  assumes "\<lbrace>n x \<cdot>  n y\<rbrace> z \<lbrace>n x\<rbrace>"
  shows "\<lbrace>n x\<rbrace> (n y \<cdot> z)\<^sup>\<star> \<cdot> t y \<lbrace>n x \<cdot> t y\<rbrace>"
  by (metis assms phl.ht_at_phl_while t_n_closed)

lemma phl_test_while:
  assumes "test p" and "test b"
  and "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>p\<rbrace>"
  shows "\<lbrace>p\<rbrace> (b \<cdot> x)\<^sup>\<star> \<cdot> !b \<lbrace>p \<cdot> !b\<rbrace>"
  by (metis assms phl_n_while test_double_comp_var)

lemma phl_while_syntax:
  assumes "test p" and "test b" and "\<lbrace>p \<cdot> b\<rbrace> x \<lbrace>p\<rbrace>"
  shows "\<lbrace>p\<rbrace> while b do x od \<lbrace>p \<cdot> !b\<rbrace>"
  by (metis assms phl_test_while)

end

lemma (in kat) "test p \<Longrightarrow> p \<cdot> x\<^sup>\<star> \<le> x\<^sup>\<star> \<cdot> p \<Longrightarrow> p \<cdot> x \<le> x \<cdot> p"
  oops

lemma (in kat) "test p \<Longrightarrow> test b \<Longrightarrow> p \<cdot> (b \<cdot> x)\<^sup>\<star> \<cdot> !b \<le> (b \<cdot> x)\<^sup>\<star> \<cdot> !b \<cdot> p \<cdot> !b \<Longrightarrow> p \<cdot> b \<cdot> x \<le> x \<cdot> p"
  oops

lemma (in kat) "test p \<Longrightarrow> test q \<Longrightarrow>  p \<cdot> x \<cdot> y \<le> x \<cdot> y \<cdot> q \<Longrightarrow>(\<exists>r. test r \<and> p \<cdot> x \<le> x \<cdot> r \<and> r \<cdot> y  \<le> y \<cdot> q)"
  (* nitpick *)  oops

lemma (in kat) "test p \<Longrightarrow> test q \<Longrightarrow>  p \<cdot> x \<cdot> y \<cdot> !q = 0 \<Longrightarrow>(\<exists>r. test r \<and> p \<cdot> x \<cdot> !r = 0 \<and> r \<cdot> y \<cdot> !q = 0)"
  (* nitpick *) oops

text \<open>The following facts should be moved. They show that the rules of Hoare logic based on Tarlecki triples are invertible.\<close>

abbreviation (in near_dioid) tt :: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" ("\<lparr>_\<rparr>_\<lparr>_\<rparr>") where
  "\<lparr>x\<rparr> y \<lparr>z\<rparr> \<equiv> x \<cdot> y \<le> z"

lemma (in near_dioid_one) tt_skip: "\<lparr>p\<rparr> 1 \<lparr>p\<rparr>"
  by simp

lemma (in near_dioid) tt_cons1: "(\<exists>q'. \<lparr>p\<rparr> x \<lparr>q'\<rparr> \<and> q'\<le> q) \<longleftrightarrow> \<lparr>p\<rparr> x \<lparr>q\<rparr>"
  using local.order_trans by blast

lemma (in near_dioid) tt_cons2:  "(\<exists>p'. \<lparr>p'\<rparr> x \<lparr>q\<rparr> \<and> p \<le> p') \<longleftrightarrow> \<lparr>p\<rparr> x \<lparr>q\<rparr>"
  using local.dual_order.trans local.mult_isor by blast

lemma (in near_dioid) tt_seq: "(\<exists>r. \<lparr>p\<rparr> x \<lparr>r\<rparr> \<and> \<lparr>r\<rparr> y \<lparr>q\<rparr>) \<longleftrightarrow> \<lparr>p\<rparr> x \<cdot> y \<lparr>q\<rparr>"
  by (metis local.tt_cons2 mult_assoc)

lemma (in dioid) tt_cond: "\<lparr>p \<cdot> v\<rparr> x \<lparr>q\<rparr> \<and> \<lparr>p \<cdot> w\<rparr> y \<lparr>q\<rparr> \<longleftrightarrow> \<lparr>p\<rparr> (v \<cdot> x + w \<cdot> y)\<lparr>q\<rparr>"
  by (simp add: local.distrib_left mult_assoc)

lemma (in kleene_algebra) tt_while: "w \<le> 1 \<Longrightarrow> \<lparr>p \<cdot> v\<rparr> x \<lparr>p\<rparr> \<Longrightarrow> \<lparr>p\<rparr> (v \<cdot> x)\<^sup>\<star> \<cdot> w \<lparr>p\<rparr>"
  by (metis local.star_inductr_var_equiv local.star_subid local.tt_seq local.tt_skip mult_assoc)

text \<open>The converse implication can be refuted. The situation is similar to the ht case.\<close>

lemma (in kat) tt_while: "test v \<Longrightarrow>  \<lparr>p\<rparr> (v \<cdot> x)\<^sup>\<star> \<cdot> !v \<lparr>p\<rparr> \<Longrightarrow> \<lparr>p \<cdot> v\<rparr> x \<lparr>p\<rparr>"
  (* nitpick *) oops

lemma (in kat) tt_while: "test v \<Longrightarrow>  \<lparr>p\<rparr> (v \<cdot> x)\<^sup>\<star>  \<lparr>p\<rparr> \<Longrightarrow> \<lparr>p \<cdot> v\<rparr> x \<lparr>p\<rparr>"
  using local.star_inductr_var_equiv mult_assoc by auto

text \<open>Perhaps this holds with possibly infinite loops in DRA...\<close>

text \<open>wlp in KAT\<close>

lemma (in kat) "test y \<Longrightarrow> (\<exists> z. test z \<and> z \<cdot> x \<cdot> !y = 0)"
  by (metis local.annil local.test_zero_var)

end


theory Lib
imports
  Ordinary_Differential_Equations.ODE_Analysis
begin
section \<open>Generic Mathematical Lemmas\<close>
text\<open>General lemmas that don't have anything to do with dL specifically and could be fit for
  general-purpose libraries, mostly dealing with derivatives, ODEs and vectors.\<close>

lemma vec_extensionality:"(\<And>i. v$i = w$i) \<Longrightarrow> (v = w)"
  by (simp add: vec_eq_iff)

lemma norm_axis: "norm (axis i x) = norm x"
  unfolding axis_def norm_vec_def
  unfolding L2_set_def
  by(clarsimp simp add: if_distrib[where f=norm] if_distrib[where f="\<lambda>x. x\<^sup>2"] sum.If_cases)

lemma bounded_linear_axis: "bounded_linear (axis i)"
proof
  show "axis i (x + y) = axis i x + axis i y" "axis i (r *\<^sub>R x) = r *\<^sub>R axis i x" for x y :: "'a" and r
    by (auto simp: vec_eq_iff axis_def)
  show "\<exists>K. \<forall>x::'a. norm (axis i x) \<le> norm x * K"
    by (auto simp add: norm_axis intro!: exI[of _ 1])
qed

lemma bounded_linear_vec:
  fixes f::"('a::finite) \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
  assumes bounds:"\<And>i. bounded_linear (f i)"
  shows "bounded_linear (\<lambda>x. \<chi> i. f i x)"
proof -
  let ?g = "(\<lambda>x. \<chi> i. f i x)"
  have additives:"\<And>i. Modules.additive (f i)"
    using bounds unfolding bounded_linear_def bounded_linear_axioms_def linear_def
    by (simp add: Modules.additive_def bounds linear_simps(1))
  have additive:"Modules.additive (\<lambda>x. \<chi> i. f i x)"
    using additives unfolding Modules.additive_def apply auto
    by (metis (mono_tags, lifting) Cart_lambda_cong plus_vec_def vec_lambda_beta)
  have scales:"\<And>i. (\<forall>r x. f i (r *\<^sub>R x) = r *\<^sub>R f i x)"
    using bounds unfolding bounded_linear_def bounded_linear_axioms_def linear_def linear_simps
    by (simp add: bounds linear_simps(5))
  have scale:"(\<forall>r x. ?g (r *\<^sub>R x) = r *\<^sub>R ?g x)"
    using scales
  proof -
    have f1: "\<And>v0_1 v1_0. (\<chi> a. f a (v0_1 *\<^sub>R v1_0)) = (\<chi> a. v0_1 *\<^sub>R (\<chi> a. f a v1_0) $ a)"
      using scales by force
    obtain rr :: real and bb :: 'b where
      "(\<exists>v0 v1. (\<chi> uub. f uub (v0 *\<^sub>R v1)) \<noteq> (\<chi> uub. v0 *\<^sub>R (\<chi> uua. f uua v1) $ uub)) = ((\<chi> uub. f uub (rr *\<^sub>R bb)) \<noteq> (\<chi> uub. rr *\<^sub>R (\<chi> uua. f uua bb) $ uub))"
      by blast
    then show ?thesis
      using f1 by (simp add: scaleR_vec_def)
  qed
  have norms:"\<And>i. (\<exists>K. \<forall>x. norm (f i x) \<le> norm x * K)"
    using bounds unfolding bounded_linear_def bounded_linear_axioms_def by auto
  let ?Ki = "(\<lambda>i. SOME K. \<forall>x. norm (f i x) \<le> norm x * K)"
  have each_norm:"\<And>i.  \<forall>x. norm (f i x) \<le> norm x * (?Ki i)"
    subgoal for i
      using norms someI_ex[of "(\<lambda>K.  \<forall>x. norm (f i x) \<le> norm x * K)"]
      by auto
      done
  let ?TheK = "(\<Sum> i \<in> (UNIV::'a set).?Ki i)"
  have axes:"\<And>x. (?g x) = (\<Sum> i\<in>(UNIV::'a set). (axis i (f i x)))"
    unfolding axis_def by(rule vec_extensionality, auto)
  have triangle:"\<And>x. (\<Sum> i \<in> (UNIV::'a set). norm (axis i (f i x))) \<ge> norm (\<Sum> i \<in> (UNIV::('a::finite) set). axis i (f i x))"
    using norm_sum by blast
  have triangle':"\<And>x. (\<Sum> i \<in> (UNIV::'a set). norm (f i x)) \<ge> norm (\<Sum> i \<in> (UNIV::('a::finite) set). axis i (f i x))"
    using norm_axis
    by (simp add: norm_axis Real_Vector_Spaces.sum_norm_le)
  have norms':"\<And>x. (\<Sum> i\<in> (UNIV::'a set). norm (f i x)) \<le> norm x * ?TheK"
    using norms  each_norm axes triangle'
    by (simp add: sum_mono sum_distrib_right sum_distrib_left)
  have leq:"\<And>x. norm(?g x) \<le> norm x * ?TheK" using axes triangle' norms'
    using dual_order.trans by fastforce
  have norm:"(\<exists>K. \<forall>x. norm (\<chi> i. f i x) \<le> norm x * K)"
    using leq by blast
  have linears:"\<And>i. linear (f i)"
    using bounds unfolding bounded_linear_def bounded_linear_axioms_def by auto
  have linear:"linear (\<lambda>x. \<chi> i. f i x)"
    using linears scale additive
    by (metis (mono_tags, lifting) Cart_lambda_cong Modules.additive_def linearI)
  show ?thesis
    unfolding bounded_linear_def bounded_linear_axioms_def
    using linear norm by auto
qed

lift_definition blinfun_vec::"('a::finite \<Rightarrow> 'b::real_normed_vector \<Rightarrow>\<^sub>L real) \<Rightarrow> 'b \<Rightarrow>\<^sub>L (real ^ 'a)" is "(\<lambda>(f::('a \<Rightarrow> 'b \<Rightarrow> real)) (x::'b). \<chi> (i::'a). f i x)"
  by(rule bounded_linear_vec, simp)

lemmas blinfun_vec_simps[simp] = blinfun_vec.rep_eq

lemma continuous_blinfun_vec:"(\<And>i. continuous_on UNIV (blinfun_apply (g i))) \<Longrightarrow> continuous_on UNIV (blinfun_vec g)"
  by (simp add: continuous_on_vec_lambda)

lemma blinfun_elim:"\<And>g. (blinfun_apply (blinfun_vec g)) = (\<lambda>x. \<chi> i. g i x)"
  using blinfun_vec.rep_eq by auto

lemma sup_plus:
  fixes f g::"('b::metric_space) \<Rightarrow> real"
  assumes nonempty:"R \<noteq> {}"
  assumes bddf:"bdd_above (f ` R)"
  assumes bddg:"bdd_above (g ` R)"
  shows "(SUP x \<in> R. f x  + g x) \<le> (SUP x \<in> R. f x) + (SUP x \<in> R. g x)"
proof -
  have bddfg:"bdd_above((\<lambda>x. f x + g x ) ` R)"
    using bddf bddg apply (auto simp add: bdd_above_def)
    using add_mono_thms_linordered_semiring(1) by blast
  have eq:"(Sup ( (\<lambda>x. f x + g x) ` R) \<le> (SUP x\<in>R. f x) + (SUP x\<in>R. g x)) = (\<forall>x\<in>R. (f x + g x) \<le> (SUP x\<in>R. f x) + (SUP x\<in>R. g x))"
    apply(rule cSUP_le_iff)
     subgoal by (rule nonempty)
    subgoal by (rule bddfg)
    done
  have fs:"\<And>x. x \<in> R \<Longrightarrow> f x \<le> (SUP x\<in>R. f x)"
    using bddf
    by (simp add: cSUP_upper)
  have gs:"\<And>x. x \<in> R \<Longrightarrow> g x \<le> (SUP x\<in>R. g x)"
    using bddg
    by (simp add: cSUP_upper)
  have "(\<forall>x\<in>R. (f x + g x) \<le> (SUP x\<in>R. f x) + (SUP x\<in>R. g x))"
    apply auto
    subgoal for x using fs[of x] gs[of x] by auto
    done
  then show ?thesis by (auto simp add: eq)
qed

lemma continuous_blinfun_vec':
  fixes f::"'a::{finite,linorder} \<Rightarrow> 'b::{metric_space, real_normed_vector,abs} \<Rightarrow> 'b \<Rightarrow>\<^sub>L real"
  fixes S::"'b set"
  assumes conts:"\<And>i. continuous_on UNIV (f i)"
  shows "continuous_on UNIV (\<lambda>x. blinfun_vec (\<lambda> i. f i x))"
proof (auto simp add:  LIM_def continuous_on_def)
  fix x1 and \<epsilon>::real
  assume \<epsilon>:"0 < \<epsilon>"
  let ?n = "card (UNIV::'a set)"
  have conts':" \<And>i x1 \<epsilon>. 0 < \<epsilon> \<Longrightarrow> \<exists>\<delta>>0. \<forall>x2. x2 \<noteq> x1 \<and> dist x2 x1 < \<delta> \<longrightarrow> dist (f i  x2) (f i x1) < \<epsilon>"
    using conts by(auto simp add: LIM_def continuous_on_def)
  have conts'':"\<And>i. \<exists>\<delta>>0. \<forall>x2. x2 \<noteq> x1 \<and> dist x2 x1 < \<delta> \<longrightarrow> dist (f i  x2) (f i x1) < (\<epsilon>/?n)"
    subgoal for i using conts'[of "\<epsilon> / ?n"  x1 i] \<epsilon> by auto done
  let ?f = "(\<lambda>x. blinfun_vec (\<lambda> i. f i x))"
  let ?P\<delta> = "(\<lambda> i \<delta>. (\<delta>>0 \<and> (\<forall>x2. x2 \<noteq> x1 \<and> dist x2 x1 < \<delta> \<longrightarrow> dist (f i  x2) (f i x1) < (\<epsilon>/?n))))"
  let ?\<delta>i = "(\<lambda>i. SOME \<delta>. ?P\<delta> i \<delta>)"
  have Ps:"\<And>i. \<exists>\<delta>. ?P\<delta> i \<delta>" using conts'' by auto
  have P\<delta>i:"\<And>i. ?P\<delta> i (?\<delta>i i)"
    subgoal for i using someI[of "?P\<delta> i" ] Ps[of i] by auto done
  have finU:"finite (UNIV::'a set)" by auto
  let ?\<delta> = "linorder_class.Min  (?\<delta>i ` UNIV)"
  have \<delta>0s:"\<And>i. ?\<delta>i i > 0" using P\<delta>i by blast
  then have \<delta>0s':"\<And>i. 0 < ?\<delta>i i" by auto
  have bounds:"bdd_below (?\<delta>i ` UNIV)"
    unfolding bdd_below_def
    using \<delta>0s less_eq_real_def by blast
  have \<delta>s:"\<And>i. ?\<delta> \<le> ?\<delta>i i"
    using bounds cINF_lower[of ?\<delta>i] by auto
  have finite:"finite ((?\<delta>i ` UNIV))" by auto
  have nonempty:"((?\<delta>i ` UNIV)) \<noteq> {}" by auto
  have \<delta>:"?\<delta> > 0 " using Min_gr_iff[OF finite nonempty] \<delta>0s'
    by blast
  have conts''':"\<And>i x2. x2 \<noteq> x1 \<Longrightarrow> dist x2 x1 < ?\<delta>i i \<Longrightarrow> dist (f i  x2) (f i x1) < (\<epsilon>/?n)"
    subgoal for i x2
      using conts''[of i] apply auto
      subgoal for \<delta>
        apply(erule allE[where x=x2])
        using P\<delta>i  \<delta>s[of i] apply (auto simp add: \<delta>s[of i])
        done
      done
    done
  have "\<And>x2. x2 \<noteq> x1 \<and> dist x2 x1 < ?\<delta> \<Longrightarrow> dist (blinfun_vec (\<lambda>i. f i x2)) (blinfun_vec (\<lambda>i. f i x1)) < \<epsilon>"
  proof (auto)
    fix x2
    assume ne:"x2 \<noteq> x1"
    assume dist:"\<forall>i. dist x2 x1 < ?\<delta>i i"
    have dists:"\<And>i. dist x2 x1 < ?\<delta>i i"
      subgoal for i using dist \<delta>s[of i] by auto done
    have euclid:"\<And>y. norm(?f x1 y - ?f x2 y) = (L2_set (\<lambda>i. norm(f i x1 y - f i x2 y)) UNIV)"
      by (simp add: norm_vec_def)
    have finite:"finite (UNIV::'a set)" by auto
    have nonempty: "(UNIV::'a set) \<noteq> {}" by auto
    have nonemptyB: "(UNIV::'b set) \<noteq> {}" by auto
    have nonemptyR: "(UNIV::real set) \<noteq> {}" by auto
    have SUP_leq:"\<And>f::('b \<Rightarrow> real). \<And> g::('b \<Rightarrow> real). \<And> S::'b set. S \<noteq> {} \<Longrightarrow> bdd_above (g ` S) \<Longrightarrow> (\<And>x. x \<in> (S::'b set) \<Longrightarrow> ((f x)::real) \<le> ((g x)::real)) \<Longrightarrow> (SUP x\<in>S. f x) \<le> (SUP x\<in>S. g x)"
      by(rule cSup_mono, auto)
    have SUP_sum_comm':"\<And>R S f . finite (S::'a set) \<Longrightarrow> (R::'d::metric_space set) \<noteq> {} \<Longrightarrow>
      (\<And>i x. ((f i x)::real) \<ge> 0) \<Longrightarrow>
      (\<And>i. bdd_above (f i ` R)) \<Longrightarrow>
      (SUP x\<in>R . (\<Sum>i \<in> S. f i x)) \<le> (\<Sum>i \<in> S. (SUP x\<in>R. f i x))"
    proof -
      fix  R::"'d set" and S ::"('a)set"  and f  ::"'a \<Rightarrow> 'd \<Rightarrow> real"
      assume non:"R \<noteq> {} "
      assume fin:"finite S"
      assume every:"(\<And>i x. 0 \<le> f i x)"
      assume bddF:"\<And>i. bdd_above (f i ` R)"
      then have bddF':"\<And>i. \<exists>M. \<forall>x \<in>R. f i x \<le> M "
        unfolding bdd_above_def by auto
      let ?boundP = "(\<lambda>i M. \<forall>x \<in>R. f i x \<le> M)"
      let ?bound = "(\<lambda>i::'a. SOME M. \<forall>x \<in>R. f i x \<le> M)"
      have "\<And>i. \<exists>M. ?boundP i M" using bddF' by auto
      then have each_bound:"\<And>i. ?boundP i (?bound i)"
        subgoal for i using someI[of "?boundP i"] by blast done
      let ?bigBound = "(\<lambda>F. \<Sum>i\<in>F. (?bound i))"
      have bddG:"\<And>i::'a. \<And>F. bdd_above ((\<lambda>x. \<Sum>i\<in>F. f i x) ` R)"
        subgoal for i F
          using bddF[of i] unfolding bdd_above_def apply auto
          apply(rule exI[where x="?bigBound F"])
          subgoal for M
            apply auto
            subgoal for x
              using each_bound by (simp add: sum_mono)
            done
          done
        done
      show "?thesis R S f" using fin assms
      proof (induct)
        case empty
        have "((SUP x\<in>R. \<Sum>i\<in>{}. f i x)::real) \<le> (\<Sum>i\<in>{}. SUP a\<in>R. f i a)"   by (simp add: non)
        then show ?case by auto
      next
        case (insert x F)
        have "((SUP xa\<in>R. \<Sum>i\<in>insert x F. f i xa)::real) \<le> (SUP xa\<in>R. f x xa +  (\<Sum>i\<in>F. f i xa))"
          using insert.hyps(2) by auto
        moreover have "...  \<le> (SUP xa\<in> R. f x xa) + (SUP xa\<in>R. (\<Sum>i\<in>F. f i xa))"
          by(rule sup_plus, rule non, rule bddF, rule bddG)
        moreover have "... \<le> (SUP xa\<in> R. f x xa) + (\<Sum>i\<in>F. SUP a\<in>R. f i a)"
          using add_le_cancel_left conts insert.hyps(3) by blast
        moreover have "... \<le> (\<Sum>i\<in>(insert x F). SUP a\<in>R. f i a)"
          by (simp add: insert.hyps(2))
        ultimately have "((SUP xa\<in>R. \<Sum>i\<in>insert x F. f i xa)::real) \<le> (\<Sum>i\<in>(insert x F). SUP a\<in>R. f i a)"
          by linarith
        then show ?case by auto
      qed
    qed
    have SUP_sum_comm:"\<And>R S y1 y2 . finite (S::'a set) \<Longrightarrow> (R::'b set) \<noteq> {} \<Longrightarrow> (SUP x\<in>R . (\<Sum>i \<in> S. norm(f i y1 x - f i y2 x)/norm(x))) \<le> (\<Sum>i \<in> S. (SUP x\<in>R. norm(f i y1 x - f i y2 x)/norm(x)))"
      apply(rule SUP_sum_comm')
         apply(auto)[3]
      proof (unfold bdd_above_def)
        fix R S y1 y2 i
          { fix rr :: "real \<Rightarrow> real"
            obtain bb :: "real \<Rightarrow> ('b \<Rightarrow> real) \<Rightarrow> 'b set \<Rightarrow> 'b" where
              ff1: "\<And>r f B. r \<notin> f ` B \<or> f (bb r f B) = r"
              by moura
            { assume "\<exists>r. \<not> rr r \<le> norm (f i y1 - f i y2)"
              then have "\<exists>r. norm (blinfun_apply (f i y1) (bb (rr r) (\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R) - blinfun_apply (f i y2) (bb (rr r) (\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R)) / norm (bb (rr r) (\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R) \<noteq> rr r"
                by (metis (no_types) le_norm_blinfun minus_blinfun.rep_eq)
              then have "\<exists>r. rr r \<le> r \<or> rr r \<notin> (\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R"
                using ff1 by meson }
              then have "\<exists>r. rr r \<le> r \<or> rr r \<notin> (\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R"
                by blast }
        then show "\<exists>r. \<forall>ra\<in>(\<lambda>b. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R. ra \<le> r"
          by meson
      qed
    have SUM_leq:"\<And>S::('a) set. \<And> f g ::('a \<Rightarrow> real). S \<noteq> {} \<Longrightarrow> finite S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> f x < g x) \<Longrightarrow> (\<Sum>x\<in>S. f x) < (\<Sum>x\<in>S. g x)"
      by(rule sum_strict_mono, auto)
    have L2:"\<And>f S. L2_set (\<lambda>x. norm(f x)) S \<le> (\<Sum>x \<in> S. norm(f x))"
      using L2_set_le_sum norm_ge_zero by metis
    have L2':"\<And>y. (L2_set (\<lambda>i. norm(f i x1 y - f i x2 y)) UNIV)/norm(y) \<le> (\<Sum>i\<in>UNIV. norm(f i x1 y - f i x2 y))/norm(y)"
      subgoal for y
        using L2[of "(\<lambda> x. f x x1 y - f x x2 y)" UNIV]
        by (auto simp add: divide_right_mono)
      done
    have "\<And>i. (SUP y\<in>UNIV.  norm((f i x1 - f i x2) y)/norm(y)) = norm(f i x1 - f i x2)"
      by (simp add: onorm_def norm_blinfun.rep_eq)
    then have each_norm:"\<And>i. (SUP y\<in>UNIV.  norm(f i x1 y - f i x2 y)/norm(y)) = norm(f i x1 - f i x2)"
      by (metis (no_types, lifting) SUP_cong blinfun.diff_left)
    have bounded_linear:"\<And>i. bounded_linear (\<lambda>y. f i x1 y - f i x2 y)"
      by (simp add: blinfun.bounded_linear_right bounded_linear_sub)
    have each_bound:"\<And>i. bdd_above ((\<lambda>y. norm(f i x1 y - f i x2 y)/norm(y)) ` UNIV)"
      using bounded_linear unfolding bdd_above_def
    proof -
      fix i :: 'a
      { fix rr :: "real \<Rightarrow> real"
        have "\<And>a r. norm (blinfun_apply (f a x1) r - blinfun_apply (f a x2) r) / norm r \<le> norm (f a x1 - f a x2)"
          by (metis le_norm_blinfun minus_blinfun.rep_eq)
        then have "\<And>r R. r \<notin> (\<lambda>r. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r) ` R \<or> r \<le> norm (f i x1 - f i x2)"
          by blast
        then have "\<exists>r. rr r \<le> r \<or> rr r \<notin> range (\<lambda>r. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r)"
          by blast }
      then show "\<exists>r. \<forall>ra\<in>range (\<lambda>r. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r). ra \<le> r"
        by meson
    qed
    have bdd_above:"(bdd_above ((\<lambda>y. (\<Sum>i\<in>UNIV. norm(f i x1 y - f i x2 y)/norm(y))) ` UNIV))"
      using each_bound unfolding bdd_above_def apply auto
    proof -
      assume each:"(\<And>i. \<exists>M. \<forall>x. \<bar>blinfun_apply (f i x1) x - blinfun_apply (f i x2) x\<bar> / norm x \<le> M)"
      let ?boundP = "(\<lambda>i M. \<forall>x. \<bar>blinfun_apply (f i x1) x - blinfun_apply (f i x2) x\<bar> / norm x \<le> M)"
      let ?bound = "(\<lambda>i. SOME x. ?boundP i x)"
      have bounds:"\<And>i. ?boundP i (?bound i)"
        subgoal for i using each someI[of "?boundP i"] by blast done
      let ?bigBound = "\<Sum>i\<in>(UNIV::'a set). ?bound i"
      show "\<exists>M. \<forall>x. (\<Sum>i\<in>UNIV. \<bar>blinfun_apply (f i x1) x - blinfun_apply (f i x2) x\<bar> / norm x) \<le> M"
        apply(rule exI[where x= ?bigBound])
        by(auto simp add: bounds sum_mono)
    qed
    have bdd_above:"(bdd_above ((\<lambda>y. (\<Sum>i\<in>UNIV. norm(f i x1 y - f i x2 y))/norm(y)) ` UNIV))"
      using bdd_above unfolding bdd_above_def apply auto
    proof -
      fix M :: real
      assume a1: "\<forall>x. (\<Sum>i\<in>UNIV. \<bar>blinfun_apply (f i x1) x - blinfun_apply (f i x2) x\<bar> / norm x) \<le> M"
      { fix bb :: "real \<Rightarrow> 'b"
        have "\<And>b. (\<Sum>a\<in>UNIV. \<bar>blinfun_apply (f a x1) b - blinfun_apply (f a x2) b\<bar>) / norm b \<le> M"
          using a1 by (simp add: sum_divide_distrib)
        then have "\<exists>r. (\<Sum>a\<in>UNIV. \<bar>blinfun_apply (f a x1) (bb r) - blinfun_apply (f a x2) (bb r)\<bar>) / norm (bb r) \<le> r"
          by blast }
      then show "\<exists>r. \<forall>b. (\<Sum>a\<in>UNIV. \<bar>blinfun_apply (f a x1) b - blinfun_apply (f a x2) b\<bar>) / norm b \<le> r"
        by meson
    qed
    have "dist (?f x2) (?f x1) = norm((?f x2) - (?f x1))"
      by (simp add: dist_blinfun_def)
    moreover have "... = (SUP y\<in>UNIV. norm(?f x1 y - ?f x2 y)/norm(y))"
      by (metis (no_types, lifting) SUP_cong blinfun.diff_left norm_blinfun.rep_eq norm_minus_commute onorm_def)
    moreover have "... = (SUP y\<in>UNIV. (L2_set (\<lambda>i. norm(f i x1 y - f i x2 y)) UNIV)/norm(y))"
      using  euclid by auto
    moreover have "... \<le> (SUP y\<in>UNIV. (\<Sum>i\<in>UNIV. norm(f i x1 y - f i x2 y))/norm(y))"
      using L2' SUP_cong SUP_leq bdd_above by auto
    moreover have "... = (SUP y\<in>UNIV. (\<Sum>i\<in>UNIV. norm(f i x1 y - f i x2 y)/norm(y)))"
      by (simp add: sum_divide_distrib)
    moreover have "... \<le> (\<Sum>i\<in>UNIV. (SUP y\<in>UNIV.  norm(f i x1 y - f i x2 y)/norm(y)))"
      by(rule SUP_sum_comm[OF finite  nonemptyB, of x1 x2])
    moreover have "... = (\<Sum>i\<in>UNIV. norm(f i x1 - f i x2))"
      using each_norm by simp
    moreover have "... = (\<Sum>i\<in>UNIV. dist(f i x1) (f i x2))"
      by (simp add: dist_blinfun_def)
    moreover have "... < (\<Sum>i\<in>(UNIV::'a set). \<epsilon> / ?n)"
      using conts'''[OF ne dists] using SUM_leq[OF nonempty, of "(\<lambda>i.  dist (f i x1) (f i x2))" "(\<lambda>i.  \<epsilon> / ?n)"]
      by (simp add: dist_commute)
    moreover have "... = \<epsilon>"
      by(auto)
    ultimately show "dist (?f x2) (?f x1) < \<epsilon>"
      by linarith
  qed
  then show "\<exists>s>0. \<forall>x2. x2 \<noteq> x1 \<and> dist x2 x1 < s \<longrightarrow> dist (blinfun_vec (\<lambda>i. f i x2)) (blinfun_vec (\<lambda>i. f i x1)) < \<epsilon>"
    using \<delta> by blast
qed

lemma has_derivative_vec[derivative_intros]:
  assumes "\<And>i. ((\<lambda>x. f i x) has_derivative (\<lambda>h. f' i h)) F"
  shows "((\<lambda>x. \<chi> i. f i x) has_derivative (\<lambda>h. \<chi> i. f' i h)) F"
proof -
  have *: "(\<chi> i. f i x) = (\<Sum>i\<in>UNIV. axis i (f i x))" "(\<chi> i. f' i x) = (\<Sum>i\<in>UNIV. axis i (f' i x))" for x
    by (simp_all add: axis_def sum.If_cases vec_eq_iff)
  show ?thesis
    unfolding *
    by (intro has_derivative_sum bounded_linear.has_derivative[OF bounded_linear_axis] assms)
qed

lemma has_derivative_proj:
  fixes j::"('a::finite)"
  fixes f::"'a \<Rightarrow> real \<Rightarrow> real"
  assumes assm:"((\<lambda>x. \<chi> i. f i x) has_derivative (\<lambda>h. \<chi> i. f' i h)) F"
  shows "((\<lambda>x. f j x) has_derivative (\<lambda>h. f' j h)) F"
proof -
  have bounded_proj:"bounded_linear (\<lambda> x::(real^'a). x $ j)"
    by (simp add: bounded_linear_vec_nth)
  show "?thesis"
    using bounded_linear.has_derivative[OF bounded_proj, of "(\<lambda>x. \<chi> i. f i x)" "(\<lambda>h. \<chi> i. f' i h)", OF assm]
    by auto
qed

lemma has_derivative_proj':
  fixes i::"'a::finite"
  shows "\<forall>x. ((\<lambda> x. x $ i) has_derivative (\<lambda>x::(real^'a). x $ i)) (at x)"
proof -
  have bounded_proj:"bounded_linear (\<lambda> x::(real^'a). x $ i)"
    by (simp add: bounded_linear_vec_nth)
  show "?thesis"
    using bounded_proj unfolding has_derivative_def by auto
qed

lemma has_vector_derivative_zero_constant:
  assumes "convex s"
  assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_vector_derivative 0) (at x within s)"
  obtains c where "\<And>x. x \<in> s \<Longrightarrow> f x = c"
  using has_derivative_zero_constant[of s f] assms
  by (auto simp: has_vector_derivative_def)

lemma constant_when_zero:
  fixes v::"real \<Rightarrow> (real, 'i::finite) vec"
  assumes x0: "(v t0) $ i = x0"
  assumes sol: "(v solves_ode f) T S"
  assumes f0: "\<And>s x. s \<in> T \<Longrightarrow> f s x $ i = 0"
  assumes t0:"t0 \<in> T"
  assumes t:"t \<in> T"
  assumes convex:"convex T"
  shows "v t $ i = x0"
proof -
  from solves_odeD[OF sol]
  have deriv: "(v has_vderiv_on (\<lambda>t. f t (v t))) T" by simp
  then have "((\<lambda>t. v t $ i) has_vderiv_on (\<lambda>t. 0)) T"
    using f0
    by (auto simp: has_vderiv_on_def has_vector_derivative_def cart_eq_inner_axis
      intro!: derivative_eq_intros)
  from has_vderiv_on_zero_constant[OF convex this]
  obtain c where c:"\<And>x. x \<in> T \<Longrightarrow> v x $ i = c" by blast
  with x0 have "c = x0" "v t $ i = c"
    using t t0 c x0 by blast+
  then show ?thesis by simp
qed

lemma
  solves_ode_subset:
  assumes x: "(x solves_ode f) T X"
  assumes s: "S \<subseteq> T"
  shows "(x solves_ode f) S X"
  apply(rule solves_odeI)
   using has_vderiv_on_subset s solves_ode_vderivD x apply force
  using assms by (auto intro!: solves_odeI dest!: solves_ode_domainD)

lemma
  solves_ode_supset_range:
  assumes x: "(x solves_ode f) T X"
  assumes y: "X \<subseteq> Y"
  shows "(x solves_ode f) T Y"
  apply(rule solves_odeI)
   using has_vderiv_on_subset y solves_ode_vderivD x apply force
  using assms by (auto intro!: solves_odeI dest!: solves_ode_domainD)

lemma
  usolves_ode_subset:
  assumes x: "(x usolves_ode f from t0) T X"
  assumes s: "S \<subseteq> T"
  assumes t0: "t0 \<in> S"
  assumes S: "is_interval S"
  shows "(x usolves_ode f from t0) S X"
proof (rule usolves_odeI)
  note usolves_odeD[OF x]
  show "(x solves_ode f) S X" by (rule solves_ode_subset; fact)
  show "t0 \<in> S" "is_interval S" by(fact+)
  fix z t
  assume s: "{t0 -- t} \<subseteq> S" and z: "(z solves_ode f) {t0 -- t} X" and z0: "z t0 = x t0"
  then have "t0 \<in> {t0 -- t}" "is_interval {t0 -- t}"
    by auto
  moreover note s
  moreover have "(z solves_ode f) {t0--t} X"
    using solves_odeD[OF z] \<open>S \<subseteq> T\<close>
    by (intro solves_ode_subset_range[OF z]) force
  moreover note z0
  moreover have "t \<in> {t0 -- t}" by simp
  ultimately show "z t = x t"
    by (meson \<open>\<And>z ta T'. \<lbrakk>t0 \<in> T'; is_interval T'; T' \<subseteq> T; (z solves_ode f) T' X; z t0 = x t0; ta \<in> T'\<rbrakk> \<Longrightarrow> z ta = x ta\<close> assms(2) dual_order.trans)
qed

\<comment> \<open>Example of using lemmas above to show a lemma that could be useful for dL: The constant ODE\<close>
\<comment> \<open>0 does not change the state.\<close>
lemma example:
  fixes x t::real and i::"('sz::finite)"
  assumes "t > 0"
  shows "x = (ll_on_open.flow UNIV (\<lambda>t. \<lambda>x. \<chi> (i::('sz::finite)). 0) UNIV 0 (\<chi> i. x) t) $ i"
proof -
  let ?T = UNIV
  let ?f = "(\<lambda>t. \<lambda>x. \<chi> i::('sz::finite). 0)"
  let ?X = UNIV
  let ?t0.0 = 0
  let ?x0.0 = "\<chi> i::('sz::finite). x"
  interpret ll: ll_on_open "UNIV" "(\<lambda>t x. \<chi> i::('sz::finite). 0)" UNIV
    apply unfold_locales
    using gt_ex local_lipschitz_constI
    using interval_def continuous_on_def local_lipschitz_def
    by (blast, (simp add: local_lipschitz_constI)+)
  have foo1:"?t0.0 \<in> ?T" by auto
  have foo2:"?x0.0 \<in> ?X" by auto
  let ?v = "ll.flow  ?t0.0 ?x0.0"
  from ll.flow_solves_ode[OF foo1 foo2]
  have solves:"(ll.flow  ?t0.0 ?x0.0 solves_ode ?f) (ll.existence_ivl  ?t0.0 ?x0.0) ?X"  by (auto)
  then have solves:"(?v solves_ode ?f) (ll.existence_ivl  ?t0.0 ?x0.0) ?X" by auto
  have thex0: "(?v ?t0.0) $ (i::('sz::finite)) = x" by auto
  have sol_help: "(?v solves_ode ?f) (ll.existence_ivl  ?t0.0 ?x0.0) ?X" using solves by auto
  have ivl:"ll.existence_ivl ?t0.0 ?x0.0 = UNIV"
    by (rule ll.existence_ivl_eq_domain)
       (auto intro!: exI[where x=0] simp: vec_eq_iff)
  have sol: "(?v solves_ode ?f) UNIV ?X" using solves ivl by auto
  have thef0: "\<And>t x. ?f t x $ i = 0" by auto
  from constant_when_zero [OF thex0 sol thef0]
  have "?v t $ i = x"
    by auto
  thus ?thesis by auto
 qed

lemma MVT_ivl:
  fixes f::"'a::ordered_euclidean_space\<Rightarrow>'b::ordered_euclidean_space"
  assumes fderiv: "\<And>x. x \<in> D \<Longrightarrow> (f has_derivative J x) (at x within D)"
  assumes J_ivl: "\<And>x. x \<in> D \<Longrightarrow> J x u \<ge> J0"
  assumes line_in: "\<And>x. x \<in> {0..1} \<Longrightarrow> a + x *\<^sub>R u \<in> D"
  shows "f (a + u) - f a \<ge> J0"
proof -
  from MVT_corrected[OF fderiv line_in] obtain t where
    t: "t\<in>Basis \<rightarrow> {0<..<1}" and
    mvt: "f (a + u) - f a = (\<Sum>i\<in>Basis. (J (a + t i *\<^sub>R u) u \<bullet> i) *\<^sub>R i)"
    by auto
  note mvt
  also have "\<dots> \<ge> J0"
  proof -
    have J: "\<And>i. i \<in> Basis \<Longrightarrow> J0 \<le> J (a + t i *\<^sub>R u) u"
      using J_ivl t line_in by (auto simp: Pi_iff)
    show ?thesis
      using J
      unfolding atLeastAtMost_iff eucl_le[where 'a='b]
      by auto
  qed
  finally show ?thesis .
qed

lemma MVT_ivl':
  fixes f::"'a::ordered_euclidean_space\<Rightarrow>'b::ordered_euclidean_space"
  assumes fderiv: "(\<And>x. x \<in> D \<Longrightarrow> (f has_derivative J x) (at x within D))"
  assumes J_ivl: "\<And>x. x \<in> D \<Longrightarrow> J x (a - b) \<ge> J0"
  assumes line_in: "\<And>x. x \<in> {0..1} \<Longrightarrow> b + x *\<^sub>R (a - b) \<in> D"
  shows "f a \<ge> f b + J0"
proof -
  have "f (b + (a - b)) - f b \<ge> J0"
    apply (rule MVT_ivl[OF fderiv ])
      apply assumption
     apply (rule J_ivl) apply assumption
    using line_in
    apply (auto simp: diff_le_eq le_diff_eq ac_simps)
    done
  thus ?thesis
    by (auto simp: diff_le_eq le_diff_eq ac_simps)
qed
end


theory RecursiveVDMMap
imports VDMToolkit
begin

text \<open>
  \begin{vdmsl}
    sum_elems: map nat to nat -> nat
    sum_elems(m) ==
      if m = {|->} then 0 else
        let d in set dom m in m(d) + sum_elems({d}<-:m)
	  --@IsaMeasure( { ({d} <-: m, m) | m : map nat to nat, d: nat & m <> {} and d in set dom m } )
    --@Witness({ 1 |-> 1 })
    measure card dom m;
  \end{vdmsl}\<close>

definition
  pre_sum_elems :: \<open>(VDMNat \<rightharpoonup> VDMNat) \<Rightarrow> \<bool>\<close>
  where
  \<open>pre_sum_elems m \<equiv> inv_Map inv_VDMNat inv_VDMNat m\<close>

lemmas pre_sum_elems_defs = pre_sum_elems_def inv_Map_defs inv_VDMNat_def

function (domintros)
  sum_elems :: \<open>(VDMNat \<rightharpoonup> VDMNat) \<Rightarrow> VDMNat\<close>
  where
  \<open>sum_elems m =
      (if pre_sum_elems m then
          (if m = Map.empty then
            0
          else
            let d = (SOME e . e \<in> dom m) in the(m d) + (sum_elems ({d} -\<triangleleft> m))
          )
       else
          undefined
      )
  \<close>
  by (pat_completeness, auto)

abbreviation
  sum_elems_wf :: \<open>((VDMNat \<rightharpoonup> VDMNat) \<times> (VDMNat \<rightharpoonup> VDMNat)) VDMSet\<close>
  where
  \<open>sum_elems_wf \<equiv> { (({d} -\<triangleleft> m), m) | m d . m \<noteq> Map.empty \<and> d \<in> dom m \<and> pre_sum_elems m }\<close>

lemma l_sum_elems_wf: "wf sum_elems_wf"
  thm wf_measure[of \<open>\<lambda> m . card (dom m)\<close>, THEN wf_subset]
  apply (rule wf_measure[of \<open>\<lambda> m . card (dom m)\<close>, THEN wf_subset])
  apply (simp add: measure_def inv_image_def less_than_def less_eq)
  apply (rule subsetI, simp add: case_prod_beta)
  apply (elim exE conjE)
  by (simp add: l_VDMMap_filtering_card pre_sum_elems_defs)

lemma l_sum_elems_wf_valid: "sum_elems_wf \<noteq> {}"
  apply safe
  apply (erule equalityE)
  apply (simp add: subset_eq)
  text \<open>This will require the user to define a @Witness in VDM.\<close>
  apply (erule_tac x=\<open>[1 \<mapsto> 1]\<close> in allE)
  by (simp add: pre_sum_elems_defs)

lemma l_pre_sum_elems_sum_elems_wf:
  "pre_sum_elems m \<Longrightarrow> m \<noteq> Map.empty \<Longrightarrow> ({(SOME e. e \<in> dom m)} -\<triangleleft> m, m) \<in> sum_elems_wf"
  apply (simp add: pre_sum_elems_defs)
  by (metis domIff empty_iff some_in_eq)

termination
  apply (rule "termination"[OF l_sum_elems_wf])
  using l_pre_sum_elems_sum_elems_wf by presburger

end


theory WaypointManagerFunSpec imports
Main
Sublist
"~~/src/HOL/Library/Multiset"
begin

locale WaypointManager =
  fixes get_number :: "'w \<Rightarrow> 'id"
  fixes get_nextwp :: "'w \<Rightarrow> 'id"
  fixes update_nextwp :: "'w \<Rightarrow> 'id \<Rightarrow> 'w"
  assumes correct_update1[simp,intro]:"get_nextwp (update_nextwp w i) = i"
  and correct_update2[simp,intro]:"get_number (update_nextwp w i) = get_number w"
  and correct_update3[simp,intro]:"get_nextwp w = i \<Longrightarrow> w = update_nextwp w i"

context WaypointManager begin

(* FUNSPEC(find_wp): Find a waypoint in a list of waypoints by its number. This is how we
   notionally expect the find_wp function to work. *)
definition find_waypoint :: "'w list \<Rightarrow> 'id \<Rightarrow> 'w option" where
"find_waypoint ws i \<equiv> List.find (\<lambda> w. get_number w = i) ws"

(* Extending the waypoint list by an uninteresting waypoint preserve find_waypoint failure. *)
lemma find_waypoint_none_extend:
"None = find_waypoint ws i \<Longrightarrow> get_number w \<noteq> i  \<Longrightarrow> None = find_waypoint (ws @[w]) i"
  apply(induct ws) using find_waypoint_def by auto

(* Extending the waypoint list by any waypoint preserves find_waypoint success. *)
lemma find_waypoint_none_extend_some:
"None = find_waypoint ws i \<Longrightarrow> get_number w = i \<Longrightarrow> Some w = find_waypoint (ws @[w]) i"
  apply(induct ws) using find_waypoint_def by auto

(* Lift find_waypoint properties to a nice FOL formula. *)
lemma find_waypoint_succuss:
  "Some w = find_waypoint ws i \<Longrightarrow> \<exists> j. j < length ws \<and> w = ws ! j \<and> i = get_number w"
  apply(induct ws)
   apply (simp add: find_waypoint_def)
    by (metis (mono_tags, lifting) find_Some_iff find_waypoint_def)

(* Lift find_waypoint properties to a nice FOL formula. *)
lemma find_waypoint_failure_not_equal_all_elems:
  "None = find_waypoint ws n \<Longrightarrow> \<forall> i < length ws. get_number (ws ! i) \<noteq> n"
proof(induct ws)
  case Nil
  then show ?case by auto
next
  case (Cons a ws)
  then have "None = find_waypoint ws n \<and> get_number a \<noteq> n"
    by (metis (mono_tags) find_waypoint_def find.simps(2) option.distinct(1))
  then show ?case
    using Cons by (metis Suc_less_eq gr0_conv_Suc length_Cons not_gr_zero nth_Cons_0 nth_Cons_Suc)
qed

(* If a list L1 is a prefix of another L2, that list can be extended by some other list such
   that it results L2. *)
lemma prefix_ident: "prefix ws' ws \<Longrightarrow> \<exists> ws1. ws = ws'@ws1"
apply (induct ws' arbitrary: ws) using prefix_def by blast+

(* If a waypoint is found in a prefix L1 the same waypoint will be found in L2. *)
lemma find_waypoint_ignores_dup_matches:
  "prefix ws' ws \<Longrightarrow> Some w = find_waypoint ws' n \<Longrightarrow> Some w = find_waypoint ws n"
proof(induct ws' arbitrary: ws)
  case Nil
  then show ?case using find_waypoint_def by auto
next
  case (Cons w' ws'')
  then obtain ws1 where y1:"ws = w' # ws'' @ ws1" by (metis append_Cons prefix_ident Cons)
  thus ?case using Cons y1 by (metis Sublist.Cons_prefix_Cons find.simps(2) find_waypoint_def)
qed

(* A condition ensure the first waypoint in the list is always found. *)
lemma find_waypoint_next_is_match:
assumes a1:"Some w = find_waypoint ws (get_number (ws ! j))"
and  a2:"None = find_waypoint (take j ws) (get_number (ws ! j))"
and a3:"j < length ws"
shows "ws ! j  = w"
proof -
  have "prefix (take j ws) ws" using take_is_prefix by blast
  then have y2:"Some w = find_waypoint (take j ws @ [ws ! j]) (get_number (ws ! j))"
    by (metis (no_types, lifting) a2  find_waypoint_none_extend_some
        a1 a3 find_waypoint_ignores_dup_matches hd_drop_conv_nth take_hd_drop take_is_prefix)
  thus ?thesis by (metis find_waypoint_none_extend_some a2 option.inject)
qed

(* A successful find returns something sensible. *)
lemma find_waypoint_success_id:"Some w = find_waypoint ws i \<Longrightarrow> get_number w = i"
  apply(induct ws arbitrary: w)
  apply (simp add: find_waypoint_def)
  using find_waypoint_succuss by blast

(* If we find a waypoint then there is a prefix where we cant find the waypoint. *)
lemma find_waypoint_success_construction:
  "Some w = find_waypoint ws i \<Longrightarrow> (\<exists> ws' ws''. ws'@ w # ws'' = ws \<and> None = find_waypoint ws' i)"
proof(induct ws arbitrary: w i)
  case Nil
  then show ?case by (simp add: find_waypoint_def)
next
  case (Cons a ws)
  then have "a = w \<or> a \<noteq> w" by auto
  thus ?case
  proof
    assume "a = w"
    thus ?case using Cons find_waypoint_def by fastforce
  next
    assume "a \<noteq> w"
    thus ?case using Cons find_waypoint_def by (metis append_Cons find.simps(2) option.inject)
  qed
qed

(* Alternate formalization that find_waypoint is a function. *)
lemma find_waypoint_disaggree_absurd:
  "None = find_waypoint ws i \<Longrightarrow> Some w = find_waypoint ws i \<Longrightarrow> False" by auto

(* Whatever find_waypoints finds is in the list. *)
lemma find_waypoint_success_membership:"Some w = find_waypoint ws i \<Longrightarrow> List.member ws w"
  using WaypointManager.find_waypoint_success_construction in_set_member WaypointManager_axioms
  by fastforce

(* If a waypoint is found it's id exists in the multiset of all waypoint id's in the
 * waypoint list. *)
lemma find_waypoint_success_mset_membership:
  "Some w = find_waypoint ws i \<Longrightarrow> (get_number w) \<in># mset (map get_number ws)"
  apply(induct ws arbitrary: i w)
    apply (auto simp add: find_waypoint_def)
     by (metis find_Some_iff option.inject)

lemma find_waypoint_success_set_membership:
  "Some w = find_waypoint ws i \<Longrightarrow> (get_number w) \<in> set (map get_number ws)"
  apply(induct ws arbitrary: i w)
    apply (auto simp add: find_waypoint_def)
     by (metis  option.inject)

(* Find waypoint returns a waypoint with the proper id. *)
lemma find_waypoint_correct:"find_waypoint ws i = Some w \<Longrightarrow> get_number w = i"
  apply(induct ws)
   apply (simp add: find_waypoint_def)
  by (metis find_waypoint_success_id)

(* If a waypoint can be founnd, the waypoint can still be found in an extend waypoint list. *)
lemma find_waypoint_extend:"find_waypoint ws i = Some w \<Longrightarrow> \<exists> w'. find_waypoint (a#ws) i = Some w'"
  by (simp add: find_waypoint_def)

(* Well-formed waypoint lists: The next waypoint for all waypoints must be findable in the list. *)
definition waypoints_wf where
  "waypoints_wf ws \<equiv>
  (\<forall> w'. List.member ws w' \<longrightarrow> (\<exists> w. Some w = find_waypoint ws (get_nextwp w')))"

(* A lemma exposing the details of the waypoints_wf definition. *)
lemma waypoints_wf_result:
  "waypoints_wf ws \<Longrightarrow> List.member ws w' \<Longrightarrow> (\<exists> w. Some w = find_waypoint ws (get_nextwp w'))"
  using waypoints_wf_def by auto

(* Some odd behavior:
  - By definition of this function, cycles in the incoming 'w list will be unrolled in the output
    window. This means that there may be multiple waypoints in the same window with the same number.
    Thus we cannot demand wellformed windows have the property:
      (\<forall> w'. List.member (tl ws) w' \<longrightarrow>  (\<exists> w. Some w' = find_waypoint ws (get_nextwp w)))
*)

(* Create a waypoint list segment of some specificied size n by follow the waypoint next id
 * n times. *)
fun waypoints_window_aux :: "'w list \<Rightarrow> 'id \<Rightarrow> nat \<Rightarrow> ('w list) option" where
"waypoints_window_aux ws i 0 = None"
|"waypoints_window_aux ws i (Suc 0) =
  (case find_waypoint ws i of
    None \<Rightarrow> None
    | Some w \<Rightarrow> Some [w])"
|"waypoints_window_aux ws i (Suc (Suc n)) =
  (case find_waypoint ws i of
    None \<Rightarrow> None
    | Some w \<Rightarrow>
          (case waypoints_window_aux ws (get_nextwp w) (Suc n) of
            None \<Rightarrow> None
            | Some win \<Rightarrow> Some (w # win)))"

(* The head of the segment corresponds to the return value of a particular invocation of
 * find_waypoint. *)
lemma waypoint_window_aux_find_waypoint_hd:
 "waypoints_window_aux ws i len = Some win \<Longrightarrow> Some (hd (win)) = find_waypoint ws i"
  apply (induct rule:waypoints_window_aux.induct)
    by (auto split: option.splits)

(* If we get a segment then it has at least one waypoint in it. *)
lemma  waypoint_window_aux_success_len_nonzero:
 "waypoints_window_aux ws i len = Some win \<Longrightarrow> 0 < len"
  apply (induct len)
  by (auto split: option.splits)

(* Waypoint list will never be empty. *)
lemma waypoint_window_aux_success_len_nonempty:
  assumes a:"waypoints_window_aux ws i len = Some []" shows " False"
  apply(cases rule:waypoints_window_aux.elims[OF a])
  by (auto split: option.splits)

(* Unroll the head of segments of size two or greater. *)
lemma waypoints_window_aux_success_more_than_one:
  "waypoints_window_aux ws i (Suc (Suc n)) = Some win \<Longrightarrow>
    find_waypoint ws i = Some (hd win)
    \<and> waypoints_window_aux ws (get_nextwp (hd win)) (Suc n) = Some (tl win)"
  apply(cases rule:waypoints_window_aux.elims)
  by (auto split:option.splits)

(* Successful segment with size of one. *)
lemma waypoints_window_aux_success_just_one:
  "waypoints_window_aux ws i (Suc 0) = Some win \<Longrightarrow> \<exists> w. find_waypoint ws i = Some w \<and> win = [w]"
  apply(cases rule:waypoints_window_aux.elims)
  by (auto split:option.splits)

(* Succesful segment has exactly it's specificied length. *)
lemma waypoints_window_aux_success_length:
  "waypoints_window_aux ws i len = Some win \<Longrightarrow> length win = len"
proof (induct len arbitrary:i win)
  case 0
  then show ?case by auto
next
  case (Suc len)
  have "0 = len \<or> 0 < len" by auto
  thus ?case
  proof
    assume y1:"0 = len"
    then have y2:"waypoints_window_aux ws i (Suc 0) = Some win" using Suc by auto
    obtain w where "win = [w]" using waypoints_window_aux_success_just_one[OF y2] by auto
    thus ?case using y1 by simp
  next
    assume y1:"0 < len"
    then obtain len' where y2:"len = Suc len'"
      using gr0_implies_Suc by blast
    then have y3:"find_waypoint ws i = Some (hd win)
      \<and> waypoints_window_aux ws (get_nextwp (hd win)) (Suc len') = Some (tl win)"
      using waypoints_window_aux_success_more_than_one Suc by blast
    then have "length (tl win) = len" using Suc y2 by blast
    thus ?case using y3 y1 by auto
  qed
qed

(* We can find all next waypoint id's from a segment in its constructing waypoint list. *)
lemma waypoint_window_aux_nextwp:
"waypoints_window_aux ws i len = Some win \<Longrightarrow>
  \<forall> j < len.  (0 < j \<longrightarrow> Some (win ! j) = find_waypoint ws (get_nextwp (win ! (j - 1))))
   \<and> (j = 0 \<longrightarrow> Some (win ! j) = find_waypoint ws i)"
proof (induct len arbitrary: i win)
  case 0
  then show ?case by auto
next
  case (Suc len)
  then have "len = 0 \<or> 0 < len" by auto
  thus ?case
  proof
    assume "len = 0"
    thus ?case using Suc
      by (metis One_nat_def hd_conv_nth less_numeral_extra(3) less_one
          waypoint_window_aux_find_waypoint_hd waypoint_window_aux_success_len_nonempty)
  next
    assume y1:"0 < len"
    then obtain n where y2:"Suc len = Suc (Suc n)"  using gr0_conv_Suc by auto
    then have y3:"find_waypoint ws i = Some (hd win)
      \<and> waypoints_window_aux ws (get_nextwp (hd win)) len = Some (tl win)"
      using Suc waypoints_window_aux_success_more_than_one by blast
    then have y4:"find_waypoint ws i = Some (hd win)" and
              y5:"waypoints_window_aux ws (get_nextwp (hd win)) len = Some (tl win)"  by auto
    then have y6:
      "\<forall>j<len. (0 < j \<longrightarrow> Some (tl win ! j) =
          find_waypoint ws (get_nextwp (tl win ! (j - 1))))
       \<and> (j = 0 \<longrightarrow> Some (tl win ! j) = find_waypoint ws (get_nextwp (hd win)))"
      using Suc(1)[OF y5] by auto
    then have y7:"\<forall>j< Suc len. (j = 0 \<longrightarrow> Some (win ! j) = find_waypoint ws i)"
      by (metis Suc.prems WaypointManager.waypoint_window_aux_success_len_nonempty
          WaypointManager_axioms hd_conv_nth y4)
    then have y8:
      "\<forall>j<Suc len. (j = 0 \<longrightarrow> Some (win ! j) = find_waypoint ws i)
      \<and> (j = 1 \<longrightarrow> Some (win ! j) = find_waypoint ws (get_nextwp (hd win)))" using y6 y4
      by (metis One_nat_def Suc.prems hd_Cons_tl nth_Cons_Suc
          waypoint_window_aux_success_len_nonempty y1)
    then have
      "\<forall>j<len. (0 < j \<longrightarrow> Some (tl win ! j) = find_waypoint ws (get_nextwp (tl win ! (j - 1))))"
      using y6 y7 by auto
    then have "\<forall>j<len. (0 < j \<longrightarrow> Some (win ! (j + 1)) = find_waypoint ws (get_nextwp (win ! j )))"
      by (metis (no_types, hide_lams) One_nat_def Suc(2) Suc_pred' add.right_neutral add_Suc_right
          hd_Cons_tl nth_Cons_Suc waypoint_window_aux_success_len_nonempty)
    then have
      "\<forall>j<Suc len. (1 < j \<longrightarrow> Some (win ! j ) = find_waypoint ws (get_nextwp (win ! (j - 1) )))"
      by (metis One_nat_def Suc_lessE Suc_less_eq
          add.right_neutral add_Suc_right diff_Suc_Suc diff_zero)
    thus ?case using y8
      by (metis Suc_diff_1 Suc_eq_plus1_left diff_self_eq_0 linorder_neqE_nat not_add_less1
          option.inject plus_nat.add_0 y4)
  qed
qed

(* Make the last waypoint in the segment refer to itself. *)
fun waypoints_window :: "'w list \<Rightarrow> 'id \<Rightarrow> nat \<Rightarrow> ('w list) option" where
  "waypoints_window ws i len =
    (case waypoints_window_aux ws i len of
      None \<Rightarrow> None
    | Some ws \<Rightarrow> Some (butlast ws @ [ update_nextwp (last ws) (get_number (last ws)) ]))"

(* After correcting self-looping the last element the only difference in the segments is the last
 * waypoint. *)
lemma waypoints_window_aux_to_waypoints_window_success_rel:
"Some win' = waypoints_window_aux ws i len
\<Longrightarrow> Some win = waypoints_window ws i len
\<Longrightarrow> win = butlast win' @ [ update_nextwp (last win') (get_number (last win')) ]"
  apply(cases rule:waypoints_window_aux.elims) by (auto split: option.splits)

(* If we can get a segment we can get a self-looped segment. *)
lemma waypoints_window_aux_to_waypoints_window_success:
"Some win' = waypoints_window_aux ws i len
\<Longrightarrow> \<exists> win. Some win = waypoints_window ws i len
    \<and> win = butlast win' @ [ update_nextwp (last win') (get_number (last win')) ]"
  apply(cases rule:waypoints_window_aux.elims)
     apply(auto split: option.splits)
  by metis+

(* The nextwp field of all but the last waypoint in a segment returned
 * from waypoints_window_aux_is_wf can be found in the segment. *)
lemma waypoints_window_aux_is_wf:
  "Some win = waypoints_window_aux ws i len
  \<Longrightarrow>  (\<forall> w'. List.member (butlast win) w' \<longrightarrow> (\<exists> w. Some w = find_waypoint win (get_nextwp w')))"
proof(induct len arbitrary: i win)
  case 0
  then show ?case using waypoint_window_aux_success_len_nonempty by auto
next
  case (Suc len)
  then have "len = 0 \<or> 0 < len" by auto
  thus ?case
  proof
    assume "len = 0"
    thus ?case by (metis One_nat_def Suc.prems(1)
                   WaypointManager.waypoints_window_aux_success_length WaypointManager_axioms
                   cancel_comm_monoid_add_class.diff_cancel
                   length_0_conv length_butlast member_rec(2))
  next
    assume "0 < len"
    then obtain len' where y1:"len = Suc len'"  using Suc_pred' by blast
    then have y2:"waypoints_window_aux ws i (Suc (Suc len')) = Some win" using Suc by auto
    then have y3:"find_waypoint ws i = Some (hd win)
                  \<and> waypoints_window_aux ws (get_nextwp (hd win)) (Suc len') = Some (tl win)"
      using waypoints_window_aux_success_more_than_one y2 by auto
    then have y4:"find_waypoint ws i = Some (hd win)"
      and y5:"waypoints_window_aux ws (get_nextwp (hd win)) (Suc len') = Some (tl win)"
      by auto
    then have y6:"Some (tl win) = waypoints_window_aux ws (get_nextwp (hd win)) len" using y1
      by auto
    then have y7:"\<forall> w'. List.member (butlast (tl win)) w'
                  \<longrightarrow> (\<exists> w. Some w = find_waypoint (tl win) (get_nextwp w'))"
      using Suc(1)[OF y6] by auto
    then have y8:"\<forall> w'. List.member (butlast (tl win)) w'
                  \<longrightarrow> (\<exists> w. Some w = find_waypoint win (get_nextwp w'))"
      by (metis Nitpick.size_list_simp(2) WaypointManager.waypoints_window_aux_success_length
          find_waypoint_extend WaypointManager_axioms list.collapse old.nat.distinct(2) y2)
   then have y9:"Some (hd (tl win)) = find_waypoint (tl win) (get_nextwp (hd win))"
     by (metis (mono_tags, lifting) Nitpick.size_list_simp(2) find.simps(2) find_waypoint_correct
         find_waypoint_def list.exhaust_sel old.nat.distinct(2)
         waypoint_window_aux_find_waypoint_hd waypoints_window_aux_success_length y1 y6)
   then have y10:"Some (hd (tl win)) = find_waypoint win (get_nextwp (hd win))"
     by (metis Suc.prems find.simps(2) find_waypoint_correct find_waypoint_def list.exhaust_sel
         waypoint_window_aux_find_waypoint_hd waypoint_window_aux_success_len_nonempty y4 y6)
   then have y11:"\<forall> w'. List.member ((hd win)#(butlast (tl win))) w'
                  \<longrightarrow> (\<exists> w. Some w = find_waypoint win (get_nextwp w'))"
     by (metis y8 member_rec(1))
   then have y12:"\<forall> w'. List.member (butlast ((hd win)#(tl win))) w'
                  \<longrightarrow> (\<exists> w. Some w = find_waypoint win (get_nextwp w'))"
     by (simp add: member_rec(2))
   then have y13:"\<forall> w'. List.member (butlast win) w'
                  \<longrightarrow> (\<exists> w. Some w = find_waypoint win (get_nextwp w'))"
     by (metis find_waypoint_success_membership list.exhaust_sel member_rec(2) y10)
   thus ?case by auto
  qed
qed

(* A suffix can be added to find_Waypoint and not impact validity. *)
lemma find_waypoint_success_suffix:
  "Some w = find_waypoint win i \<Longrightarrow> Some w = find_waypoint (win@winsuf) i"
   using find_waypoint_ignores_dup_matches prefixI by blast

(* Modifying the last elements nextwp field preserves find_waypoint success. *)
lemma find_waypoint_success_mod_last_nextwp:
"Some w = find_waypoint win i
  \<Longrightarrow> \<exists> w. Some w = find_waypoint ((butlast win)@[ update_nextwp (last win) x]) i"
proof(induct win arbitrary: i)
  case Nil
  then show ?case  using find_waypoint_succuss by fastforce
next
  case (Cons a win)
  then have "get_number a = i \<or> get_number a \<noteq> i" by auto
  thus ?case
  proof
    assume "get_number a = i"
    thus ?case using find_waypoint_success_suffix Cons  by (simp add: find_waypoint_def)
  next
    assume "get_number a \<noteq> i"
    then have "Some w = find_waypoint win i" using Cons by (simp add: find_waypoint_def)
    then have "\<exists> w. Some w = find_waypoint ((butlast win)@[ update_nextwp (last win) x]) i"
      using Cons by auto
    thus ?case using Cons find_waypoint_def by auto
  qed
qed

(* Membership property extension. *)
lemma prop_on_list_prop_on_tl:
  "\<forall>w. List.member ws w \<longrightarrow> P w \<Longrightarrow>  P w' \<Longrightarrow> \<forall>w. List.member (ws@[w']) w \<longrightarrow> P w"
  apply (induct ws) by (simp add: member_rec(1))+

(* A self loop can be added safely. *)
lemma add_self_loop_suffix:
  assumes a1:"get_number x = get_nextwp x"
    and a2:"(\<forall> w'. List.member ws1 w' \<longrightarrow> (\<exists> w. Some w = find_waypoint (ws1@[x]) (get_nextwp w')))"
  shows
    "(\<forall> w'. List.member (ws1@[x]) w' \<longrightarrow> (\<exists> w. Some w = find_waypoint (ws1@[x]) (get_nextwp w')))"
proof -
  have y1:"\<exists> w. Some w = find_waypoint (ws1@[x]) (get_nextwp x)"
  proof (induct ws1)
    case Nil
    then show ?case by (simp add: a1 find_waypoint_def)
  next
    case (Cons a ws1)
    then have "get_number a = (get_nextwp x) \<or> get_number a \<noteq> (get_nextwp x)" by auto
    thus ?case
    proof
      assume "get_number a = (get_nextwp x)"
      thus ?case by (simp add: find_waypoint_def)
    next
      assume "get_number a \<noteq> (get_nextwp x)"
      thus ?case by (metis (mono_tags, lifting) Cons append_Cons find_waypoint_extend)
    qed
  qed
  thus ?thesis using prop_on_list_prop_on_tl[OF a2 y1] by blast
qed

(* A successful call to waypoint_window returns a well-formed waypoint segment. *)
lemma waypoints_window_is_wf: "Some win = waypoints_window ws i len \<Longrightarrow>  waypoints_wf win"
proof -
  assume a1:"Some win = waypoints_window ws i len"
  then obtain win' where y1:"Some win' = waypoints_window_aux ws i len"
    using option.splits
    by (metis (no_types, lifting) not_Some_eq option.simps(4) waypoints_window.simps)
  then have y2:"butlast win' @ [ update_nextwp (last win') (get_number (last win')) ] = win"
    using a1 waypoints_window_aux_to_waypoints_window_success_rel by blast
  then have y3:"(\<forall> w'. List.member (butlast win') w'
                \<longrightarrow> (\<exists> w. Some w =
                        find_waypoint
                          (butlast win' @ [ update_nextwp (last win') (get_number (last win')) ])
                          (get_nextwp w')))"
    using waypoints_window_aux_is_wf y1 find_waypoint_success_mod_last_nextwp by blast
  then have y4:
    "(\<forall> w'. List.member
              (butlast win' @ [ update_nextwp (last win') (get_number (last win')) ])
              w'
    \<longrightarrow> (\<exists> w. Some w =
                find_waypoint
                  (butlast win' @ [ update_nextwp (last win') (get_number (last win')) ])
                  (get_nextwp w')))"
    using add_self_loop_suffix[OF _ y3] by auto
  thus ?thesis using y2 waypoints_wf_def by auto
qed
end

end